Liren Large Software Subsidy 9

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 4.ddi / ELSTF10.FOR < prev next >

Wrap

Text File | 1987-04-16 | 70.4 KB | 880 lines

SUBROUTINE THDFE(ID,PROP1,PROP2,PROP4,PROP5,PROP6,LM, 00301560 $S,RF,XM,SA,SF,TEMPD,KK1,KK2,KK4,KK5,KK6,IX,IA,NEL,NUMNP, 00301570 $NDMX,NSMX,MXDF,MMA) 00301580 IMPLICIT REAL*8 (A-H,O-Z) 00301590 REAL*8 ID,LM 00301600 REAL*8MODUE 00301610 COMMON A(1) 00301620 COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,MEL,NOD9(12),RRJUNK(218) R0301630 COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3), 00301640 $PROP(4),B(60 ),XJ(3,3),HP(60),UP(60),DE,DET,STR(6,60) 00301650 &,FN(20,2),RRQTSA(226) R0301660 COMMON /ELTEMP/TAVG,RRELTE(102) R0301670 COMMON /CG/ SCG(4),RRCG(2) R0301680 COMMON /PREP/ XZ(2),KSKIP,NDYN,NRPREP(15) R0301690 COMMON /AMB/ GRAV,REFT,JROT 00301710 COMMON /ELPAR/ XPAR(14),NZQ,MBAND,NZD(8),N2P,N3P,NMRI,NTRI,N1P 00301720 & ,NRELPA(43) R0301721 COMMON/MASS/LMASS 00301730 COMMON /TRASH/ XX(7) 00301740 $,ZQ(2),H8(8),LSW,KDM,STRS(6,60) 00301750 $ ,W,I,J,L,II,I2,JJ,NC,NN,NR,NT,MAT,NDM,NPR,NRTRAS(209) R0301770 DIMENSION LM(MXDF),RF(MXDF,KK6),S(MXDF,MXDF),SA(NSMX,MXDF), 00301780 $SF(NSMX,KK6),TEMPD(NDMX,KK6) 00301790 DIMENSION PROP6(KK6,7),XM(MXDF,MMA),ITABLE(9) 00301800 DIMENSION PROP5(KK5,7) 00301810 DIMENSION IX(13),ID(NUMNP,3),IA(20) 00301820 DIMENSION PRES(7) 00301830 DIMENSION EVAL( 9,3) 00301840 DIMENSION TM(9,8) 00301850 DATA EVAL / 1., 1.,-1.,-1., 1., 1.,-1.,-1., 0., 00301860 $ -1., 1., 1.,-1.,-1., 1., 1.,-1., 0., 00301870 $ -1.,-1.,-1.,-1., 1., 1., 1., 1., 0./ 00301880 LL=KK6 00301890 MEL=NEL 00301900 DO 80 I=2,9 00301910 80 ITABLE(I)=I-1 00301920 ITABLE(1)=9 00301930 LSW=0 00301940 IF(IX(4).NE.IX(3).OR.IX(8).NE.IX(7)) GO TO 90 00301950 LSW=1 00301960 IA(11)=IX(3) 00301970 IA(15)=IX(7) 00301980 IA(20)=IA(19) 00301990 ITABLE(4)=5 00302000 ITABLE(5)=6 00302010 90 CONTINUE 00302020 II=0 00302030 DO 100 I=9,20 00302040 NN=IA(I) 00302050 IF(NN.EQ.0) GO TO 100 00302060 II=II+1 00302070 NOD9(II)=I 00302080 100 CONTINUE 00302090 IEL=II+8 00302100 NND9=II 00302110 110 I2=0 00302120 DO 130 I=1,IEL 00302130 IF(I.LE.8) II=IX(I) 00302140 IF(I.LE.8) GO TO 120 00302150 JJ=NOD9(I-8) 00302160 II=IA(JJ) 00302170 120 I2=I2 + 3 00302180 CALL UNPKID(ID,NUMNP,LM(I2-2),W,2,II,1) 00302190 CALL UNPKID(ID,NUMNP,LM(I2-1),W,2,II,2) 00302200 CALL UNPKID(ID,NUMNP,LM(I2) ,W,2,II,3) 00302210 CALL UNPKID(ID,NUMNP,W,YZ(I2-2),1,II,1) 00302220 CALL UNPKID(ID,NUMNP,W,YZ(I2-1),1,II,2) 00302230 130 CALL UNPKID(ID,NUMNP,W,YZ(I2) ,1,II,3) 00302240 IF(JROT.EQ.0) GO TO 134 00302250 I2=0 00302260 DO 132 I=1,IEL 00302270 I2=I2+3 00302280 132 CALL CENT(YZ(I2-2),YZ(I2-1),FN(I,1),FN(I,2)) 00302290 134 CONTINUE 00302300 NS=54 00302310 IF(NND9.EQ.0) NS=6 00302320 IF(LSW.LE.0) GO TO 135 00302330 NS=30 00302340 LM(10)=0. 00302350 LM(11)=0. 00302360 LM(12)=0. 00302370 LM(22)=0. 00302380 LM(23)=0. 00302390 LM(24)=0. 00302400 LM(31)=0. 00302410 LM(32)=0. 00302420 LM(33)=0. 00302430 LM(43)=0. 00302440 LM(44)=0. 00302450 LM(45)=0.0 00302460 LM(58)=0.0 00302470 LM(59)=0.0 00302480 LM(60)=0.0 00302490 135 CONTINUE 00302500 MAT=IX(9) 00302510 IF(MAT.GT.18.AND.NTRI.EQ.0) WRITE(6,140)NEL 00302520 IF(MAT.GT.18.AND.NTRI.EQ.0) MAT=1 00302530 140 FORMAT (//20X, 45HNO USER SUPPLIED MATERIALS ARE AVAIL. FOR EL.,I500302540 $/) 00302550 IF(MAT.GT.18) GO TO 150 00302560 PROP(1)= MODUE(TAVG,MAT) 00302570 PROP(2)=PRATO (TAVG,MAT) 00302580 PROP(3)=DENS(TAVG,MAT)/1728.0E0/GRAV 00302590 PROP(4)=ALPHZM(TAVG,MAT) 00302600 GO TO 160 00302610 150 CALL MATEV(MAT,NMRI,NTRI,TAVG,PROP(1),PROP(2),PROP(4),PROP(3), 00302620 $A(N1P),A(N2P),A(N3P),NEL) 00302630 PROP(3)=PROP(3)/GRAV 00302640 160 DE=PROP(3) 00302650 NINTOP=IX(12) 00302660 IF(NDYN.EQ.7) NINTOP=9 00302670 NINT=3 00302680 IF(IEL.LE.8) NINT=2 00302690 IF(NINTOP.GT.0.AND.NINTOP.LE.3) NINT=2 00302700 IF(NINTOP.GT.0.AND.NINTOP.LE.3) NINTOP=0 00302710 SQ3=1.0/SQRT(3.0) 00302720 IF(NINT.EQ.3) SQ3= SQRT(0.6) 00302730 RS=1.0/SQ3 00302740 RSF=1.0 00302750 RSF2=0.0 00302760 IF(NINT.EQ.3) RSF=1.0/3.0 00302770 IF(NINT.EQ.3) RSF2=4.0 00302780 AS=(5.0+RSF2+(3.0+RSF2)*RS)*RSF*0.25 00302790 BS=-(RS+1.0)*RSF*0.25 00302800 CS= (RS-1.0)*RSF*0.25 00302810 DS=(5.0+RSF2-(3.0+RSF2)*RS)*RSF*0.25 00302820 DO 161 I=1,8 00302830 DO 161 J=1,8 00302840 161 TM(J,I)=BS 00302850 DO 162 I=1,8 00302860 J=9-I 00302870 TM(I,I)=AS 00302880 162 TM(J,I)=CS 00302890 DO 163 I=3,8 00302900 J=I-2 00302910 TM(I,J)=CS 00302920 163 TM(J,I)=CS 00302930 DO 164 I=1,3 00302940 J=I+5 00302950 TM(I,J)=CS 00302960 TM(J,I)=CS 00302970 K=I+1 00302980 J=K+3 00302990 TM(K,J)=CS 00303000 164 TM(J,K)=CS 00303010 DO 165 I=1,2 00303020 J=I+6 00303030 TM(I,J)=DS 00303040 TM(J,I)=DS 00303050 K=I+2 00303060 J=K+2 00303070 TM(J,K)=DS 00303080 165 TM(K,J)=DS 00303090 DO 166 K=1,8 00303100 I=10-K 00303110 L=I-1 00303120 DO 166 J=1,8 00303130 166 TM(I,J)=TM(L,J) 00303140 DO 167 I=1,8 00303150 167 TM(1,I)=0.125 00303160 IF(MAT.EQ.19.OR.MAT.EQ.20) NINT=1 00303170 ND=3*IEL 00303180 CALL STIF60(S,RF,PROP6,LL,TEMPD,NDMX,MXDF,XM) 00303190 IF(KSKIP.EQ.1) RETURN 00303200 IF(LMASS.NE.1) GO TO 1160 00303210 DO 1140 I=1,ND 00303220 1140 XM(I,I)=XM(I,1) 00303230 DO 1150 I=1,ND 00303240 IRK=I+1 00303250 IF(IRK.GT.ND) GO TO 1150 00303260 DO 1145 J=IRK,ND 00303270 XM(I,J)=0.0E0 00303280 1145 XM(J,I)=XM(I,J) 00303290 1150 CONTINUE 00303300 1160 CONTINUE 00303310 NT=(ND*ND-ND)/2+ND 00303320 NDM=ND-1 00303330 DO 180 I=1,NDM 00303340 II=ND-I+1 00303350 L=ND+1 00303360 DO 180 J=II,ND 00303370 L=L-1 00303380 NR= MOD(NT,MXDF) 00303390 NC=NT/MXDF+1 00303400 IF(NR.GT.0) GO TO 170 00303410 NR=MXDF 00303420 NC=NC-1 00303430 170 S(L,II)=S(NR,NC) 00303440 180 NT=NT-1 00303450 IF(NINT.EQ.1) NINT=3 00303460 NPR=IX(11) 00303470 IF(IX(10).GT.1) NPR=IX(10)+99 00303480 IF(NPR.LE.0) GO TO 240 00303490 IF(NPR.LE.KK5) GO TO 200 00303500 WRITE(6,190)NEL 00303510 190 FORMAT(//20X, 44HTHE PRESSURE TYPE DOES NOT EXIST FOR ELEMENT,I5/ 00303520 $ 20X, 21H EXECUTION WILL STOP.//) 00303530 KSKIP=1 00303540 RETURN 00303550 200 DO 210 I=1,7 00303560 210 PRES(I)=PROP5(NPR,I) 00303570 CALL PLD60(PRES) 00303580 IF(KSKIP.EQ.1) RETURN 00303590 DO 230 I=1,LL 00303600 PLF=PROP6(I,1) 00303610 PHF=1.0 00303620 IF(PLF.EQ.0.0) GO TO 230 00303630 DO 220 J=1,ND 00303640 220 RF(J,I)=RF(J,I)+PLF*UP(J)+ PHF*HP(J) 00303650 230 CONTINUE 00303660 240 CONTINUE 00303670 KK=NS/6 00303680 DS=D(4,4) 00303690 DO 340 II=1,8 00303700 I6=6*II-3 00303710 I=ITABLE(II) 00303720 E1=EVAL(II,1)*SQ3 00303730 E2=EVAL(II,2)*SQ3 00303740 E3=EVAL(II,3)*SQ3 00303750 CALL DERIQ3(NEL,YZ,B,DET,E1,E2,E3,NOD9,1) 00303760 DO 250 I=1,ND 00303770 DO 250 J=1,6 00303780 250 STR(J,I)=0.0 00303790 DO 260 K=3,ND,3 00303800 K3=K 00303810 K2=K3-1 00303820 K1=K2-1 00303830 STR(1,K1)=B(K1) 00303840 STR(2,K2)=B(K2) 00303850 STR(3,K3)=B(K3) 00303860 STR(4,K1)=B(K2) 00303870 STR(4,K2)=B(K1) 00303880 STR(5,K2)=B(K3) 00303890 STR(5,K3)=B(K2) 00303900 STR(6,K1)=B(K3) 00303910 260 STR(6,K3)=B(K1) 00303920 DO 280 I=1,3 00303930 IM=I+3 00303940 DO 280 J=1,ND 00303950 SP=0.0 00303960 DO 270 L7=1,3 00303970 270 SP=SP+D(I,L7)*STR(L7,J) 00303980 STRS(I,J)=SP 00303990 280 STRS(IM,J)=DS*STR(IM,J) 00304000 DO 330 L=1,LL 00304010 TOPT=PROP6(L,2) 00304020 IF(TOPT.EQ.0) GO TO 330 00304030 IF(TOPT.EQ.2) TEMP=PROP6(L,3) 00304040 IF(TOPT.NE.1) GO TO 310 00304050 TEMP=0.0 00304060 KL=8 00304070 DO 290 K=1,8 00304080 290 TEMP=TEMP+H(K)*TEMPD(K,L) 00304090 DO 300 K=9,20 00304100 IF(IA(K).EQ.0) GO TO 300 00304110 KL=KL+1 00304120 TEMP=TEMP+H(KL)*TEMPD(K,L) 00304130 300 CONTINUE 00304140 310 TEMP=TEMP-REFT 00304150 DO 320 NK=1,3 00304160 IM=I6+NK 00304170 320 SF(IM,L)=-TAU(NK)*TEMP 00304180 330 CONTINUE 00304190 331 DO 334 M=1,KK 00304200 J7=6*M-6 00304210 I=ITABLE(M)+1 00304220 IF(M.EQ.1) I=1 00304230 FACTOR=TM(I,II) 00304240 DO 332 J1=1,6 00304250 L33=J1+J7 00304260 DO 332 K1=1,ND 00304270 332 SA(L33,K1)=SA(L33,K1)+FACTOR*STRS(J1,K1) 00304280 DO 333 J1=1,3 00304290 L33=J1+J7 00304300 MO=I6+J1 00304310 DO 333 K1=1,LL 00304320 333 SF(L33,K1)=SF(L33,K1)+FACTOR*SF(MO,K1) 00304330 334 CONTINUE 00304340 340 CONTINUE 00304350 DO 345 I=1,KK 00304360 L3=6*I-6 00304370 DO 345 J1=4,6 00304380 J7=L3+J1 00304390 DO 345 K1=1,LL 00304400 345 SF(J7,K1)=0.0 00304410 LK=4 00304420 IF(NND9.EQ.0) GO TO 351 00304430 DO 350 I=2,KK 00304440 LK=LK+6 00304450 J=ITABLE(I) 00304460 350 SF(LK,1)= IX(J)/10000. 00304470 351 CONTINUE 00304480 IF(DE.EQ.0.0) GO TO 390 00304490 IRK=1 00304500 IRK1=1 00304510 IRK2=1 00304520 DO 360 IM=3,ND,3 00304530 IM1=IM-1 00304540 IM2=IM-2 00304550 IF(LMASS.NE.1) GO TO 355 00304560 IRK=IM 00304570 IRK1=IM1 00304580 IRK2=IM2 00304590 355 CONTINUE 00304600 SCG(1)=SCG(1)+XM(IM2,IRK2)*YZ(IM2) 00304610 SCG(2)=SCG(2)+XM(IM1,IRK1)*YZ(IM1) 00304620 SCG(3)=SCG(3)+XM(IM,IRK )*YZ(IM) 00304630 360 SCG(4)=SCG(4)+XM(IM,IRK) 00304640 DO 380 I=1,LL 00304650 AX=PROP6(I,5)*GRAV 00304660 IF(JROT.EQ.0) GO TO 365 00304670 AX=0.0 00304680 AY=0.0 00304690 365 CONTINUE 00304700 AZ=PROP6(I,7)*GRAV 00304710 IF(AX.EQ.0.0.AND.AY.EQ. 0.0.AND.AZ.EQ.0.0) GO TO 380 00304720 IRK=1 00304730 IRK1=1 00304740 IRK2=1 00304750 DO 370 IM=3,ND,3 00304760 IM1=IM-1 00304770 IM2=IM-2 00304780 IF(LMASS.NE.1) GO TO 368 00304790 IRK=IM 00304800 IRK1=IM1 00304810 IRK2=IM2 00304820 368 CONTINUE 00304830 RF(IM2,I)=RF(IM2,I)+XM(IM2,IRK2)*AX 00304840 RF(IM1,I)=RF(IM1,I)+XM(IM1,IRK1)*AY 00304850 370 RF(IM ,I)=RF(IM ,I)+XM(IM,IRK)*AZ 00304860 380 CONTINUE 00304870 390 CONTINUE 00304880 IF(JROT.EQ.0) GO TO 410 00304890 IM2=-2 00304900 IRK1=1 00304910 IRK2=1 00304920 DO 400 I=1,IEL 00304930 IM2=IM2+3 00304940 IM1=IM2+1 00304950 IF(LMASS.NE.1) GO TO 393 00304960 IRK1=IM1 00304970 IRK2=IM2 00304980 393 CONTINUE 00304990 DO 400 J=1,LL 00305000 AX=PROP6(J,5) 00305010 AY=PROP6(J,6) 00305020 RF(IM2,J)=RF(IM2,J)+XM(IM2,IRK2)*(AX*FN(I,1)+AY*FN(I,2)) 00305030 400 RF(IM1,J)=RF(IM1,J)+XM(IM1,IRK1)*(AX*FN(I,2)-AY*FN(I,1)) 00305040 410 CONTINUE 00305050 CALL WRITET(MBAND,NDIF,IX(13),ND,NS,LM,SA) 00305060 RETURN 00305070 END 00305080 SUBROUTINE STIF60( S,RF,PROP6,LL,TEMPD,NDMX,MXDF,XM) 00269800 IMPLICIT REAL*8 (A-H,O-Z) 00269810 DIMENSION PROP6(LL,7),TEMPD(NDMX,LL),RF(MXDF,LL),XM(1) 00269820 DIMENSION S(1) 00269830 COMMON /TRASH/BB(9) 00269840 $ ,H8(8),RRTRAS(473) R0269850 COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3), 00269860 $PROP( 4),B(60 ),XJ(3,3),HP(60),UP(60),DE,DET,RRQTSA(626) R0269870 COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,NEL,NOD9(12),RRJUNK(218) R0269880 COMMON /GASS/ XG(4,4),WGT(4,4),IPERM(3) R0269890 COMMON /PREP/ XZ(2),KSKIP,RRPREP(8) R0269900 COMMON /AMB/ GRAV,REFT,JROT R0269910 D1=PROP(1) 00269920 D2=D1 00269930 D3=0.0 00269940 DO 70 I=1,6 00269950 DO 70 J=1,6 00269960 70 D(I,J)=0.0 00269970 DO 80 I=1,3 00269980 DO 80 J=1,3 00269990 80 D(I,J)=D1 00270000 IF(NINT.EQ.1) GO TO 90 00270010 CALL STST3L(PROP,D,TAU) 00270020 D1=D(1,1) 00270030 D2=D(1,2) 00270040 D3=D(4,4) 00270050 90 CONTINUE 00270060 FACT=PROP(1)/((1.-2.*PROP(2))*(1.+PROP(2))) 00270070 FACT=FACT*PROP(4)*(1.+PROP(2)) 00270080 WGH=0.0 00270090 NINTX=NINT 00270100 NINTY=NINT 00270110 NINTZ=NINT 00270120 IF(NINT.EQ.1) NINTX=3 00270130 IF(NINT.EQ.1) NINTY=3 00270140 IF(NINT.EQ.1) NINTZ=3 00270150 IF(NINTOP.EQ.1) NINTX=NINT-1 00270160 IF(NINTOP.EQ.2) NINTY=NINT-1 00270170 IF(NINTOP.EQ.3) NINTZ=NINT-1 00270180 DO 200 LX=1,NINTX 00270190 E1=XG(LX,NINTX) 00270200 DO 200 LY=1,NINTY 00270210 E2=XG(LY,NINTY) 00270220 DO 200 LZ=1,NINTZ 00270230 E3=XG(LZ,NINTZ) 00270240 WT=WGT(LX,NINTX)*WGT(LY,NINTY)*WGT(LZ,NINTZ) 00270250 CALL DERIQ3 (NEL, YZ,B,DET,E1,E2,E3,NOD9,0) 00270260 IF(KSKIP.EQ.1) RETURN 00270270 FAC=WT*DET 00270280 IF(DE.EQ.0.0) GO TO 110 00270290 GG=FAC*DE 00270300 IF(NINTOP.EQ.9) GO TO 101 00270310 DO 100 I=1,IEL 00270320 II=3*I-2 00270330 100 XM(II)=XM(II)+H(I)*GG 00270340 GO TO 110 00270350 101 IK=1 00270360 DO 105 I=1,ND,3 00270370 XM(I)=XM(I)+H(IK)*H(IK)*GG 00270380 105 IK=IK+1 00270390 WGH=WGH+GG 00270400 110 CONTINUE 00270410 IF(PROP(4).EQ.0.0) GO TO 170 00270420 DO 160 I=1,LL 00270430 TMR=0.0 00270440 TOPT=PROP6(I,2) 00270450 IF(TOPT.EQ.0) GO TO 160 00270460 IF(TOPT.EQ.2)TMR=PROP6(I,3) 00270470 IF(TOPT.NE.1) GO TO 140 00270480 DO 120 II=1,8 00270490 120 TMR=TMR+TEMPD(II,I)*H(II) 00270500 IF(NND9.EQ.0) GO TO 140 00270510 IK=8 00270520 DO 130 II=1,NND9 00270530 J=NOD9(II) 00270540 IK=IK+1 00270550 130 TMR=TMR+TEMPD(J,I)*H(IK) 00270560 140 TMR=TMR-REFT 00270570 TMR=TMR*FACT*FAC 00270580 DO 150 II=1,ND 00270590 150 RF(II,I)=RF(II,I)+TMR*B(II) 00270600 160 CONTINUE 00270610 170 CONTINUE 00270620 FAC= DSQRT(FAC) 00270630 DO 180 I=1,ND 00270640 180 B(I)=FAC*B(I) 00270650 KL=0 00270660 DO 190 I=1,ND 00270670 DO 190 J=I,ND 00270680 KL=KL + 1 00270690 190 S(KL)=S(KL) + B(I)*B(J) 00270700 200 CONTINUE 00270710 KL=1 00270720 DO 250 II=1,IEL 00270730 I0=3*(II-1) 00270740 DO 240 JJ=II,IEL 00270750 J0=3*(JJ-1) 00270760 KS=KL 00270770 IC=0 00270780 DO 220 I=1,3 00270790 DO 210 J=1,3 00270800 IC=IC + 1 00270810 BB(IC)=S(KS) 00270820 210 KS=KS + 1 00270830 220 KS=KS + ND - I0 - I - 3 00270840 KS1=KL 00270850 KS2=KS1 + ND - I0 - 1 00270860 KS3=KS2 + ND - I0 - 2 00270870 S(KS1)=BB(1)*D1 + (BB(5) + BB(9))*D3 00270880 S(KS2+1)=BB(5)*D1 + (BB(1) + BB(9))*D3 00270890 S(KS3+2)=BB(9)*D1 + (BB(1) + BB(5))*D3 00270900 IF (II.EQ.JJ) GO TO 230 00270910 S(KS1+1)=BB(2)*D2 + BB(4)*D3 00270920 S(KS2)=BB(4)*D2 + BB(2)*D3 00270930 S(KS1+2)=BB(3)*D2 + BB(7)*D3 00270940 S(KS3)=BB(7)*D2 + BB(3)*D3 00270950 S(KS2+2)=BB(6)*D2 + BB(8)*D3 00270960 S(KS3+1)=BB(8)*D2 + BB(6)*D3 00270970 GO TO 240 00270980 230 S(KS1+1)=BB(2)*(D2 + D3) 00270990 S(KS1+2)=BB(3)*(D2 + D3) 00271000 S(KS2+2)=BB(6)*(D2 + D3) 00271010 240 KL=KL + 3 00271020 250 KL=KL + 2*(ND-I0) - 3 00271030 260 CONTINUE 00271040 IF(DE.LE.0.0) RETURN 00271050 TMR=0.0 00271060 DO 265 I=1,ND,3 00271070 265 TMR=TMR +XM(I) 00271080 WGH=WGH/TMR 00271090 IF(NINTOP.NE.9) WGH=1.0 00271100 DO 270 I=1,ND,3 00271110 XM(I)=XM(I)*WGH 00271120 IK=I+1 00271130 KL=I+2 00271140 XM(IK)=XM(I) 00271150 270 XM(KL)=XM(I) 00271160 RETURN 00271170 END 00271180 SUBROUTINE STST3L(PROP,C,TAU) 00282620 IMPLICIT REAL*8 (A-H,O-Z) 00282630 COMMON/TRASH/YM,PV,A1,B1,C1,D1,RRTRAS(484) R0282640 DIMENSION PROP(1),C(6,1),TAU(1) 00282650 100 YM=PROP(1) 00282660 PV=PROP(2) 00282670 C1=1. - 2.*PV 00282680 B1=YM/(1. + PV) 00282690 A1=B1/C1 00282700 D1=1. - PV 00282710 D1=A1*D1 00282720 A1=A1*PV 00282730 B1=0.5*B1 00282740 DO 110 I=1,6 00282750 DO 110 J=1,6 00282760 110 C(I,J)=0.0 00282770 DO 120 I=1,3 00282780 120 C(I,I)=D1 00282790 DO 130 I=2,3 00282800 130 C(1,I)=A1 00282810 C(2,3)=A1 00282820 DO 140 I=4,6 00282830 140 C(I,I)=B1 00282840 DO 150 I=1,6 00282850 DO 150 J=1,6 00282860 150 C(J,I)=C(I,J) 00282870 DO 160 I=1,3 00282880 TAU(I)=0.0 00282890 DO 160 J=1,3 00282900 160 TAU(I)=TAU(I)+C(I,J)*PROP(4) 00282910 RETURN 00282920 END 00282930 SUBROUTINE DERIQ3 (NEL,XX,B,DET,R,S,T,NOD9,KFL) 00057600 IMPLICIT REAL*8 (A-H,O-Z) 00057610 COMMON /JUNK/ IEL,NRJUNK(453) R0057620 COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3), 00057630 $PROP( 4),Y(60 ),XJ(3,3),RRQTSA(748) R0057640 DIMENSION XX(3,1),B(1),NOD9(1) 00057650 COMMON /TRASH/ XJI(3,3),RRTRAS(481) R0057660 CALL FUNCT (R,S,T,H,P,NOD9,XJ,DET,XX,KFL) 00057670 IF(DET.LT.1.0E-20) DET=1.0E-20 00057680 DUM=1.0/DET 00057690 XJI(1,1)=DUM*( XJ(2,2)*XJ(3,3) - XJ(2,3)*XJ(3,2)) 00057700 XJI(2,1)=DUM*(-XJ(2,1)*XJ(3,3) + XJ(2,3)*XJ(3,1)) 00057710 XJI(3,1)=DUM*( XJ(2,1)*XJ(3,2) - XJ(2,2)*XJ(3,1)) 00057720 XJI(1,2)=DUM*(-XJ(1,2)*XJ(3,3) + XJ(1,3)*XJ(3,2)) 00057730 XJI(2,2)=DUM*( XJ(1,1)*XJ(3,3) - XJ(1,3)*XJ(3,1)) 00057740 XJI(3,2)=DUM*(-XJ(1,1)*XJ(3,2) + XJ(1,2)*XJ(3,1)) 00057750 XJI(1,3)=DUM*( XJ(1,2)*XJ(2,3) - XJ(1,3)*XJ(2,2)) 00057760 XJI(2,3)=DUM*(-XJ(1,1)*XJ(2,3) + XJ(1,3)*XJ(2,1)) 00057770 XJI(3,3)=DUM*( XJ(1,1)*XJ(2,2) - XJ(1,2)*XJ(2,1)) 00057780 DO 120 K=1,IEL 00057790 K2=K*3 00057800 K2P=K2+1 00057810 DO 100 I=1,3 00057820 100 B(K2P -I)=0.0 00057830 DO 110 I=1,3 00057840 B(K2-2)=B(K2-2) + XJI(1,I)*P(I,K) 00057850 B(K2-1)=B(K2-1) + XJI(2,I)*P(I,K) 00057860 110 B(K2)=B(K2) + XJI(3,I)*P(I,K) 00057870 120 CONTINUE 00057880 RETURN 00057890 END 00057900 SUBROUTINE FUNCT (R1,S1,T1,H,P,NOD9,XJ,DET,XX,KFL) 00097380 IMPLICIT REAL*8 (A-H,O-Z) 00097390 COMMON /PREP/ XZ(2),KSKIP,RRPREP(8) R0097400 COMMON/TRASH/RP,SP,TP,RM,SM,TM,RR,SS,TT 00097410 $,H8(8),LSW,NRTRAS(945) R0097420 COMMON /JUNK/ IEL,NND9,NINT,NINTOP,ND,NEL,RRJUNK(224) R0097430 DIMENSION H(20),P(3,20),NOD9(12),IPERM(8),XJ(3,3),XX(3,20) 00097440 DIMENSION PDH1(3),PDH5(3) 00097450 DATA IPERM / 2,3,4,1,6,7,8,5 / 00097460 R=R1 00097470 S=S1 00097480 T=T1 00097490 IELX=IEL 00097500 RP=1.0 + R 00097510 SP=1.0 + S 00097520 TP=0.125*(1.0+T) 00097530 RM=1.0 - R 00097540 SM=1.0 - S 00097550 TM=0.125*(1.0-T) 00097560 RR=1.0 - R*R 00097570 SS=1.0 - S*S 00097580 TT=1.0 - T*T 00097590 H(1)=RP*SM*TM 00097600 H(2)=RP*SP*TM 00097610 H(3)=RM*SP*TM 00097620 H(4)=RM*SM*TM 00097630 H(5)=RP*SM*TP 00097640 H(6)=RP*SP*TP 00097650 H(7)=RM*SP*TP 00097660 H(8)=RM*SM*TP 00097670 DO 50 I=1,8 00097680 50 H8(I)=H(I) 00097690 P(1,1)=SM*TM 00097700 P(1,2)=SP*TM 00097710 P(1,3)=-P(1,2) 00097720 P(1,4)=-P(1,1) 00097730 P(1,5)=SM*TP 00097740 P(1,6)=SP*TP 00097750 P(1,7)=-P(1,6) 00097760 P(1,8)=-P(1,5) 00097770 P(2,2)=RP*TM 00097780 P(2,1)=-P(2,2) 00097790 P(2,3)=RM*TM 00097800 P(2,4)=-P(2,3) 00097810 P(2,6)=RP*TP 00097820 P(2,5)=-P(2,6) 00097830 P(2,7)=RM*TP 00097840 P(2,8)=-P(2,7) 00097850 P(3,5)= 0.125*RP*SM 00097860 P(3,6)= 0.125*RP*SP 00097870 P(3,7)= 0.125*RM*SP 00097880 P(3,8)= 0.125*RM*SM 00097890 P(3,1)=-P(3,5) 00097900 P(3,2)=-P(3,6) 00097910 P(3,3)=-P(3,7) 00097920 P(3,4)=-P(3,8) 00097930 IF (IEL.EQ.8) GO TO 290 00097940 TM=TM+TM 00097950 TP=TP+TP 00097960 R=R+R 00097970 S=S+S 00097980 TT=0.25*TT 00097990 T=-0.50*T 00098000 I=0 00098010 100 I=I + 1 00098020 IF (I.GT.NND9) GO TO 230 00098030 NN=NOD9(I) - 8 00098040 GO TO (110,120,130,140,150,160,170,180,190,200,210,220), NN 00098050 110 H(9)=RP*SS*TM 00098060 P(1, 9)=SS*TM 00098070 P(2, 9)=-RP*S*TM 00098080 P(3, 9)=-0.25*RP*SS 00098090 GO TO 100 00098100 120 H(10)=RR*SP*TM 00098110 P(1,10)=-R*SP*TM 00098120 P(2,10)=RR*TM 00098130 P(3,10)=-0.25*RR*SP 00098140 GO TO 100 00098150 130 H(11)=RM*SS*TM 00098160 P(1,11)=-SS*TM 00098170 P(2,11)=-RM*S*TM 00098180 P(3,11)=-0.25*RM*SS 00098190 GO TO 100 00098200 140 H(12)=RR*SM*TM 00098210 P(1,12)=-R*SM*TM 00098220 P(2,12)=-RR*TM 00098230 P(3,12)=-0.25*RR*SM 00098240 GO TO 100 00098250 150 H(13)=RP*SS*TP 00098260 P(1,13)=SS*TP 00098270 P(2,13)=-RP*S*TP 00098280 P(3,13)= 0.25*RP*SS 00098290 GO TO 100 00098300 160 H(14)=RR*SP*TP 00098310 P(1,14)=-R*SP*TP 00098320 P(2,14)=RR*TP 00098330 P(3,14)= 0.25*RR*SP 00098340 GO TO 100 00098350 170 H(15)=RM*SS*TP 00098360 P(1,15)=-SS*TP 00098370 P(2,15)=-RM*S*TP 00098380 P(3,15)= 0.25*RM*SS 00098390 GO TO 100 00098400 180 H(16)=RR*SM*TP 00098410 P(1,16)=-R*SM*TP 00098420 P(2,16)=-RR*TP 00098430 P(3,16)= 0.25*RR*SM 00098440 GO TO 100 00098450 190 H(17)=RP*SM*TT 00098460 P(1,17)=SM*TT 00098470 P(2,17)=-RP*TT 00098480 P(3,17)=RP*SM*T 00098490 GO TO 100 00098500 200 H(18)=RP*SP*TT 00098510 P(1,18)=SP*TT 00098520 P(2,18)=RP*TT 00098530 P(3,18)=RP*SP*T 00098540 GO TO 100 00098550 210 H(19)=RM*SP*TT 00098560 P(1,19)=-SP*TT 00098570 P(2,19)= RM*TT 00098580 P(3,19)=RM*SP*T 00098590 GO TO 100 00098600 220 H(20)=RM*SM*TT 00098610 P(1,20)=-SM*TT 00098620 P(2,20)=-RM*TT 00098630 P(3,20)=RM*SM*T 00098640 GO TO 100 00098650 230 IH=0 00098660 240 IH=IH + 1 00098670 IF (IH.GT.NND9) GO TO 290 00098680 II=IH + 7 00098690 IF (II.EQ.IELX) GO TO 300 00098700 250 IN=NOD9(IH) 00098710 IF (IN.GT.16) GO TO 270 00098720 I1=IN - 8 00098730 I2=IPERM(I1) 00098740 H(I1)=H(I1) - 0.5*H(IN) 00098750 H(I2)=H(I2) - 0.5*H(IN) 00098760 H(IH+8)=H(IN) 00098770 DO 260 J=1,3 00098780 P(J,I1)=P(J,I1) - 0.5*P(J,IN) 00098790 P(J,I2)=P(J,I2) - 0.5*P(J,IN) 00098800 260 P(J,IH+8)=P(J,IN) 00098810 GO TO 240 00098820 270 CONTINUE 00098830 I1=IN - 16 00098840 I2=I1 + 4 00098850 H(I1)=H(I1) - 0.5*H(IN) 00098860 H(I2)=H(I2) - 0.5*H(IN) 00098870 H(IH+8)=H(IN) 00098880 DO 280 J=1,3 00098890 P(J,I1)=P(J,I1) - 0.5*P(J,IN) 00098900 P(J,I2)=P(J,I2) - 0.5*P(J,IN) 00098910 280 P(J,IH+8)=P(J,IN) 00098920 GO TO 240 00098930 290 CONTINUE 00098940 IF(LSW.LE.0) GO TO 295 00098950 DELTH1=0.25*RR*SS*TM 00098960 DELTH5=0.25*RR*SS*TP 00098970 H(1)=H(1)+DELTH1 00098980 H(2)=H(2)+DELTH1 00098990 H(3)=H(3)+H(4)+H(11) 00099000 H(4)=0.0 00099010 H(5)=H(5)+DELTH5 00099020 H(6)=H(6)+DELTH5 00099030 H(7)=H(7)+H(8)+H(15) 00099040 H(8)=0.0 00099050 H(9)=H(9)-2.0*DELTH1 00099060 H(11)=0.0 00099070 H(13)=H(13)-2.*DELTH5 00099080 H(15)=0.0 00099090 H(19)=H(19)+H(20) 00099100 H(20)=0.0 00099110 PDH1(1)=-0.25*R*SS*TM 00099120 PDH1(2)=-0.25*S*RR*TM 00099130 PDH1(3)=-0.0625*RR*SS 00099140 PDH5(1)=-0.25*R*SS*TP 00099150 PDH5(2)=-0.25*S*RR*TP 00099160 PDH5(3)=-PDH1(3) 00099170 DO 292 I=1,3 00099180 P(I,1)=P(I,1)+PDH1(I) 00099190 P(I,2)=P(I,2)+PDH1(I) 00099200 P(I,3)=P(I,3)+P(I,4)+P(I,11) 00099210 P(I,4)=0.0 00099220 P(I,5)=P(I,5)+PDH5(I) 00099230 P(I,6)=P(I,6)+PDH5(I) 00099240 P(I,7)=P(I,7)+P(I,8)+P(I,15) 00099250 P(I,8)=0.0 00099260 P(I,9)=P(I,9)-2.0*PDH1(I) 00099270 P(I,11)=0.0 00099280 P(I,13)=P(I,13)-2.0*PDH5(I) 00099290 P(I,15)=0.0 00099300 P(I,19)=P(I,19)+P(I,20) 00099310 292 P(I,20)=0.0 00099320 295 CONTINUE 00099330 300 DO 320 I=1,3 00099340 DO 320 J=1,3 00099350 DUM=0.0 00099360 DO 310 K=1,IELX 00099370 310 DUM=DUM + P(I,K)*XX(J,K) 00099380 320 XJ(I,J)=DUM 00099390 DET = XJ(1,1)*XJ(2,2)*XJ(3,3) 00099400 $ + XJ(1,2)*XJ(2,3)*XJ(3,1) 00099410 $ + XJ(1,3)*XJ(2,1)*XJ(3,2) 00099420 $ - XJ(1,3)*XJ(2,2)*XJ(3,1) 00099430 $ - XJ(1,2)*XJ(2,1)*XJ(3,3) 00099440 $ - XJ(1,1)*XJ(2,3)*XJ(3,2) 00099450 IF(DET.GT.1.0E-08) GO TO 330 00099460 IF(KFL.GT.0) GO TO 330 00099470 WRITE (6,340) NEL 00099480 KSKIP=1 00099490 330 CONTINUE 00099500 RETURN 00099510 340 FORMAT (40H STOP - NEGATIVE OR ZERO DETERMINANT / 00099520 $1X, 00099530 $11HON ELEMENT ,I5,35HCHECK NUMBERING OR COORDINATES. ) 00099540 END 00099550 SUBROUTINE PLD60(PRES) 00166400 IMPLICIT REAL*8(A-H,O-Z) 00166410 REAL*8 LM 00166420 DIMENSION KFACE(6,8) 00166430 DIMENSION KCRD(6),FVAL(6) 00166440 DIMENSION PRES(7) 00166450 COMMON /QTSARG/ D(6,6),P(3,20),YZ(60),H(20),TAU(3), 00166460 $PROP(4),B(60), A(3,3),LM(60),XM(60),DE,DET,RRQTSA(626) R0166470 COMMON /JUNK/IEL,NND9,NINT,NINTOP,ND,NEL,NOD9(12),ETA(3), R0166480 & RRJUNK(215) R0166490 COMMON /TRASH/ ZA(17),LSW,NRTRAS(945) R0166500 COMMON /PREP/ ZB(2),KSKIP,RRPREP(8) R0166510 COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3) 00166520 DATA KCRD / 1,1,2,2,3,3/ 00166530 DATA FVAL /1.,-1.,1.,-1.,1.,-1./ 00166540 DATA KFACE/ 1, 4, 2, 1, 6, 2, 00166550 $ 2, 3, 3, 4, 7, 3, 00166560 $ 6, 7, 7, 8, 8, 4, 00166570 $ 5, 8, 6, 5, 5, 1, 00166580 $ 9,11,10,12,14,10, 00166590 $ 18,19,19,20,15,11, 00166600 $ 13,15,14,16,16,12, 00166610 $ 17,20,18,17,13, 9/ 00166620 DO 100 I=1,ND 00166630 LM(I)=0.0 00166640 100 XM(I)=0.0 00166650 DO 210 KK=1,3 00166660 YREF=PRES(2) 00166670 KTYPE=1 00166680 IF(KK.EQ.1.AND.YREF.NE.0) KTYPE=2 00166690 PR=PRES(1) 00166700 IF(KK.GE.2) PR=PRES(2*KK) 00166710 KF=PRES(2*KK+1) 00166720 IF(LSW.LE.0.OR.KF.NE.2) GO TO 105 00166730 KSKIP=1 00166740 WRITE(6,102)NEL 00166750 102 FORMAT(/20X,7HELEMENT,I5,34H IS A WEDGE AND PRESSURE CANNOT BE, 00166760 $45H APPLIED TO FACE NO. 2, EXECUTION TERMINATED.//) 00166770 RETURN 00166780 105 CONTINUE 00166790 IF(PR.EQ.0) GO TO 210 00166800 IF(KF.EQ.0) GO TO 210 00166810 IF(KF.EQ.1.OR.KF.EQ.3.OR.KF.EQ.5) PR=-PR 00166820 ML = KCRD(KF) 00166830 ETA(ML) = FVAL(KF) 00166840 MM = IPERM(ML) 00166850 MN = IPERM(MM) 00166860 DO 180 LX=1,NINT 00166870 ETA(MM)=XK(LX,NINT) 00166880 W1=WGT(LX,NINT) 00166890 DO 180 LY=1,NINT 00166900 ETA(MN)=XK(LY,NINT) 00166910 W2=WGT(LY,NINT) 00166920 CALL FUNCT (ETA(1),ETA(2),ETA(3),H,P,NOD9, A,DET,YZ,1) 00166930 A1 = (A(MM,2)*A(MN,3)-A(MM,3)*A(MN,2)) 00166940 A2 = (A(MM,3)*A(MN,1)-A(MM,1)*A(MN,3)) 00166950 A3 = (A(MM,1)*A(MN,2)-A(MM,2)*A(MN,1)) 00166960 AA= 00166970 $ DSQRT(A1**2+A2**2+A3**2) 00166980 A1 = A1/AA 00166990 A2 = A2/AA 00167000 A3 = A3/AA 00167010 AA = 0. 00167020 BB = 0. 00167030 CC = 0. 00167040 DO 110 I = 1,3 00167050 AA=AA+A(MM,I)**2 00167060 CC=CC+A(MN,I)**2 00167070 110 BB = BB + A(MM,I)*A(MN,I) 00167080 C= DSQRT(AA*CC - BB*BB) 00167090 IF (KTYPE.EQ.2) GO TO 120 00167100 FORCE = PR 00167110 GO TO 140 00167120 120 YY = 0. 00167130 DO 130 I=1,IEL 00167140 K=3*I 00167150 130 YY=YY+H(I)*YZ(K) 00167160 YY = YY - YREF 00167170 FORCE = -PR*YY 00167180 IF(YY.GT.0.) FORCE = 0. 00167190 140 CONTINUE 00167200 TS=FORCE*W1*W2*C 00167210 DO 170 I=1,8 00167220 N= KFACE(KF,I) 00167230 IF(I.LE.4) GO TO 160 00167240 IF(NND9.EQ.0) GO TO 170 00167250 IL=N 00167260 DO 150 IK=1,NND9 00167270 N=IK+8 00167280 IF(NOD9(IK).EQ.IL) GO TO 160 00167290 150 CONTINUE 00167300 GO TO 170 00167310 160 QQ=TS*H(N) 00167320 K=3*N 00167330 XM(K-2)=XM(K-2)+QQ*A1 00167340 XM(K-1)=XM(K-1)+QQ*A2 00167350 XM(K )=XM(K )+QQ*A3 00167360 170 CONTINUE 00167370 180 CONTINUE 00167380 IF(KTYPE.LT.2.OR. KK. GT.1) GO TO 200 00167390 DO 190 I=1,ND 00167400 LM(I)=XM(I) 00167410 190 XM(I)=0.0 00167420 200 CONTINUE 00167430 210 CONTINUE 00167440 RETURN 00167450 END 00167460