OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qgrtails.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| qgrtails ../starter/source/elements/solid_2d/quad/qgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| zeroin ../starter/source/system/zeroin.F
31!||--- uses -----------------------------------------------------
32!|| inivol_def_mod ../starter/share/modules1/inivol_mod.f
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| r2r_mod ../starter/share/modules1/r2r_mod.f
35!||====================================================================
36 SUBROUTINE qgrtails(
37 1 IXQ ,PM ,IPARG ,GEO ,
38 2 EADD ,ND ,DD_IAD ,IDX ,
39 3 INUM ,INDEX ,CEP ,IPARTQ ,
40 4 ITR1 ,IGRSURF ,IGRQUAD,MAT_PARAM,
41 5 IGEO ,IPM ,IQUAOFF,INIVOL,PRINT_FLAG)
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
52C-----------------------------------------------
53C A R G U M E N T S
54C-----------------------------------------------
55C IXQ(7,NUMELQ) TABLEAU CONECS+PID+MID+NOS SOLIDES 4N E
56C PM(NPROPM,NUMMAT) TABLEAU DES CARACS DES MATERIAUX E
57C IPARG(NPARG,NGROUP)TABLEAU DES CARACTERISTIQUES DES GROUPES E/S
58C GEO(NPROPG,NUMGEO) TABLEAU DES CARACS DES PID E
59C EADD(NUMELQ) TABLEAU DES ADRESEES DANS IDAM CHGT DAMIER E
60C DD_IAD TABLEAU DE LA DD EN SUPER GROUPES S
61C INUM(8,NUMELQ) TABLEAU DE TRAVAIL E/S
62C INDEX(NUMELQ) TABLEAU DE TRAVAIL E/S
63C CEP(NUMELQ) TABLEAU DE TRAVAIL E/S
64C IPARTQ(NUMELQ) TABLEAU DE TRAVAIL E/S
65C ITR1(NSELQ) TABLEAU DE TRAVAIL E/S
66C-----------------------------------------------
67C I M P L I C I T T Y P E S
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C C O M M O N B L O C K S
72C-----------------------------------------------
73#include "vect01_c.inc"
74#include "com01_c.inc"
75#include "com04_c.inc"
76#include "units_c.inc"
77#include "param_c.inc"
78#include "scr17_c.inc"
79#include "r2r_c.inc"
80C-----------------------------------------------
81C D U M M Y A R G U M E N T S
82C-----------------------------------------------
83 INTEGER ND, IDX
84 INTEGER IGEO(NPROPGI,NUMGEO),IPM(NPROPMI,NUMMAT), IXQ(NIXQ,NUMELQ),IPARG(NPARG,*),
85 . EADD(*),DD_IAD(NSPMD+1,*),INUM(9,*),INDEX(*),
86 . CEP(*),IPARTQ(*),ITR1(*),
87 . IQUAOFF(*)
88 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
89 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
90 MY_REAL PM(NPROPM,NUMMAT), GEO(NPROPG,NUMGEO)
91C-----------------------------------------------
92 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
93 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
94 TYPE(matparam_struct_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
95C-----------------------------------------------
96C L O C A L V A R I A B L E S
97C-----------------------------------------------
98 INTEGER
99 . ngr1, mln, ng, n, mid, pid, ii, nel, ne1,
100 . p, nel_prec, lb_l, igt, jhbe, i,
101 . ml1, ml2, mt1, mt2,nb,ineg,ieos,
102 . mode, work(70000),nn,j,
103 . iplast,ifail,nfail,
104 . ngp(nspmd+1),icpre,ipartr2r,ismst,tag_invol,
105 . jale_from_mat,jale_from_prop
106 INTEGER ID,MFT,ILOC,JJ
107 CHARACTER(LEN=NCHARTITLE)::TITR
108 LOGICAL lFOUND
109C--------------------------------------------------------------
110C BORNAGE DES GROUPES DE MVSIZ
111C--------------------------------------------------------------
112 ngr1 = ngroup + 1
113C
114C phase 1 : domain decompostition
115C
116 idx=idx+nd*(nspmd+1)
117 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
118C NSPGROUP = NSPGROUP + ND
119 nft = 0
120C initialisation dd_iad
121 DO n=1,nd
122 DO p=1,nspmd+1
123 dd_iad(p,nspgroup+n) = 0
124 END DO
125 ENDDO
126C
127C phase 2 : bornage en groupe de mvsiz
128C ngroup est global, iparg est global mais organise en fonction de dd
129C
130 DO n=1,nd
131 nel = eadd(n+1)-eadd(n)
132C
133 DO i = 1, nel
134 index(i) = i
135 inum(1,i)=ipartq(nft+i)
136 inum(2,i)=ixq(1,nft+i)
137 inum(3,i)=ixq(2,nft+i)
138 inum(4,i)=ixq(3,nft+i)
139 inum(5,i)=ixq(4,nft+i)
140 inum(6,i)=ixq(5,nft+i)
141 inum(7,i)=ixq(6,nft+i)
142 inum(8,i)=ixq(7,nft+i)
143 inum(9,i)=iquaoff(nft+i)
144 ENDDO
145
146 mode=0
147 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
148 DO i = 1, nel
149 ipartq(i+nft)=inum(1,index(i))
150 ixq(1,i+nft)=inum(2,index(i))
151 ixq(2,i+nft)=inum(3,index(i))
152 ixq(3,i+nft)=inum(4,index(i))
153 ixq(4,i+nft)=inum(5,index(i))
154 ixq(5,i+nft)=inum(6,index(i))
155 ixq(6,i+nft)=inum(7,index(i))
156 ixq(7,i+nft)=inum(8,index(i))
157 iquaoff(i+nft)=inum(9,index(i))
158 itr1(nft+index(i)) = nft+i
159 ENDDO
160
161C dd-iad
162 p = cep(nft+index(1))
163 nb = 1
164 DO i = 2, nel
165 IF (cep(nft+index(i))/=p) THEN
166 dd_iad(p+1,nspgroup+n) = nb
167 nb = 1
168 p = cep(nft+index(i))
169 ELSE
170 nb = nb + 1
171 ENDIF
172 ENDDO
173 dd_iad(p+1,nspgroup+n) = nb
174 DO p = 2, nspmd
175 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
176 . + dd_iad(p-1,nspgroup+n)
177 ENDDO
178 DO p = nspmd+1,2,-1
179 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
180 ENDDO
181 dd_iad(1,nspgroup+n) = 1
182C
183C maj CEP
184C
185 DO i = 1, nel
186 index(i) = cep(nft+index(i))
187 ENDDO
188 DO i = 1, nel
189 cep(nft+i) = index(i)
190 ENDDO
191 nft = nft + nel
192 ENDDO
193
194C
195C RENUMEROTATION POUR SURFACES
196C
197 DO i=1,nsurf
198 nn=igrsurf(i)%NSEG
199 DO j=1,nn
200 IF(igrsurf(i)%ELTYP(j) == 2)
201 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
202 ENDDO
203 ENDDO
204C
205C RENUMEROTATION POUR GROUPES DE SHELL
206C
207 DO i=1,ngrquad
208 nn=igrquad(i)%NENTITY
209 DO j=1,nn
210 igrquad(i)%ENTITY(j) = itr1(igrquad(i)%ENTITY(j))
211 ENDDO
212 ENDDO
213C
214 ineg = 0
215 DO 300 n=1,nd
216
217 nft = 0
218 lb_l = lbufel
219 DO p = 1, nspmd
220 ngp(p)=0
221 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
222 IF (nel>0) THEN
223 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
224 ngp(p)=ngroup
225 ng = (nel-1)/nvsiz + 1
226 DO 220 i=1,ng
227C ngroup global
228 ngroup=ngroup+1
229 ii = eadd(n)+nft
230 mid = ixq(1,ii)
231 pid = ixq(6,ii)
232 ipartr2r = 0
233 IF (nsubdom>0) ipartr2r = tag_mat(mid)
234 npt =1
235 jhbe=0
236 jpor=0
237 jcvt = 0
238 isorth=0
239 iplast= 1
240 icpre=0
241 ismst = 0
242 igt = 0
243 IF(pid/=0)THEN
244 IF(igeo(10,pid)==17 .OR.
245 . (n2d==1.AND.igeo(10,pid)==22)) THEN
246 npt = igeo(4,pid)
247 jhbe = igeo(10,pid)
248 ENDIF
249 icpre = igeo(13,pid)
250 igt = igeo(11,pid)
251 istrain= igeo(12,pid)
252 jcvt = igeo(16,pid)
253 isorth = igeo(17,pid)
254 ismst = igeo(5,pid)
255 IF (igt /= 15) iplast = igeo(9,pid)
256 IF(igt==15) jpor=2*nint(geo(28,pid))
257 ENDIF
258 mln = nint(pm(19,abs(mid)))
259 IF(mid<0)THEN
260 IF(mln==6.AND.jpor/=2)mln=17
261 IF(mln==46)mln=47
262 mid=abs(mid)
263 ixq(1,ii)=mid
264 ineg = 1
265 ENDIF
266 jale_from_mat = nint(pm(72,mid))
267 jale_from_prop = igeo(62,pid)
268 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
269 jlag=0
270 IF(jale==0.AND.mln/=18)jlag=1
271 jeul=0
272 IF(jale==2)THEN
273 jale=0
274 jeul=1
275 ENDIF
276
277 !ale rezoning/remaping : number of mat/eos variables to treat(used by staggered scheme only : arezon.f)
278 ! 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
279 ! this numbering here will be used in arezon.F to loop over variables to rezon/remap
280 IF(jale == 1)THEN
281 ale%REZON%NUM_NUVAR_MAT = ale%REZON%NUM_NUVAR_MAT + mat_param(mid)%REZON%NUM_NUVAR_MAT
282 ale%REZON%NUM_NUVAR_EOS = ale%REZON%NUM_NUVAR_EOS + mat_param(mid)%REZON%NUM_NUVAR_EOS
283 ENDIF
284
285 !ALE UVAR REZONING (81:MAT, 82:EOS)
286 IF(jale == 1)THEN
287 iparg(81,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_MAT
288 iparg(82,ngroup) = mat_param(mid)%REZON%NUM_NUVAR_EOS
289 ENDIF
290
291 jtur=nint(pm(70,mid))
292 jthe=nint(pm(71,mid))
293
294 jmult=0
295 IF(mln==20)THEN
296 jmult=nint(pm(20,mid))
297 mt1=nint(pm(21,mid))
298 mt2=nint(pm(22,mid))
299 ml1=nint(pm(19,mt1))
300 ml2=nint(pm(19,mt2))
301 ELSE
302 jmult=0
303 ml1=0
304 ml2=0
305 ENDIF
306C--------------------
307C- ICPRE,ISMSTR JCVT Automatic
308C--------------------
309 IF (igt == 14.OR.igt == 6) THEN
310 IF (icpre < 0) icpre =0
311 IF (ismst < 0) ismst =4
312 IF (jcvt<0) THEN
313 jcvt = 0
314 IF (jlag>0) jcvt = 1
315 END IF
316 END IF
317C--------------------
318C TEST COMPATIBILITE
319C--------------------
320
321 id=igeo(1,pid)
322 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
323 IF (ismst /= 2 .AND. ismst /= 4) THEN
324 CALL ancmsg(msgid=1223,
325 . msgtype=msgerror,
326 . anmode=aninfo_blind_2,
327 . i1=id,
328 . c1=titr,
329 . prmod=msg_cumu)
330 ENDIF
331 IF (mln==68 ) THEN
332 CALL ancmsg(msgid=1224,
333 . msgtype=msgerror,
334 . anmode=aninfo_blind_1,
335 . i1=id,
336 . c1=titr)
337 ENDIF
338 IF (jhbe==17.AND.(jale+jeul /= 0)) THEN
339 CALL ancmsg(msgid=1222,
340 . msgtype=msgwarning,
341 . anmode=aninfo_blind_2,
342 . i1=id,
343 . c1=titr,
344 . prmod=msg_cumu)
345 jhbe = 2
346 IF (geo(13,pid) == zero) geo(13,pid) = em01
347 npt = 1
348 igeo(4,pid) = npt
349 igeo(10,pid) = jhbe
350 END IF
351C
352 IF(jcvt/=0.AND.(jlag==0.OR.mln==20))THEN
353 CALL fretitl2(titr,
354 . igeo(npropgi-ltitr+1,pid),ltitr)
355 CALL ancmsg(msgid=610,
356 . msgtype=msgwarning,
357 . anmode=aninfo_blind_1,
358 . i1=id,
359 . c1=titr,
360 . i2=ixq(7,ii))
361 jcvt=0
362 END IF
363 israt=ipm(3,mid)
364 ifail = 0
365 nfail = mat_param(mid)%NFAIL
366 istrain = 1
367 ieos=ipm(4,mid)
368
369C
370C - initial volume franction -
371C
372 lfound=.false.
373 tag_invol=0
374 IF(num_inivol > 0)THEN
375 ! 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.
376 mft = eadd(n)-1 + nft
377 ne1=min( nvsiz, nel + nel_prec - nft)
378 DO iloc = 1 ,ne1
379 DO jj=1,num_inivol
380 IF(inivol(jj)%PART_ID == ipartq(iloc+mft)) THEN
381 tag_invol = 1
382 lfound=.true.
383 EXIT
384 ENDIF
385 IF(lfound)EXIT
386 ENDDO
387 END DO
388 END IF
389
390C-------------------------------------------------
391C STOCKAGE IPARG
392C-------------------------------------------------
393 CALL zeroin(1,nparg,iparg(1,ngroup))
394C
395 iparg(1,ngroup) = mln
396 ne1 = min( nvsiz, nel + nel_prec - nft)
397 iparg(2,ngroup) = ne1
398 iparg(3,ngroup)= eadd(n)-1 + nft
399 iparg(4,ngroup) = 1 ! obsolete
400c IPARG(4,NGROUP) = LBUFEL+1
401 iparg(5,ngroup) = 2
402 iparg(6,ngroup) = npt
403 iparg(7,ngroup) = jale
404 iparg(11,ngroup)= jeul
405 iparg(12,ngroup)= jtur
406 IF(jale == 0 .AND. jeul == 0)THEN
407 iparg(13,ngroup)=-abs(jthe) ! -1 nodal temperature +1 centroid temperature
408 ELSE
409 iparg(13,ngroup)=+abs(jthe) ! -1 nodal temperature +1 centroid temperature
410 ENDIF
411 iparg(14,ngroup)= jlag
412 iparg(18,ngroup)= mid
413 iparg(20,ngroup)= jmult
414 ! Multifluid law, setting NLAY
415 IF (mln == 151) iparg(20, ngroup) = ipm(20, mid)
416 iparg(10,ngroup)= icpre
417 iparg(23,ngroup)= jhbe
418 iparg(24,ngroup)= 0
419 iparg(25,ngroup)= ml1
420 iparg(26,ngroup)= ml2
421 iparg(27,ngroup)= jpor
422 iparg(29,ngroup)= iplast
423C reperage groupe/processeur
424 iparg(32,ngroup)= p-1
425C attention en toute rigeur >=46
426 iparg(34,ngroup)= nint(pm(10,mid))
427 iparg(37,ngroup)= jcvt
428 iparg(38,ngroup)= igt
429 iparg(40,ngroup)= israt
430 iparg(42,ngroup)= isorth
431 iparg(43,ngroup)= ifail
432 iparg(44,ngroup)= istrain
433 !inivol
434 iparg(53,ngroup) = tag_invol
435C equation of state
436 iparg(55,ngroup)= ieos
437 iparg(62,ngroup)= pid
438C flag for group of duplicated elements in multidomains
439 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
440 nft = nft + ne1
441 220 CONTINUE
442 ngp(p)=ngroup-ngp(p)
443 ENDIF
444 ENDDO
445C DD_IAD => nb groupes par sous domaine
446 ngp(nspmd+1)=0
447 DO p = 1, nspmd
448 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
449 dd_iad(p,nspgroup+n)=ngp(p)
450 END DO
451 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
452C
453 300 CONTINUE
454C
455 nspgroup = nspgroup + nd
456C Traitement CFD sur MID negatif sur tous les solides si ineg=1
457 IF (ineg==1) THEN
458 DO i = 1, numelq
459 ixq(1,i) = abs(ixq(1,i))
460 ENDDO
461 ENDIF
462C
463 IF(print_flag>6) THEN
464 WRITE(iout,1000)
465 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
466 + iparg(4,n),iparg(6,n),iparg(7,n),iparg(11,n),
467 + iparg(12,n),iparg(13,n),iparg(23,n),
468 + iparg(24,n),iparg(18,n),iparg(27,n),
469 + iparg(29,n)+1,iparg(43,n),iparg(55,n),
470 + n=ngr1,ngroup)
471 ENDIF
472 CALL ancmsg(msgid=1222,
473 . msgtype=msgwarning,
474 . anmode=aninfo_blind_2,
475 . prmod=msg_print)
476 CALL ancmsg(msgid=1223,
477 . msgtype=msgerror,
478 . anmode=aninfo_blind_2,
479 . prmod=msg_print)
480C
481 1000 FORMAT(//,7x,'4-NODE 2D SOLID ELEMENT GROUPS'/
482 + 7x,'---------------------'//
483 +' GROUP MAT. ELEM. FIRST BUFFER GAUSS',
484 +' A.L.E. EULER TURBU. THERM. HOUR- INTEG',
485 +' VAR POROUS PLASTI. FAILURE IEOS '/
486 +' # LAW NUMBER ELEM. ADDRESS POINTS',
487 +' FLAG FLAG FLAG FLAG GLASS FLAG',
488 +' MID MEDIUM FLAG FLAG TYPE '/)
489 1001 FORMAT(17(i10))
490C
491 RETURN
492 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
groupdef_mod
Definition groupdef_mod.F:662
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
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
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
qgrtails
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)
Definition qgrtails.F:42
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
starter
program starter
Definition starter.F:39
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47