OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mqvisc26.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 "scr02_c.inc"
#include "scr07_c.inc"
#include "scr17_c.inc"
#include "scr18_c.inc"
#include "param_c.inc"
#include "cong1_c.inc"
#include "units_c.inc"
#include "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine mqvisc26 (pm, off, rho, rk, t, ssp, re, sti, dt2t, neltst, ityptst, aire, offg, geo, pid, vol, vd2, deltax, vis, d1, d2, d3, pnew, psh, mat, ngl, qvis, ssp_eq, xk, nel, ity, ismstr, jtur, jthe)

Function/Subroutine Documentation

◆ mqvisc26()

subroutine mqvisc26 ( pm,
off,
rho,
rk,
t,
ssp,
re,
sti,
dt2t,
integer neltst,
integer ityptst,
aire,
offg,
geo,
integer, dimension(*) pid,
vol,
vd2,
deltax,
vis,
d1,
d2,
d3,
pnew,
psh,
integer, dimension(*) mat,
integer, dimension(*) ngl,
qvis,
ssp_eq,
xk,
integer, intent(in) nel,
integer, intent(in) ity,
integer, intent(in) ismstr,
integer, intent(in) jtur,
integer, intent(in) jthe )

Definition at line 28 of file mqvisc26.F.

38C============================================================================
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42#include "comlock.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "com08_c.inc"
53#include "scr02_c.inc"
54#include "scr07_c.inc"
55#include "scr17_c.inc"
56#include "scr18_c.inc"
57#include "param_c.inc"
58#include "cong1_c.inc"
59#include "units_c.inc"
60#include "impl1_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER, INTENT(IN) :: NEL
65 INTEGER, INTENT(IN) :: ITY
66 INTEGER, INTENT(IN) :: ISMSTR
67 INTEGER, INTENT(IN) :: JTUR
68 INTEGER, INTENT(IN) :: JTHE
69 INTEGER NELTST,ITYPTST,PID(*),MAT(*), NGL(*)
70 my_real dt2t
71 my_real
72 . pm(npropm,*), off(*), rho(*), rk(*), t(*), re(*),sti(*),
73 . offg(*),geo(npropg,*),
74 . vol(*), vd2(*), deltax(*), ssp(*), aire(*), vis(*),
75 . psh(*), pnew(*),qvis(*) ,ssp_eq(*),
76 . d1(*), d2(*), d3(*), xk(*)
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I,J, MT, K, MX
81C REAL
82 my_real
83 . dd(mvsiz), al(mvsiz),
84 . dtx(mvsiz), ad(mvsiz), qx(mvsiz), cx(mvsiz),
85 . qa, qb, visi, facq,qaa,
86 . cns1, cns2, sph, ak1, bk1, ak2, bk2, tli, akk, xmu, tmu, rpr,
87 . atu, qad, qbd, qaap
88 my_real
89 . tidt,tvol,trho,taire
90C=======================================================================
91 IF(impl == 0)THEN
92 DO i=1,nel
93 dd(i)=-d1(i)-d2(i)-d3(i)
94 ad(i)=zero
95 al(i)=zero
96 cx(i)=ssp(i)+sqrt(vd2(i))
97 ENDDO
98 IF(impl_s>0)THEN
99 visi=zero
100 facq=zero
101 ELSE
102 visi=one
103 facq=one
104 ENDIF
105 ELSE
106 DO i=1,nel
107 dd(i)=-d1(i)-d2(i)-d3(i)
108 ad(i)=zero
109 al(i)=zero
110 cx(i)=sqrt(vd2(i))
111 ENDDO
112 visi=zero
113 facq=zero
114 ENDIF
115C
116 IF(n2d>0) THEN
117 DO i=1,nel
118 IF(off(i)==1.)THEN
119 al(i)=sqrt(aire(i))
120 ad(i)= max(zero,dd(i))
121 ENDIF
122 ENDDO
123 ELSE
124 DO i=1,nel
125 IF(off(i)==1.)THEN
126 al(i)=vol(i)**third
127 ad(i)= max(zero,dd(i))
128 ENDIF
129 ENDDO
130 ENDIF
131C
132 IF(invstr>=35)THEN
133 mt = mat(1)
134 mx = pid(1)
135 qa =facq*geo(14,mx)
136 qb =facq*geo(15,mx)
137 cns1=geo(16,mx)
138 DO i=1,nel
139 cns2=geo(17,mx)*ssp(i)*al(i)*rho(i)
140 psh(i)=pm(88,mt)
141 pnew(i)=0.
142 qaa = qa*qa*ad(i)
143 qx(i)=(qb+cns1)*ssp(i)+al(i) * qaa
144 . + visi*(two*vis(i)+cns2) / max(em20,rho(i)*deltax(i))
145 qvis(i)=rho(i)*ad(i)*al(i)*(qaa*al(i)+qb*ssp(i))
146 ENDDO
147 ELSE
148 mt = mat(1)
149 qa =facq*pm(2,mt)
150 qb =facq*pm(3,mt)
151 cns1=pm(93,mt)
152 DO i=1,nel
153 cns2=pm(94,mt)*ssp(i)*al(i)*rho(i)
154 psh(i)=pm(88,mt)
155 pnew(i)=0.
156 qaa = qa*qa*ad(i)
157 qx(i)=(qb+cns1)*ssp(i)+deltax(i) *qaa
158 . + visi*(2.*vis(i)+cns2) / max(em20,rho(i)*deltax(i))
159 qvis(i)=rho(i)*ad(i)*al(i)*(qaa*al(i)+qb*ssp(i))
160 ENDDO
161 ENDIF
162C
163C
164 DO i=1,nel
165 ssp_eq(i) = max(em20,qx(i)+sqrt(qx(i)*qx(i)+cx(i)*cx(i)))
166 dtx(i) = deltax(i) / ssp_eq(i)
167 ENDDO
168C
169 IF(jthe==1)THEN
170 mt = mat(1)
171 sph = pm(69,mt)
172 ak1 = pm(75,mt)
173 bk1 = pm(76,mt)
174 ak2 = pm(77,mt)
175 bk2 = pm(78,mt)
176 tli = pm(80,mt)
177 DO i=1,nel
178 IF(t(i)<tli)THEN
179 akk=ak1+bk1*t(i)
180 ELSE
181 akk=ak2+bk2*t(i)
182 ENDIF
183 akk = akk+xk(i)
184 IF(jtur/=0)THEN
185 xmu = rho(i)*pm(24,mt)
186 tmu = pm(81,mt)
187 rpr = pm(95,mt)
188 atu=rpr*tmu*rk(i)*rk(i)/(max(em15,re(i)*vol(i))*xmu)
189 akk=akk*(one+atu)
190 ENDIF
191 dtx(i) = min(dtx(i),half*deltax(i)*deltax(i)*sph/max(akk,em20))
192 ENDDO
193 ENDIF
194C
195 DO 60 i=1,nel
196 sti(i) = zero
197 IF(off(i)==zero.OR.offg(i)<zero) GO TO 60
198 IF(n2d==0) THEN
199 tidt = 1./dtx(i)
200 trho = rho(i) * tidt
201 tvol = vol(i) * tidt
202 sti(i) = fourth * trho * tvol
203 ELSE
204 tidt = 1./dtx(i)
205 trho = rho(i) * tidt
206 taire = aire(i) * tidt
207 sti(i) = half * trho * taire
208 ENDIF
209 dtx(i)= dtfac1(ity)*dtx(i)
210 IF(nodadt==0)dt2t= min(dtx(i),dt2t)
211 60 CONTINUE
212C
213 IF(idtmin(ity)==1)THEN
214 DO 70 i=1,nel
215 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero.
216 . or.offg(i)<zero) GO TO 70
217 tstop = tt
218#include "lockon.inc"
219 WRITE(iout,*)
220 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
221 WRITE(istdo,*)
222 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
223#include "lockoff.inc"
224 70 CONTINUE
225 ELSEIF(idtmin(ity)==2)THEN
226 DO 75 i=1,nel
227 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero.
228 . or.offg(i)<zero) GO TO 75
229 off(i) = 0.0
230#include "lockon.inc"
231 WRITE(iout,*)
232 . ' -- DELETE SOLID ELEMENTS',ngl(i)
233 WRITE(istdo,*)
234 . ' -- DELETE SOLID ELEMENTS',ngl(i)
235#include "lockoff.inc"
236 idel7nok = 1
237 75 CONTINUE
238 ELSEIF(idtmin(ity)==3.AND.ismstr==2)THEN
239 DO 76 i=1,nel
240 IF(dtx(i)>dtmin1(ity).OR.
241 . off(i)<one.OR.offg(i)==two) GO TO 76
242 offg(i) = two
243#include "lockon.inc"
244 WRITE(iout,*)
245 . '-- CONSTANT TIME STEP FOR SOLID ELEMENT NUMBER ',ngl(i)
246 WRITE(istdo,*)
247 . '-- CONSTANT TIME STEP FOR SOLID ELEMENT NUMBER ',ngl(i)
248#include "lockoff.inc"
249 76 CONTINUE
250 ELSEIF(idtmin(ity)==5)THEN
251 DO 570 i=1,nel
252 IF(dtx(i)>dtmin1(ity).OR.off(i)==zero.
253 . or.offg(i)<zero) GO TO 570
254 mstop = 2
255#include "lockon.inc"
256 WRITE(iout,*)
257 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
258 WRITE(istdo,*)
259 . ' **ERROR : TIME STEP LESS OR EQUAL DTMIN FOR SOLID ELEMENTS'
260#include "lockoff.inc"
261 570 CONTINUE
262 ENDIF
263C
264 IF(nodadt==0)THEN
265 DO 80 i=1,nel
266 IF(dtx(i)>dt2t.OR.off(i)<=zero.OR.offg(i)<=zero)GOTO 80
267 dt2t = dtx(i)
268 neltst =ngl(i)
269 ityptst=ity
270 80 CONTINUE
271 ENDIF
272C
273 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