OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lszk.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!|| lszk ../common_source/eos/lszk.F
25!||--- called by ------------------------------------------------------
26!|| eosmain ../common_source/eos/eosmain.F
27!||====================================================================
28 SUBROUTINE lszk ( IFLAG,NEL ,PM ,OFF ,EINT ,MU ,
29 2 ESPE ,DVOL ,DF ,VNEW ,MAT ,PSH ,
30 3 PNEW ,DPDM ,DPDE )
31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34C
35C-----------------------------------------------
36C D e s c r i p t i o n
37C-----------------------------------------------
38C This subroutine contains numerical solving
39C of LSZK EOS
40C Landau Stanyukovich Zeldovich Kompaneet
41!----------------------------------------------------------------------------
42!! \details STAGGERED SCHEME IS EXECUTED IN TWO PASSES IN EOSMAIN : IFLG=0 THEN IFLG=1
43!! \details COLLOCATED SCHEME IS DOING A SINGLE PASS : IFLG=2
44!! \details
45!! \details STAGGERED SCHEME
46!! \details EOSMAIN / IFLG = 0 : DERIVATIVE CALCULATION FOR SOUND SPEED ESTIMATION c[n+1] REQUIRED FOR PSEUDO-VISCOSITY (DPDE:partial derivative, DPDM:total derivative)
47!! \details MQVISCB : PSEUDO-VISCOSITY Q[n+1]
48!! \details MEINT : INTERNAL ENERGY INTEGRATION FOR E[n+1] : FIRST PART USING P[n], Q[n], and Q[n+1] CONTRIBUTIONS
49!! \details EOSMAIN / IFLG = 1 : UPDATE P[n+1], T[N+1]
50!! \details INTERNAL ENERGY INTEGRATION FOR E[n+1] : LAST PART USING P[n+1] CONTRIBUTION
51!! \details (second order integration dE = -P.dV where P = 0.5(P[n+1] + P[n]) )
52!! \details COLLOCATED SCHEME
53!! \details EOSMAIN / IFLG = 2 : SINGLE PASS FOR P[n+1] AND DERIVATIVES
54!----------------------------------------------------------------------------
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59#include "comlock.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "param_c.inc"
64#include "com04_c.inc"
65#include "com06_c.inc"
66#include "com08_c.inc"
67#include "vect01_c.inc"
68#include "scr06_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER MAT(NEL), IFLAG, NEL
73 my_real PM(NPROPM,NUMMAT),
74 . off(nel) ,eint(nel) ,mu(nel) ,
75 . espe(nel) ,dvol(nel) ,df(nel) ,
76 . vnew(nel) ,pnew(nel) ,dpdm(nel),
77 . dpde(nel)
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, MX
82 my_real :: P0,PSH(NEL),GAMMA,E0,AA,BB,DVV,PP,AR0B,B,PC
83C-----------------------------------------------
84C S o u r c e L i n e s
85C-----------------------------------------------
86 IF(iflag == 0) THEN
87 mx = mat(1)
88 e0 = pm(23,mx)
89 gamma = pm(34,mx)
90 p0 = pm(32,mx)
91 psh(1:nel) = pm(88,mx)
92 ar0b = pm(35,mx)
93 b = pm(36,mx)
94 pc = pm(37,mx)
95 DO i=1,nel
96 pp = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
97 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pp !total derivative
98 dpde(i) = (gamma-one)*(one+mu(i)) !partial derivative
99 pnew(i) = max(pp,pc)*off(i) ! P(mu[n+1],E[n])
100 pnew(i) = pnew(i) - psh(i)
101 ENDDO
102
103 ELSEIF(iflag == 1) THEN
104 mx = mat(1)
105 e0 = pm(23,mx)
106 gamma = pm(34,mx)
107 p0 = pm(32,mx)
108 psh(1:nel) = pm(88,mx)
109 ar0b = pm(35,mx)
110 b = pm(36,mx)
111 pc = pm(37,mx)
112 DO i=1,nel
113 bb = (gamma-one)*(one+mu(i))
114 dpde(i) = bb
115 aa = ar0b*exp(b*log(one+mu(i)))
116 dvv = half*dvol(i)*df(i) / max(em15,vnew(i))
117 pnew(i) = (aa + bb*espe(i) ) / (one+bb*dvv)
118 pnew(i) = max(pnew(i),pc)*off(i) ! P(mu[n+1],E[n+1])
119 eint(i) = eint(i) - half*dvol(i)*(pnew(i))
120 pnew(i) = pnew(i) - psh(i)
121 ENDDO
122
123 ELSEIF (iflag == 2) THEN
124 mx = mat(1)
125 e0 = pm(23,mx)
126 gamma = pm(34,mx)
127 p0 = pm(32,mx)
128 psh(1:nel) = pm(88,mx)
129 ar0b = pm(35,mx)
130 b = pm(36,mx)
131 DO i=1, nel
132 IF (vnew(i) > zero) THEN
133 pnew(i) = (gamma-one)*(one+mu(i))*espe(i) + ar0b*exp(b*log(one+mu(i)))
134 dpdm(i) = (gamma-one)*espe(i)+ar0b*b/(one+mu(i))*exp((b-one)*log(one+mu(i)))+(gamma-one)*df(i)*pnew(i) !total derivative
135 dpde(i) = (gamma-one)*(one+mu(i)) !partial derivative
136 pnew(i) = pnew(i)-psh(i)
137 ENDIF
138 ENDDO
139
140 ENDIF
141
142C-----------------------------------------------
143 RETURN
144 END
lszk
subroutine lszk(iflag, nel, pm, off, eint, mu, espe, dvol, df, vnew, mat, psh, pnew, dpdm, dpde)
Definition lszk.F:31
max
#define max(a, b)
Definition macros.h:21