OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
meos8.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!|| meos8 ../engine/source/materials/mat_share/meos8.F
25!||--- called by ------------------------------------------------------
26!|| mmain8 ../engine/source/materials/mat_share/mmain8.F
27!||--- calls -----------------------------------------------------
28!|| mqvisc8 ../engine/source/materials/mat_share/mqvisc8.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!||====================================================================
32 SUBROUTINE meos8(
33 1 PM, OFF, SIG, EINT,
34 2 RHO, QOLD, VOL, RK,
35 3 T, RE, STIFN, NEL,
36 4 D1, D2, D3, VNEW,
37 5 DELTAX, RHO0, DVOL, VD2,
38 6 VIS, MAT, NC, NGL,
39 7 GEO, PID, DT2T, NELTST,
40 8 ITYPTST, OFFG, MSSA, DMELS,
41 9 BUFLY, SSP, ITY, NPT,
42 A JTUR, JTHE, JSMS)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE elbufdef_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "mvsiz_p.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "param_c.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER, INTENT(IN) :: ITY
63 INTEGER, INTENT(IN) :: NPT
64 INTEGER, INTENT(IN) :: JTUR
65 INTEGER, INTENT(IN) :: JTHE
66 INTEGER, INTENT(IN) :: JSMS
67 INTEGER MAT(MVSIZ),NC(8,MVSIZ),NGL(MVSIZ),PID(MVSIZ)
68 INTEGER NEL,NELTST,ITYPTST
69C REAL
70 my_real
71 . PM(NPROPM,*),
72 . off(mvsiz) ,sig(nel,6), eint(nel), rho(nel) , qold(nel),
73 . vol(nel) ,rk(*) , t(*) , re(*) , stifn(*) ,
74 . d1(*) , d2(*) , d3(*) ,
75 . vnew(mvsiz), deltax(mvsiz) , rho0(mvsiz), dvol(mvsiz),
76 . vd2(mvsiz) , vis(mvsiz),geo(npropg,*), dt2t, offg(*),
77 . mssa(*) , dmels(*) , ssp(mvsiz)
78 TYPE (BUF_LAY_), TARGET :: BUFLY
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I,J,II,JPT,IPT,MX,JJ(6)
83C REAL
84 my_real
85 . AMU(MVSIZ), AMU2(MVSIZ), ESPE(MVSIZ),
86 . C1(MVSIZ), C2(MVSIZ), C3(MVSIZ), C4(MVSIZ),
87 . C5(MVSIZ), C6(MVSIZ), G(MVSIZ) , POLD(MVSIZ), DPDM(MVSIZ),
88 . a(mvsiz) , b(mvsiz) , pc(mvsiz), pnew(mvsiz), df(mvsiz),
89 . psh(mvsiz),
90 . dvv
91 my_real,
92 . DIMENSION(:), POINTER :: sigp
93 TYPE(l_bufel_) ,POINTER :: LBUF
94C=======================================================================
95 mx =mat(1)
96C
97 DO j=1,6
98 jj(j) = nel*(j-1)
99 ENDDO
100C
101 DO i=1,nel
102 g(i) =pm(22,mx)
103 c1(i) =pm(31,mx)
104 c2(i) =pm(32,mx)
105 c3(i) =pm(33,mx)
106 c4(i) =pm(34,mx)
107 c5(i) =pm(35,mx)
108 c6(i) =pm(36,mx)
109 pc(i) =pm(37,mx)
110 psh(i) =pm(88,mx)
111 ENDDO
112C
113 DO i=1,nel
114 pold(i)=(sig(i,1)+sig(i,2)+sig(i,3)) * third
115 sig(i,1)=zero
116 sig(i,2)=zero
117 sig(i,3)=zero
118 sig(i,4)=zero
119 sig(i,5)=zero
120 sig(i,6)=zero
121 ENDDO
122C
123 DO i=1,nel
124 df(i) =rho0(i)/rho(i)
125 amu(i) =one/df(i)-one
126 amu2(i)= max(zero,amu(i))**2
127 espe(i)=df(i)*eint(i)/ max(em15,vnew(i))
128 ENDDO
129C--------------------------------------------------
130C VITESSE DU SON APPROCHEE COURANTE
131C--------------------------------------------------
132 DO i=1,nel
133 dpdm(i)=onep333*g(i)
134 . +c2(i)+two*c3(i)*max(zero,amu(i))+three*c4(i)*amu(i)*amu(i)
135 . +c6(i)*espe(i)
136 . +(c5(i)+c6(i)*amu(i))*df(i)*df(i)*
137 . (psh(i)+c1(i)+(c2(i)+c4(i)*amu(i)*amu(i))*amu(i)+c3(i)*amu2(i)+
138 . (c5(i)+c6(i)*amu(i))*espe(i))
139 ENDDO
140C
141 DO i=1,nel
142 ssp(i)=sqrt(abs(dpdm(i))/rho0(i))
143 ENDDO
144C--------------------------------------------------
145C VISCOSITE VOLUMETRIQUE ET PAS DE TEMPS
146C--------------------------------------------------
147 CALL mqvisc8(
148 1 pm, off, rho, rk,
149 2 t, re, stifn, eint,
150 3 d1, d2, d3, vnew,
151 4 dvol, vd2, deltax, vis,
152 5 qold, ssp, mat, nc,
153 6 ngl, geo, pid, dt2t,
154 7 neltst, ityptst, offg, mssa,
155 8 dmels, nel, ity, jtur,
156 9 jthe, jsms)
157C--------------------------------------------------
158C PRESSION
159C--------------------------------------------------
160 DO i=1,nel
161 eint(i)=eint(i)+half*dvol(i)*(pold(i)-psh(i))*off(i)
162 espe(i)=df(i)*eint(i)/ max(em15,vnew(i))
163 ENDDO
164C
165 DO i=1,nel
166 a(i)=c1(i)+amu(i)*(c2(i)+c4(i)*amu(i)*amu(i))+c3(i)*amu2(i)
167 b(i)=c5(i)+c6(i)*amu(i)
168 ENDDO
169C
170 DO i=1,nel
171 dvv=half*dvol(i)*df(i) / max(em15,vnew(i))
172 pnew(i)=(a(i)+(espe(i)-psh(i)*dvv)*b(i))/(one + b(i)*dvv)
173 pnew(i)= max(pnew(i),pc(i))*off(i)
174 ENDDO
175C
176 DO i=1,nel
177 eint(i)=eint(i) - half*dvol(i)*(pnew(i)+psh(i))
178 ENDDO
179C--------------------------------------------------
180C CONTRIBUTION VOLUMIQUE AUX POINTS DE GAUSS
181C--------------------------------------------------
182 DO ipt=1,npt
183 lbuf => bufly%LBUF(1,1,ipt)
184 sigp => bufly%LBUF(1,1,ipt)%SIG(1:nel*6)
185 jpt=(ipt-1)*nel
186 DO i=1,nel
187 sigp(jj(1)+i)= sigp(jj(1)+i)-pnew(i)
188 sigp(jj(2)+i)= sigp(jj(2)+i)-pnew(i)
189 sigp(jj(3)+i)= sigp(jj(3)+i)-pnew(i)
190 sigp(jj(4)+i)= sigp(jj(4)+i)
191 sigp(jj(5)+i)= sigp(jj(5)+i)
192 sigp(jj(6)+i)= sigp(jj(6)+i)
193 ENDDO
194C--------------------------------------------------
195C CONTRAINTE MOYENNE (OUTPUT)
196C--------------------------------------------------
197 DO i=1,nel
198 sig(i,1)=sig(i,1)+one_over_8*sigp(jj(1)+i)
199 sig(i,2)=sig(i,2)+one_over_8*sigp(jj(2)+i)
200 sig(i,3)=sig(i,3)+one_over_8*sigp(jj(3)+i)
201 sig(i,4)=sig(i,4)+one_over_8*sigp(jj(4)+i)
202 sig(i,5)=sig(i,5)+one_over_8*sigp(jj(5)+i)
203 sig(i,6)=sig(i,6)+one_over_8*sigp(jj(6)+i)
204 ENDDO
205 ENDDO ! DO IPT=1,NPT
206C---------------------------------------------
207C
208C DIVISION PAR LE VOLUME POUR L'ALE <(:o))=
209C VOL EST LE VOLUME INITIAL EN LAG.
210C
211C---------------------------------------------
212 DO i=1,nel
213 eint(i)=eint(i) / max(em15,vol(i))
214 ENDDO
215C-----------
216 RETURN
217 END
max
#define max(a, b)
Definition macros.h:21
meos8
subroutine meos8(pm, off, sig, eint, rho, qold, vol, rk, t, re, stifn, nel, d1, d2, d3, vnew, deltax, rho0, dvol, vd2, vis, mat, nc, ngl, geo, pid, dt2t, neltst, ityptst, offg, mssa, dmels, bufly, ssp, ity, npt, jtur, jthe, jsms)
Definition meos8.F:43
mqvisc8
subroutine mqvisc8(pm, off, rho, rk, t, re, sti, eint, d1, d2, d3, vol, dvol, vd2, deltax, vis, qold, ssp, mat, nc, ngl, geo, pid, dt2t, neltst, ityptst, offg, mssa, dmels, nel, ity, jtur, jthe, jsms)
Definition mqvisc8.F:41