OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dt51law.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dt51law (pm, geo, pid, mat, bufmat, ipm, deltax, aire, vol, dtx)

Function/Subroutine Documentation

◆ dt51law()

subroutine dt51law ( dimension(npropm, *), intent(in) pm,
dimension(npropg, *), intent(in) geo,
integer, dimension(*), intent(in) pid,
integer, dimension(*), intent(in) mat,
dimension(*), target bufmat,
integer, dimension(npropmi, *), intent(in) ipm,
dimension(*), target deltax,
dimension(*), intent(in) aire,
dimension(*), intent(in) vol,
dimension(*), intent(inout) dtx )

Definition at line 31 of file dt51law.F.

32C-----------------------------------------------
33C D e s c r i p t i o n
34C-----------------------------------------------
35C ELEMENTARY TIME STEPS FOR ALE MULTI MATERIAL LAW 51 (/MAT/MULTIMAT)
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 "vect01_c.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 my_real, INTENT(IN) :: pm(npropm, *), geo(npropg, *), aire(*), vol(*)
53 my_real, INTENT(INOUT) :: dtx(*)
54 my_real, INTENT(IN), DIMENSION(:), TARGET :: bufmat(*), deltax(*)
55 INTEGER, INTENT(IN) :: PID(*),MAT(*),IPM(NPROPMI, *)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER :: I, MX, IADBUF,IFLG(MVSIZ), BIJ(4)
60 my_real,DIMENSION(:),POINTER :: uparam
61
63 . ssp(mvsiz) , dpdm(mvsiz) , rho0(mvsiz) , g(mvsiz) ,
64 . bulk(mvsiz) , c1(mvsiz) , g43(mvsiz) , p ,
65 . av1(mvsiz) , av2(mvsiz) , av3(mvsiz) , av4(mvsiz) ,
66 . rho10(mvsiz), rho20(mvsiz), rho30(mvsiz), rho40(mvsiz),
67 . c01(mvsiz) , c02(mvsiz) , c03(mvsiz) , c04(mvsiz) ,
68 . c11(mvsiz) , c12(mvsiz) , c13(mvsiz) , c14(mvsiz) ,
69 . c21(mvsiz) , c22(mvsiz) , c23(mvsiz) , c24(mvsiz) ,
70 . c31(mvsiz) , c32(mvsiz) , c33(mvsiz) , c34(mvsiz) ,
71 . c41(mvsiz) , c42(mvsiz) , c43(mvsiz) , c44(mvsiz) ,
72 . c51(mvsiz) , c52(mvsiz) , c53(mvsiz) , c54(mvsiz) ,
73 . g1(mvsiz) , g2(mvsiz) , g3(mvsiz) , g4(mvsiz) ,
74 . e01(mvsiz) , e02(mvsiz) , e03(mvsiz) , e04(mvsiz) ,
75 . pm1(mvsiz) , pm2(mvsiz) , pm3(mvsiz) , pm4(mvsiz) ,
76 . dpdm1(mvsiz), dpdm2(mvsiz), dpdm3(mvsiz), dpdm4(mvsiz),
77 . pext , pfar , vdet(mvsiz) ,
78 . ssp1(mvsiz) , ssp2(mvsiz) , ssp3(mvsiz) , ssp4(mvsiz),
79 . vis(mvsiz) , rho0_bak(mvsiz)
80
81 INTEGER :: IAV(4),IRHO(4)
82
83
84c-----------------------------------------------
85 iav(1:4) = (/ 4,5,6,46 /)
86 irho(1:4) = (/ 9,10,11,47 /)
87C-----------------------------------------------
88C S o u r c e L i n e s
89C-----------------------------------------------
90 iflg(1) = zero
91 DO i=1,llt
92 iadbuf = ipm(7,mat(i))
93 uparam =>bufmat(iadbuf:iadbuf+280)
94 bij(1:4) = uparam(277:280)
95 av1(i) = uparam(iav(bij(1)))
96 av2(i) = uparam(iav(bij(2)))
97 av3(i) = uparam(iav(bij(3)))
98 av4(i) = uparam(iav(bij(4)))
99 pfar = uparam(07)
100 pext = uparam(08)
101 rho10(i) = uparam(irho(bij(1)))
102 rho20(i) = uparam(irho(bij(2)))
103 rho30(i) = uparam(irho(bij(3)))
104 rho40(i) = uparam(irho(bij(4)))
105 c11(i) = uparam(12)
106 c12(i) = uparam(13)
107 c13(i) = uparam(14)
108 c14(i) = zero
109 c21(i) = uparam(15)
110 c22(i) = uparam(16)
111 c23(i) = uparam(17)
112 c24(i) = zero
113 c31(i) = uparam(18)
114 c32(i) = uparam(20)
115 c33(i) = uparam(21)
116 c34(i) = zero
117 c41(i) = uparam(22)
118 c42(i) = uparam(23)
119 c43(i) = uparam(24)
120 c44(i) = zero
121 c51(i) = uparam(25)
122 c52(i) = uparam(26)
123 c53(i) = uparam(27)
124 c54(i) = zero
125 g1(i) = uparam(28)*two_third
126 g2(i) = uparam(29)*two_third
127 g3(i) = uparam(30)*two_third
128 g4(i) = zero
129 iflg(i) = uparam(31)
130 e01(i) = uparam(32)
131 e02(i) = uparam(33)
132 e03(i) = uparam(34)
133 e04(i) = uparam(48)
134 c01(i) = uparam(35)
135 c02(i) = uparam(36)
136 c03(i) = uparam(37)
137 c04(i) = uparam(49)
138 pm1(i) = uparam(39)
139 pm2(i) = uparam(40)
140 pm3(i) = uparam(41)
141 pm4(i) = uparam(56)
142 vdet(i) = uparam(42)
143 vis(i) = zero
144 enddo!next I
145
146 IF (iflg(1) == 6) THEN
147 DO i=lft,llt
148 dtx(i)=ep20
149 ENDDO
150 RETURN
151 ENDIF
152
153 DO i=lft,llt
154 !---submat-1---!
155 IF(av1(i)>zero .AND. rho10(i) > zero) THEN
156 dpdm1(i) = c11(i)+c51(i)*e01(i)+c41(i)*(c01(i)+c41(i)*e01(i))
157 dpdm1(i) = g1(i) + max(dpdm1(i), c11(i))
158 ELSE
159 dpdm1(i) = zero
160 ENDIF
161 !---submat-2---!
162 IF(av2(i)>zero .AND. rho20(i) > zero) THEN
163 dpdm2(i) = c12(i)+c52(i)*e02(i)+c42(i)*(c02(i)+c42(i)*e02(i))
164 dpdm2(i) = g2(i) + max(dpdm2(i), c12(i))
165 ELSE
166 dpdm2(i) = zero
167 ENDIF
168 !---submat-3---!
169 IF(av3(i)>zero .AND. rho30(i) > zero) THEN
170 dpdm3(i) = c13(i)+c53(i)*e03(i)+c43(i)*(c03(i)+c43(i)*e03(i))
171 dpdm3(i) = g3(i) + max(dpdm3(i), c13(i))
172 ELSE
173 dpdm3(i) = zero
174 ENDIF
175 enddo!next I
176
177 DO i=lft,llt
178 !---submat-1---!
179 IF(av1(i)>zero) THEN
180 ssp1(i) = sqrt(abs(dpdm1(i))/rho10(i))
181 ELSE
182 ssp1(i) = zero
183 ENDIF
184 !---submat-2---!
185 IF(av2(i)>zero) THEN
186 ssp2(i)=sqrt(abs(dpdm2(i))/rho20(i))
187 ELSE
188 ssp2(i)=zero
189 ENDIF
190 !---submat-3---!
191 IF(av3(i)>zero) THEN
192 ssp3(i)=sqrt(abs(dpdm3(i))/rho30(i))
193 ELSE
194 ssp3(i)=zero
195 ENDIF
196 !---submat-4---!
197 IF(av4(i)>zero) THEN
198 ssp4(i)=vdet(i)
199 ELSE
200 ssp4(i)=zero
201 ENDIF
202 END do!next I
203
204 DO i=lft,llt
205 rho0(i) = av1(i)*rho10(i) + av2(i)*rho20(i) + av3(i)*rho30(i) + av4(i)*rho40(i)
206 ENDDO
207
208 DO i=lft,llt
209 bulk(i) = av1(i)*rho10(i)*ssp1(i)**2
210 . + av2(i)*rho20(i)*ssp2(i)**2
211 . + av3(i)*rho30(i)*ssp3(i)**2
212 . + av4(i)*rho40(i)*ssp4(i)**2
213 IF (rho0(i) > zero) THEN
214 ssp(i) = sqrt(bulk(i)/rho0(i))
215 rho0_bak(i)=rho0(i)
216 ELSE
217 ssp(i) = em20
218 rho0_bak(i)=em20
219 ENDIF
220 enddo!next I
221
222 !----------------------------------------------!
223 ! ELEMENTARY TIME STEP (ARTIFICIAL VISCOSITY) !
224 !----------------------------------------------!
225 IF(jsph==0)THEN
226 CALL dtel(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, aire, vol, dtx)
227 ELSE
228 CALL dtsph(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, vol, dtx)
229 ENDIF
230C-----------
231 RETURN
#define my_real
Definition cppsort.cpp:32
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
Definition dtel.F:46
subroutine dtsph(ssp, pm, geo, pid, mat, rho0, vis, deltax, vol, dtx)
Definition dtsph.F:44
#define max(a, b)
Definition macros.h:21