OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fmqviscb.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "cong1_c.inc"
#include "impl1_c.inc"
#include "param_c.inc"
#include "scr02_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine fmqviscb (nel, pm, geo, pid, mat, ngl, neltst, ityptst, dt2t, uvar, ssp, off, offg, aire, deltax, vis, vd2, qvis, ity, ismstr)

Function/Subroutine Documentation

◆ fmqviscb()

subroutine fmqviscb ( integer nel,
pm,
geo,
integer, dimension(*) pid,
integer, dimension(*) mat,
integer, dimension(*) ngl,
integer neltst,
integer ityptst,
dt2t,
uvar,
ssp,
off,
offg,
aire,
deltax,
vis,
vd2,
qvis,
integer, intent(in) ity,
integer, intent(in) ismstr )

Definition at line 30 of file fmqviscb.F.

36C============================================================================
37C-----------------------------------------------
38C G l o b a l P a r a m e t e r s
39C-----------------------------------------------
40 USE ale_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "comlock.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "com08_c.inc"
56#include "cong1_c.inc"
57#include "impl1_c.inc"
58#include "param_c.inc"
59#include "scr02_c.inc"
60#include "scr07_c.inc"
61#include "scr17_c.inc"
62#include "scr18_c.inc"
63#include "units_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER, INTENT(IN) :: ITY
68 INTEGER, INTENT(IN) :: ISMSTR
69C
70 INTEGER NELTST,ITYPTST,PID(*),MAT(*),NEL,NGL(*)
71 my_real dt2t
72 my_real pm(npropm,nummat),
73 . geo(npropg,numgeo),deltax(*),ssp(*),
74 . aire(*),qvis(*),vis(*),uvar(nel,*),off(*),vd2(*),offg(*)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,J, MT, K,ICOUNT,LIST(MVSIZ),ERROR, ALE_OR_EULER
79 my_real al(mvsiz),
80 . dtx(mvsiz), ad(mvsiz), qx(mvsiz), cx(mvsiz),ssp_eq(mvsiz),
81 . rho0(mvsiz),dtmin(mvsiz),qa, qb, visi, facq,qaa,
82 . cns1, cns2, sph, ak1, bk1, ak2, bk2,
83 . tli, akk, xmu, tmu, rpr,
84 . atu, qad, qbd, qaap,dd
85 my_real tidt,tvol,trho,taire, dtinv
86C-----------------------------------------------
87
88 ! by default don't apply /DT/NODA/* to ALE/EULER cells ; unless if /DT/NODA/ALEON is enabled (hidden card introduced for backward compatibility)
89 mt = mat(1)
90 ale_or_euler = 0
91 IF(nint(pm(72,mt))==1 .OR. nint(pm(72,mt))==2)ale_or_euler = 1
92 IF( ale%GLOBAL%I_DT_NODA_ALE_ON==1)ale_or_euler = 0
93
94 dtinv = dt1 / max(em20 , dt1**2)
95 IF(impl==zero)THEN
96 DO i=1,nel
97 ad(i)=zero
98 al(i)=zero
99 cx(i)=ssp(i)+sqrt(vd2(i))
100 ENDDO
101 ENDIF
102
103 visi=one
104 facq=one
105
106 IF(n2d>0) THEN
107 mt = mat(1)
108 DO i=1,nel
109 IF(off(i)==one)THEN
110 al(i)=sqrt(aire(i))
111 rho0(i)=pm(192,mt)
112 dd = qvis(i) ! volumic strain
113 ad(i)= max(zero,dd)
114 ENDIF
115 ENDDO
116 ELSE
117 mt = mat(1)
118 DO i=1,nel
119 IF(off(i)==one)THEN
120 al(i)=uvar(i,3)**third
121 rho0(i)=pm(192,mt)
122 dd = qvis(i) ! volumic strain
123 ad(i)= max(zero,dd)
124 ENDIF
125 ENDDO
126 ENDIF
127C
128 DO i=1,nel
129 qa =facq*geo(14,pid(i))
130 qb =facq*geo(15,pid(i))
131 cns1=geo(16,pid(i))
132 cns2=geo(17,pid(i))*ssp(i)*al(i)*uvar(i,1)
133 qaa = qa*qa*ad(i)
134 qx(i)=(qb+cns1)*ssp(i)+deltax(i) * qaa + visi*(two*vis(i)+cns2) / max(em20,uvar(i,1)*deltax(i))
135 qvis(i)=uvar(i,1)*ad(i)*al(i)*(qaa*al(i)+qb*ssp(i))
136 dtmin(i) = geo(172,pid(i))
137 ENDDO
138C
139 DO i=1,nel
140 ssp_eq(i) = max(em20,qx(i)+sqrt(qx(i)*qx(i)+cx(i)*cx(i)))
141 dtx(i) = deltax(i) / ssp_eq(i)
142 ENDDO
143C
144 ! KDTSMSTR==1 en version 5, par defaut.
145 IF(kdtsmstr==1.AND.ismstr==1.OR.(ismstr==2.AND.idtmin(1)==3))THEN
146 DO 50 i=1,nel
147 IF(off(i)==zero.OR.offg(i)<zero) GO TO 50
148 IF(n2d==0) THEN
149 tidt = one/dtx(i)
150 IF(offg(i)>one)THEN
151 trho = rho0(i) * tidt
152 ELSE
153 trho = uvar(i,1) * tidt
154 tvol = uvar(i,3) * tidt
155 END IF
156 !STI will be changed to 2*STI/NNE in SxCUMU
157 ELSE
158 !small strain is not available in 2D analysis
159 tidt = one/dtx(i)
160 trho = uvar(i,1) * tidt
161 taire = aire(i) * tidt
162 ENDIF
163C dt2 replaced with dt2t
164 50 CONTINUE
165 IF(ale_or_euler==0)THEN
166 DO i=1,nel
167 dtx(i)= dtfac1(ity)*dtx(i)
168 ENDDO
169 ELSE
170 DO i=1,nel
171 dtx(i)= dtfac1(102)*dtx(i)
172 ENDDO
173 ENDIF
174 !/DT/NODA & /DT/NODA/CST HAS NO EFFECT WITH ALE/EULER
175 IF(ale_or_euler==1 .OR. nodadt==0)THEN
176 DO i=1,nel
177 IF(off(i)/=zero.AND.offg(i)>=zero)dt2t = min(dtx(i),dt2t)
178 ENDDO
179 ENDIF
180 ELSE
181 DO 60 i=1,nel
182 IF(off(i)==zero.OR.offg(i)<zero) GO TO 60
183 IF(n2d==0) THEN
184 tidt = one/dtx(i)
185 trho = uvar(i,1) * tidt
186 tvol = uvar(i,3) * tidt
187 !STI will be changed to 2*STI/NNE in SxCUMU
188 ELSE
189 tidt = one/dtx(i)
190 trho = uvar(i,1) * tidt
191 taire = aire(i) * tidt
192 ENDIF
193C dt2 remplace par dt2t
194 60 CONTINUE
195 IF(ale_or_euler==0)THEN
196 DO i=1,nel
197 dtx(i)= dtfac1(ity)*dtx(i)
198 ENDDO
199 ELSE
200 DO i=1,nel
201 dtx(i)= dtfac1(102)*dtx(i)
202 ENDDO
203 ENDIF
204 !/DT/NODA & /DT/NODA/CST HAS NO EFFECT WITH ALE/EULER
205 IF(ale_or_euler.eq .1.OR. nodadt==0)THEN
206 DO i=1,nel
207 IF(off(i)/=zero.AND.offg(i)>=zero)dt2t = min(dtx(i),dt2t)
208 ENDDO
209 ENDIF
210 END IF
211C
212 IF(imconv==1)THEN
213 IF(idtmin(ity)==1)THEN
214 error=0
215 DO 70 i=1,nel
216 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero .OR.offg(i)<zero) GO TO 70
217 error=1
218 70 CONTINUE
219
220 IF (error==1) THEN
221 tstop = tt
222#include "lockon.inc"
223 WRITE(iout,*) ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
224 WRITE(istdo,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
225#include "lockoff.inc"
226 ENDIF
227 ELSEIF(idtmin(ity)==2)THEN
228 icount=0
229 DO 75 i=1,nel
230 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero.OR.offg(i)<zero) GO TO 75
231 off(i) = zero
232 icount=icount+1
233 list(icount)=i
234 75 CONTINUE
235
236 DO j=1,icount
237 i = list(j)
238#include "lockon.inc"
239 WRITE(iout,*)' -- DELETE SOLID ELEMENTS',ngl(i)
240 WRITE(istdo,*)' -- DELETE SOLID ELEMENTS',ngl(i)
241#include "lockoff.inc"
242 idel7nok = 1
243 ENDDO
244 ELSEIF(idtmin(ity)==3.AND.ismstr==2)THEN
245 icount = 0
246 DO 76 i=1,nel
247 IF(dtmin(i)/=0) THEN
248 IF(dtx(i)>dtmin(i).OR.off(i)<one.OR.offg(i)<=zero.OR.offg(i)==two) GO TO 76
249 ELSE
250 IF(dtx(i)>dtmin1(ity).OR.off(i)<one.OR.offg(i)<=zero.OR.offg(i)==two) GO TO 76
251 ENDIF
252 offg(i) = two
253 icount=icount+1
254 list(icount)=i
255 76 CONTINUE
256
257 DO j=1,icount
258 i=list(j)
259#include "lockon.inc"
260 WRITE(iout,*)'-- CONSTANT TIME STEP FOR SOLID ELEMENT NUMBER ',ngl(i)
261 WRITE(istdo,*)'-- CONSTANT TIME STEP FOR SOLID ELEMENT NUMBER ',ngl(i)
262#include "lockoff.inc"
263 ENDDO
264 ELSEIF(idtmin(ity)==5)THEN
265 error=0
266 DO 570 i=1,nel
267 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero.
268 . or.offg(i)<zero) GO TO 570
269 error=1
270 570 CONTINUE
271 IF (error==1) THEN
272 mstop = 2
273#include "lockon.inc"
274 WRITE(iout,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
275 WRITE(istdo,*)' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
276#include "lockoff.inc"
277 ENDIF
278 ENDIF
279 END IF ! IF(IMCONV==1)
280C
281 !/DT/NODA & /DT/NODA/CST HAS NO EFFECT WITH ALE/EULER
282 IF(nodadt==0 .OR. ale_or_euler==1)THEN
283 DO 80 i=1,nel
284 IF(dtx(i)>dt2t.OR.off(i)<=zero.OR.offg(i)<=zero) GO TO 80
285C nelts et itypts remplaces par neltst et itypst
286 dt2t = dtx(i)
287 neltst =ngl(i)
288 ityptst=ity
289 80 CONTINUE
290 ENDIF
291
292 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249