OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qgrtails.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine qgrtails (ixq, pm, iparg, geo, eadd, nd, dd_iad, idx, inum, index, cep, ipartq, itr1, igrsurf, igrquad, mat_param, igeo, ipm, iquaoff, inivol, print_flag)

Function/Subroutine Documentation

◆ qgrtails()

subroutine qgrtails ( integer, dimension(nixq,numelq) ixq,
pm,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(*) eadd,
integer nd,
integer, dimension(nspmd+1,*) dd_iad,
integer idx,
integer, dimension(9,*) inum,
integer, dimension(*) index,
integer, dimension(*) cep,
integer, dimension(*) ipartq,
integer, dimension(*) itr1,
type (surf_), dimension(nsurf) igrsurf,
type (group_), dimension(ngrquad) igrquad,
type(matparam_struct_), dimension(nummat), intent(in) mat_param,
integer, dimension(npropgi,numgeo) igeo,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(*) iquaoff,
type (inivol_struct_), dimension(num_inivol) inivol,
integer, intent(in) print_flag )
Parameters
[in]print_flagflag to print the element group data

Definition at line 36 of file qgrtails.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE r2r_mod
47 USE groupdef_mod
48 USE inivol_def_mod , ONLY : inivol_struct_, num_inivol
49 USE matparam_def_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51 USE ale_mod , ONLY : ale
52 use element_mod , only : nixq
53C-----------------------------------------------
54C A R G U M E N T S
55C-----------------------------------------------
56C IXQ(7,NUMELQ) TABLEAU CONECS+PID+MID+NOS SOLIDES 4N E
57C PM(NPROPM,NUMMAT) ARRAY OF MATERIAL PROPERTIES E
58C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
59C GEO(NPROPG,NUMGEO) ARRAY OF PID CHARACTERISTICS E
60C EADD(NUMELQ) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER E
61C DD_IAD ARRAY OF DD IN SUPER GROUPS S
62C INUM(8,NUMELQ) TABLEAU DE TRAVAIL E/S
63C INDEX(NUMELQ) TABLEAU DE TRAVAIL E/S
64C CEP(NUMELQ) TABLEAU DE TRAVAIL E/S
65C IPARTQ(NUMELQ) TABLEAU DE TRAVAIL E/S
66C ITR1(NSELQ) TABLEAU DE TRAVAIL E/S
67C-----------------------------------------------
68C I M P L I C I T T Y P E S
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C O M M O N B L O C K S
73C-----------------------------------------------
74#include "vect01_c.inc"
75#include "com01_c.inc"
76#include "com04_c.inc"
77#include "units_c.inc"
78#include "param_c.inc"
79#include "scr17_c.inc"
80#include "r2r_c.inc"
81C-----------------------------------------------
82C D U M M Y A R G U M E N T S
83C-----------------------------------------------
84 INTEGER ND, IDX
85 INTEGER IGEO(NPROPGI,NUMGEO),IPM(NPROPMI,NUMMAT), IXQ(NIXQ,NUMELQ),IPARG(NPARG,*),
86 . EADD(*),DD_IAD(NSPMD+1,*),INUM(9,*),INDEX(*),
87 . CEP(*),IPARTQ(*),ITR1(*),
88 . IQUAOFF(*)
89 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
90 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
91 my_real pm(npropm,nummat), geo(npropg,numgeo)
92C-----------------------------------------------
93 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
94 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
95 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
96C-----------------------------------------------
97C L O C A L V A R I A B L E S
98C-----------------------------------------------
99 INTEGER
100 . NGR1, MLN, NG, N, MID, PID, II, NEL, NE1,
101 . P, NEL_PREC, LB_L, IGT, JHBE, I,
102 . ML1, ML2, MT1, MT2,NB,INEG,IEOS,
103 . MODE, WORK(70000),NN,J,
104 . IPLAST,IFAIL,NFAIL,
105 . NGP(NSPMD+1),ICPRE,IPARTR2R,ISMST,TAG_INVOL,
106 . JALE_FROM_MAT,JALE_FROM_PROP
107 INTEGER ID,MFT,ILOC,JJ
108 CHARACTER(LEN=NCHARTITLE)::TITR
109 LOGICAL lFOUND
110C--------------------------------------------------------------
111C bounding of MVSIZ groups
112C--------------------------------------------------------------
113 ngr1 = ngroup + 1
114C
115C Phase 1: Domain Decomposition
116C
117 idx=idx+nd*(nspmd+1)
118 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
119C NSPGROUP = NSPGROUP + ND
120 nft = 0
121C initialisation dd_iad
122 DO n=1,nd
123 DO p=1,nspmd+1
124 dd_iad(p,nspgroup+n) = 0
125 END DO
126 ENDDO
127C
128C Phase 2: MVSIZ Group Bounds
129C ngroup is global, iparg is global but organized based on dd
130C
131 DO n=1,nd
132 nel = eadd(n+1)-eadd(n)
133C
134 DO i = 1, nel
135 index(i) = i
136 inum(1,i)=ipartq(nft+i)
137 inum(2,i)=ixq(1,nft+i)
138 inum(3,i)=ixq(2,nft+i)
139 inum(4,i)=ixq(3,nft+i)
140 inum(5,i)=ixq(4,nft+i)
141 inum(6,i)=ixq(5,nft+i)
142 inum(7,i)=ixq(6,nft+i)
143 inum(8,i)=ixq(7,nft+i)
144 inum(9,i)=iquaoff(nft+i)
145 ENDDO
146
147 mode=0
148 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
149 DO i = 1, nel
150 ipartq(i+nft)=inum(1,index(i))
151 ixq(1,i+nft)=inum(2,index(i))
152 ixq(2,i+nft)=inum(3,index(i))
153 ixq(3,i+nft)=inum(4,index(i))
154 ixq(4,i+nft)=inum(5,index(i))
155 ixq(5,i+nft)=inum(6,index(i))
156 ixq(6,i+nft)=inum(7,index(i))
157 ixq(7,i+nft)=inum(8,index(i))
158 iquaoff(i+nft)=inum(9,index(i))
159 itr1(nft+index(i)) = nft+i
160 ENDDO
161
162C dd-iad
163 p = cep(nft+index(1))
164 nb = 1
165 DO i = 2, nel
166 IF (cep(nft+index(i))/=p) THEN
167 dd_iad(p+1,nspgroup+n) = nb
168 nb = 1
169 p = cep(nft+index(i))
170 ELSE
171 nb = nb + 1
172 ENDIF
173 ENDDO
174 dd_iad(p+1,nspgroup+n) = nb
175 DO p = 2, nspmd
176 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
177 . + dd_iad(p-1,nspgroup+n)
178 ENDDO
179 DO p = nspmd+1,2,-1
180 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
181 ENDDO
182 dd_iad(1,nspgroup+n) = 1
183C
184C maj CEP
185C
186 DO i = 1, nel
187 index(i) = cep(nft+index(i))
188 ENDDO
189 DO i = 1, nel
190 cep(nft+i) = index(i)
191 ENDDO
192 nft = nft + nel
193 ENDDO
194
195C
196C renumbering for surfaces
197C
198 DO i=1,nsurf
199 nn=igrsurf(i)%NSEG
200 DO j=1,nn
201 IF(igrsurf(i)%ELTYP(j) == 2)
202 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
203 ENDDO
204 ENDDO
205C
206C renumbering for shell groups
207C
208 DO i=1,ngrquad
209 nn=igrquad(i)%NENTITY
210 DO j=1,nn
211 igrquad(i)%ENTITY(j) = itr1(igrquad(i)%ENTITY(j))
212 ENDDO
213 ENDDO
214C
215 ineg = 0
216 DO 300 n=1,nd
217
218 nft = 0
219 lb_l = lbufel
220 DO p = 1, nspmd
221 ngp(p)=0
222 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
223 IF (nel>0) THEN
224 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
225 ngp(p)=ngroup
226 ng = (nel-1)/nvsiz + 1
227 DO 220 i=1,ng
228C ngroup global
229 ngroup=ngroup+1
230 ii = eadd(n)+nft
231 mid = ixq(1,ii)
232 pid = ixq(6,ii)
233 ipartr2r = 0
234 IF (nsubdom>0) ipartr2r = tag_mat(mid)
235 npt =1
236 jhbe=0
237 jpor=0
238 jcvt = 0
239 isorth=0
240 iplast= 1
241 icpre=0
242 ismst = 0
243 igt = 0
244 IF(pid/=0)THEN
245 IF(igeo(10,pid)==17 .OR.
246 . (n2d==1.AND.igeo(10,pid)==22)) THEN
247 npt = igeo(4,pid)
248 jhbe = igeo(10,pid)
249 ENDIF
250 icpre = igeo(13,pid)
251 igt = igeo(11,pid)
252 istrain= igeo(12,pid)
253 jcvt = igeo(16,pid)
254 isorth = igeo(17,pid)
255 ismst = igeo(5,pid)
256 IF (igt /= 15) iplast = igeo(9,pid)
257 IF(igt==15) jpor=2*nint(geo(28,pid))
258 ENDIF
259 mln = nint(pm(19,abs(mid)))
260 IF(mid<0)THEN
261 IF(mln==6.AND.jpor/=2)mln=17
262 IF(mln==46)mln=47
263 mid=abs(mid)
264 ixq(1,ii)=mid
265 ineg = 1
266 ENDIF
267 jale_from_mat = nint(pm(72,mid))
268 jale_from_prop = igeo(62,pid)
269 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
270 jlag=0
271 IF(jale==0.AND.mln/=18)jlag=1
272 jeul=0
273 IF(jale==2)THEN
274 jale=0
275 jeul=1
276 ENDIF
277
278 !ALE REZONING/REMAPING : number of MAT/EOS variables to treat (used by staggered scheme only : arezon.F)
279 ! With ALE framework, since the Mesh is arbitrary, the variable must be updated to map thei expected location and not follow the arbitrary mesh displacement
280 ! this numbering here will be used in arezon.F to loop over variables to rezon/remap
281 IF(jale == 1)THEN
282 ale%REZON%NUM_NUVAR_MAT = max(ale%REZON%NUM_NUVAR_MAT, mat_param(mid)%REZON%NUM_NUVAR_MAT )
283 ale%REZON%NUM_NUVAR_EOS = max(ale%REZON%NUM_NUVAR_EOS, mat_param(mid)%REZON%NUM_NUVAR_EOS )
284 ENDIF
285
286 !ALE UVAR REZONING (81:MAT, 82:EOS)
287 IF(jale == 1)THEN
288 iparg(81,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_MAT
289 iparg(82,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_EOS
290 ENDIF
291
292 jtur=nint(pm(70,mid))
293 jthe=nint(pm(71,mid))
294
295 jmult=0
296 IF(mln==20)THEN
297 jmult=nint(pm(20,mid))
298 mt1=nint(pm(21,mid))
299 mt2=nint(pm(22,mid))
300 ml1=nint(pm(19,mt1))
301 ml2=nint(pm(19,mt2))
302 ELSE
303 jmult=0
304 ml1=0
305 ml2=0
306 ENDIF
307C--------------------
308C- ICPRE,ISMSTR JCVT Automatic
309C--------------------
310 IF (igt == 14.OR.igt == 6) THEN
311 IF (icpre < 0) icpre =0
312 IF (ismst < 0) ismst =4
313 IF (jcvt<0) THEN
314 jcvt = 0
315 IF (jlag>0) jcvt = 1
316 END IF
317 END IF
318C--------------------
319C TEST COMPATIBILITE
320C--------------------
321
322 id=igeo(1,pid)
323 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
324 IF (ismst /= 2 .AND. ismst /= 4) THEN
325 CALL ancmsg(msgid=1223,
326 . msgtype=msgerror,
327 . anmode=aninfo_blind_2,
328 . i1=id,
329 . c1=titr,
330 . prmod=msg_cumu)
331 ENDIF
332 IF (mln==68 ) THEN
333 CALL ancmsg(msgid=1224,
334 . msgtype=msgerror,
335 . anmode=aninfo_blind_1,
336 . i1=id,
337 . c1=titr)
338 ENDIF
339 IF (jhbe==17.AND.(jale+jeul /= 0)) THEN
340 CALL ancmsg(msgid=1222,
341 . msgtype=msgwarning,
342 . anmode=aninfo_blind_2,
343 . i1=id,
344 . c1=titr,
345 . prmod=msg_cumu)
346 jhbe = 2
347 IF (geo(13,pid) == zero) geo(13,pid) = em01
348 npt = 1
349 igeo(4,pid) = npt
350 igeo(10,pid) = jhbe
351 END IF
352C
353 IF(jcvt/=0.AND.(jlag==0.OR.mln==20))THEN
354 CALL fretitl2(titr,
355 . igeo(npropgi-ltitr+1,pid),ltitr)
356 CALL ancmsg(msgid=610,
357 . msgtype=msgwarning,
358 . anmode=aninfo_blind_1,
359 . i1=id,
360 . c1=titr,
361 . i2=ixq(7,ii))
362 jcvt=0
363 END IF
364 israt=ipm(3,mid)
365 ifail = 0
366 nfail = mat_param(mid)%NFAIL
367 istrain = 1
368 ieos=ipm(4,mid)
369
370C
371C - initial volume franction -
372C
373 lfound=.false.
374 tag_invol=0
375 IF(num_inivol > 0)THEN
376 ! Warning : In same group you can have different PArts, A loop over elem in groups has to be introduced to check if INIVOL PART is there.
377 mft = eadd(n)-1 + nft
378 ne1=min( nvsiz, nel + nel_prec - nft)
379 DO iloc = 1 ,ne1
380 DO jj=1,num_inivol
381 IF(inivol(jj)%PART_ID == ipartq(iloc+mft)) THEN
382 tag_invol = 1
383 lfound=.true.
384 EXIT
385 ENDIF
386 IF(lfound)EXIT
387 ENDDO
388 END DO
389 END IF
390
391C-------------------------------------------------
392C STOCKAGE IPARG
393C-------------------------------------------------
394 CALL zeroin(1,nparg,iparg(1,ngroup))
395C
396 iparg(1,ngroup) = mln
397 ne1 = min( nvsiz, nel + nel_prec - nft)
398 iparg(2,ngroup) = ne1
399 iparg(3,ngroup)= eadd(n)-1 + nft
400 iparg(4,ngroup) = 1 ! obsolete
401c IPARG(4,NGROUP) = LBUFEL+1
402 iparg(5,ngroup) = 2
403 iparg(6,ngroup) = npt
404 iparg(7,ngroup) = jale
405 iparg(11,ngroup)= jeul
406 iparg(12,ngroup)= jtur
407 IF(jale == 0 .AND. jeul == 0)THEN
408 iparg(13,ngroup)=-abs(jthe) ! -1 nodal temperature +1 centroid temperature
409 ELSE
410 iparg(13,ngroup)=+abs(jthe) ! -1 nodal temperature +1 centroid temperature
411 ENDIF
412 iparg(14,ngroup)= jlag
413 iparg(18,ngroup)= mid
414 iparg(20,ngroup)= jmult
415 ! Multifluid law, setting NLAY
416 IF (mln == 151) iparg(20, ngroup) = ipm(20, mid)
417 iparg(10,ngroup)= icpre
418 iparg(23,ngroup)= jhbe
419 iparg(24,ngroup)= 0
420 iparg(25,ngroup)= ml1
421 iparg(26,ngroup)= ml2
422 iparg(27,ngroup)= jpor
423 iparg(29,ngroup)= iplast
424C Group/Processor Splition
425 iparg(32,ngroup)= p-1
426C Be careful in all rigor> = 46
427 iparg(34,ngroup)= nint(pm(10,mid))
428 iparg(37,ngroup)= jcvt
429 iparg(38,ngroup)= igt
430 iparg(40,ngroup)= israt
431 iparg(42,ngroup)= isorth
432 iparg(43,ngroup)= ifail
433 iparg(44,ngroup)= istrain
434 !inivol
435 iparg(53,ngroup) = tag_invol
436C equation of state
437 iparg(55,ngroup)= ieos
438 iparg(62,ngroup)= pid
439C flag for group of duplicated elements in multidomains
440 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
441 nft = nft + ne1
442 220 CONTINUE
443 ngp(p)=ngroup-ngp(p)
444 ENDIF
445 ENDDO
446C Dd_iad => nb groups by sub -domain
447 ngp(nspmd+1)=0
448 DO p = 1, nspmd
449 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
450 dd_iad(p,nspgroup+n)=ngp(p)
451 END DO
452 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
453C
454 300 CONTINUE
455C
456 nspgroup = nspgroup + nd
457C CFD treatment on MID negative on all solids if ineg=1
458 IF (ineg==1) THEN
459 DO i = 1, numelq
460 ixq(1,i) = abs(ixq(1,i))
461 ENDDO
462 ENDIF
463C
464 IF(print_flag>6) THEN
465 WRITE(iout,1000)
466 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
467 + iparg(4,n),iparg(6,n),iparg(7,n),iparg(11,n),
468 + iparg(12,n),iparg(13,n),iparg(23,n),
469 + iparg(24,n),iparg(18,n),iparg(27,n),
470 + iparg(29,n)+1,iparg(43,n),iparg(55,n),
471 + n=ngr1,ngroup)
472 ENDIF
473 CALL ancmsg(msgid=1222,
474 . msgtype=msgwarning,
475 . anmode=aninfo_blind_2,
476 . prmod=msg_print)
477 CALL ancmsg(msgid=1223,
478 . msgtype=msgerror,
479 . anmode=aninfo_blind_2,
480 . prmod=msg_print)
481C
482 1000 FORMAT(//,7x,'4-NODE 2D SOLID ELEMENT GROUPS'/
483 + 7x,'---------------------'//
484 +' GROUP MAT. ELEM. FIRST BUFFER GAUSS',
485 +' A.L.E. EULER TURBU. THERM. HOUR- INTEG',
486 +' VAR POROUS PLASTI. FAILURE IEOS '/
487 +' # LAW NUMBER ELEM. ADDRESS POINTS',
488 +' FLAG FLAG FLAG FLAG GLASS FLAG',
489 +' MID MEDIUM FLAG FLAG TYPE '/)
490 1001 FORMAT(17(i10))
491C
492 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
groupdef_mod
Definition groupdef_mod.F:668
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::inivol
type(inivol_struct_), dimension(:), allocatable inivol
Definition inivol_mod.F:84
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
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
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
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
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47