OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fmqviscb.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| fmqviscb ../engine/source/materials/mat_share/fmqviscb.F
25!||--- called by ------------------------------------------------------
26!|| mulaw ../engine/source/materials/mat_share/mulaw.F90
27!||--- uses -----------------------------------------------------
28!|| ale_mod ../common_source/modules/ale/ale_mod.F
29!||====================================================================
30 SUBROUTINE fmqviscb(
31 1 NEL, PM, GEO, PID,
32 2 MAT, NGL, NELTST, ITYPTST,
33 3 DT2T, UVAR, SSP, OFF,
34 4 OFFG, AIRE, DELTAX, VIS,
35 5 VD2, QVIS, ITY, ISMSTR)
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
293 END
fmqviscb
subroutine fmqviscb(nel, pm, geo, pid, mat, ngl, neltst, ityptst, dt2t, uvar, ssp, off, offg, aire, deltax, vis, vd2, qvis, ity, ismstr)
Definition fmqviscb.F:36
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