OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cgrtails.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!|| cgrtails ../starter/source/elements/shell/coque/cgrtails.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| arret ../starter/source/system/arret.F
30!|| cpp_reorder_elements ../starter/source/spmd/cpp_reorder_elements.cpp
31!|| fretitl2 ../starter/source/starter/freform.F
32!|| zeroin ../starter/source/system/zeroin.F
33!||--- uses -----------------------------------------------------
34!|| drape_mod ../starter/share/modules1/drape_mod.F
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| r2r_mod ../starter/share/modules1/r2r_mod.F
37!|| reorder_mod ../starter/share/modules1/reorder_mod.F
38!|| stack_mod ../starter/share/modules1/stack_mod.f
39!||====================================================================
40 SUBROUTINE cgrtails(
41 1 IXC ,PM ,IPARG ,GEO ,
42 2 EADD ,ND ,IPARTC ,DD_IAD,
43 3 IDX ,INUM ,ITR1 ,
44 4 INDEX ,CEP ,THK ,XNUM,
45 5 IGRSURF,IGRSH4N ,IGEO ,IPM ,
46 6 IPART ,SH4TREE ,NOD2ELC ,ISHEOFF ,
47 7 SH4TRIM ,TAGPRT_SMS,LGAUGE ,IWORKSH ,
48 8 STACK ,DRAPE ,RNOISE ,MAT_PARAM,
49 9 SH4ANG, IDDLEVEL , DRAPEG,PRINT_FLAG,PTSHEL,DAMP_RANGE_PART)
50C-----------------------------------------------
51C M o d u l e s
52C-----------------------------------------------
53 USE my_alloc_mod
54 USE message_mod
55 USE r2r_mod
56 USE stack_mod
57 USE reorder_mod
58 USE groupdef_mod
59 USE matparam_def_mod
60 USE drape_mod
61 USE qa_out_mod
62 USE names_and_titles_mod , ONLY : nchartitle
63C-----------------------------------------------
64C A R G U M E N T S
65C-----------------------------------------------
66C IXC(NIXC,NUMELC) ARRAY MID(1)+CONECS(2-5)+PID(6)+ E
67C N GLOBAL(7) E
68C PM(NPROPM,NUMMAT) ARRAY MATERIAL CHARACTERISTICS E
69C IPARG(NPARG,NGROUP)ARRAY GROUP CHARACTERISTICS E/S
70C GEO(NPROPG,NUMGEO) ARRAY PID CHARACTERISTICS E
71C EADD(NUMELC) ARRAY ADDRESSES IN IDAM CHECKBOARD E
72C DD_IAD ARRAY FROM DD IN SUPER GROUPS S
73C IPARTC E/S
74C INUM(9,NUMELC) WORKING ARRAY E/S
75C ITR1(NSELC) WORKING ARRAY E/S
76C INDEX(NUMELC) WORKING ARRAY E/S
77C THK(NUMELC) THICKNESS ARRAY E/S
78C XNUM(NUMELC) WORKING ARRAY E/S
79C CEP(NUMELC) WORKING ARRAY E/S
80C ISHEOFF(NUMELC) FLAG ELEM RBY ON/OFF E/S
81C-----------------------------------------------
82C I M P L I C I T T Y P E S
83C-----------------------------------------------
84#include "implicit_f.inc"
85C-----------------------------------------------
86C C O M M O N B L O C K S
87C-----------------------------------------------
88#include "com01_c.inc"
89#include "com04_c.inc"
90#include "com_xfem1.inc"
91#include "units_c.inc"
92#include "param_c.inc"
93#include "vect01_c.inc"
94#include "scr17_c.inc"
95#include "remesh_c.inc"
96#include "sms_c.inc"
97#include "r2r_c.inc"
98#include "drape_c.inc"
99C-----------------------------------------------
100C D U M M Y A R G U M E N T S
101C-----------------------------------------------
102 INTEGER ND, IDX
103 INTEGER IXC(NIXC,*),IPARG(NPARG,*),EADD(*),IGEO(NPROPGI,*),
104 . DD_IAD(NSPMD+1,*),IPARTC(*),SH4TRIM(*),
105 . INUM(9,*),ITR1(*),INDEX(*),CEP(*),
106 . IPM(NPROPMI,*), IPART(LIPART1,*), SH4TREE(KSH4TREE,*),
107 . ISHEOFF(*),TAGPRT_SMS(*),LGAUGE(3,*),
108 . NOD2ELC(*),IWORKSH(3,*)
109 INTEGER, INTENT(IN) :: IDDLEVEL
110 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
111 INTEGER , DIMENSION(NUMELC) , INTENT(INOUT):: PTSHEL
112 INTEGER , INTENT(IN) :: DAMP_RANGE_PART(NPART) !< flag to compute the damping range
113 MY_REAL
114 . PM(NPROPM,*), GEO(NPROPG,*), XNUM(*),THK(*),RNOISE(NPERTURB,*),
115 . SH4ANG(*)
116 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
117C-----------------------------------------------
118 TYPE (STACK_PLY) :: STACK
119 TYPE (DRAPE_) , TARGET :: DRAPE (NUMELC_DRAPE + NUMELTG_DRAPE)
120 TYPE (DRAPEG_) :: DRAPEG
121 TYPE (DRAPE_) , DIMENSION(:), ALLOCATABLE :: XNUM_DRAPE
122 TYPE (DRAPEG_) :: XNUM_DRAPEG
123C-----------------------------------------------
124 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
125 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
126C-----------------------------------------------
127C L O C A L V A R I A B L E S
128C-----------------------------------------------
129 INTEGER I,K,NGR1,MLN,ISMST, ICSEN, JLEV, MY_NVSIZ, IADM,NLEVXF,
130 . npn, n, mid, pid, ihbe,npg,ixfem_err,
131 . ii, j, midn, pidn, nsg, nel, ne1, ithk,
132 . ipla, igtyp, kfts, p, nel_prec,nb,
133 . nn,prt,
134 . imatly, ipt,ilev,mpt, ie, nuvarr,
135 . ngp(nspmd+1),n1,nvarv,ivisc,ifwv,ixfem,iptun,irep,
136 . isubstack,ipmat, ippid,
137 . ipartr2r,nb_law58,ipert,stat,igmat,ipinch,ism0,iseatbelt,
138 . nslice,kk,npt_drp, idrape, jj,iel,iel0,ishel,idamp_freq_range
139 INTEGER, DIMENSION(:), ALLOCATABLE :: INUM_R2R
140 my_real, DIMENSION(:), ALLOCATABLE :: ANGLE
141 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEXS2,INUM_PTSHEL
142
143 INTEGER MODE,WORK(70000)
144 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ISTOR,INUM_WORKSH
145C REAL OU REAL*8
146 INTEGER ID
147 CHARACTER(LEN=NCHARTITLE)::TITR,TITR1,TITR2
148 my_real, DIMENSION(:,:), ALLOCATABLE :: xnum_rnoise
149 INTEGER :: NB_NODES, LDIM, OFFSET
150
151 TYPE (DRAPE_PLY_) , POINTER :: DRAPE_PLY
152C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
153 CALL my_alloc(inum_r2r,1+r2r_siu*numelc)
154 CALL my_alloc(angle,numelc)
155
156 IF(nadmesh /= 0)THEN
157 ALLOCATE( istor(ksh4tree+1,numelc) )
158 ELSE
159 ALLOCATE( istor(0,0) )
160 ENDIF
161
162 CALL my_alloc(indexs2,numelc)
163 indexs2(1:numelc)=permutation%SHELL(1:numelc)
164C
165 IF (nperturb > 0) THEN
166 ALLOCATE(xnum_rnoise(nperturb,numelc),stat=stat)
167 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
168 . msgtype=msgerror,
169 . c1='XNUM_RNOISE')
170 ELSE
171 ALLOCATE(xnum_rnoise(0,0))
172 ENDIF
173C
174 iptun = 1
175 ixfem_err = 0
176C--------------------------------------------------------------
177C GROUPING BY MVSIZ GROUPS
178C--------------------------------------------------------------
179 ngr1 = ngroup + 1
180C
181C phase 1 : domain decomposition
182C
183 idx=idx+nd*(nspmd+1)
184 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
185 nft = 0
186C initialization dd_iad
187 DO n=1,nd
188 DO p=1,nspmd+1
189 dd_iad(p,nspgroup+n) = 0
190 END DO
191 ENDDO
192C
193 iel = 0
194 DO n=1,nd
195 nel = eadd(n+1)-eadd(n)
196C
197 IF (ndrape > 0 .AND. numelc_drape > 0) THEN
198 ALLOCATE(xnum_drape(nel))
199 ALLOCATE(xnum_drapeg%INDX(nel))
200 xnum_drapeg%INDX = 0
201 DO i =1, nel
202 iel0 = drapeg%INDX(i + nft)
203 IF(iel0 == 0) cycle
204 npt = drape(iel0)%NPLY
205 npt_drp = drape(iel0)%NPLY_DRAPE
206 ALLOCATE(xnum_drape(i)%INDX_PLY(npt))
207 ALLOCATE(xnum_drape(i)%DRAPE_PLY(npt_drp))
208 xnum_drape(i)%INDX_PLY= 0
209 DO j = 1,npt_drp
210 nslice = drape(iel0)%DRAPE_PLY(j)%NSLICE
211 ALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%RDRAPE(nslice,2))
212 ALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%IDRAPE(nslice,3))
213 xnum_drape(i)%DRAPE_PLY(j)%RDRAPE = 0
214 xnum_drape(i)%DRAPE_PLY(j)%IDRAPE = 0
215 ENDDO
216 ENDDO
217 ELSE
218 ALLOCATE( xnum_drape(0) )
219 ENDIF
220 ALLOCATE(inum_worksh(3,nel))
221C
222 IF(ndrape > 0 .AND. numelc_drape > 0) THEN
223 DO i = 1, nel
224 index(i) = i
225 inum(1,i)=ipartc(nft+i)
226 inum(2,i)=isheoff(nft+i)
227 inum(3,i)=ixc(1,nft+i)
228 inum(4,i)=ixc(2,nft+i)
229 inum(5,i)=ixc(3,nft+i)
230 inum(6,i)=ixc(4,nft+i)
231 inum(7,i)=ixc(5,nft+i)
232 inum(8,i)=ixc(6,nft+i)
233 inum(9,i)=ixc(7,nft+i)
234 xnum(i)=thk(nft+i)
235 inum_worksh(1,i) = iworksh(1, nft + i)
236 inum_worksh(2,i) = iworksh(2, nft + i)
237 inum_worksh(3,i) = iworksh(3, nft + i)
238 IF (nsubdom>0) inum_r2r(i) = tag_elcf(nft+i)
239 IF (nperturb > 0) THEN
240 DO ipert = 1, nperturb
241 xnum_rnoise(ipert,i) = rnoise(ipert,nft+i)
242 ENDDO
243 ENDIF
244 angle(i) = sh4ang(nft + i)
245 !drape structure
246 iel0 = drapeg%INDX(nft + i)
247 xnum_drapeg%INDX(i) = iel0
248 IF(iel0 == 0) cycle
249 npt = drape(iel0)%NPLY
250 xnum_drape(i)%NPLY = npt
251 xnum_drape(i)%INDX_PLY(1:npt) = drape(iel0)%INDX_PLY(1:npt)
252 npt = drape(iel0)%NPLY_DRAPE
253 xnum_drape(i)%NPLY_DRAPE = npt
254 xnum_drape(i)%THICK = drape(iel0)%THICK
255 DO jj = 1, npt
256 drape_ply => drape(iel0)%DRAPE_PLY(jj)
257 nslice = drape_ply%NSLICE
258 xnum_drape(i)%DRAPE_PLY(jj)%NSLICE = nslice
259 xnum_drape(i)%DRAPE_PLY(jj)%IPID = drape_ply%IPID
260 DO kk = 1,nslice
261 xnum_drape(i)%DRAPE_PLY(jj)%IDRAPE(kk,1)=drape_ply%IDRAPE(kk,1)
262 xnum_drape(i)%DRAPE_PLY(jj)%IDRAPE(kk,2)=drape_ply%IDRAPE(kk,2)
263 xnum_drape(i)%DRAPE_PLY(jj)%RDRAPE(kk,1)=drape_ply%RDRAPE(kk,1)
264 xnum_drape(i)%DRAPE_PLY(jj)%RDRAPE(kk,2)=drape_ply%RDRAPE(kk,2)
265 ENDDO
266 DEALLOCATE(drape_ply%IDRAPE, drape_ply%RDRAPE)
267 ENDDO
268 DEALLOCATE(drape(iel0)%DRAPE_PLY)
269 DEALLOCATE(drape(iel0)%INDX_PLY)
270 ENDDO
271 ELSE
272 DO i = 1, nel
273 index(i) = i
274 inum(1,i)=ipartc(nft+i)
275 inum(2,i)=isheoff(nft+i)
276 inum(3,i)=ixc(1,nft+i)
277 inum(4,i)=ixc(2,nft+i)
278 inum(5,i)=ixc(3,nft+i)
279 inum(6,i)=ixc(4,nft+i)
280 inum(7,i)=ixc(5,nft+i)
281 inum(8,i)=ixc(6,nft+i)
282 inum(9,i)=ixc(7,nft+i)
283 xnum(i)=thk(nft+i)
284 inum_worksh(1,i) = iworksh(1,nft + i)
285 inum_worksh(2,i) = iworksh(2,nft + i)
286 inum_worksh(3,i) = iworksh(3,nft + i)
287 IF (nsubdom>0) inum_r2r(i) = tag_elcf(nft+i)
288 IF (nperturb > 0) THEN
289 DO ipert = 1, nperturb
290 xnum_rnoise(ipert,i) = rnoise(ipert,nft+i)
291 ENDDO
292 ENDIF
293 angle(i) = sh4ang(nft+i)
294 ENDDO
295 ENDIF
296 IF(abs(isigi) == 3 .OR. abs(isigi) == 4 .OR. abs(isigi) == 5) THEN
297 ALLOCATE(inum_ptshel(nel))
298 DO i = 1, nel
299 inum_ptshel(i)=ptshel(nft+i)
300 ENDDO
301 ENDIF
302C
303 IF(nadmesh/=0)THEN
304 DO k=1,ksh4tree
305 DO i=1,nel
306 istor(k,i)=sh4tree(k,nft+i)
307 ENDDO
308 ENDDO
309 IF(lsh4trim/=0)THEN
310 DO i=1,nel
311 istor(ksh4tree+1,i)=sh4trim(nft+i)
312 ENDDO
313 END IF
314 END IF
315C
316 IF(doqa .NE. 0 .OR. nadmesh /=0 .OR. iddlevel == 0) THEN
317 mode=0
318 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
319 ELSE
320 nb_nodes = 4 ! 8 nodes for solids
321 ldim = 9 ! fist dimension of INUM
322 offset = 3 ! nodes starts at INUM(4,I)
323 CALL cpp_reorder_elements(nel, nspmd, nb_nodes, offset, ldim , cep(nft+1), inum, index)
324 ENDIF
325 IF(ndrape > 0 .AND. numelc_drape > 0) THEN
326 DO i = 1, nel
327 permutation%SHELL(i+nft)=indexs2(index(i)+nft)
328 ipartc(i+nft) =inum(1,index(i))
329 isheoff(i+nft)=inum(2,index(i))
330 thk(i+nft) =xnum(index(i))
331 ixc(1,i+nft)=inum(3,index(i))
332 ixc(2,i+nft)=inum(4,index(i))
333 ixc(3,i+nft)=inum(5,index(i))
334 ixc(4,i+nft)=inum(6,index(i))
335 ixc(5,i+nft)=inum(7,index(i))
336 ixc(6,i+nft)=inum(8,index(i))
337 ixc(7,i+nft)=inum(9,index(i))
338 IF (nsubdom>0) tag_elcf(nft+i) = inum_r2r(index(i))
339 itr1(nft+index(i)) = nft+i
340 iworksh(1, nft + i)=inum_worksh(1,index(i))
341 iworksh(2, nft + i)=inum_worksh(2,index(i))
342 iworksh(3, nft + i)=inum_worksh(3,index(i))
343C
344 IF (nperturb > 0) THEN
345 DO ipert = 1, nperturb
346 rnoise(ipert,i+nft) = xnum_rnoise(ipert,index(i))
347 ENDDO
348 ENDIF
349 sh4ang(nft+i) = angle(index(i))
350 !!
351 iel0 = xnum_drapeg%INDX(index(i))
352 drapeg%INDX(nft + i)= 0
353 IF(iel0 == 0) cycle
354 iel = iel + 1
355 npt = xnum_drape(index(i))%NPLY ! number of layer shell
356 ALLOCATE(drape(iel)%INDX_PLY(npt))
357 drape(iel)%INDX_PLY = 0
358 drapeg%INDX(nft + i)= iel
359 drape(iel)%INDX_PLY(1:npt) = xnum_drape(index(i))%INDX_PLY(1:npt)
360 drape(iel)%NPLY = npt
361 npt = xnum_drape(index(i))%NPLY_DRAPE ! NPT_DRP
362 drape(iel)%NPLY_DRAPE= npt
363 drape(iel)%THICK = xnum_drape(index(i))%THICK
364 ALLOCATE(drape(iel)%DRAPE_PLY(npt))
365 DO jj = 1, npt
366 drape_ply => drape(iel)%DRAPE_PLY(jj)
367 nslice = xnum_drape(index(i))%DRAPE_PLY(jj)%NSLICE
368 drape_ply%NSLICE = nslice
369 drape_ply%IPID = xnum_drape(index(i))%DRAPE_PLY(jj)%IPID
370 ALLOCATE(drape_ply%IDRAPE(nslice,2), drape_ply%RDRAPE(nslice,2))
371 drape_ply%IDRAPE = 0
372 drape_ply%RDRAPE = zero
373 DO kk = 1,nslice
374 drape_ply%IDRAPE(kk,1) = xnum_drape(index(i))%DRAPE_PLY(jj)%IDRAPE(kk,1)
375 drape_ply%IDRAPE(kk,2) = xnum_drape(index(i))%DRAPE_PLY(jj)%IDRAPE(kk,2)
376 drape_ply%RDRAPE(kk,1) = xnum_drape(index(i))%DRAPE_PLY(jj)%RDRAPE(kk,1)
377 drape_ply%RDRAPE(kk,2) = xnum_drape(index(i))%DRAPE_PLY(jj)%RDRAPE(kk,2)
378 ENDDO
379 ENDDO
380 ENDDO
381 ELSE
382 DO i = 1, nel
383 permutation%SHELL(i+nft)=indexs2(index(i)+nft)
384 ipartc(i+nft) =inum(1,index(i))
385 isheoff(i+nft)=inum(2,index(i))
386 thk(i+nft) =xnum(index(i))
387 ixc(1,i+nft)=inum(3,index(i))
388 ixc(2,i+nft)=inum(4,index(i))
389 ixc(3,i+nft)=inum(5,index(i))
390 ixc(4,i+nft)=inum(6,index(i))
391 ixc(5,i+nft)=inum(7,index(i))
392 ixc(6,i+nft)=inum(8,index(i))
393 ixc(7,i+nft)=inum(9,index(i))
394 IF (nsubdom>0) tag_elcf(nft+i) = inum_r2r(index(i))
395 itr1(nft+index(i)) = nft+i
396 iworksh(1, nft + i)=inum_worksh(1,index(i))
397 iworksh(2, nft + i)=inum_worksh(2,index(i))
398 iworksh(3, nft + i)=inum_worksh(3,index(i))
399 IF (nperturb > 0) THEN
400 DO ipert = 1, nperturb
401 rnoise(ipert,i+nft) = xnum_rnoise(ipert,index(i))
402 ENDDO
403 ENDIF
404 sh4ang(nft+i) = angle(index(i))
405 ENDDO
406 ENDIF ! NDRAPE
407
408 IF(abs(isigi)==3.OR.abs(isigi)== 4.OR.abs(isigi)==5)THEN
409 DO i=1,nel
410 ptshel(nft+i) = inum_ptshel(index(i))
411 ENDDO
412 DEALLOCATE(inum_ptshel)
413 ENDIF
414 IF(nadmesh/=0)THEN
415 DO k=1,ksh4tree
416 DO i=1,nel
417 sh4tree(k,i+nft)=istor(k,index(i))
418 ENDDO
419 ENDDO
420 IF(lsh4trim/=0)THEN
421 DO i=1,nel
422 sh4trim(i+nft)=istor(ksh4tree+1,index(i))
423 ENDDO
424 END IF
425 END IF
426
427C dd-iad
428 p = cep(nft+index(1))
429 nb = 1
430 DO i = 2, nel
431 IF (cep(nft+index(i))/=p) THEN
432 dd_iad(p+1,nspgroup+n) = nb
433 nb = 1
434 p = cep(nft+index(i))
435 ELSE
436 nb = nb + 1
437 ENDIF
438 ENDDO
439 dd_iad(p+1,nspgroup+n) = nb
440 DO p = 2, nspmd
441 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
442 . + dd_iad(p-1,nspgroup+n)
443 ENDDO
444 DO p = nspmd+1,2,-1
445 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
446 ENDDO
447 dd_iad(1,nspgroup+n) = 1
448C
449C update CEP
450C
451 DO i = 1, nel
452 index(i) = cep(nft+index(i))
453 ENDDO
454 DO i = 1, nel
455 cep(nft+i) = index(i)
456 ENDDO
457 nft = nft + nel
458C
459 IF(ndrape > 0 .AND. numelc_drape > 0) THEN
460 DO i =1, nel
461 iel0 = xnum_drapeg%INDX(i)
462 IF(iel0 == 0 ) cycle
463 npt_drp = xnum_drape(i)%NPLY_DRAPE
464 DO j = 1,npt_drp
465 DEALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%RDRAPE)
466 DEALLOCATE(xnum_drape(i)%DRAPE_PLY(j)%IDRAPE)
467 ENDDO
468 DEALLOCATE(xnum_drape(i)%DRAPE_PLY,xnum_drape(i)%INDX_PLY)
469 ENDDO
470 DEALLOCATE(xnum_drape,xnum_drapeg%INDX )
471 ELSE
472 DEALLOCATE(xnum_drape )
473 ENDIF
474 !!
475 DEALLOCATE(inum_worksh)
476 ENDDO ! ND
477C
478C TREE RENUMBERING
479C
480 IF(nadmesh/=0)THEN
481 DO i=1,numelc
482 IF(sh4tree(1,i)/=0)
483 . sh4tree(1,i)=itr1(sh4tree(1,i))
484 IF(sh4tree(2,i)/=0)
485 . sh4tree(2,i)=itr1(sh4tree(2,i))
486 ENDDO
487 END IF
488C
489C RENUMBERING FOR SURFACES
490C
491 DO i=1,nsurf
492 nn=igrsurf(i)%NSEG
493 DO j=1,nn
494 IF (igrsurf(i)%ELTYP(j) == 3)
495 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
496 ENDDO
497 ENDDO
498C
499C RENUMBERING FOR shell in Accel (gauge)
500C
501 DO i=1,nbgauge
502 n1 = lgauge(1,i)
503 IF(n1 <= 0) THEN
504 n1=-lgauge(3,i)
505 IF(n1 > 0) lgauge(3,i)=-itr1(n1)
506 ENDIF
507 ENDDO
508C
509C RENUMBERING FOR SHELL GROUPS
510C
511 DO i=1,ngrshel
512 nn=igrsh4n(i)%NENTITY
513 DO j=1,nn
514 igrsh4n(i)%ENTITY(j) = itr1(igrsh4n(i)%ENTITY(j))
515 ENDDO
516 ENDDO
517C
518C renumbering INVERSE CONNECTIVITY
519C
520 DO i=1,4*numelc
521 IF(nod2elc(i) /= 0)nod2elc(i)=itr1(nod2elc(i))
522 END DO
523C
524C-------------------------------------------------------------------------
525C phase 2 : grouping by MVSIZ groups
526C ngroup is global, iparg is global but organized according to dd
527C
528 DO 300 n=1,nd
529 nft = 0
530 DO p = 1, nspmd
531 ngp(p)=0
532 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
533 IF (nel>0) THEN
534 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
535 ngp(p)=ngroup
536 DO WHILE (nft < nel_prec+nel)
537C ngroup global
538 ngroup=ngroup+1
539 ii = eadd(n)+nft
540 mid = ixc(1,ii)
541 mln = nint(pm(19,mid))
542 pid = ixc(6,ii)
543 ipartr2r = 0
544 IF (nsubdom>0) ipartr2r = tag_mat(mid)
545 npn = igeo(4,pid)
546 ismst = igeo(5,pid)
547 igtyp = igeo(11,pid)
548 isrot = igeo(20,pid)
549 ipinch= igeo(51,pid)
550 ishxfem_ply = igeo(19,pid)
551 irep = igeo(6,pid)
552 ihbe = nint(geo(171,pid))
553 ithk = nint(geo(35,pid))
554 ipla = nint(geo(39,pid))
555 istrain = nint(geo(11,pid))
556 icsen= igeo(3,pid)
557 igmat = igeo(98 ,pid)
558 nlevxf = 0
559 ixfem = 0
560 isubstack = 0
561 idrape = 0
562 IF (igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52) THEN
563 npn = iworksh(1,ii)
564 isubstack =iworksh(3,ii)
565 IF(npn == 0) THEN
566 id = igeo(1,pid)
567 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
568 CALL ancmsg(msgid=1241,
569 . msgtype=msgerror,
570 . anmode=aninfo,
571 . i1=id,
572 . c1=titr,
573 . i2=ixc(nixc,ii))
574 CALL arret(2)
575 ENDIF
576 ENDIF
577 IF(ndrape > 0 .AND. (igtyp == 17 .OR. igtyp == 51 .OR. igtyp ==52) ) THEN
578 IF(drapeg%INDX(ii) /= 0 ) idrape = 1
579 ENDIF
580 ishel=ihbe+1
581 IF ((ishel /=12 .AND. ishel /=24).AND.ishel > 5 ) THEN ! not expected
582 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
583 CALL ancmsg(msgid=3007,
584 . anmode=aninfo,
585 . msgtype=msgerror,
586 . i1=igeo(1,pid),
587 . c1=titr,
588 . i2=ishel,
589 . prmod=msg_cumu)
590 ENDIF
591c-------- check xfem compatibility
592c IF (ICRACK3D > 0) THEN
593 IF (igtyp == 11 .or. igtyp == 16) THEN
594 DO ipt = 1, npn
595 imatly = igeo(100+ipt,pid)
596 IF (mat_param(imatly)%NFAIL > 0) THEN
597 ixfem = mat_param(imatly)%IXFEM
598 ENDIF
599 ENDDO
600 IF (ixfem > 0) ixfem = 1
601 IF (ixfem == 1) nlevxf = nxel*npn
602 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
603 ippid = 2
604 ipmat = ippid + npn
605 DO ipt = 1, npn
606 imatly = stack%IGEO(ipmat + ipt ,isubstack)
607 IF (mat_param(imatly)%NFAIL > 0) ixfem = mat_param(imatly)%IXFEM
608 IF (ixfem > 0) ixfem = 1
609 IF (ixfem == 1) nlevxf = nxel*npn
610 ENDDO
611 ELSEIF (igtyp == 1 .or. igtyp == 9 .or. igtyp == 10 .or. igtyp == 17) THEN
612 ixfem = mat_param(mid)%IXFEM
613 IF (ixfem == 1) THEN
614 ixfem = 2
615 nlevxf = nxel
616 ENDIF
617 ENDIF
618 nlevmax = max(nlevmax, nlevxf)
619c ENDIF
620c
621 IF (ihbe == 11 .and. ixfem > 0) THEN ! not compatible with Batoz shells
622 ixfem = 0
623 nlevxf = 0
624 nlevmax = 0
625 numelcrk = 0
626 icrack3d = 0
627 ixfem_err = 1
628 CALL ancmsg(msgid=1601,
629 . anmode=aninfo,
630 . msgtype=msgerror,
631 . i1=igeo(1,pid),
632 . c1=titr,
633 . prmod=msg_cumu)
634 ENDIF
635c--------
636C
637 id=igeo(1,pid)
638 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
639C--------------------
640C- ISMSTR IPLAST,ITHICK Automatic
641C-----------all shell prop
642 IF (igtyp > 0) THEN
643C----- fixed to 1 excepting small strain case
644 IF (ithk<0) THEN
645 ithk = 1
646 IF (mat_param(mid)%SMSTR==1 .OR. mln == 1) ithk = 0
647C--------message out
648 ism0 = ithk
649 IF (ithk == 0) ism0=2
650 CALL ancmsg(msgid=1770,
651 . msgtype=msginfo,
652 . anmode=aninfo_blind_2,
653 . i1=id,
654 . c1=titr,
655 . i2=ism0,
656 . prmod=msg_cumu)
657 END IF
658C----- fixed to iterative, but can be changed according to law
659 IF (ipla<0) THEN
660 ipla = 1
661C--------message out
662 CALL ancmsg(msgid=1771,
663 . msgtype=msginfo,
664 . anmode=aninfo_blind_2,
665 . i1=id,
666 . c1=titr,
667 . i2=ipla,
668 . prmod=msg_cumu)
669 END IF
670C------ --
671 IF (ismst<0) THEN
672C--- MATPARAM%SMSTR : 2 large, 1: small ; MATPARAM%STRAIN_FORMULATION : 1 inc, 2 total
673c there is no recommended total strain for shell for the moment
674 IF (mat_param(mid)%SMSTR==1) THEN
675 ismst = 1
676 ELSE
677 ismst = 2
678C----certain laws to use 4 to see one by one
679 IF (mat_param(mid)%STRAIN_FORMULATION==2) ismst =4
680 IF (mln == 58 ) ismst =4
681 IF (mln == 19 .AND. npn==1) ismst =11
682 END IF
683 geo(3,pid) = ismst
684C--------message out
685 CALL ancmsg(msgid=1772,
686 . msgtype=msginfo,
687 . anmode=aninfo_blind_2,
688 . i1=id,
689 . c1=titr,
690 . i2=ismst,
691 . prmod=msg_cumu)
692 END IF
693 END IF !(IGTYP > 0) THEN
694C-----
695 IF (igtyp == 16 .and. mln == 58 .and. ismst /= 4) THEN
696 ismst = 4
697 CALL ancmsg(msgid=772,
698 . msgtype=msgwarning,
699 . anmode=aninfo_blind_2,
700 . i1=id,
701 . c1=titr,
702 . prmod=msg_cumu)
703 ENDIF
704 IF (igtyp == 1 .AND. (mln == 25 .OR.
705 . mln == 15 )) THEN
706 CALL ancmsg(msgid=1052,
707 . msgtype=msgerror,
708 . anmode=aninfo,
709 . i1=id,
710 . c1=titr,
711 . i2=ipm(1,mid))
712 ELSEIF (igtyp == 1 .AND. (mln ==57.OR. mln ==78 .OR.
713 . mln == 32 .OR. mln == 43 .OR. mln == 73.OR.mln == 87
714 . .OR.mln == 107.OR.mln == 112) ) THEN
715 CALL ancmsg(msgid=1065,
716 . msgtype=msgwarning,
717 . anmode=aninfo_blind_1,
718 . i1=id,
719 . c1=titr,
720 . i2=ipm(1,mid))
721 ELSEIF (igtyp == 1 .AND. mln ==200)THEN
722 CALL ancmsg(msgid=2035,
723 . msgtype=msgerror,
724 . anmode=aninfo_blind_1,
725 . i1=id,
726 . c1=titr,
727 . i2=mln)
728 ENDIF
729 IF (igtyp == 1 .and. ismst == 11 ) THEN
730 ! ISMST = 11 compatibility
731 ismst = 2
732 CALL ancmsg(msgid=1876,
733 . msgtype=msgwarning,
734 . anmode=aninfo_blind_2,
735 . i1=id,
736 . c1=titr,
737 . i2=mln,
738 . i3=ismst,
739 . prmod=msg_cumu)
740 ELSEIF (ismst == 10 ) THEN
741 IF (ishel /=12 .AND. ishel /=24 ) THEN ! not expected
742 CALL ancmsg(msgid=3019,
743 . anmode=aninfo,
744 . msgtype=msgwarning,
745 . i1=id,
746 . c1=titr,
747 . i2=ishel,
748 . prmod=msg_cumu)
749 ismst = 2
750 ENDIF
751 IF (mln /=42 .AND. mln /=69 .AND. mln /=88 .and. mln /= 99) THEN
752 CALL ancmsg(msgid=3020, anmode=aninfo, msgtype=msgwarning,
753 . i1=id,
754 . c1=titr,
755 . i2=mln,
756 . prmod=msg_cumu)
757 ismst = 2
758 ENDIF
759 ENDIF
760
761 IF(igtyp == 0)mln=0
762 IF(nadmesh == 0)THEN
763 ilev=0
764 my_nvsiz=nvsiz
765 ELSE
766 prt = ipartc(ii)
767 iadm= ipart(10,prt)
768 IF(iadm==0)THEN
769 ilev = 0
770 my_nvsiz=nvsiz
771 ELSE
772 ilev= sh4tree(3,ii)
773 IF(ilev<0)ilev=-ilev-1
774 my_nvsiz=max(4,min(4**ilev,nvsiz))
775 END IF
776 END IF
777c------
778c global integration
779 IF (npn > 1 .and. mln == 1) THEN
780 npn = 0
781 CALL fretitl2(titr2,ipm(npropmi-ltitr+1,mid),ltitr)
782 CALL ancmsg(msgid=1084,
783 . anmode=aninfo_blind_2,
784 . msgtype=msgwarning,
785 . i1=id,
786 . c1=titr,
787 . i2=ipm(1,mid),
788 . c2=titr2,
789 . prmod=msg_cumu)
790 ENDIF
791 IF (npn > 1 .and. mln == 91) THEN
792 npn = 0
793 ENDIF
794c switch global integration to npt=3
795 IF (npn == 0 .and. mln /= 0 .and. mln /= 1 .and. mln /= 91) THEN
796 CALL ancmsg(msgid=1912,
797 . anmode=aninfo,
798 . msgtype=msgwarning,
799 . i1=id,
800 . c1=titr,
801 . i2=mln,
802 . prmod=msg_cumu)
803 npn = 3
804 ENDIF
805 IF (npn == 0 .and. mln > 2 .and. mln /= 22 .and.
806 . mln /= 36 .and. mln /= 43 .and. mln /= 60 .and.
807 . mln /= 86 .and. mln /= 13 .and. mln /= 91) THEN
808 CALL fretitl2(titr1,
809 . ipm(npropmi-ltitr+1,mid),
810 . ltitr)
811 CALL ancmsg(msgid=23,
812 . anmode=aninfo,
813 . msgtype=msgerror,
814 . i1=id,
815 . c1=titr,
816 . i2=ipm(1,mid),
817 . c2=titr1,
818 . i3=mln)
819 ENDIF
820c
821 IF (npn == 0.AND.(mln == 36.OR.mln == 86))THEN
822 IF(ipla == 0) ipla=1
823 IF(ipla == 2) ipla=0
824 ELSEIF(npn == 0.AND.mln == 2)THEN
825 IF(ipla == 2) ipla=0
826 ELSE
827 IF(ipla == 2) ipla=0
828 IF(ipla == 3) ipla=2
829 ENDIF
830C
831 IF(ithk == 2)THEN
832 ithk = 0
833 ELSEIF(mln == 32)THEN
834 ithk = 1
835 ENDIF
836C---------Drilling dof---ISHELL=12(QBAT uses NB4)--------
837 IF (isrot>0.AND.ihbe<11) THEN
838 CALL ancmsg(msgid=854,
839 . msgtype=msgwarning,
840 . anmode=aninfo_blind_2,
841 . i1=id,
842 . c1=titr)
843 isrot=0
844 END IF
845C------
846 CALL zeroin(1,nparg,iparg(1,ngroup))
847 iparg(1,ngroup) = mln
848 ne1 = min( my_nvsiz, nel + nel_prec - nft)
849 iparg(2,ngroup) = ne1
850 iparg(3,ngroup)= eadd(n)-1 + nft
851 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with
852c other groups using old buffer
853 iparg(43,ngroup) = 0
854C
855 nvarv = 0
856 ivisc = 0
857 ifwv = 0
858C-------------
859
860 IF (igtyp == 11) THEN
861 DO ipt = 1, npn
862 imatly = igeo(100+ipt,pid)
863 IF(mat_param(imatly)%NFAIL > 0)THEN
864 iparg(43,ngroup) = 1
865 ENDIF
866 IF (mat_param(imatly)%IVISC > 0 ) ivisc = 1
867 IF (mat_param(imatly)%IFAILWAVE > 0) ifwv = 1
868 ENDDO
869C-------------
870 ELSEIF(igtyp == 17) THEN
871!! IIGEO = 40 + 5*(ISUBSTACK - 1)
872!! IADI = IGEO(IIGEO + 3,PID)
873!! IPPID = IADI
874!! IPMAT = IPPID + NPN
875!! IPMAT_IPLY = IPMAT + NPN
876 ippid = 2
877 ipmat = ippid + npn
878 DO ipt = 1, npn
879 imatly = stack%IGEO(ipmat + ipt ,isubstack)
880 IF(mat_param(imatly)%NFAIL > 0)THEN
881 iparg(43,ngroup) = 1
882 ENDIF
883 IF( mat_param(imatly)%IVISC > 0 ) ivisc = 1
884 ENDDO
885C---
886C new shell property (variable NPT through each layer)
887C---
888 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
889 nb_law58 = 0
890 ippid = 2
891 ipmat = ippid + npn
892 DO ipt = 1, npn
893 imatly = stack%IGEO(ipmat + ipt ,isubstack)
894 IF (mat_param(imatly)%NFAIL > 0) THEN
895 iparg(43,ngroup) = 1
896 ENDIF
897 IF (mat_param(imatly)%IVISC > 0) ivisc = 1
898 IF (mat_param(imatly)%IFAILWAVE > 0) ifwv = 1
899C --- PID 51 combined with LAW58 ---
900 IF (nint(pm(19,imatly)) == 58) nb_law58 = nb_law58 + 1
901 ENDDO
902C --- set new IREP for groups:
903 IF (nb_law58 == npn) THEN
904 irep = 2
905 ELSEIF (nb_law58 > 0) THEN
906 irep = irep + 3
907 ENDIF
908C-------------
909 ELSE ! IGTYP = 1
910 IF(mat_param(mid)%NFAIL > 0.AND.mln /= 0 .AND. mln /=13)THEN
911 iparg(43,ngroup) = 1
912 ENDIF
913 IF (mat_param(mid)%IVISC > 0 ) ivisc = 1
914 IF (mat_param(mid)%IFAILWAVE > 0) ifwv = 1
915 ENDIF ! IGTYP
916C-------------
917C
918 IF (mln == 13) irigid_mat = 1
919 jthe = nint(pm(71,mid))
920C thermal material expansion
921 iparg(49,ngroup) = 0
922 IF(ipm(218,mid) > 0 .AND. mln /= 0 .AND. mln /=13) THEN
923 iparg(49,ngroup) = 1
924 ENDIF
925C Visco model using /VISC
926 IF (ivisc > 0 .AND. mln /= 0 .AND. mln /=13) THEN
927 iparg(61,ngroup) = 1
928 ENDIF
929C
930 jsms=0
931 IF(isms/=0)THEN
932 IF(idtgrs/=0)THEN
933 IF(tagprt_sms(ipartc(ii))/=0)jsms=1
934 ELSE
935 jsms=1
936 END IF
937 END IF
938 iparg(52,ngroup)=jsms
939C---------
940 iparg(54,ngroup) = ixfem
941 iparg(65,ngroup) = nlevxf
942C flag for group of duplicated elements in multidomains
943 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
944 iparg(5,ngroup) = 3 ! ITY
945 iparg(6,ngroup) = npn
946 iparg(9,ngroup) = ismst
947 iparg(13,ngroup) = jthe !shell : 0 or 1 only
948 iparg(23,ngroup) = ihbe
949 iparg(28,ngroup) = ithk
950 iparg(29,ngroup) = ipla
951 iparg(41,ngroup) = isrot
952 iparg(44,ngroup) = istrain
953 iparg(62,ngroup) = pid
954 iparg(90,ngroup) = ipinch
955C
956 iseatbelt = 0
957 IF(mln == 119) iseatbelt = 1
958 iparg(91,ngroup) = iseatbelt
959C damping frequency range apply to group
960 idamp_freq_range = damp_range_part(ipartc(ii))
961 iparg(93,ngroup) = idamp_freq_range
962C
963 nsg = 1
964 kfts= 0
965 DO 210 j = 2,ne1
966 midn = ixc(1,j+eadd(n)+nft-1)
967 pidn = ixc(6,j+eadd(n)+nft-1)
968 IF(mid/=midn.OR.pid/=pidn)THEN
969 pid = pidn
970 mid = midn
971 nsg = nsg + 1
972 kfts= j
973 ENDIF
974 210 CONTINUE
975C
976 iparg(10,ngroup)= nsg
977 iparg(18,ngroup)= mid
978 iparg(30,ngroup)= kfts
979 iparg(35,ngroup)= irep
980 iparg(38,ngroup)= igtyp
981 iparg(39,ngroup)= icsen
982 iparg(45,ngroup)= ilev
983 IF(nadmesh/=0)THEN
984 iparg(8,ngroup)=1
985 DO j=1,ne1
986 sh4tree(4,j+eadd(n)+nft-1)=ngroup
987 jlev=sh4tree(3,j+eadd(n)+nft-1)
988 IF(jlev >= 0)iparg(8,ngroup)=0
989 END DO
990 END IF
991
992 nuvarr = 0
993 IF (igtyp == 11) THEN
994 mpt = iabs(npn)
995 DO ipt= 1,mpt
996 DO j=1,ne1
997 ie=j+eadd(n)+nft-1
998 imatly = igeo(100+ipt,ixc(6,ie))
999 nuvarr = max(nuvarr,ipm(221,ixc(1,ie)))
1000 ENDDO
1001 ENDDO
1002 ELSE
1003 DO j=1,ne1
1004 ie=j+eadd(n)+nft-1
1005 nuvarr = max(nuvarr,ipm(221,ixc(1,ie)))
1006 ENDDO
1007 END IF
1008 iparg(47,ngroup)=nuvarr
1009
1010
1011 IF(ihbe == 11)THEN
1012 npg=4
1013 ELSE
1014 npg=1
1015 END IF
1016 iparg(48,ngroup)=npg
1017C group/processor identification
1018 iparg(32,ngroup) = p-1
1019 iparg(50,ngroup) = ishxfem_ply
1020C for stack
1021 iparg(71,ngroup) = isubstack
1022 iparg(75,ngroup) = igmat
1023c non-local variable regularization flag for failure models
1024 iparg(78,ngroup) = mat_param(mid)%NLOC ! NLOC_FAIL
1025 iparg(79,ngroup) = ifwv
1026C
1027 iparg(92,ngroup) = idrape !
1028 nft = nft + ne1
1029C
1030 END DO
1031 ngp(p)=ngroup-ngp(p)
1032 ENDIF
1033 ENDDO
1034C DD_IAD => nb groups per sub domain
1035 ngp(nspmd+1)=0
1036 DO p = 1, nspmd
1037 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
1038 dd_iad(p,nspgroup+n)=ngp(p)
1039 END DO
1040 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
1041
1042C
1043 300 CONTINUE
1044c
1045 IF (ixfem_err == 1) icrack3d = 0
1046C
1047 nspgroup = nspgroup + nd
1048C-----------
1049 CALL ancmsg(msgid=1084,
1050 . anmode=aninfo_blind_2,
1051 . msgtype=msgwarning,
1052 . prmod=msg_print)
1053c
1054 CALL ancmsg(msgid=1601,
1055 . anmode=aninfo,
1056 . msgtype=msgerror,
1057 . i1=pid,
1058 . c1=titr ,
1059 . prmod=msg_print)
1060 CALL ancmsg(msgid=1770,
1061 . msgtype=msginfo,
1062 . anmode=aninfo_blind_2,
1063 . prmod=msg_print)
1064 CALL ancmsg(msgid=1771,
1065 . msgtype=msginfo,
1066 . anmode=aninfo_blind_2,
1067 . prmod=msg_print)
1068 CALL ancmsg(msgid=1772,
1069 . msgtype=msginfo,
1070 . anmode=aninfo_blind_2,
1071 . prmod=msg_print)
1072 CALL ancmsg(msgid=1876,
1073 . msgtype=msgwarning,
1074 . anmode=aninfo_blind_2,
1075 . prmod=msg_print)
1076 CALL ancmsg(msgid=1912,
1077 . anmode=aninfo_blind_2,
1078 . msgtype=msgwarning,
1079 . prmod=msg_print)
1080 CALL ancmsg(msgid=772,
1081 . msgtype=msgwarning,
1082 . anmode=aninfo_blind_2,
1083 . prmod=msg_print)
1084 CALL ancmsg(msgid=3007,
1085 . anmode=aninfo,
1086 . msgtype=msgerror,
1087 . prmod=msg_print)
1088 CALL ancmsg(msgid=3019,
1089 . anmode=aninfo,
1090 . msgtype=msgwarning,
1091 . prmod=msg_print)
1092 CALL ancmsg(msgid=3020,
1093 . anmode=aninfo,
1094 . msgtype=msgwarning,
1095 . prmod=msg_print)
1096C-----------
1097 IF(print_flag>6) THEN
1098 WRITE(iout,1000)
1099 DO n=ngr1,ngroup
1100 mln = iparg(1,n)
1101c
1102 WRITE(iout,1001)n,mln,iparg(2,n),iparg(3,n)+1,
1103 + iparg(5,n),iabs(iparg(6,n)),
1104 + iparg(9,n),iparg(10,n),iparg(44,n),
1105 + iparg(23,n),iparg(43,n),iparg(90,n)
1106 ENDDO
1107 ENDIF
1108C-----------
1109 1000 FORMAT(/
1110 + /6x,'3D - SHELL ELEMENT GROUPS'/
1111 + 6x,'-------------------------'/
1112 +' GROUP MATERIAL ELEMENT FIRST',
1113 +' ELEMENT INTEG',
1114 +' SMALL SUB STRAIN HOURGLASS FAILURE PINCHING'/
1115 +' LAW NUMBER ELEMENT',
1116 +' TYPE PTS',
1117 +' STRAIN GROUPS OUTPUT FLAG FLAG FLAG'/)
1118 1001 FORMAT(12(1x,i10))
1119cc 1002 FORMAT(/6X,'BUFFER LENGTH : ',I10 )
1120C
1121 IF (ALLOCATED(xnum_rnoise)) DEALLOCATE(xnum_rnoise)
1122C
1123
1124 DEALLOCATE(indexs2)
1125 DEALLOCATE( istor )
1126 DEALLOCATE(inum_r2r)
1127 DEALLOCATE(angle)
1128 RETURN
1129 END
cgrtails
subroutine cgrtails(ixc, pm, iparg, geo, eadd, nd, ipartc, dd_iad, idx, inum, itr1, index, cep, thk, xnum, igrsurf, igrsh4n, igeo, ipm, ipart, sh4tree, nod2elc, isheoff, sh4trim, tagprt_sms, lgauge, iworksh, stack, drape, rnoise, mat_param, sh4ang, iddlevel, drapeg, print_flag, ptshel, damp_range_part)
Definition cgrtails.F:50
cpp_reorder_elements
void cpp_reorder_elements(int *NEL, int *NSPMD, int *NODES_PER_ELT, int *OFFSET, int *LDA, int *domain, int *elt2Nodes, int *permutation)
Definition cpp_reorder_elements.cpp:318
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
drape_mod
Definition drape_mod.F:54
groupdef_mod
Definition groupdef_mod.F:662
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
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::doqa
integer doqa
Definition qa_out_mod.F:84
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_elcf
integer, dimension(:), allocatable tag_elcf
Definition r2r_mod.F:141
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
reorder_mod
Definition reorder_mod.F:45
reorder_mod::permutation
type(reorder_struct_) permutation
Definition reorder_mod.F:54
stack_mod
Definition stack_mod.F:72
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
arret
subroutine arret(nn)
Definition arret.F:87
starter
program starter
Definition starter.F:39
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47