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,*),(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 . istre,ihbe,jj_old,ngf,ngl,nn,
68 . nlay,mpt,npt_all,igtyp,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
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
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)
383 . DD_IAD,SIZLOC,SIZP0 ,THKE ,GEO ,
384 . IGEO ,STACK ,DRAPE_SH4N, DRAPE_SH3N ,IXC ,
385 . IXTG ,SIZ_WR,DRAPEG)
392 use element_mod ,
only : nixc,nixtg
396#include "implicit_f.inc"
400#include "param_c.inc"
401#include "units_c.inc"
403#include "com01_c.inc"
404#include "scr16_c.inc"
405#include "mvsiz_p.inc"
412 INTEGER IPARG(NPARG,*), DD_IAD(NSPMD+1,*),SIZLOC,SIZP0,
413 . igeo(npropgi,*),ixc(nixc,*),ixtg(nixtg,*),
416 . thke(*),geo(npropg,*)
417 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
418 TYPE (STACK_PLY) :: STACK
422 INTEGER NG,NEL,NFT,ITY,LFT,NPT,
425 . JJ_OLD,NGF,NGL,NN,K,NPG,IPG,NLAY,NPTS,NPTR,IL,ITHK,NPTT,IT,
426 . igtyp,ixfem,isubstack,npt_all,mpt,compteur,l,ii(8)
427 INTEGER,
DIMENSION(NSPGROUP) :: JJ_LOC
428 INTEGER,
DIMENSION(NSPGROUP+1,NSPMD) :: ADRESS
430 . WA(SIZLOC),WAP0(SIZ_WR),WAP0_LOC(SIZP0)
435 TYPE(buf_lay_) ,
POINTER :: BUFLY
436 TYPE(g_bufel_) ,
POINTER :: GBUF
437 TYPE(L_BUFEL_) ,
POINTER :: LBUF
438 TYPE(DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
442 WRITE(iugeo,
'(2A)')
'/SHELL /TENSOR /',key
443 WRITE(iugeo,
'(A)')text
444 IF (itens == 95)
THEN
446 .
'#(NPG=Surface Quadratue Points; For QEPH,QBAT,DKT18: NPG>1) '
447 IF (outyy_fmt == 2)
THEN
449 . .GT.
'#FORMAT: (IF NPT0) (2I8/1P6E12.5/6E12.5) '
451 .
'#NPT,NPG,THICK,EM,EB,H1,H2,H3'
453 .
'#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
454 .
'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
456 .
'#FORMAT: (IF NPT == 0) ((2I8/1P6E12.5/6E12.5/3E12.5)) '
458 .
'#0,NPG,THICK,EM,EB,H1,H2,H3'
460 .
'#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
461 .
'K=1,NPG),I=1,NUMSHL)'
464 . .GT.
'#FORMAT: (IF NPT0) (2I10/1P6E20.13/6E20.13) '
466 .
'#NPT,NPG,THICK,EM,EB,H1,H2,H3'
468 .
'#(TX,TY,TXY,TXZ,TYZ,EPSP(K,J,I)',
469 .
'K=1,NPG),J=1,NPT),I=1,NUMSHL)'
471 .
'#FORMAT: (IF NPT == 0) ((2I10/1P6E20.13/6E20.13/3E20.13)) '
473 .
'#0,NPG,THICK,EM,EB,H1,H2,H3'
475 .
'#(NX,NY,NXY,NXZ,NYZ,EPSP,MX,MY,MXY(K,I)',
476 .
'K=1,NPG),I=1,NUMSHL)'
478 ELSEIF (itens == 96)
THEN
479 IF (outyy_fmt == 2)
THEN
481 .
'#FORMAT: (1P6E12.5/3E12.5) '
483 .
'#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
484 .
'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
487 .
'#FORMAT: (1P6E20.13/3E20.13) '
489 .
'#(EX(I),EY(I),EXY(I),EXZ(I),EYZ(I),',
490 .
'EPSP(I),KX(I),KY(I),KXY(I),I=1,NUMSHL)'
501 ngl = ngl + dd_iad(ispmd+1,nn)
504 IF (ity == 3 .OR. ity == 7)
THEN
511 istrain= iparg(44,ng)
516 isubstack=iparg(71,ng)
518 gbuf => elbuf_tab(ng)%GBUF
519 nlay = elbuf_tab(ng)%NLAY
520 nptr = elbuf_tab(ng)%NPTR
521 npts = elbuf_tab(ng)%NPTS
532 IF (igtyp == 51 .OR. igtyp == 52 )
THEN
535 npt_all = npt_all + elbuf_tab(ng)%BUFLY
540 IF (mlw == 27 .OR. mlw == 25 .OR.
541 . mlw == 32 .OR. mlw == 15) istrain=1
545 IF (itens == 95)
THEN
551 ELSEIF (ihbe >= 11)
THEN
552 CALL c_tf_ne(elbuf_tab(ng),ihbe ,nel ,npt ,mlw ,
553 . ity ,istrain ,jj ,wa ,1 ,
554 . nlay ,nptr ,npts ,ithk ,nft ,
555 . thke ,npg ,igtyp,geo ,igeo ,
556 . ixfem ,isubstack,stack,drape_sh4n, drape_sh3n
557 . ixc ,ixtg ,mpt ,drapeg )
559 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23)
THEN
561 IF (gbuf%G_HOURG == 0)
THEN
566 hourg(1) = gbuf%HOURG(ii(1)+i)
567 hourg(2) = gbuf%HOURG(ii(2)+i)
568 hourg(3) = gbuf%HOURG(ii(3)+i)
574 wa(jj+2) = gbuf%THK(i)
576 wa(jj+2) = thke(i+nft)
579 wa(jj+3) = gbuf%EINT(i)
580 wa(jj+4) = gbuf%EINT(i+llt)
584 wa(jj+8) = gbuf%FORPG(ii(1)+i)
585 wa(jj+9) = gbuf%FORPG(ii(2)+i)
586 wa(jj+10) = gbuf%FORPG(ii(3)+i)
587 wa(jj+11) = gbuf%FORPG(ii(4)+i)
588 wa(jj+12) = gbuf%FORPG(ii(5)+i)
589 IF (gbuf%G_PLA > 0)
THEN
590 wa(jj+13) = gbuf%PLA(i)
594 wa(jj+14) = gbuf%MOMPG(ii(1)+i)
595 wa(jj+15) = gbuf%MOMPG(ii(2)+i)
596 wa(jj+16) = gbuf%MOMPG(ii(3)+i)
601 IF (gbuf%G_HOURG == 0)
THEN
606 hourg(1) = gbuf%HOURG(ii(1)+i)
607 hourg(2) = gbuf%HOURG(ii
608 hourg(3) = gbuf%HOURG(ii(3)+i)
618 wa(jj+3) = gbuf%EINT(i)
619 wa(jj+4) = gbuf%EINT(i+llt)
627 wa(jj+1) = gbuf%FORPG(ii(1)+i)
628 wa(jj+2) = gbuf%FORPG(ii(2)+i)
629 wa(jj+3) = gbuf%FORPG(ii(3)+i)
630 wa(jj+4) = gbuf%FORPG(ii(4)+i)
631 wa(jj+5) = gbuf%FORPG(ii(5)+i)
632 IF (gbuf%G_PLA > 0)
THEN
633 wa(jj+6) = gbuf%PLA(i)
637 wa(jj+7) = gbuf%MOMPG(ii(1)+i)
638 wa(jj+8) = gbuf%MOMPG(ii(2)+i)
639 wa(jj+9) = gbuf%MOMPG(ii(3)+i)
645 bufly => elbuf_tab(ng)%BUFLY(1)
648 lbuf => bufly%LBUF(1,1,it)
649 wa(jj+1) = lbuf%SIG(ii(1)+i)
650 wa(jj+2) = lbuf%SIG(ii(2)+i)
651 wa(jj+3) = lbuf%SIG(ii(3)+i)
652 wa(jj+4) = lbuf%SIG(ii(4)+i)
653 wa(jj+5) = lbuf%SIG(ii(5)+i)
654 IF (bufly%L_PLA > 0)
THEN
655 wa(jj+6) = lbuf%PLA(i)
661 ELSEIF (nlay > 1)
THEN
663 bufly => elbuf_tab(ng)%BUFLY(il)
666 lbuf => bufly%LBUF(1,1,it)
667 wa(jj+1) = lbuf%SIG(ii(1)+i)
668 wa(jj+2) = lbuf%SIG(ii(2)+i)
669 wa(jj+3) = lbuf%SIG(ii(3)+i)
670 wa(jj+4) = lbuf%SIG(ii(4)+i)
671 wa(jj+5) = lbuf%SIG(ii(5)+i)
672 IF (bufly%L_PLA > 0)
THEN
673 wa(jj+6) = lbuf%PLA(i)
688 ELSEIF (itens == 96)
THEN
690 IF (gbuf%G_STRA > 0)
THEN
692 wa(jj+1) = gbuf%STRA(ii(1)+i)
693 wa(jj+2) = gbuf%STRA(ii(2)+i)
694 wa(jj+3) = gbuf%STRA(ii(3)+i)
695 wa(jj+4) = gbuf%STRA(ii(4)+i)
696 wa(jj+5) = gbuf%STRA(ii(5)+i)
700 IF (gbuf%G_PLA > 0)
THEN
702 il = iabs(nlay)/2 + 1
703 bufly => elbuf_tab(ng)%BUFLY(il)
704 IF (bufly%L_PLA > 0)
THEN
709 lbuf => bufly%LBUF(1,1,it)
710 func(6) = func(6) + lbuf%PLA(i)/nptt
714 wa(jj+6) = bufly%PLAPT(i)
718 bufly => elbuf_tab(ng)%BUFLY(1)
719 IF (bufly%L_PLA > 0)
THEN
721 il = iabs(nptt)/2 + 1
723 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i)
726 wa(jj+6) = bufly%PLAPT(i3+i)
733 wa(jj+7) = gbuf%STRA(ii(6)+i)
734 wa(jj+8) = gbuf%STRA(ii(7)+i)
735 wa(jj+9) = gbuf%STRA(ii(8)+i)
749 IF (gbuf%G_PLA > 0)
THEN
751 il = iabs(nlay)/2 + 1
752 bufly => elbuf_tab(ng)%BUFLY(il)
753 IF (bufly%L_PLA > 0)
THEN
758 lbuf => bufly%LBUF(1,1,it)
759 func(6) = func(6) + lbuf%PLA(i)/nptt
763 wa(jj+6) = bufly%PLAPT(i)
767 bufly => elbuf_tab(ng)%BUFLY(1)
768 IF (bufly%L_PLA > 0)
THEN
770 il = iabs(nptt)/2 + 1
772 wa(jj+6) = bufly%LBUF(1,1,il)%PLA(i)
775 wa(jj+6) = bufly%PLAPT(i3+i)
794 jj_loc(nn) = jj - compteur
804 adress(nn,1) = jj_loc(nn-1) + adress(nn-1,1)
812 IF((adress(nn+1,k)-1-adress(nn,k))>=0)
THEN
813 DO l = adress(nn,k),adress(nn+1,k)-1
814 compteur = compteur + 1
815 wap0(compteur) = wap0_loc(l)
824 IF (itens == 95)
THEN
826 DO WHILE (j < jj_old+1)
830 IF (outyy_fmt == 2)
THEN
833 WRITE(iugeo,
'(2I8/,1P6E12.5)')
834 . npt,npg,zero,zero,zero,
836 WRITE(iugeo,
'(1P6E12.5)')
839 WRITE(iugeo,
'(1P3E12.5)')
844 WRITE(iugeo,
'(2I10/,1P6E20.13)')
845 . npt,npg,zero,zero,zero,
847 WRITE(iugeo,
'(1P6E20.13)')
850 WRITE(iugeo,
'(1P3E20.13)')
853 ELSEIF (ihbe >= 11)
THEN
854 IF (outyy_fmt == 2)
THEN
856 npg = nint(wap0(j+1))
857 WRITE(iugeo,
'(2I8/,1P3E12.5)')npt,npg,
862 WRITE(iugeo,
'(1P6E12.5/1P3E12.5)')
869 WRITE(iugeo,
'(1P6E12.5)')(wap0(j+k),k=0,5)
876 npg = nint(wap0(j+1))
877 WRITE(iugeo,
'(2I10/,1P3E20.13)')npt,npg,
882 WRITE(iugeo,
'(1P6E20.13/1P3E20.13)')
889 WRITE(iugeo,
'(1P6E20.13)')(wap0(j+k),k=0,5)
898 IF (outyy_fmt == 2)
THEN
899 WRITE(iugeo,
'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
900 WRITE(iugeo,
'(1P6E12.5/1P3E12.5)')(wap0(j+k),k=7,15)
902 WRITE(iugeo,
'(I10/,1P6E20.13)')npt,(wap0(j+k),k=1,6)
903 WRITE(iugeo,
'(1P6E20.13/1P3E20.13)')(wap0
907 IF (outyy_fmt == 2)
THEN
908 WRITE(iugeo,
'(I8/,1P6E12.5)')npt,(wap0(j+k),k=1,6)
910 WRITE(iugeo,
'(I10/,1P6E20.13)'
913 IF (outyy_fmt == 2)
THEN
915 WRITE(iugeo,
'(1P6E12.5)')(wap0(j-1+k),k=1,6)
920 WRITE(iugeo,
'(1P6E20.13)')(wap0(j-1+k),k=1,6)
927 ELSEIF (itens == 96)
THEN
929 IF (outyy_fmt == 2)
THEN
930 DO WHILE (j < jj_old)
931 WRITE(iugeo,
'(1P6E12.5)')(wap0(j-1+k),k=1,6)
932 WRITE(iugeo,
'(1P3E12.5)')(wap0(j-1+k),k=7,9)
936 DO WHILE (j < jj_old)
937 WRITE(iugeo,
'(1P6E20.13)')(wap0(j-1+k),k=1,6)
938 WRITE(iugeo,
'(1P3E20.13)')(wap0(j-1+k),k=7,9)
965#include "implicit_f.inc"
969#include "param_c.inc"
971#include "com01_c.inc"
972#include "scr16_c.inc"
976 INTEGER IPARG(NPARG,*),DD_IAD(NSPMD+1,*),WASZ(3),SIZ_WRITE(3*NSPGROUP+3)
977 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
981 INTEGER NGF,NGL,NN,ITY,MLW,NEL,NPT,IHBE,NPG,MPT,NG,JJ,COUNT,I,
982 . WASZ1,WASZ2,WASZ3,WASZ_95,WASZ4,
983 . IL,NLAY,IGTYP,NPT_ALL,
984 . NPTR,NPTS,SIZ_WRITE_LOC(4*NSPGROUP)
991 count = count + outp_ct(10+i)+outp_ct(50+i)+outp_ct(100+i)
994 IF ( outp_ct( 1) == 1.OR.outp_ct( 2) == 1.OR.outp_ct( 3) == 1
995 . .OR.outp_ct( 4) == 1.OR.outp_ct( 5) == 1.OR.outp_ct( 6) == 1
996 . .OR.outp_ct( 7) == 1.OR.outp_ct( 8) == 1.OR.outp_ct(91) == 1
997 . .OR.outp_ct(92) == 1.OR.outp_ct(93) == 1.OR.outp_ct(94) == 1
1004 ngl = ngl + dd_iad(ispmd+1,nn)
1007 IF(ity == 3.OR.ity == 7)
THEN
1014 siz_write_loc(nn) = jj
1022 IF (outp_ct(95) == 1)
THEN
1027 ngl = ngl + dd_iad(ispmd+1,nn)
1030 IF (ity == 3.OR.ity
THEN
1035 igtyp = iparg(38,ng)
1037 nlay = elbuf_tab(ng)%NLAY
1038 nptr = elbuf_tab(ng)%NPTR
1039 npts = elbuf_tab(ng)%NPTS
1042 IF (igtyp == 51 .OR. igtyp == 52)
THEN
1045 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
1047 mpt =
max(1,npt_all)
1050 IF (ihbe >= 11)
THEN
1054 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) mpt=0
1056 IF (ihbe == 23)
THEN
1060 jj = jj + ((9*npg)+5)*nel
1062 jj = jj + (6*npg*mpt+5)*nel
1064 ELSEIF (ihbe == 11)
THEN
1067 jj = jj + ((9*npg)+5)*nel
1069 jj = jj + ((6*npg*mpt)+5)*nel
1073 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23)
THEN
1079 jj = jj + (6*mpt+7)*nel
1090 siz_write_loc(nspgroup+nn) = jj
1097 IF (outp_ct(95) == 1)
THEN
1102 ngl = ngl + dd_iad(ispmd+1,nn)
1106 IF(ity == 3.OR.ity == 7)
THEN
1112 siz_write_loc(2*nspgroup+nn) = jj
1118 IF (outp_ct(96) == 1)
THEN
1123 ngl = ngl + dd_iad(ispmd+1,nn)
1130 siz_write_loc(3*nspgroup+nn) = jj
1133 wasz_95 =
max(wasz2,wasz3)
1138 siz_write(nn) = siz_write_loc(nn)
1139 siz_write(nspgroup+nn) =
max(siz_write_loc(nspgroup+nn),siz_write_loc(2*nspgroup+nn))
1140 siz_write(2*nspgroup+nn) = siz_write_loc(3*nspgroup+nn)
1143 siz_write(3*nspgroup+nn) = wasz(nn)
subroutine c_tf_ne(elbuf_str, ihbe, nel, npt, mlw, ity, istrain, jj, wa, iw, nlay, nptr, npts, ithk, nft, thke, npg, igtyp, geo, igeo, ixfem, isubstack, stack, drape_sh4n, drape_sh3n, ixc, ixtg, mpt, drapeg)