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