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

Go to the source code of this file.

Functions/Subroutines

subroutine ig3dgrtails (kxig3d, iparg, geo, eadd, nd, dd_iad, idx, lb_max, inum, index, cep, ipartig3d, itr1, igrsurf, ixig3d, igeo, pm, nige, knotlocel, matparam_tab)

Function/Subroutine Documentation

◆ ig3dgrtails()

subroutine ig3dgrtails ( integer, dimension(nixig3d,*) kxig3d,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(*) eadd,
integer nd,
integer, dimension(nspmd+1,*) dd_iad,
integer idx,
integer lb_max,
integer, dimension(nixig3d+1,*) inum,
integer, dimension(*) index,
integer, dimension(*) cep,
integer, dimension(*) ipartig3d,
integer, dimension(*) itr1,
type (surf_), dimension(nsurf) igrsurf,
integer, dimension(*) ixig3d,
integer, dimension(npropgi,numgeo) igeo,
pm,
integer, dimension(*) nige,
knotlocel,
type(matparam_struct_), dimension(nummat), intent(in), target matparam_tab )

Definition at line 32 of file ig3dgrtails.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE message_mod
42 USE groupdef_mod
43 USE matparam_def_mod
44 USE ale_mod , ONLY : ale
45C-----------------------------------------------
46C A R G U M E N T S
47C-----------------------------------------------
48C KXIG3D(NIXIG3D,NUMELIG3D) ARRAY: CONECS+PID+NOS RESSORTS E
49C IPARG(NPARG,NGROUP) ARRAY: GROUP PARAMS E/S
50C GEO(NPROPG,NUMGEO) ARRAY: PROPERTY PARAMS E
51C EADD(NUMELIG3D) ARRAY: IDAM INDEXES / checkboard E
52C DD_IAD ARRAY: DD IN SUPER GROUP S
53C INDEX(NUMELIG3D) ARRAY: WORKING E/S
54C INUM (9*NUMELIG3D) ARRAY: WORKING E/S
55C CEP(NUMELIG3D) ARRAY: WORKING E/S
56C ITR1(NUMELIG3D) ARRAY: WORKING E/S
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com01_c.inc"
65#include "com04_c.inc"
66#include "units_c.inc"
67#include "param_c.inc"
68#include "vect01_c.inc"
69#include "tabsiz_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER KXIG3D(NIXIG3D,*),IPARG(NPARG,*),EADD(*),
74 . ND, DD_IAD(NSPMD+1,*),IDX,IGEO(NPROPGI,NUMGEO),
75 . LB_MAX, INUM(NIXIG3D+1,*), INDEX(*),CEP(*),
76 . IPARTIG3D(*), ITR1(*),NIGE(*)
77 my_real geo(npropg,numgeo),pm(npropm,nummat),knotlocel(*)
78 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
79 TYPE(MATPARAM_STRUCT_) , TARGET, DIMENSION(NUMMAT),INTENT(IN) :: MATPARAM_TAB
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER NGR1, NG, ISSN, MTNN, I, NE1, N, NFIX,
84 . PID, NEL_PREC, LB_L, P, NEL,NB,
85 . MODE, WORK(70000),NN,IAD1,NGROU, J,MID,IETYP,
86 . MT,IXIG3D(*),NUVAR,NUVARN,NXVIE,NXVIN,INND,II,inno,
87 . NGP(NSPMD+1),JALE_FROM_MAT,JALE_FROM_PROP
88 my_real knotlocelindx(sknotlocel)
89 TYPE(MATPARAM_STRUCT_) , POINTER :: MATPARAM
90C
91 DATA nxvie/3/, nxvin/0/
92C----------------------------------------------------------
93 npt = 1
94C----------------------------------------------------------
95 ngr1 = ngroup + 1
96 nullify(matparam)
97C
98C phase 1 : decompostition canonique
99C
100 idx=idx+nd*(nspmd+1)
101 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
102 nft = 0
103C initialisation dd_iad
104 DO n=1,nd
105 DO p=1,nspmd+1
106 dd_iad(p,nspgroup+n) = 0
107 END DO
108 ENDDO
109
110 DO n=1,nd
111 nel = eadd(n+1)-eadd(n)
112C
113 DO i = 1, nel
114 index(i) = i
115 inum(1,i)=ipartig3d(nft+i)
116 DO j=1,nixig3d
117 inum(j+1,i)=kxig3d(j,nft+i)
118 ENDDO
119 DO j=1,6
120 knotlocelindx((i-1)*6+j)=knotlocel((nft+i-1)*6+j)
121 ENDDO
122 ENDDO
123
124 mode=0
125 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
126 DO i = 1, nel
127 ipartig3d(i+nft)=inum(1,index(i))
128 DO j=1,6
129 knotlocel((i+nft-1)*6+j)=knotlocelindx((index(i)-1)*6+j)
130 ENDDO
131 DO j=1,nixig3d
132 kxig3d(j,i+nft)=inum(j+1,index(i))
133 ENDDO
134
135 itr1(nft+index(i)) = nft+i
136 ENDDO
137C dd-iad
138 p = cep(nft+index(1))
139 nb = 1
140 DO i = 2, nel
141 IF (cep(nft+index(i))/=p) THEN
142 dd_iad(p+1,nspgroup+n) = nb
143 nb = 1
144 p = cep(nft+index(i))
145 ELSE
146 nb = nb + 1
147 ENDIF
148 ENDDO
149 dd_iad(p+1,nspgroup+n) = nb
150 DO p = 2, nspmd
151 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
152 . + dd_iad(p-1,nspgroup+n)
153 ENDDO
154 DO p = nspmd+1,2,-1
155 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
156 ENDDO
157 dd_iad(1,nspgroup+n) = 1
158C
159C maj CEP
160C
161 DO i = 1, nel
162 index(i) = cep(nft+index(i))
163 ENDDO
164 DO i = 1, nel
165 cep(nft+i) = index(i)
166 ENDDO
167 nft = nft + nel
168 ENDDO
169C phase 2 : bornage en groupe de mvsiz
170C ngroup est global, iparg est global mais organise en fonction de dd
171C
172 DO 300 n=1,nd
173 nft = 0
174 lb_l = lbufel
175 DO p = 1, nspmd
176 ngp(p)=0
177 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
178 IF (nel>0) THEN
179 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
180 ngp(p)=ngroup
181 ng = (nel-1)/nvsiz + 1
182 DO 220 i=1,ng
183C xgroup global
184 ngroup=ngroup+1
185 ii = eadd(n)+nft
186 mid = kxig3d(1,ii)
187 pid = kxig3d(2,ii)
188 innd = kxig3d(3,ii)
189 mtnn= nint(pm(19,abs(kxig3d(1,ii))))
190 ietyp = 101
191 geo(8,pid)=ietyp + em01
192 matparam => matparam_tab(mid)
193
194 jale_from_mat = nint(pm(72,mid))
195 jale_from_prop = igeo(62,pid)
196 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
197
198 jlag=0
199 IF(jale == 0.AND.mtnn/=18)jlag=1
200 jeul=0
201 IF(jale == 2)THEN
202 jale=0
203 jeul=1
204C foam + air
205 ELSEIF(jale == 3 .AND. mtnn == 77) THEN
206 jlag=1
207 ENDIF
208
209 !ALE REZONING/REMAPING : number of MAT/EOS variables to treat (used by staggered scheme only : arezon.F)
210 ! 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
211 ! this numbering here will be used in arezon.F to loop over variables to rezon/remap
212 IF(jale == 1)THEN
213 ale%REZON%NUM_NUVAR_MAT = ale%REZON%NUM_NUVAR_MAT + matparam%REZON%NUM_NUVAR_MAT
214 ale%REZON%NUM_NUVAR_EOS = ale%REZON%NUM_NUVAR_EOS + matparam%REZON%NUM_NUVAR_EOS
215 ENDIF
216
217 !ALE UVAR REZONING (81:MAT, 82:EOS)
218 IF(jale == 1)THEN
219 iparg(81,ngroup) = matparam%REZON%NUM_NUVAR_MAT
220 iparg(82,ngroup) = matparam%REZON%NUM_NUVAR_EOS
221 ENDIF
222
223 IF(mtnn/=50)jtur=nint(pm(70,mid))
224 jthe = nint(pm(71,mid))
225C
226 CALL zeroin(1,nparg,iparg(1,ngroup))
227C
228 ne1 = min( nvsiz, nel + nel_prec - nft)
229 nuvar =nint( geo(25,pid))
230 nuvarn=nint( geo(35,pid))
231
232 iparg(1,ngroup) = mtnn
233 iparg(2,ngroup) = ne1
234 iparg(3,ngroup) = ii-1
235 iparg(4,ngroup) = 1
236 iparg(5,ngroup) = ietyp
237 iparg(6,ngroup) = npt
238 iparg(7,ngroup) = jale
239 iparg(11,ngroup)= jeul
240 iparg(12,ngroup)= jtur
241 iparg(13,ngroup)= jthe ! -1 nodal temperature +1 centroid temperature
242 IF(jale+jeul>0)iparg(13,ngroup)=-jthe
243 iparg(14,ngroup)= jlag
244 iparg(75,ngroup) = innd
245 iparg(62,ngroup) = pid
246 iparg(38,ngroup) = igeo(11,pid)
247 iparg(56,ngroup) = igeo(41,pid)
248 iparg(57,ngroup) = igeo(42,pid)
249 iparg(58,ngroup) = igeo(43,pid)
250C
251c LBUFEL= IPARG(4,NGROUP)+NE1*
252c . (NXVIE+NUVAR+INND*(NXVIN+NUVARN))-1
253C reperage groupe/processeur
254 iparg(32,ngroup)= p-1
255 nft = nft + ne1
256 220 CONTINUE
257 ngp(p)=ngroup-ngp(p)
258 ENDIF
259 ENDDO
260 lb_l = lbufel - lb_l
261 lb_max = max(lb_max,lb_l)
262C DD_IAD => nb groupes par sous domaine
263 ngp(nspmd+1)=0
264 DO p = 1, nspmd
265 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
266 dd_iad(p,nspgroup+n)=ngp(p)
267 END DO
268 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
269C
270 300 CONTINUE
271C
272 nspgroup = nspgroup + nd
273C
274C RENUMEROTATION POUR SURFACES
275C
276 DO i=1,nsurf ! mettre un if pour ne pas changer les faces EF classiques
277 nn=igrsurf(i)%NSEG_IGE
278 DO j=1,nn
279 IF(igrsurf(i)%ELTYP_IGE(j) == 101)
280 . igrsurf(i)%ELEM_IGE(j) = itr1(igrsurf(i)%ELEM_IGE(j))
281 ENDDO
282 ENDDO
283C
284 DO i=1,numfakenodigeo
285 nige(i)=itr1(nige(i))
286 ENDDO
287C
288 WRITE(iout,1000)
289 WRITE(iout,1001)(n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
290 + iparg(4,n),iparg(5,n),
291 + n=ngr1,ngroup)
292c WRITE(IOUT,1002) LBUFEL
293C
294 1000 FORMAT(10x,' 3D - ISO-GEOMETRIC ELEMENT GROUPS '/
295 + 10x,' ----------------------------------'/
296 +' GROUP ELEMENT ELEMENT FIRST BUFFER ELEMENT '/
297 +' MATERIAL NUMBER ELEMENT ADDRESS TYPE '/)
298 1001 FORMAT(6(1x,i7,1x))
299 1002 FORMAT(' BUFFER LENGTH : ',i10 )
300C
301
302 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
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
message_mod
Definition message_mod.F:1249
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47