32 SUBROUTINE outp_c_t(ITENS ,KEY ,TEXT ,ELBUF_TAB,
33 . IPARG ,EPSDOT,DD_IAD,SIZLOC ,SIZP0,SIZ_WR)
41#include "implicit_f.inc"
56 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*)
57 INTEGER ITENS,SIZLOC,SIZP0,SIZ_WR
60 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
65 INTEGER NG,NEL,NFT,ITY,LFT,NPT,IPT,N0,
66 . llt,mlw,istrain,n,ns1,ns2,
67 . i1,i2,istre,ihbe,jj_old,ngf,ngl,nn,len,
68 . ir,is,nptr,npts,nlay,mpt,npt_all,igtyp,nptt,ii(8)
69 INTEGER RESP0,WRTLEN,RES,COMPTEUR,L,K
70 INTEGER,
DIMENSION(NSPGROUP) :: JJ_LOC
71 INTEGER,
DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
73 . wa(sizloc),wap0(siz_wr),wap0_loc(sizp0)
76 TYPE(g_bufel_) ,
POINTER :: GBUF
79 WRITE(iugeo,
'(2A)')
'/SHELL /TENSOR /',key
80 WRITE(iugeo,
'(A)')text
81 IF (outyy_fmt == 2)
THEN
83 .
'#FORMAT: (1P6E12.5) (TX(I),TY(I),TXY(I),I=1,NUMSHL)'
86 .
'#FORMAT: (1P6E20.13) (TX(I),TY(I),TXY(I),I=1,NUMSHL)'
97 ngl = ngl + dd_iad(ispmd+1,nn)
100 IF (ity == 3 .OR. ity == 7)
THEN
108 istrain = iparg(44,ng)
111 nlay = elbuf_tab(ng)%NLAY
112 gbuf =>elbuf_tab(ng)%GBUF
119 IF (mlw == 0 .OR. mlw == 13) cycle
120 IF (mlw == 27 .OR. mlw == 25 .OR.
121 . mlw == 32 .OR. mlw == 15) istrain=1
127 IF (igtyp == 51 .OR. igtyp == 52)
THEN
130 npt_all = npt_all + elbuf_tab(ng)%BUFLY(ipt)%NPTT
132 IF (nlay == 1) mpt =
max(1,npt_all)
142 ELSEIF (itens == 2)
THEN
147 ELSEIF (itens == 3)
THEN
153 ELSEIF (mlw == 3 .OR. mlw == 23)
THEN
160 ELSEIF (itens == 4)
THEN
166 ELSEIF (mlw == 3 .OR. mlw == 23)
THEN
173 ELSEIF (itens >= 11 .and. itens <= 40)
THEN
176 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23)
THEN
180 ipt =
min(mpt,itens-10)
187 ELSEIF (itens == 5)
THEN
191 IF (istrain == 1)
THEN
198 ELSEIF (itens == 6)
THEN
202 IF (istrain == 1)
THEN
209 ELSEIF (itens == 7)
THEN
213 IF (istrain == 1)
THEN
220 ELSEIF (itens == 8)
THEN
224 IF (istrain == 1)
THEN
231 ELSEIF (itens >= 51 .and. itens <= 80)
THEN
235 IF (istrain == 1 .and. mpt /= 0)
THEN
236 ipt =
min(mpt,itens-50)
238 a2 = half*(((2*ipt-one)/mpt)- one)
246 ELSEIF (itens == 91)
THEN
250 ELSEIF (itens == 92)
THEN
254 ELSEIF (itens == 93)
THEN
258 ELSEIF (itens == 94)
THEN
262 ELSEIF (itens >= 101 .and. itens <= 130)
THEN
264 ipt =
min(mpt,itens-100)
266 a2 = half*(((2*ipt-one)/mpt)-one)
276 wa(jj) = a1 * gbuf%FOR(ii(j)+i) + a2 * gbuf%MOM(ii(j)+i)
279 ELSEIF (istre == 0 .and. gbuf%G_STRA > 0)
THEN
287 wa(jj-2)= a1*gbuf%STRA(ii(1)+i)+ a2*gbuf%STRA(ii(1)+i)*thk
288 wa(jj-1)= a1*gbuf%STRA(ii(2)+i)+ a2*gbuf%STRA(ii(2)+i)*thk
289 wa(jj) = half*(gbuf%STRA(ii(3)+i)+ a2*gbuf%STRA(ii(3)+i)*thk)
291 ELSEIF (istre == 2)
THEN
304 wa(jj-2)= a1 * epsdot(1,n+n0) + a2 * epsdot(4,n+n0)*thk
305 wa(jj-1)= a1 * epsdot(2,n+n0) + a2 * epsdot(5,n+n0)*thk
306 wa(jj)= half*(a1*epsdot(3,n+n0)+a2*epsdot(6,n+n0)*thk)
312 jj_loc(nn) = jj - compteur
319 wap0_loc(1:jj) = wa(1:jj)
322 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
331 IF((adress(nn+1,k)-1-adress(nn,k))>=0)
THEN
332 DO l = adress(nn,k),adress(nn+1,k)-1
333 compteur = compteur + 1
334 wap0(compteur+resp0) = wap0_loc(l)
339 jj_old = compteur+resp0
344 IF (outyy_fmt == 2)
THEN
345 WRITE(iugeo,
'(1P6E12.5)')(wap0(j),j=1,wrtlen)
347 WRITE(iugeo,
'(1P6E20.13)')(wap0(j),j=1,wrtlen)
351 wap0(i)=wap0(wrtlen+i)
358 IF (outyy_fmt == 2)
THEN
359 WRITE(iugeo,
'(1P6E12.5)')(wap0(j),j=1,resp0)
361 WRITE(iugeo,
'(1P6E20.13)')(wap0(j),j=1,resp0)
382 . DD_IAD,SIZLOC,SIZP0 ,THKE ,GEO ,
383 . IGEO ,STACK ,DRAPE_SH4N, DRAPE_SH3N ,IXC ,
384 . IXTG ,SIZ_WR,DRAPEG)
394#include "implicit_f.inc"
398#include "param_c.inc"
399#include "units_c.inc"
401#include "com01_c.inc"
402#include "scr16_c.inc"
403#include "mvsiz_p.inc"
410 INTEGER IPARG(NPARG,*), (NSPMD+1,*),SIZLOC,SIZP0,
411 . igeo(npropgi,*),ixc(nixc,*),ixtg(nixtg,*),
414 . thke(*),geo(npropg,*)
415 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
416 TYPE (STACK_PLY) :: STACK
420 INTEGER NG,NEL,NFT,ITY,LFT,NPT,IPT,N0,
421 . LLT,MLW,ISTRAIN,N,NS1,NS2,
422 . I1,I2,I3,I4,I5,I11,ISTRE,IHBE,I,J,JJ,
423 . JJ_OLD,NGF,NGL,NN,LEN,K,NPG,IPG,NLAY,NPTS,NPTR,IL,ITHK,NPTT,IT,
424 . igtyp,ixfem,isubstack,npt_all,mpt,compteur,l,ii(8)
425 INTEGER,
DIMENSION(NSPGROUP) :: JJ_LOC
426 INTEGER,
DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
428 . WA(SIZLOC),WAP0(SIZ_WR),WAP0_LOC(SIZP0)
431 . a1,a2,thk,func(6),hourg(5),pla(mvsiz)
433 TYPE() ,
POINTER :: BUFLY
434 TYPE(g_bufel_) ,
POINTER :: GBUF
435 TYPE(L_BUFEL_) ,
POINTER :: LBUF
436 TYPE(DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
440 WRITE(iugeo,'(2a)
')'/shell /tensor /
',KEY
441 WRITE(IUGEO,'(a)
')TEXT
442 IF (ITENS == 95) THEN
444 . '#(NPG=Surface Quadratue Points; For QEPH,QBAT,DKT18: NPG>1) '
445 IF (outyy_fmt == 2)
THEN
447 . .GT.
'#FORMAT: (IF NPT0) (2I8/1P6E12.5/6E12.5) '
449 .
'#NPT,NPG,THICK,EM,EB,H1,H2,H3'
451 .
'#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
452 .
'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
454 .
'#FORMAT: (IF NPT == 0) ((2I8/1P6E12.5/6E12.5/3E12.5)) '
456 .
'#0,NPG,THICK,EM,EB,H1,H2,H3'
458 .
'#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
459 .
'K=1,NPG),I=1,NUMSHL)'
462 . .GT.
'#FORMAT: (IF NPT0) (2I10/1P6E20.13/6E20.13) '
464 .
'#NPT,NPG,THICK,EM,EB,H1,H2,H3'
466 .
'#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
467 .
'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
469 .
'#FORMAT: (IF NPT == 0) ((2I10/1P6E20.13/6E20.13/3E20.13)) '
471 .
'#0,NPG,THICK,EM,EB,H1,H2,H3'
473 .
'#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
474 .
'K=1,NPG),I=1,NUMSHL)'
476 ELSEIF (itens == 96)
THEN
477 IF (outyy_fmt == 2)
THEN
479 .
'#FORMAT: (1P6E12.5/3E12.5) '
481 .
'#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
482 .
'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
485 .
'#FORMAT: (1P6E20.13/3E20.13) '
487 .
'#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
488 .
'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
499 ngl = ngl + dd_iad(ispmd+1,nn)
502 IF (ity == 3 .OR. ity == 7)
THEN
509 istrain= iparg(44,ng)
514 isubstack=iparg(71,ng)
516 gbuf => elbuf_tab(ng)%GBUF
517 nlay = elbuf_tab(ng)%NLAY
518 nptr = elbuf_tab(ng)%NPTR
519 npts = elbuf_tab(ng)%NPTS
530 IF (igtyp == 51 .OR. igtyp == 52 )
THEN
533 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
538 IF (mlw == 27 .OR. mlw == 25 .OR.
539 . mlw == 32 .OR. mlw == 15) istrain=1
543 IF (itens == 95)
THEN
549 ELSEIF (ihbe >= 11)
THEN
550 CALL c_tf_ne(elbuf_tab(ng),ihbe ,nel ,npt ,mlw ,
551 . ity ,istrain ,jj ,wa ,1 ,
552 . nlay ,nptr ,npts ,ithk ,nft ,
554 . ixfem ,isubstack,stack,drape_sh4n, drape_sh3n,
555 . ixc ,ixtg ,mpt ,drapeg )
559 IF (gbuf%G_HOURG == 0)
THEN
564 hourg(1) = gbuf%HOURG(ii(1)+i
565 hourg(2) = gbuf%HOURG(ii(2)+i)
566 hourg(3) = gbuf%HOURG(ii(3)+i)
572 wa(jj+2) = gbuf%THK(i)
574 wa(jj+2) = thke(i+nft)
577 wa(jj+3) = gbuf%EINT(i)
578 wa(jj+4) = gbuf%EINT(i+llt)
582 wa(jj+8) = gbuf%FORPG(ii(1)+i)
583 wa(jj+9) = gbuf%FORPG(ii(2)+i)
584 wa(jj+10) = gbuf%FORPG(ii(3)+i)
585 wa(jj+11) = gbuf%FORPG(ii(4)+i)
586 wa(jj+12) = gbuf%FORPG(ii(5)+i)
587 IF (gbuf%G_PLA > 0)
THEN
588 wa(jj+13) = gbuf%PLA(i)
592 wa(jj+14) = gbuf%MOMPG(ii(1)+i)
593 wa(jj+15) = gbuf%MOMPG(ii(2)+i)
594 wa(jj+16) = gbuf%MOMPG(ii(3)+i)
599 IF (gbuf%G_HOURG == 0)
THEN
604 hourg(1) = gbuf%HOURG(ii(1)+i)
605 hourg(2) = gbuf%HOURG(ii(2)+i)
606 hourg(3) = gbuf%HOURG(ii(3)+i)
612 wa(jj+2) = gbuf%THK(i)
614 wa(jj+2) = thke(i+nft)
616 wa(jj+3) = gbuf%EINT(i)
617 wa(jj+4) = gbuf%EINT(i+llt)
625 wa(jj+1) = gbuf%FORPG(ii(1)+i)
626 wa(jj+2) = gbuf%FORPG(ii(2)+i)
627 wa(jj+3) = gbuf%FORPG(ii(3)+i)
628 wa(jj+4) = gbuf%FORPG(ii(4)+i)
629 wa(jj+5) = gbuf%FORPG(ii(5)+i)
630 IF (gbuf%G_PLA > 0)
THEN
631 wa(jj+6) = gbuf%PLA(i)
635 wa(jj+7) = gbuf%MOMPG(ii(1)+i)
636 wa(jj+8) = gbuf%MOMPG(ii(2)+i)
637 wa(jj+9) = gbuf%MOMPG(ii(3)+i)
643 bufly => elbuf_tab(ng)%BUFLY(1)
646 lbuf => bufly%LBUF(1,1,it)
647 wa(jj+1) = lbuf%SIG(ii(1)+i)
648 wa(jj+2) = lbuf%SIG(ii(2)+i)
649 wa(jj+3) = lbuf%SIG(ii(3)+i)
650 wa(jj+4) = lbuf%SIG(ii(4)+i)
651 wa(jj+5) = lbuf%SIG(ii(5)+i)
652 IF (bufly%L_PLA > 0)
THEN
653 wa(jj+6) = lbuf%PLA(i)
659 ELSEIF (nlay > 1)
THEN
661 bufly => elbuf_tab(ng)%BUFLY(il)
664 lbuf => bufly%LBUF(1,1,it)
665 wa(jj+1) = lbuf%SIG(ii(1)+i)
666 wa(jj+2) = lbuf%SIG(ii(2)+i)
667 wa(jj+3) = lbuf%SIG(ii(3)+i)
668 wa(jj+4) = lbuf%SIG(ii(4)+i)
669 wa(jj+5) = lbuf%SIG(ii(5)+i)
670 IF (bufly%L_PLA > 0)
THEN
671 wa(jj+6) = lbuf%PLA(i)
686 ELSEIF (itens == 96)
THEN
688 IF (gbuf%G_STRA > 0)
THEN
690 wa(jj+1) = gbuf%STRA(ii(1)+i)
691 wa(jj+2) = gbuf%STRA(ii(2)+i)
692 wa(jj+3) = gbuf%STRA(ii(3)+i)
693 wa(jj+4) = gbuf%STRA(ii(4)+i)
694 wa(jj+5) = gbuf%STRA(ii(5)+i)
698 IF (gbuf%G_PLA > 0)
THEN
700 il = iabs(nlay)/2 + 1
701 bufly => elbuf_tab(ng)%BUFLY(il)
702 IF (bufly%L_PLA > 0)
THEN
707 lbuf => bufly%LBUF(1,1,it)
708 func(6) = func(6) + lbuf%PLA(i)/nptt
712 wa(jj+6) = bufly%PLAPT(i)
716 bufly => elbuf_tab(ng)%BUFLY(1)
717 IF (bufly%L_PLA > 0)
THEN
719 il = iabs(nptt)/2 + 1
721 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i
724 wa(jj+6) = bufly%PLAPT(i3+i)
731 wa(jj+7) = gbuf%STRA(ii(6)+i)
732 wa(jj+8) = gbuf%STRA(ii(7)+i)
733 wa(jj+9) = gbuf%STRA(ii(8)+i)
747 IF (gbuf%G_PLA > 0)
THEN
749 il = iabs(nlay)/2 + 1
750 bufly => elbuf_tab(ng)%BUFLY(il)
751 IF (bufly%L_PLA > 0)
THEN
756 lbuf => bufly%LBUF(1,1,it)
757 func(6) = func(6) + lbuf%PLA(i)/nptt
761 wa(jj+6) = bufly%PLAPT(i)
765 bufly => elbuf_tab(ng)%BUFLY(1)
766 IF (bufly%L_PLA > 0)
THEN
768 il = iabs(nptt)/2 + 1
770 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i)
773 wa(jj+6) = bufly%PLAPT(i3+i)
792 jj_loc(nn) = jj - compteur
799 wap0_loc(1:jj) = wa(1:jj)
802 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
810 IF((adress(nn+1,k)-1-adress(nn,k))>=0)
THEN
811 DO l = adress(nn,k),adress(nn+1,k)-1
812 compteur = compteur + 1
813 wap0(compteur) = wap0_loc(l)
822 IF (itens == 95)
THEN
824 DO WHILE (j < jj_old+1)
828 IF (outyy_fmt == 2)
THEN
831 WRITE(iugeo,
'(2I8/,1P6E12.5)')
832 . npt,npg,zero,zero,zero,
834 WRITE(iugeo,
'(1P6E12.5)')
837 WRITE(iugeo,
'(1P3E12.5)')
842 WRITE(iugeo,
'(2I10/,1P6E20.13)')
843 . npt,npg,zero,zero,zero,
845 WRITE(iugeo,
'(1P6E20.13)')
848 WRITE(iugeo,
'(1P3E20.13)')
851 ELSEIF (ihbe >= 11)
THEN
852 IF (outyy_fmt == 2)
THEN
854 npg = nint(wap0(j+1))
855 WRITE(iugeo,
'(2I8/,1P3E12.5)')npt,npg,
860 WRITE(iugeo,
'(1P6E12.5/1P3E12.5)')
867 WRITE(iugeo,
'(1P6E12.5)')(wap0(j+k),k=0,5)
874 npg = nint(wap0(j+1))
875 WRITE(iugeo,
'(2I10/,1P3E20.13)')npt,npg,
880 WRITE(iugeo,
'(1P6E20.13/1P3E20.13)')
887 WRITE(iugeo,
'(1P6E20.13)')(wap0(j+k),k=0,5)
896 IF (outyy_fmt == 2)
THEN
897 WRITE(iugeo,
'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
898 WRITE(iugeo,
'(1P6E12.5/1P3E12.5)')(wap0(j+k),k=7,15)
900 WRITE(iugeo,
'(I10/,1P6E20.13)')npt,(wap0(j+k),k=1,6)
901 WRITE(iugeo,
'(1P6E20.13/1P3E20.13)')(wap0(j+k),k=7,15)
905 IF (outyy_fmt == 2)
THEN
906 WRITE(iugeo,
'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
908 WRITE(iugeo,
'(I10/,1P6E20.13)')npt,(wap0(j+k),k=1,6)
911 IF (outyy_fmt == 2)
THEN
913 WRITE(iugeo,
'(1P6E12.5)'
918 WRITE(iugeo,
'(1P6E20.13)')(wap0(j-1+k),k=1,6)
925 ELSEIF (itens == 96)
THEN
927 IF (outyy_fmt == 2)
THEN
928 DO WHILE (j < jj_old)
929 WRITE(iugeo,
'(1P6E12.5)')(wap0(j-1+k),k=1,6)
930 WRITE(iugeo,
'(1P3E12.5)')(wap0(j-1+k),k=7,9)
934 DO WHILE (j < jj_old)
935 WRITE(iugeo,
'(1P6E20.13)')(wap0(j-1+k),k=1,6)
936 WRITE(iugeo,
'(1P3E20.13)')(wap0(j-1+k),k=7,9)
963#include "implicit_f.inc"
967#include "param_c.inc"
969#include "com01_c.inc"
970#include "scr16_c.inc"
974 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ(3),SIZ_WRITE(3*NSPGROUP+3)
975 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
979 INTEGER NGF,NGL,NN,ITY,MLW,NEL,NPT,IHBE,NPG,MPT,NG,JJ,COUNT,I,
980 . WASZ1,WASZ2,WASZ3,WASZ_95,WASZ4,
981 . IL,NLAY,IGTYP,NPT_ALL,
982 . NPTR,NPTS,SIZ_WRITE_LOC(4*NSPGROUP)
989 count = count + outp_ct(10+i)+outp_ct(50+i)+outp_ct(100+i)
992 IF ( outp_ct( 1) == 1.OR.outp_ct( 2) == 1.OR.outp_ct( 3) == 1
993 . .OR.outp_ct( 4) == 1.OR.outp_ct( 5) == 1.OR.outp_ct( 6) == 1
994 . .OR.outp_ct( 7) == 1.OR.outp_ct( 8) == 1.OR.outp_ct(91) == 1
995 . .OR.outp_ct(92) == 1.OR.outp_ct(93) == 1.OR.outp_ct(94) == 1
1002 ngl = ngl + dd_iad(ispmd+1,nn)
1005 IF(ity == 3.OR.ity == 7)
THEN
1012 siz_write_loc(nn) = jj
1020 IF (outp_ct(95) == 1)
THEN
1025 ngl = ngl + dd_iad(ispmd+1,nn)
1028 IF (ity == 3.OR.ity == 7)
THEN
1033 igtyp = iparg(38,ng)
1035 nlay = elbuf_tab(ng)%NLAY
1036 nptr = elbuf_tab(ng)%NPTR
1037 npts = elbuf_tab(ng)%NPTS
1040 IF (igtyp == 51 .OR. igtyp == 52)
THEN
1043 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
1045 mpt =
max(1,npt_all)
1048 IF (ihbe >= 11)
THEN
1052 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) mpt=0
1054 IF (ihbe == 23)
THEN
1058 jj = jj + ((9*npg)+5)*nel
1060 jj = jj + (6*npg*mpt+5)*nel
1062 ELSEIF (ihbe == 11)
THEN
1065 jj = jj + ((9*npg)+5)*nel
1067 jj = jj + ((6*npg*mpt)+5)*nel
1071 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23)
THEN
1077 jj = jj + (6*mpt+7)*nel
1088 siz_write_loc(nspgroup+nn) = jj
1095 IF (outp_ct(95) == 1)
THEN
1100 ngl = ngl + dd_iad(ispmd+1,nn)
1104 IF(ity == 3.OR.ity == 7)
THEN
1110 siz_write_loc(2*nspgroup+nn) = jj
1116 IF (outp_ct(96) == 1)
THEN
1121 ngl = ngl + dd_iad(ispmd+1,nn)
1128 siz_write_loc(3*nspgroup+nn) = jj
1131 wasz_95 =
max(wasz2,wasz3)
1136 siz_write(nn) = siz_write_loc(nn)
1137 siz_write(nspgroup+nn) =
max(siz_write_loc(nspgroup+nn),siz_write_loc(2*nspgroup+nn))
1138 siz_write(2*nspgroup+nn) = siz_write_loc(3*nspgroup+nn)
1141 siz_write(3*nspgroup+nn) = wasz(nn)