OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
q4init2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "scry_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine q4init2 (elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v, mat_param)

Function/Subroutine Documentation

◆ q4init2()

subroutine q4init2 ( type(elbuf_struct_), target elbuf_str,
ms,
integer, dimension(nixq,*) ixq,
pm,
x,
type(detonators_struct_) detonators,
geo,
veul,
type(t_ale_connectivity), intent(inout) ale_connectivity,
integer, dimension(*) iparg,
dtelem,
sigi,
integer, dimension(npropgi,*) igeo,
integer nel,
skew,
msq,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartq,
integer, dimension(npropmi,*) ipm,
integer nsigs,
wma,
integer, dimension(*) ptquad,
bufmat,
integer, dimension(*) npf,
tf,
integer, dimension(*) ipargg,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
partsav,
v,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param )

Definition at line 46 of file q4init2.F.

53C-----------------------------------------------
54C M o d u l e s
55C-----------------------------------------------
56 USE elbufdef_mod
57 USE message_mod
58 USE detonators_mod
59 USE ale_connectivity_mod
60 USE names_and_titles_mod , ONLY : nchartitle
61 USE matparam_def_mod
62 use element_mod , only : nixq
63C-----------------------------------------------
64C I m p l i c i t T y p e s
65C-----------------------------------------------
66#include "implicit_f.inc"
67C-----------------------------------------------
68C G l o b a l P a r a m e t e r s
69C-----------------------------------------------
70#include "mvsiz_p.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "vect01_c.inc"
75#include "com04_c.inc"
76#include "scry_c.inc"
77#include "param_c.inc"
78#include "scr17_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 INTEGER IXQ(NIXQ,*), IPARG(*),IGEO(NPROPGI,*),
83 . NEL,IPART(LIPART1,*),IPARTQ(*),IPM(NPROPMI,*), PTQUAD(*),
84 . NSIGS, NPF(*),IPARGG(*)
85 my_real
86 . ms(*), pm(npropm,*), x(*), geo(npropg,*),
87 . veul(10,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),
88 . msq(*), bufmat(*), tf(*),wma(*),partsav(20,*),v(*)
89 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
90 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
91 my_real,INTENT(IN) :: facload(lfacload,*)
92 TYPE(DETONATORS_STRUCT_) :: DETONATORS
93 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
94 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
95C-----------------------------------------------
96C FUNCTION:
97C ARGUMENTS: (I: input, O: output, IO: input & output, W: workspace)
98C TYPE NAME FUNCTION
99C I IXQ(NIXQ,*) - ELEMENT "MID", CONNECTIVITY, "PID", "SN"
100C I PM(NPROPM,*) - MATERIAL DATA (REAL)
101C I X(3,*) - NODAL COORDINATES
102C I GEO(NPROPG,*) - GEOMETRICAL PROPERTY DATA (REAL)
103C I IPARG(*) - PART PROPERTY DATA OF ELEMENT GROUP
104C O DTELEM(*) - ELEMENT TIME STEP
105C I SIGI(NSIGS,*) - (1~6,*): INITIAL STRESS
106C (7~10,*): NUMBER, DENSITY, PLASTIC STRAIN, INTERNAL ENERGY
107C I IGEO(NPROPGI,*) - GEOMETRICAL PROPERTY DATA (INTEGER)
108C I NEL - ELEMENT NUMBER IN THIS GROUP
109C I SKEW(LSKEW,*) - ELEMENT SKEW
110C O MSQ(*) - ONE FOURTH OF ELEMENT MASS
111C I IPART(LIPART1,*) - PART PROPERTY DATA (USED FOR SPH CASE)
112C I IPARTQ(*) - ID OF PART THAT ELEMENT BELONGS TO (USED FOR SPH CASE)
113C I IPM(NPROPMI,*) - MATERIAL DATA (INTEGER)
114C I NSIGS - NUMBER OF DATA IN "SIGI"
115C I PTQUAD(*) - POINTER OF ELEMENT ADRESS IN "SIGI"
116C I NPF(*),TF(*) - Radioss function (x=Time) data
117C I IPARGG(*) - PART PROPERTY DATA OF ELEMENT GROUP (USED FOR ALE CASE)
118C-----------------------------------------------
119C L o c a l V a r i a b l e s
120C-----------------------------------------------
121 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
122 INTEGER NF1, I, IGTYP, IHBE, IP
123 INTEGER IR,IS,NPTR,NPTS,IBID, IPID1
124 my_real y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
125 + z1(mvsiz),z2(mvsiz),z3(mvsiz),z4(mvsiz),
126 + y12(mvsiz),y34(mvsiz),y13(mvsiz),y24(mvsiz),
127 + y14(mvsiz),y23(mvsiz),
128 + z12(mvsiz),z34(mvsiz),z13(mvsiz),z24(mvsiz),
129 + z14(mvsiz),z23(mvsiz),yavg(mvsiz),area(mvsiz),
130 + bid(1),dtx(mvsiz),
131 + sy(mvsiz) ,sz(mvsiz) ,ty(mvsiz) ,tz(mvsiz),
132 . e1y(mvsiz),e1z(mvsiz),e2y(mvsiz),e2z(mvsiz)
133 my_real wi,ksi,eta,fv
134 my_real deltax(mvsiz),y234(mvsiz),y124(mvsiz)
135 my_real :: tempel(nel)
136 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
137
138C-----------------------------------------------
139 CHARACTER(LEN=NCHARTITLE)::TITR1
140C-----------------------------------------------
141 TYPE(L_BUFEL_) ,POINTER :: LBUF
142 TYPE(G_BUFEL_) ,POINTER :: GBUF
143 TYPE(BUF_MAT_) ,POINTER :: MBUF
144C-----------------------------------------------
145 my_real
146 . w_gauss(9,9),a_gauss(9,9)
147 DATA w_gauss /
148 1 2. ,0. ,0. ,
149 1 0. ,0. ,0. ,
150 1 0. ,0. ,0. ,
151 2 1. ,1. ,0. ,
152 2 0. ,0. ,0. ,
153 2 0. ,0. ,0. ,
154 3 0.555555555555556,0.888888888888889,0.555555555555556,
155 3 0. ,0. ,0. ,
156 3 0. ,0. ,0. ,
157 4 0.347854845137454,0.652145154862546,0.652145154862546,
158 4 0.347854845137454,0. ,0. ,
159 4 0. ,0. ,0. ,
160 5 0.236926885056189,0.478628670499366,0.568888888888889,
161 5 0.478628670499366,0.236926885056189,0. ,
162 5 0. ,0. ,0. ,
163 6 0.171324492379170,0.360761573048139,0.467913934572691,
164 6 0.467913934572691,0.360761573048139,0.171324492379170,
165 6 0. ,0. ,0. ,
166 7 0.129484966168870,0.279705391489277,0.381830050505119,
167 7 0.417959183673469,0.381830050505119,0.279705391489277,
168 7 0.129484966168870,0. ,0. ,
169 8 0.101228536290376,0.222381034453374,0.313706645877887,
170 8 0.362683783378362,0.362683783378362,0.313706645877887,
171 8 0.222381034453374,0.101228536290376,0. ,
172 9 0.081274388361574,0.180648160694857,0.260610696402935,
173 9 0.312347077040003,0.330239355001260,0.312347077040003,
174 9 0.260610696402935,0.180648160694857,0.081274388361574/
175 DATA a_gauss /
176 1 0. ,0. ,0. ,
177 1 0. ,0. ,0. ,
178 1 0. ,0. ,0. ,
179 2 -.577350269189626,0.577350269189626,0. ,
180 2 0. ,0. ,0. ,
181 2 0. ,0. ,0. ,
182 3 -.774596669241483,0. ,0.774596669241483,
183 3 0. ,0. ,0. ,
184 3 0. ,0. ,0. ,
185 4 -.861136311594053,-.339981043584856,0.339981043584856,
186 4 0.861136311594053,0. ,0. ,
187 4 0. ,0. ,0. ,
188 5 -.906179845938664,-.538469310105683,0. ,
189 5 0.538469310105683,0.906179845938664,0. ,
190 5 0. ,0. ,0. ,
191 6 -.932469514203152,-.661209386466265,-.238619186083197,
192 6 0.238619186083197,0.661209386466265,0.932469514203152,
193 6 0. ,0. ,0. ,
194 7 -.949107912342759,-.741531185599394,-.405845151377397,
195 7 0. ,0.405845151377397,0.741531185599394,
196 7 0.949107912342759,0. ,0. ,
197 8 -.960289856497536,-.796666477413627,-.525532409916329,
198 8 -.183434642495650,0.183434642495650,0.525532409916329,
199 8 0.796666477413627,0.960289856497536,0. ,
200 9 -.968160239507626,-.836031107326636,-.613371432700590,
201 9 -.324253423403809,0. ,0.324253423403809,
202 9 0.613371432700590,0.836031107326636,0.968160239507626/
203C-----------------------------------------------
204C S o u r c e L i n e s
205C=======================================================================
206 gbuf => elbuf_str%GBUF
207 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
208 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
209c
210 igtyp = iparg(38)
211 ihbe = iparg(23)
212 jcvt = iparg(37)
213!
214 isorth = 0
215 ibid = 0
216 bid = zero
217 tempel(:) = zero
218C
219 nf1 = nft+1
220 IF(jcvt==0)THEN
221 CALL qcoor2(x,ixq(1,nf1),ngl,mat,
222 . pid, ix1, ix2, ix3, ix4,
223 . y1, y2, y3, y4,
224 . z1, z2, z3, z4,
225 . sy, sz, ty, tz)
226 DO i=lft,llt
227 yavg(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
228 ENDDO
229 ELSE
230 CALL q4rcoor2(x,ixq(1,nf1),ngl,mat,
231 . pid, ix1, ix2, ix3, ix4,
232 . y1, y2, y3, y4,
233 . z1, z2, z3, z4,yavg,y234,y124,
234 . sy,sz,ty,tz,
235 . e1y, e1z, e2y, e2z)
236 ENDIF
237C
238 IF (igtyp == 6) CALL qmorth2(pid ,geo ,igeo ,gbuf%GAMA, nel,
239 . sy ,sz ,ty ,tz ,
240 . e1y ,e1z , e2y, e2z)
241C
242 CALL q4voli2(gbuf%VOL,ixq(1,nf1),
243 . ngl, area,
244 . y1, y2, y3, y4,
245 . z1, z2, z3, z4,y234,y124)
246 CALL qdlen2(iparg(63),
247 . area, deltax,
248 . y1, y2, y3, y4,
249 . z1, z2, z3, z4)
250 IF(jeul/=0) CALL edlen2(veul(1,nf1), area, deltax)
251 DO i=lft,llt
252 y12(i) = y1(i) - y2(i)
253 y34(i) = y3(i) - y4(i)
254 y13(i) = y1(i) - y3(i)
255 y24(i) = y2(i) - y4(i)
256 y14(i) = y1(i) - y4(i)
257 y23(i) = y2(i) - y3(i)
258 z12(i) = z1(i) - z2(i)
259 z34(i) = z3(i) - z4(i)
260 z13(i) = z1(i) - z3(i)
261 z24(i) = z2(i) - z4(i)
262 z14(i) = z1(i) - z4(i)
263 z23(i) = z2(i) - z3(i)
264 ENDDO
265C
266C
267 ip=0
268 CALL matini(pm ,ixq ,nixq ,x ,
269 . geo ,ale_connectivity ,detonators ,iparg ,
270 . sigi ,nel ,skew ,igeo ,
271 . ipart ,ipartq ,
272 . mat ,ipm ,nsigs ,numquad ,ptquad ,
273 . ip ,ngl ,npf ,tf ,bufmat ,
274 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
275 . facload ,deltax ,tempel ,mat_param )
276
277C ENTER THE INTEGRATION POINTS LOOP -->
278 nptr = 2
279 npts = 2
280 DO ir=1,nptr
281 DO is=1,npts
282c
283 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,1)
284C
285 ip = ir + (is-1)*nptr
286 ksi = a_gauss(ir,nptr)
287 eta = a_gauss(is,npts)
288 wi = w_gauss(ir,nptr)*w_gauss(is,npts)
289C
290 CALL q4deri2(lbuf%VOL,ksi,eta,wi,
291 2 y12,y34,y13,y24,y14,y23,
292 3 z12,z34,z13,z24,z14,z23,
293 4 y1,y2,y3,y4,yavg,ihbe,ngl)
294C
295 CALL matini(
296 . pm ,ixq ,nixq ,x ,
297 . geo ,ale_connectivity ,detonators ,iparg ,
298 . sigi ,nel ,skew ,igeo ,
299 . ipart ,ipartq ,
300 . mat ,ipm ,nsigs ,numquad ,ptquad ,
301 . ip ,ngl ,npf ,tf ,bufmat ,
302 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
303 . facload, deltax ,tempel ,mat_param )
304C
305 ENDDO
306 ENDDO
307C EXIT THE INTEGRATION POINTS LOOP <--
308C----------------------------------------
309C initialization of thermal and turbulence
310C----------------------------------------
311 IF(jthe/=0)CALL atheri(mat ,pm ,lbuf%TEMP)
312 IF(jtur/=0)CALL aturi2(ipargg ,lbuf%RHO,pm,ixq,x,
313 . lbuf%RK ,lbuf%RE, area)
314C------------------------------------------
315C initialization of the mass matrix
316C------------------------------------------
317 IF(jlag+jale+jeul/=0)
318 . CALL qmasi2(pm,mat,ms,gbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
319 . ix1, ix2, ix3, ix4,x ,v)
320C-------------------------------------------
321C calculation of elementary timesteps (dt)
322C-------------------------------------------
323 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
324 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, area,
325 . gbuf%VOL, dtx, igeo,igtyp)
326 DO 10 i=lft,llt
327 IF(ixq(6,i+nft)/=0) THEN
328 IF(igtyp/=0 .AND. igtyp/=6 .AND.
329 . igtyp/=14.AND.igtyp/=15)THEN
330 ipid1=ixq(nixq-1,i+nft)
331 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
332 CALL ancmsg(msgid=226,
333 . msgtype=msgerror,
334 . anmode=aninfo_blind_1,
335 . i1=igeo(1,ipid1),
336 . c1=titr1,
337 . i2=igtyp)
338 ENDIF
339 ENDIF
340 dtelem(nft+i)=dtx(i)
341 10 CONTINUE
342C
343 RETURN
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
aturi2
subroutine aturi2(iparg, rho, pm, ix, x, rk, re, aire)
Definition aturi2.F:32
my_real
#define my_real
Definition cppsort.cpp:32
dtmain
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
Definition dtmain.F:68
edlen2
subroutine edlen2(veul, aire, deltax)
Definition edlen2.F:31
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
matini
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
Definition matini.F:83
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
detonators_mod
Definition detonators_mod.F:80
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
q4voli2
subroutine q4voli2(volu, ixq, ngl, aire, y1, y2, y3, y4, z1, z2, z3, z4, y234, y124)
Definition q4voli2.F:36
qmasi2
subroutine qmasi2(pm, mat, ms, vol, msq, wma, ipart, partsav, ix1, ix2, ix3, ix4, x, v)
Definition qmasi2.F:33
qmorth2
subroutine qmorth2(pid, geo, igeo, gama, nel, ry, rz, sy, sz, e1y, e1z, e2y, e2z)
Definition qmorth2.F:37
q4rcoor2
subroutine q4rcoor2(x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, yavg, y234, y124, sy, sz, ty, tz, e1y, e1z, e2y, e2z)
Definition q4coor2.F:34
q4deri2
subroutine q4deri2(vol, ksi, eta, wi, y12, y34, y13, y24, y14, y23, z12, z34, z13, z24, z14, z23, y1, y2, y3, y4, yavg, ihbe, ngl)
Definition q4deri2.F:36
qcoor2
subroutine qcoor2(x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, sy, sz, ty, tz)
Definition qcoor2.F:38
qdlen2
subroutine qdlen2(iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qdlen2.F:39
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799