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

Go to the source code of this file.

Functions/Subroutines

subroutine c3derii (jft, jlt, pm, geo, px1, py1, py2, stifn, stifr, ixtg, thk, sh3tree, aldt, uparam, ipm, igeo, pm_stack, isubstack, strtg, imat, iprop, area, dt, x31g, y31g, z31g, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x2, x3, y3, group_param)

Function/Subroutine Documentation

◆ c3derii()

subroutine c3derii ( integer jft,
integer jlt,
pm,
geo,
px1,
py1,
py2,
stifn,
stifr,
integer, dimension(nixtg,*) ixtg,
thk,
integer, dimension(ksh3tree,*) sh3tree,
aldt,
uparam,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
pm_stack,
integer isubstack,
strtg,
integer imat,
integer iprop,
area,
dt,
x31g,
y31g,
z31g,
e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
x2,
x3,
y3,
type (group_param_) group_param )

Definition at line 30 of file c3derii.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE group_param_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "param_c.inc"
54#include "remesh_c.inc"
55#include "vect01_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER JFT, JLT, ILEV,ISUBSTACK,IMAT,IPROP
60 INTEGER IXTG(NIXTG,*), SH3TREE(KSH3TREE,*),IPM(NPROPMI,*),
61 . IGEO(NPROPGI,*)
62C REAL
63 my_real
64 . pm(npropm,*), geo(npropg,*), px1(*),py1(*),py2(*),
65 . stifn(*),stifr(*),thk(*),aldt(*),uparam(*),pm_stack(20,*),strtg(*)
66 my_real area(mvsiz),dt(mvsiz),
67 . x31g(mvsiz), y31g(mvsiz), z31g(mvsiz),
68 . x2(mvsiz), x3(mvsiz), y3(mvsiz),
69 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
70 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
71 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz)
72 TYPE (GROUP_PARAM_) :: GROUP_PARAM
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I, N, IADB,I1,I3,IPTHK,IPPOS,IGTYP,I2,
77 . IPMAT,MATLY,IPGMAT,IGMAT,IPOS
78 my_real aldtv(mvsiz)
79 my_real viscmx, a11, g, sti,stir,shf,viscdef,
80 . al1, al2, al3, almax, ssp,young,nu,rho,gmax,
81 . c1,iz,thickt,thkly,posly,a1thk,c1thk,
82 . gthk,a11r,fac,a12,e,ethk,nuthk,a12thk,rhog
83C=======================================================================
84 ssp = zero
85
86 igtyp = igeo(11,iprop)
87 igmat = igeo(98,iprop) ! global material
88 ipgmat = 700
89
90 DO i=jft,jlt
91 y3(i)=e2x(i)*x31g(i)+e2y(i)*y31g(i)+e2z(i)*z31g(i)
92 x3(i)=e1x(i)*x31g(i)+e1y(i)*y31g(i)+e1z(i)*z31g(i)
93 ENDDO
94C
95 IF(mtn==19)THEN
96 viscdef=fourth
97 ELSEIF(mtn==25.OR.mtn==27)THEN
98 viscdef=fiveem2
99 ELSE
100 viscdef=zero
101 ENDIF
102 DO 40 i=jft,jlt
103 al1 = x2(i) * x2(i)
104 al2 = (x3(i)-x2(i)) * (x3(i)-x2(i)) + y3(i) * y3(i)
105 al3 = x3(i) * x3(i) + y3(i) * y3(i)
106 almax = max(al1,al2,al3)
107 IF(igtyp == 11 .AND. igmat > 0) THEN
108 ssp = geo(ipgmat +9 ,iprop)
109 ELSEIF(igtyp == 52 .OR.
110 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0 )) THEN
111 ssp = pm_stack(9 ,isubstack)
112 ELSE
113 IF (mtn<=28) THEN
114 ssp=pm(27,imat)
115 ELSEIF (mtn == 42) THEN
116 rho = pm(1 ,imat)
117 nu = pm(21,imat)
118 gmax = pm(22,imat)
119 a11 = gmax*(one + nu)/(one - nu**2)
120 ssp = max(ssp, sqrt(a11/rho))
121 ELSEIF (mtn == 69) THEN
122 iadb = ipm(7,imat)-1
123 nu = uparam(iadb+14)
124 gmax = uparam(iadb+1)*uparam(iadb+6)
125 . + uparam(iadb+2)*uparam(iadb+7)
126 . + uparam(iadb+3)*uparam(iadb+8)
127 . + uparam(iadb+4)*uparam(iadb+9)
128 . + uparam(iadb+5)*uparam(iadb+10)
129 rho = pm(1,imat)
130 a11 = gmax*(one + nu)/(one - nu**2)
131 ssp=max(ssp, sqrt(a11/rho))
132 ELSEIF (mtn == 65) THEN
133 rho =pm(1,imat)
134 young=pm(20,imat)
135 ssp=sqrt(young/rho)
136 ELSE
137 rho =pm(1,imat)
138 young=pm(20,imat)
139 nu =pm(21,imat)
140 ssp=sqrt(young/(one-nu*nu)/rho)
141 ENDIF
142 ENDIF
143 viscmx = group_param%VISC_DM
144 IF (viscmx == zero) viscmx = viscdef
145 IF(mtn==1.OR.mtn==2.OR.mtn==3.OR.
146 . mtn==22.OR.mtn==23) viscmx=zero
147 viscmx=sqrt(one+viscmx*viscmx)-viscmx
148 aldt(i)= two*area(i) / sqrt(almax)
149 aldtv(i)= aldt(i)*viscmx
150 dt(i) = aldtv(i) / ssp
151 40 CONTINUE
152C-------------------------
153C DT NODAL
154C-------------------------
155 ipgmat = 700
156 IF(nadmesh==0)THEN
157 IF(igtyp == 11 .AND. igmat > 0) THEN
158 viscmx = group_param%VISC_DM
159 DO i=jft,jlt
160 g =geo(ipgmat +4,imat)
161 a11 =geo(ipgmat + 5,iprop)
162 a11r =geo(ipgmat + 7,iprop)
163 shf=1.
164 fac= area(i) / (aldtv(i))**2
165 sti = fac* thk(i) * a11
166 stir = fac*a11r* (one_over_12*thk(i)**3
167 . + half * shf * area(i) * g/a11)
168 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
169 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
170 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
171 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
172 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
173 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
174 strtg(i) = stir
175 END DO
176 ELSEIF(igtyp == 52 .OR.
177 . ((igtyp == 17 .OR. igtyp == 51 ).AND. igmat > 0 )) THEN
178 viscmx = group_param%VISC_DM
179 DO i=jft,jlt
180 g = pm_stack(4 ,isubstack)
181 a11 = pm_stack(5 ,isubstack)
182 a11r = pm_stack(7 ,isubstack)
183 shf=1.
184 fac= area(i) / (aldtv(i))**2
185 sti = fac* thk(i) * a11
186 stir = fac*a11r* (one_over_12*thk(i)**3
187 . + half * shf * area(i) * g/a11)
188 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
189 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
190 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
191 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
192 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
193 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
194 strtg(i) = stir
195 END DO
196 ELSE
197 viscmx = group_param%VISC_DM
198 DO i=jft,jlt
199 a11 =pm(24,imat)
200 g =pm(22,imat)
201 shf=1.
202 sti = area(i) * thk(i) * a11 / (aldtv(i))**2
203 stir = sti * (thk(i) * thk(i) * one_over_12
204 . + half * shf * area(i) * g/a11)
205 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
206 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
207 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
208 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
209 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
210 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
211 strtg(i) = stir
212 END DO
213 ENDIF
214 ELSE
215 IF(igtyp == 11 .AND. igmat > 0) THEN
216 viscmx = group_param%VISC_DM
217 DO i=jft,jlt
218 n=nft+i
219 IF(sh3tree(3,n) >= 0)THEN
220 g =geo(ipgmat +4,imat)
221 a11 =geo(ipgmat + 5,iprop)
222 a11r =geo(ipgmat + 7,iprop)
223 shf=1.
224 fac= area(i) / (aldtv(i))**2
225 sti = fac* thk(i) * a11
226 stir = fac*a11r* (one_over_12*thk(i)**3
227 . + half * shf * area(i) * g/a11)
228 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
229 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
230 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
231 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
232 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
233 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
234 strtg(i) = stir
235 END IF
236 END DO
237 ELSEIF(igtyp == 52 .OR.
238 . ((igtyp == 17 .OR. igtyp == 51 ).AND. igmat > 0 ) ) THEN
239 viscmx = group_param%VISC_DM
240 DO i=jft,jlt
241 n=nft+i
242 IF(sh3tree(3,n) >= 0)THEN
243
244 g = pm_stack(4 ,isubstack)
245 a11 = pm_stack(5 ,isubstack)
246 a11r = pm_stack(7 ,isubstack)
247 shf=1.
248 fac= area(i) / (aldtv(i))**2
249 sti = fac* thk(i) * a11
250 stir = fac*a11r* (one_over_12*thk(i)**3
251 . + half * shf * area(i) * g/a11)
252 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
253 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
254 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
255 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
256 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
257 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
258 strtg(i) = stir
259 END IF
260 END DO
261
262 ELSE
263 viscmx = group_param%VISC_DM
264 DO i=jft,jlt
265 n=nft+i
266 IF(sh3tree(3,n) >= 0)THEN
267 a11 =pm(24,imat)
268 g =pm(22,imat)
269 shf=1.
270 sti = area(i) * thk(i) * a11 / (aldtv(i))**2
271 stir = sti * (thk(i) * thk(i) * one_over_12
272 . + half * shf * area(i) * g/a11)
273 stifn(ixtg(2,i))=stifn(ixtg(2,i))+sti
274 stifn(ixtg(3,i))=stifn(ixtg(3,i))+sti
275 stifn(ixtg(4,i))=stifn(ixtg(4,i))+sti
276 stifr(ixtg(2,i))=stifr(ixtg(2,i))+stir
277 stifr(ixtg(3,i))=stifr(ixtg(3,i))+stir
278 stifr(ixtg(4,i))=stifr(ixtg(4,i))+stir
279 strtg(i) = stir
280 END IF
281 END DO
282 ENDIF
283 END IF
284C
285C---------------------------------------------------------
286 IF(ismstr/=3)THEN
287 DO 50 i=jft,jlt
288 px1(i) = zero
289 py1(i) = zero
290 py2(i) = zero
291 50 CONTINUE
292 ELSE
293C---------------------------------------------------------
294C
295 DO i=jft,jlt
296 px1(i) = -half*y3(i)
297 py1(i) = half*(x3(i)-x2(i))
298 py2(i) = -half*x3(i)
299 ENDDO
300C
301 DO 80 i=jft,jlt
302 IF(geo(5,iprop)==zero)GOTO 80
303 geo(5,iprop)= min(geo(5,iprop),dt(i))
304 80 CONTINUE
305 ENDIF
306C
307C---------------------------------------------------------
308 RETURN
309C
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21