50
51
52
53 USE my_alloc_mod
59 USE matparam_def_mod
63 use element_mod , only : nixc
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85#include "implicit_f.inc"
86
87
88
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"
100
101
102
103 INTEGER ND, IDX
104 INTEGER IXC(NIXC,*),IPARG(NPARG,*),EADD(*),IGEO(NPROPGI,*),
105 . DD_IAD(NSPMD+1,*),IPARTC(*),SH4TRIM(*),
106 . INUM(9,*),ITR1(*),(*),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
112 INTEGER , DIMENSION(NUMELC) , INTENT(INOUT):: PTSHEL
113 INTEGER , INTENT(IN) :: DAMP_RANGE_PART(NPART)
115 . pm(npropm,*), geo(npropg,*), xnum(*),thk(*),rnoise(nperturb,*),
116 . sh4ang(*)
117 TYPE(MATPARAM_STRUCT_) ,DIMENSION(NUMMAT),INTENT(IN) :: MAT_PARAM
118
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
124
125 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
126 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
127
128
129
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(+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
146
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
153
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)
165
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
174
175 iptun = 1
176 ixfem_err = 0
177
178
179
180 ngr1 = ngroup + 1
181
182
183
184 idx=idx+nd*(nspmd+1)
185 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
186 nft = 0
187
188 DO n=1,nd
189 DO p=1,nspmd+1
190 dd_iad(p,nspgroup+n) = 0
191 END DO
192 ENDDO
193
194 iel = 0
195 DO n=1,nd
196 nel = eadd(n+1)-eadd(n)
197
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))
222
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
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)
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
303
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
316
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
322 ldim = 9
323 offset = 3
325 ENDIF
327 DO i = 1, nel
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))
344
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
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
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
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
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
428
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
449
450
451
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
459
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
478
479
480
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
489
490
491
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
499
500
501
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
509
510
511
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
518
519
520
521 DO i=1,4*numelc
522 IF(nod2elc(i) /= 0)nod2elc(i)=itr1(nod2elc(i))
523 END DO
524
525
526
527
528
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)
538
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
568 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
570 . msgtype=msgerror,
571 . anmode=aninfo,
573 . c1=titr,
574 . i2=ixc(nixc,ii))
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
583 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
585 . anmode=aninfo,
586 . msgtype=msgerror,
587 . i1=igeo(1,pid),
588 . c1=titr,
589 . i2=ishel,
590 . prmod=msg_cumu)
591 ENDIF
592
593
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)
620
621
622 IF (ihbe == 11 .and. ixfem > 0) THEN
623 ixfem = 0
624 nlevxf = 0
625 nlevmax = 0
626 numelcrk = 0
627 icrack3d = 0
628 ixfem_err = 1
630 . anmode=aninfo,
631 . msgtype=msgerror,
632 . i1=igeo(1,pid),
633 . c1=titr,
634 . prmod=msg_cumu)
635 ENDIF
636
637
639 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
640
641
642
643 IF (igtyp > 0) THEN
644
645 IF (ithk<0) THEN
646 ithk = 1
647 IF (mat_param(mid)%SMSTR==1 .OR. mln == 1) ithk = 0
648
649 ism0 = ithk
650 IF (ithk == 0) ism0=2
652 . msgtype=msginfo,
653 . anmode=aninfo_blind_2,
655 . c1=titr,
656 . i2=ism0,
657 . prmod=msg_cumu)
658 END IF
659
660 IF (ipla<0) THEN
661 ipla = 1
662
664 . msgtype=msginfo,
665 . anmode=aninfo_blind_2,
667 . c1=titr,
668 . i2=ipla,
669 . prmod=msg_cumu)
670 END IF
671
672 IF (ismst<0) THEN
673
674
675 IF (mat_param(mid)%SMSTR==1) THEN
676 ismst = 1
677 ELSE
678 ismst = 2
679
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
685
687 . msgtype=msginfo,
688 . anmode=aninfo_blind_2,
690 . c1=titr,
691 . i2=ismst,
692 . prmod=msg_cumu)
693 END IF
694 END IF
695
696 IF (igtyp == 16 .and. mln == 58 .and. ismst /= 4) THEN
697 ismst = 4
699 . msgtype=msgwarning,
700 . anmode=aninfo_blind_2,
702 . c1=titr,
703 . prmod=msg_cumu)
704 ENDIF
705 IF (igtyp == 1 .AND. (mln == 25 .OR.
706 . mln == 15 )) THEN
708 . msgtype=msgerror,
709 . anmode=aninfo,
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
717 . msgtype=msgwarning,
718 . anmode=aninfo_blind_1,
720 . c1=titr,
721 . i2=ipm(1,mid))
722 ELSEIF (igtyp == 1 .AND. mln ==200)THEN
724 . msgtype=msgerror,
725 . anmode=aninfo_blind_1,
727 . c1=titr,
728 . i2=mln)
729 ENDIF
730 IF (igtyp == 1 .and. ismst == 11 ) THEN
731
732 ismst = 2
734 . msgtype=msgwarning,
735 . anmode=aninfo_blind_2,
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
744 . anmode=aninfo,
745 . msgtype=msgwarning,
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,
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
778
779
780 IF (npn > 1 .and. mln == 1) THEN
781 npn = 0
782 CALL fretitl2(titr2,ipm(npropmi-ltitr+1,mid),ltitr)
784 . anmode=aninfo_blind_2,
785 . msgtype=msgwarning,
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
795
796 IF (npn == 0 .and. mln /= 0 .and. mln /= 1 .and. mln /= 91) THEN
798 . anmode=aninfo,
799 . msgtype=msgwarning,
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
810 . ipm(npropmi-ltitr+1,mid),
811 . ltitr)
813 . anmode=aninfo,
814 . msgtype=msgerror,
816 . c1=titr,
817 . i2=ipm(1,mid),
818 . c2=titr1,
819 . i3=mln)
820 ENDIF
821
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
831
832 IF(ithk == 2)THEN
833 ithk = 0
834 ELSEIF(mln == 32)THEN
835 ithk = 1
836 ENDIF
837
838 IF (isrot>0.AND.ihbe<11) THEN
840 . msgtype=msgwarning,
841 . anmode=aninfo_blind_2,
843 . c1=titr)
844 isrot=0
845 END IF
846
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
853
854 iparg(43,ngroup) = 0
855
856 nvarv = 0
857 ivisc = 0
858 ifwv = 0
859
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
870
871 ELSEIF(igtyp == 17) THEN
872
873
874
875
876
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
886
887
888
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
900
901 IF (nint(pm(19,imatly)) == 58) nb_law58 = nb_law58 + 1
902 ENDDO
903
904 IF (nb_law58 == npn) THEN
905 irep = 2
906 ELSEIF (nb_law58 > 0) THEN
907 irep = irep + 3
908 ENDIF
909
910 ELSE
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
917
918
919 IF (mln == 13) irigid_mat = 1
920 jthe = nint(pm(71,mid))
921
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
926
927 IF (ivisc > 0 .AND. mln /= 0 .AND. mln /=13) THEN
928 iparg(61,ngroup) = 1
929 ENDIF
930
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
940
941 iparg(54,ngroup) = ixfem
942 iparg(65,ngroup) = nlevxf
943
944 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
945 iparg(5,ngroup) = 3
946 iparg(6,ngroup) = npn
947 iparg(9,ngroup) = ismst
948 iparg(13,ngroup) = jthe
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
956
957 iseatbelt = 0
958 IF(mln == 119) iseatbelt = 1
959 iparg(91,ngroup) = iseatbelt
960
961 idamp_freq_range = damp_range_part(ipartc(ii))
962 iparg(93,ngroup) = idamp_freq_range
963
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
976
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
1018
1019 iparg(32,ngroup) = p-1
1020 iparg(50,ngroup) = ishxfem_ply
1021
1022 iparg(71,ngroup) = isubstack
1023 iparg(75,ngroup) = igmat
1024
1025 iparg(78,ngroup) = mat_param(mid)%NLOC
1026 iparg(79,ngroup) = ifwv
1027
1028 iparg(92,ngroup) = idrape
1029 nft = nft + ne1
1030
1031 END DO
1032 ngp(p)=ngroup-ngp(p)
1033 ENDIF
1034 ENDDO
1035
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
1043
1044 300 CONTINUE
1045
1046 IF (ixfem_err == 1) icrack3d = 0
1047
1048 nspgroup = nspgroup + nd
1049
1051 . anmode=aninfo_blind_2,
1052 . msgtype=msgwarning,
1053 . prmod=msg_print)
1054
1056 . anmode=aninfo,
1057 . msgtype=msgerror,
1058 . i1=pid,
1059 . c1=titr ,
1060 . prmod=msg_print)
1062 . msgtype=msginfo,
1063 . anmode=aninfo_blind_2,
1064 . prmod=msg_print)
1066 . msgtype=msginfo,
1067 . anmode=aninfo_blind_2,
1068 . prmod=msg_print)
1070 . msgtype=msginfo,
1071 . anmode=aninfo_blind_2,
1072 . prmod=msg_print)
1074 . msgtype=msgwarning,
1075 . anmode=aninfo_blind_2,
1076 . prmod=msg_print)
1078 . anmode=aninfo_blind_2,
1079 . msgtype=msgwarning,
1080 . prmod=msg_print)
1082 . msgtype=msgwarning,
1083 . anmode=aninfo_blind_2,
1084 . prmod=msg_print)
1086 . anmode=aninfo,
1087 . msgtype=msgerror,
1088 . prmod=msg_print)
1090 . anmode=aninfo,
1091 . msgtype=msgwarning,
1092 . prmod=msg_print)
1094 . anmode=aninfo,
1095 . msgtype=msgwarning,
1096 . prmod=msg_print)
1097
1098 IF(print_flag>6) THEN
1099 WRITE(iout,1000)
1100 DO n=ngr1,ngroup
1101 mln = iparg(1,n)
1102
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
1109
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))
1120
1121
1122 IF (ALLOCATED(xnum_rnoise)) DEALLOCATE(xnum_rnoise)
1123
1124
1125 DEALLOCATE(indexs2)
1126 DEALLOCATE( istor )
1127 DEALLOCATE(inum_r2r)
1128 DEALLOCATE(angle)
1129 RETURN
void cpp_reorder_elements(int *NEL, int *NSPMD, int *NODES_PER_ELT, int *OFFSET, int *LDA, int *domain, int *elt2Nodes, int *permutation)
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
integer, parameter nchartitle
integer, dimension(:), allocatable tag_elcf
integer, dimension(:), allocatable tag_mat
type(reorder_struct_) permutation
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)
subroutine zeroin(n1, n2, ma)