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)

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 )

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