OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
mqvisc26.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!|| mqvisc26 ../engine/source/materials/mat_share/mqvisc26.F
25!||--- called by ------------------------------------------------------
26!|| mmain ../engine/source/materials/mat_share/mmain.F90
27!||====================================================================
28 SUBROUTINE mqvisc26(
29 1 PM, OFF, RHO, RK,
30 2 T, SSP, RE, STI,
31 3 DT2T, NELTST, ITYPTST, AIRE,
32 4 OFFG, GEO, PID, VOL,
33 5 VD2, DELTAX, VIS, D1,
34 6 D2, D3, PNEW, PSH,
35 7 MAT, NGL, QVIS, SSP_EQ,
36 8 XK, NEL, ITY, ISMSTR,
37 9 JTUR, JTHE)
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
274 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
mqvisc26
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)
Definition mqvisc26.F:38