37 2 IXTG ,WA,WAP0 ,IPARTC, IPARTTG,
38 3 IPART_STATE,STAT_INDXC,STAT_INDXTG,SIZP0,
48#include "implicit_f.inc"
63 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
64 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
65 . ipartc(*), iparttg(*), ipart_state(*),
66 . stat_indxc(*), stat_indxtg(*)
67 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
68 TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
69 double precision WA(*),WAP0(*)
73 INTEGER ,
INTENT(IN) :: NUMMAT
74 INTEGER I,N,J,K,L,II,JJ,ID,IE,LEN,NG,NEL,NFT,ITY,LFT,LLT,NPT,
75 . MLW,IGTYP,IPRT0,IPRT,IVAR,IMAT,
76 . npg,ipg,nlay,nptr,npts,nptt,il,ir,is,it,ipt,ic,ifail,nv,
77 . nfail,nvar_rupt,nptg,irupt,irupt_type,isubstack
78 INTEGER MAT(MVSIZ), PID(MVSIZ)
79 INTEGER,
DIMENSION(:),
ALLOCATABLE :: PTWA
80 INTEGER,
DIMENSION(:),
ALLOCATABLE :: PTWA_P0
82 . thk, em, eb, h1, h2, h3
83 CHARACTER*100 DELIMIT,LINE
85 TYPE(l_bufel_) ,
POINTER :: LBUF
86 TYPE(g_bufel_) ,
POINTER :: GBUF
87 TYPE(BUF_MAT_) ,
POINTER :: MBUF
88 TYPE(buf_fail_),
POINTER :: FBUF
90 .
DIMENSION(:),
POINTER :: uvarf,dfmax
93 ./
'#---1----|----2----|----3----|----4----|----5----|----6----|'/
95 ./
'----7----|----8----|----9----|----10---|'/
99 CALL my_alloc(ptwa,
max(stat_numelc ,stat_numeltg))
100 ALLOCATE(ptwa_p0(0:
max(1,stat_numelc_g,stat_numeltg_g)))
104 IF (stat_numelc==0)
GOTO 200
121 gbuf => elbuf_tab(ng)%GBUF
122 nlay = elbuf_tab(ng)%NLAY
123 nptr = elbuf_tab(ng)%NPTR
124 npts = elbuf_tab(ng)%NPTS
128 isubstack = iparg(71,ng)
135 IF (ipart_state(iprt)==0) cycle
138 IF (mlw /= 0 .AND. mlw /= 13)
THEN
155 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
156 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
157 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(1,1,1)
158 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
168 irupt = mat_param(imat)%FAIL(ifail)%FAIL_ID
169 irupt_type = mat_param(imat)%FAIL(ifail)%IRUPT
170 nvar_rupt = fbuf%FLOC(ifail)%NVAR
172 wa(jj) = nvar_rupt + 1
178 IF (irupt == 0) cycle
183 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(ir,is,it)
184 uvarf => fbuf%FLOC(ifail)%VAR
185 dfmax => fbuf%FLOC(ifail)%DAMMX
190 wa(jj) = uvarf((nv-1)*llt+i)
229 IF (ispmd == 0.AND.len > 0)
THEN
236 iprt = nint(wap0(j + 2))
237 IF (iprt /= iprt0)
THEN
238 IF (izipstrs == 0)
THEN
239 WRITE(iugeo,'(a)
') DELIMIT
240 WRITE(IUGEO,'(a)
')'/inishe/fail
'
242 .'#------------------------ REPEAT --------------------------'
244 .
'# SHELLID NLAY NPG NPTT ILAY IRUPT IRUPT_TYP NUVAR IMAT'
245 WRITE(iugeo,
'(A/A/A)')
246 .
'# REPEAT K=1,NPG ',
247 .
'# UVAR(1,I) ............. ',
248 .
'# ............... UVAR(NUVAR,I) '
250 .
'#---------------------- END REPEAT ------------------------'
251 WRITE(iugeo,
'(A)') delimit
253 WRITE(line,
'(A)') delimit
255 WRITE(line,'(a)
')'/inishe/fail
'
256 CALL STRS_TXT50(LINE,100)
258 .'#------------------------ REPEAT --------------------------'
261 .'# SHELLID NLAY NPG NPTT ILAY IRUPT IRUPT_TYP NUVAR IMAT'
267 .
'# UVAR(1,I) ............. '
270 .
'# ............... UVAR(NUVAR,I) '
273 .
'#---------------------- END REPEAT ------------------------'
275 WRITE(line,
'(A)') delimit
282 nlay = nint(wap0(j+4))
284 nptg = nint(wap0(j+5))
290 imat = nint(wap0(j+1))
292 nptt = nint(wap0(j+1))
295 nvar_rupt = nint(wap0(j+1))
297 irupt = nint(wap0(j+1))
299 irupt_type = nint(wap0(j+1))
302 IF (irupt == 0) cycle
304 IF (izipstrs == 0)
THEN
305 WRITE(iugeo,
'(9I10)') id,nlay,nptg,nptt,il,irupt,irupt_type,nvar_rupt,
308 WRITE(line,
'(9I10)') id,nlay,nptg,nptt,il,irupt,irupt_type,nvar_rupt,
312 IF (irupt /= 0 .AND. nvar_rupt /= 0)
THEN
313 IF (izipstrs == 0)
THEN
316 WRITE(iugeo,
'(1P3E20.13)')(wap0(j + l),l=1,nvar_rupt
338 IF (stat_numeltg==0)
GOTO 300
355 gbuf => elbuf_tab(ng)%GBUF
356 nlay = elbuf_tab(ng)%NLAY
357 nptr = elbuf_tab(ng)%NPTR
358 npts = elbuf_tab(ng)%NPTS
362 isubstack = iparg(71,ng)
369 IF (ipart_state(iprt)==0) cycle
372 IF (mlw /= 0 .AND. mlw /= 13)
THEN
380 wa(jj) = ixtg(nixtg,n)
389 nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
390 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
391 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(1,1,1)
392 nptt = elbuf_tab(ng)%BUFLY(il)%NPTT
396 imat = elbuf_tab(ng)%BUFLY(il)%IMAT
402 irupt = mat_param(imat)%FAIL(ifail)%FAIL_ID
403 irupt_type = mat_param(imat)%FAIL(ifail)%IRUPT
404 nvar_rupt = fbuf%FLOC(ifail)%NVAR
406 wa(jj) = nvar_rupt + 1
412 IF (irupt == 0) cycle
417 fbuf => elbuf_tab(ng)%BUFLY(il)%FAIL(ir,is,it)
418 uvarf => fbuf%FLOC(ifail)%VAR
419 dfmax => fbuf%FLOC(ifail)%DAMMX
424 wa(jj) = uvarf((nv-1)*llt+i)
462 IF (ispmd == 0.AND.len > 0)
THEN
464 DO n=1,stat_numeltg_g
469 iprt = nint(wap0(j + 2))
470 IF (iprt /= iprt0)
THEN
471 IF (izipstrs == 0)
THEN
472 WRITE(iugeo,
'(A)') delimit
473 WRITE(iugeo,
'(A)')
'/INISH3/FAIL'
475 .
'#------------------------ REPEAT --------------------------'
477 .
'# SHELLID NLAY NPG NPTT ILAY IRUPT IRUPT_TYP NUVAR IMAT'
478 WRITE(iugeo,
'(A/A/A)')
479 .
'# REPEAT K=1,NPG ',
480 .
'# UVAR(1,I) ............. ',
481 .
'# ............... UVAR(NUVAR,I) '
483 .
'#---------------------- END REPEAT ------------------------'
484 WRITE(iugeo,
'(A)') delimit
486 WRITE(line,
'(A)') delimit
488 WRITE(line,
'(A)')
'/INISH3/FAIL'
491 .
'#------------------------ REPEAT --------------------------'
494 .
'# SHELLID NLAY NPG NPTT ILAY IRUPT IRUPT_TYP NUVAR IMAT'
500 .
'# UVAR(1,I) ............. '
503 .
'# ............... UVAR(NUVAR,I) '
506 .
'#---------------------- END REPEAT ------------------------'
508 WRITE(line,
'(A)') delimit
515 nlay = nint(wap0(j+4))
517 nptg = nint(wap0(j+5))
523 imat = nint(wap0(j+1))
525 nptt = nint(wap0(j+1))
528 nvar_rupt = nint(wap0(j+1))
530 irupt = nint(wap0(j+1))
532 irupt_type = nint(wap0(j+1))
535 IF (irupt == 0) cycle
537 IF (izipstrs == 0)
THEN
538 WRITE(iugeo,'(9i10)
') ID,NLAY,NPTG,NPTT,IL,IRUPT,IRUPT_TYPE,NVAR_RUPT,
541 WRITE(LINE,'(9i10)
') ID,NLAY,NPTG,NPTT,IL,IRUPT,IRUPT_TYPE,NVAR_RUPT,
543 CALL STRS_TXT50(LINE,100)
545.AND.
IF (IRUPT /= 0 NVAR_RUPT /= 0) THEN
546 IF (IZIPSTRS == 0) THEN
549 WRITE(IUGEO,'(1p3e20.13)
')(WAP0(J + L),L=1,NVAR_RUPT)
556 CALL TAB_STRS_TXT50(WAP0(1),NVAR_RUPT,J,SIZP0,3)
561.AND.
ENDIF ! IF (IRUPT /= 0 NVAR_RUPT /= 0)
564 ENDDO ! DO N=1,STAT_NUMELTG_G
565.AND.
ENDIF ! IF (ISPMD == 0LEN > 0)