OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
gray21.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!|| gray21 ../engine/source/materials/mat/mat016/gray21.F
25!||--- called by ------------------------------------------------------
26!|| gray20 ../engine/source/materials/mat/mat016/gray20.F
27!||====================================================================
28 SUBROUTINE gray21(
29 1 PM, RHO, TEMP, XIST,
30 2 MAT, RHO0, DSP, ALP,
31 3 PCR, P1, EGG, XIST0,
32 4 XLAM, EM0, EM1, EM2,
33 5 ESPE, GEAX, G0AX, TM,
34 6 DELT, RP3, X, GP,
35 7 NEL)
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NEL
52 my_real
53 . PM(NPROPM,*), RHO(*), TEMP(*), XIST(*), RHO0(*), DSP(*), ALP(*), PCR(*), P1(*),
54 . EGG(*), XIST0(*), XLAM(*), EM0(*), EM1(*), EM2(*),
55 . ESPE(*), GEAX(*), G0AX(*), TM(*),
56 . DELT(*), RP3(*), X(*), GP(*)
57 INTEGER MAT(*)
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, MX
62 my_real
63 . P(MVSIZ), XNU(MVSIZ),
64 . vj, xj, c1,
65 . c2, c3, d1, d2, d3, thet, apy, vb, z, zj, tz, tzj, fe, a2, bb,
66 . cc, fp, v1, xm, unmm2
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70
71 !-----------------------------
72 !
73 ! BRANCHEMENTS
74 !
75 !-----------------------------
76 unmm2 = -o88p9844 + two
77 xm = ninep38
78
79 DO i=1,nel
80 mx = mat(i)
81 vj = pm(56,mx)
82 xj = one-rho0(i)*vj
83
84 !--------------------------------------
85 IF(x(i)<xj.AND.xist0(i)/=five)THEN
86 !--------------------
87 ! LIQUIDE-VAPEUR
88 !--------------------
89 xist(i) = four
90 c1 = pm(57,mx)
91 c2 = pm(58,mx)
92 c3 = pm(59,mx)
93 d1 = pm(60,mx)
94 d2 = pm(24,mx)
95 d3 = pm(25,mx)
96 thet = pm(26,mx)
97 apy = pm(27,mx)
98 vb = pm(28,mx)
99 z = vb*rho(i)
100 zj = vb/vj
101 tz = thet-z
102 tzj = thet-zj
103 fe = (tzj**3*(two*z-two+thet)/tz**2-tz*(two*zj-two+thet))*half*vb/zj**3
104 a2 = four*(d3-c3*fe)
105 bb = rp3(i)+two*d2
106 cc = two*(d1+c1*fe-espe(i)-apy*z/vb)
107 IF(a2==zero)THEN
108 temp(i) = -cc/bb
109 ELSE
110 temp(i) =(-bb+sqrt(bb**2- two*a2*cc))/a2
111 ENDIF
112 fp = (z*tzj/(zj*tz))**3
113 p(i) = rp3(i)*temp(i)*z*(one+z+z**2-z**3)/(three*vb*(one-z)**3)
114 . -apy*z**2/vb**2
115 . +fp*(c1+c2*temp(i)+c3*temp(i)**2)
116 p1(i) = zero
117 pcr(i) = p(i)*two/rho(i)
118
119 ELSEIF(espe(i)<=em1(i).OR.xist0(i)==five) THEN
120 !--------------------
121 ! SOLIDE
122 !--------------------
123 xist(i) = zero
124 a2 = gp(i)
125 bb = rp3(i)
126 cc = -em0(i)
127 IF(a2==zero)THEN
128 temp(i) = -cc/bb
129 pcr(i) = zero
130 ELSE
131 temp(i) = (-bb+sqrt(bb**2-two*a2*cc))/a2
132 pcr(i) = geax(i)*temp(i)**2
133 ENDIF
134
135 ELSEIF(espe(i)<em2(i)) THEN
136 !--------------------
137 ! FUSION 2 PHASES
138 !--------------------
139 xist(i) = one
140 xnu(i) = (espe(i)-em1(i))/(em2(i)-em1(i))
141 v1 = dsp(i)-alp(i)
142 a2 = gp(i)
143 bb = rp3(i)+xnu(i)*v1
144 cc = -(em0(i)+xnu(i)**2*delt(i)*v1)
145 IF(a2==zero)THEN
146 temp(i) = -cc/bb
147 pcr(i) = -two*xnu(i)*v1*(xlam(i)*tm(i)+(temp(i)-xnu(i)*delt(i))*g0ax(i))
148 ELSE
149 temp(i) = (-bb+sqrt(bb**2-two*a2*cc))/a2
150 pcr(i) = geax(i)*temp(i)**2-two*xnu(i)*v1*(xlam(i)*tm(i)+(temp(i)-xnu(i)*delt(i))*g0ax(i))
151 ENDIF
152
153 ELSEIF(espe(i)<=egg(i)) THEN
154 !--------------------
155 ! LIQUIDE
156 !--------------------
157 xist(i) = two
158 a2 = gp(i)-alp(i)/tm(i)
159 bb = rp3(i)
160 cc = -(em0(i)-tm(i)*(dsp(i)-half*alp(i)))
161 IF(a2==zero)THEN
162 temp(i) = -cc/bb
163 pcr(i) = -tm(i)*(xlam(i)+g0ax(i))*(two*dsp(i)-alp(i)*(one+temp(i)**2/tm(i)**2))
164 ELSE
165 temp(i) = (-bb+sqrt(bb**2-2.*a2*cc))/a2
166 pcr(i) = geax(i)*temp(i)**2-tm(i)*(xlam(i)+g0ax(i))*(two*dsp(i)-alp(i)*(one+temp(i)**2/tm(i)**2))
167 ENDIF
168
169 ELSE
170 !--------------------
171 ! LIQUIDE-CHAUD
172 !--------------------
173 xist(i) = three
174 a2 = gp(i)
175 bb = rp3(i)-xm*alp(i)
176 cc = -(em0(i)-tm(i)*(dsp(i)-half*alp(i)*unmm2))
177 IF(a2==zero)THEN
178 temp(i) = -cc/bb
179 pcr(i) = -tm(i)*( two*dsp(i)-alp(i)*(unmm2+two*xm*temp(i)/tm(i)) )*(xlam(i)+g0ax(i))
180 ELSE
181 temp(i) = (-bb+sqrt(bb**2-two*a2*cc))/a2
182 pcr(i) = geax(i)*temp(i)**2-tm(i)*(two*dsp(i)-alp(i)*(unmm2+2.*xm*temp(i)/tm(i)))*(xlam(i)+g0ax(i))
183 ENDIF
184
185 !--------------------
186
187 ENDIF
188 !--------------------------------------
189 ENDDO !next I
190
191 RETURN
192 END
gray21
subroutine gray21(pm, rho, temp, xist, mat, rho0, dsp, alp, pcr, p1, egg, xist0, xlam, em0, em1, em2, espe, geax, g0ax, tm, delt, rp3, x, gp, nel)
Definition gray21.F:36