OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ig3dgrtails.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!|| ig3dgrtails ../starter/source/elements/ige3d/ig3dgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| zeroin ../starter/source/system/zeroin.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE ig3dgrtails(
33 1 KXIG3D ,IPARG ,GEO ,EADD,
34 2 ND ,DD_IAD ,IDX ,LB_MAX, INUM,
35 3 INDEX ,CEP ,IPARTIG3D ,ITR1, IGRSURF,
36 4 IXIG3D ,
37 5 IGEO ,PM ,NIGE, KNOTLOCEL, MATPARAM_TAB)
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
303 END
ig3dgrtails
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)
Definition ig3dgrtails.F:38
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