Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1987-06-23 | 51.7 KB | 648 lines

SUBROUTINE SPCTRM (F,PX,PR,XM,W,MASS,NEQB,NF,NBLOCK,TM,WR) 00249170 IMPLICIT REAL*8 (A-H,O-Z) 00249180 REAL*8 MASS 00249190 COMMON / PREP / ZD(2),MODEX,RRPREP(8) R0249200 DIMENSION PX(NF,3),F(NEQB,NF),XM(NEQB),W(NF),MASS(NEQB) 00249210 DIMENSION DIRN(3),TM(NF),WR(NF,3), 00249220 $PR(NF,3),ROTM(3,3) 00249230 COMMON / JUNK /EXT(200),N,I,L,NTAG,IXX(2),ND,IOPT,NFUN,ITYPE 00249240 1,NFN(3),NRJUNK(41) R0249250 DATA ROTM/ 0.0D+0, 1.0D+0,-1.0D+0, 00249260 $ -1.0D+0, 0.0D+0, 1.0D+0, 00249270 $ 1.0D+0,-1.0D+0, 0.0D+0/ 00249280 CLF=EXT(4) 00249290 JROT=N 00249300 JABS=I 00249310 WRITE(6,340) 00249320 IF (MODEX.EQ.1) GO TO 140 00249330 TPI=6.2831853E0 00249340 DO 100 I=1,NF 00249350 DO 100 J=1,3 00249360 PR(I,J)=0.0E0 00249370 100 PX(I,J)=0.E0 00249380 REWIND 9 00249390 REWIND 3 00249400 DO 130 N=1,NBLOCK 00249410 BACKSPACE 10 00249420 READ (10) F 00249430 BACKSPACE 10 00249440 READ (3) MASS 00249450 READ (9) XM 00249460 DO 120 I=1,NEQB 00249470 J=MASS(I) 00249480 IF (J.LE.0) GO TO 120 00249490 DO 110 L=1,NF 00249500 110 PX(L,J)=PX(L,J)+F(I,L)*XM(I) 00249510 120 CONTINUE 00249520 IF(JROT.EQ.0) GO TO 130 00249530 DO 128 I=1,NEQB 00249540 J=MASS(I) 00249550 IF(J.LE.0) GO TO 128 00249560 WRR=(MASS(I)-J-ZD(2))*ZD(1) 00249570 DO 126 L=1,NF 00249580 126 PR(L,J)=PR(L,J)+WRR*F(I,L)*XM(I) 00249590 128 CONTINUE 00249600 130 CONTINUE 00249610 BACKSPACE 10 00249620 READ (10) W 00249630 REWIND 2 00249640 140 CONTINUE 00249650 WRITE(2)W,CLF 00249660 IF(NFUN.LT.0) WRITE(6,380) 00249670 IF(NFUN.LT.0) GO TO 165 00249680 IF(NFUN.NE.99) GO TO 145 00249690 DO 141 N=1,NBLOCK 00249700 READ (10) F 00249710 141 WRITE (2) F 00249720 WRITE (6,310) 00249730 DO 142 I=1,NF 00249740 142 WRITE (6,320) I,(PX(I,J),J=1,3) 00249750 RETURN 00249760 145 CONTINUE 00249770 CLF=CLF/100. 00249780 IF(NFUN.EQ.0) NFUN=1 00249790 READ(5,370)(NFN(I),DIRN(I),I=1,3),IN,IOPT 00249800 WRITE(6,280)NFN 00249810 NTAG=0 00249820 WRITE (6,290) DIRN 00249830 WRITE (6,300) IN 00249840 IND=1 00249850 IF(IN.EQ.2) IND=0 00249860 IF(IN.EQ.1) IND=2 00249870 IF (MODEX.EQ.1) W(1)=SD(1,1) 00249880 165 CONTINUE 00249890 IF (MODEX.EQ.1) RETURN 00249900 IF(JROT.GT.0) WRITE(6,390) 00249910 WRITE (6,310) 00249920 DO 170 I=1,NF 00249930 170 WRITE (6,320) I,(PX(I,J),J=1,3) 00249940 IF(JROT.EQ.0) GO TO 176 00249950 WRITE(6,400) 00249960 WRITE(6,310) 00249970 DO 175 I=1,NF 00249980 175 WRITE(6,320)I,(PR(I,J),J=1,3) 00249990 176 CONTINUE 00250000 IF(NFUN.LT.0) RETURN 00250010 DO 171 I=1,NF 00250020 DO 171 K=1,3 00250030 171 WR(I,K)=0. 00250040 DO 190 I=1,NF 00250050 WW=TPI/W(I) 00250060 CC NRWW = WW R0250061 DO 180 K=1,3 00250070 KFN=NFN(K) 00250080 XMUL=0.0 00250090 IF(KFN.GT.0) XMUL=SD(WW,KFN) R0250100 WR(I,K)=WR(I,K) + DABS(PX(I,K))*DIRN(K) *XMUL 00250110 IF (IND.EQ.1) WR(I,K)=WR(I,K)/(W(I)*W(I)) 00250120 IF(IND.EQ.2) WR(I,K)=WR(I,K)/W(I) 00250130 GO TO 180 00250140 180 CONTINUE 00250150 IF(JROT.GT.0) GO TO 181 00250160 181 CONTINUE 00250170 IF(JROT.LE.0) GO TO 190 00250180 DO 185 K=1,3 00250190 KFN=NFN(K) 00250200 WR(I,K)=PR(I,K)*ROTM(JROT,K) 00250210 WR(I,K)=WR(I,K)*SD(WW,KFN)/(W(I)**2) R0250220 185 CONTINUE 00250230 190 CONTINUE 00250240 DO 275 K=1,3 00250250 REWIND 10 00250260 READ (10) TM 00250270 DO 270 N=1,NBLOCK 00250280 READ (10)F 00250290 KSWCH=0 00250300 DO 210 I=1,NEQB 00250310 DO 210 J=1,NF 00250320 210 F(I,J)=F(I,J)*WR(J,K) 00250330 WRITE(2)F 00250340 270 CONTINUE 00250350 275 CONTINUE 00250360 RETURN 00250370 280 FORMAT (20H FUNCTION NUMBERS / / 00250380 $ 10X,3HX =,I3 ,4X,3HY =,I3 ,4X,3HZ =,I3 //) 00250390 290 FORMAT (20H DIRECTION FACTORS / / 00250400 $ 10X,3HX =,F10.4,4X,3HY =,F10.4,4X,3HZ =,F10.4 //) 00250410 300 FORMAT (54H0INDICATOR FOR DISPLACEMENT OR ACCELERATION SPECTRUM =,00250420 $ I5 // 00250430 $ 20H EQ.0 ACCELERATION / 00250440 $ 20H EQ.1 VELOCITY / 00250450 $ 20H EQ.2 DISPLACEMENT / 00250460 $///) 00250470 310 FORMAT (28H MODAL PARTICIPATION FACTORS, // 5H MODE,3X, 00250480 $ 11HX-DIRECTION,3X,11HY-DIRECTION,3X,11HZ-DIRECTION, / 1X) 00250490 320 FORMAT (1H ,I4,3E14.4 / 1X) 00250500 340 FORMAT(1X ,15X,26HRESPONSE SPECTRUM ANALYSIS//) 00250510 350 FORMAT(1H ,15X,I5,30H RESPONSE SPECTRA WILL BE USED// 00250520 & 16X,21HTHE CLUSTER FACTOR IS,F8.3,2H %) 00250530 370 FORMAT(3(I10,F10.0),2I10) 00250540 380 FORMAT(///20X,48HNO. OF FUNCTIONS IS LESS THAN ZERO - NO RESPONSE,00250550 $19HSPECTRUM ANALYSIS.///) 00250560 390 FORMAT(14H TRANSLATIONAL) 00250570 400 FORMAT(11H ROTATIONAL) 00250580 END 00250590 DOUBLE PRECISION FUNCTION SPHT (T,M) 00250600 IMPLICIT REAL*8(A-H,O-Z) 00250610 COMMON/MATL/MATLCO 00250620 DATA NHIGH/4HHIGH/ 00250630 IF(MATLCO.NE.NHIGH)GO TO 10 00250640 CALL SPHT2 (T,M,X) 00250650 SPHT=X 00250660 RETURN 00250670 10 CALL SPHT1 (T,M,X) 00250680 SPHT=X 00250690 RETURN 00250700 END 00250710 SUBROUTINE MODUE1 (T,M,MODUE ) 00150370 IMPLICIT REAL*8(A-H,O-Z) 00150380 REAL*8MODUE 00150390 IF(M.LT.1.OR.M.GT.15) GO TO 1000 00150400 IF(M.EQ.1) MODUE=29.665 00150410 IF(M.EQ.1) RETURN 00150420 1000 WRITE(6,1010) M 00150430 1010 FORMAT(1X ,87HERROR--YOU HAVE ENTERED MATERIAL PROPERTY ROUTINE MO00150440 1DUE WITH A MATERIAL CODE NUMBER OF , I5,1H./8X,74HONLY VALUES BETW00150450 2EEN 1 AND 15 ARE VALID. CHECK YOUR INPUT, JOB TERMINATED.) 00150460 RETURN 00150470 END 00150480 SUBROUTINE MODUE2 (T,M,MODUE ) 00150490 IMPLICIT REAL*8(A-H,O-Z) 00150500 REAL*8 MODUE 00150510 DIMENSION COEF(11,8) 00150520 DATA COEF/ 00150530 1 3.0,100.0,1500.0,28.33669,-2.882211E-3,-3.697849E-6,7.709188E-10,00150540 1 0.0,0.0,0.0,0.0, 00150550 2 3.0,100.0,1500.0,28.33669,-2.882211E-3,-3.697849E-6,7.709188E-10,00150560 2 0.0,0.0,0.0,0.0, 00150570 3 0.0,32.0,2500.0,0.01,0.0,0.0,0.0,0.0,0.0,0.0,0.0, 00150580 4 7.0,75.0,1600.0,32.17532,-8.441689E-3,1.0776E-5,1.433823E-9, 00150590 4 -3.887096E-11,5.191192E-14,-2.767454E-17,5.402884E-21, 00150600 5 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9, 00150610 5 -6.323402E-12,0.0,0.0,0.0, 00150620 6 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9, 00150630 6 -6.323402E-12,0.0,0.0,0.0, 00150640 7 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9, 00150650 7 -6.323402E-12,0.0,0.0,0.0, 00150660 8 0.0,0.0,2500.0,0.01,0.0,0.0,0.0,0.0,0.0,0.0,0.0/ 00150670 ICODE=5 00150680 IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8) 00150690 N=COEF(1,M) 00150700 T1=COEF(2,M) 00150710 T2=COEF(3,M) 00150720 IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1) 00150730 MODUE =COEF(N+4,M) 00150740 IF(N.EQ.0)RETURN 00150750 DO 10 I=1,N 00150760 10 MODUE =MODUE *T+COEF(N-I+4,M) 00150770 RETURN 00150780 END 00150790 SUBROUTINE RSC(F,I) 00216630 REAL*8 USC,BSC,F 00216640 IP=80 00216650 USC=2.**IP 00216660 BSC=2.**(-IP) 00216670 100 IF(DABS(F).LT.USC) GO TO 200 00216680 F=F*BSC 00216690 I=I+IP 00216700 GO TO 100 00216710 200 IF(DABS(F).GE.BSC) GO TO 300 00216720 F=F*USC 00216730 I=I-IP 00216740 GO TO 100 00216750 300 CONTINUE 00216760 RETURN 00216770 END 00216780 SUBROUTINE CDC 00038110 ENTRY YDSTR1 00038120 ENTRY SPHT1 00038130 ENTRY CONDT1 00038140 ENTRY BIYLD 00038150 ENTRY PLASTC 00038160 ENTRY HBIYLD 00038170 ENTRY YMODUE 00038180 RETURN 00038190 END 00038200 SUBROUTINE SPLOT (IT,JT,NDS,ISP) 00251370 IMPLICIT REAL*8 (A-H,O-Z) 00251380 COMMON /QTSARG/PP(101),KD(2,8),XM(8),TM(8),IP(8),X(8) 00251390 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00251400 $NAT,NT,NOT 00251410 DIMENSION SM(8) 00251420 DATA SM/1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8/ 00251430 DATA BL/1H /,V/1HX/,AST/1H*/ 00251440 LINE=53 00251450 IF (IT.EQ.1) IT = 61 R0251451 IF (IT.EQ.2) IT = 62 R0251452 IF (JT.EQ.1) JT = 61 R0251453 IF (JT.EQ.2) JT = 62 R0251454 READ (IT) KD,XM,TM,L 00251460 WRITE (6,270) (KD(1,I),KD(2,I),XM(I),TM(I),I,I=1,L) 00251470 DO 110 I=1,L 00251480 IF(XM(I)) 100,110,100 00251490 100 XM(I)=50.E0/XM(I) 00251500 110 CONTINUE 00251510 TT=0.E0 00251520 WRITE (6,230) 00251530 120 FORMAT(/4X,47HNOTE - AN * INDICATES MORE THAN ONE PLOT SYMBOL) 00251540 WRITE (6,240) 00251550 WRITE (6,250) TT,(V,I=1,101),TT 00251560 LLCT=9 00251570 K=1 00251580 DO 130 I=2,100 00251590 130 PP(I)=BL 00251600 DO 220 N=1,NDS 00251610 READ (JT) X 00251620 PP(1)=V 00251630 PP(51)=V 00251640 PP(101)=V 00251650 140 II=ISP 00251660 150 IF(II.LE.0) GO TO 160 00251670 WRITE (6,260) PP 00251680 LLCT=LLCT+1 00251690 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00251700 IF(LLCT.EQ.LINE) WRITE(6,240) 00251710 IF(LLCT.EQ.LINE) WRITE(6,120) 00251720 IF(LLCT.EQ.LINE) WRITE(6,230) 00251730 IF(LLCT.EQ.LINE) WRITE(6,240) 00251740 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00251750 IF(LLCT.EQ.LINE) LLCT=9 00251760 II=II-1 00251770 GO TO 150 00251780 160 TT=TT+DT 00251790 DO 180 I=1,L 00251800 XX=XM(I)*X(I) 00251810 M=XX 00251820 M=M+51 00251830 IP(I)=M 00251840 IF(PP(M).EQ.V .OR. PP(M).EQ.BL) GO TO 170 00251850 PP(M) = AST 00251860 GO TO 180 00251870 170 PP(M) = SM(I) 00251880 180 CONTINUE 00251890 IF(K.LT.10) GO TO 190 00251900 K=1 00251910 WRITE (6,250) TT,PP,TT 00251920 LLCT=LLCT+1 00251930 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00251940 IF(LLCT.EQ.LINE) WRITE(6,240) 00251950 IF(LLCT.EQ.LINE) WRITE(6,120) 00251960 IF(LLCT.EQ.LINE) WRITE(6,230) 00251970 IF(LLCT.EQ.LINE) WRITE(6,240) 00251980 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00251990 IF(LLCT.EQ.LINE) LLCT=9 00252000 GO TO 200 00252010 190 WRITE (6,260) PP 00252020 LLCT=LLCT+1 00252030 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00252040 IF(LLCT.EQ.LINE) WRITE(6,240) 00252050 IF(LLCT.EQ.LINE) WRITE(6,120) 00252060 IF(LLCT.EQ.LINE) WRITE(6,230) 00252070 IF(LLCT.EQ.LINE) WRITE(6,240) 00252080 IF(LLCT.EQ.LINE) WRITE(6,260) (V,I=1,101) 00252090 IF(LLCT.EQ.LINE) LLCT=9 00252100 K=K+1 00252110 200 DO 210 I=1,L 00252120 M=IP(I) 00252130 210 PP(M)=BL 00252140 220 CONTINUE 00252150 TT=TT+DT 00252160 WRITE (6,250) TT,(V,I=1,101),TT 00252170 WRITE (6,240) 00252180 WRITE(6,120) 00252190 RETURN 00252200 230 FORMAT (1X ,57X,15HO R D I N A T E ) 00252210 240 FORMAT ( / 1H ,3X,7HT I M E,2X,4H-1.0,21X,4H-0.5,22X,3H0.0,22X, 00252220 $ 3H0.5,22X,3H1.0,4X,7HT I M E, 1X) 00252230 250 FORMAT (1H ,G12.6,2X,101A1,G12.6) 00252240 260 FORMAT (1H ,14X,101A1) 00252250 270 FORMAT (I8,12X,I3,1P2E14.4,3X,I6) 00252260 END 00252270 SUBROUTINE SQISH(A,I,J) 00254650 REAL*8 A 00254660 J=I 00254670 RETURN 00254680 END 00254690 SUBROUTINE QVMPY2(A,B,C,N,MBAND) 00194350 IMPLICIT REAL*8(A-H,O-Z) 00194360 REAL*8 A,B,C 00194370 DIMENSION A(1),B(N,1),C(1) 00194380 DO 150 I=1,N 00194390 A(I)=0.0E0 00194400 DO 120 J=1,MBAND 00194410 K=I+J-1 00194420 A(I)=A(I)+B(I,J)*C(K) 00194430 120 CONTINUE 00194440 IF(I.EQ.1) GO TO 150 00194450 IF(MBAND.EQ.1) GO TO 150 00194460 K=I-1 00194470 L=I-MBAND+1 00194480 IF(L.LT.1) L=1 00194490 M=I 00194500 IF(M.GT.MBAND) M=MBAND 00194510 DO 130 J=L,K 00194520 A(I)=A(I)+B(J,M)*C(J) 00194530 130 M=M-1 00194540 150 CONTINUE 00194550 RETURN 00194560 END 00194570 SUBROUTINE RPZLVZ(MCODE,TEMP,PCODE,ECODE) 00216460 IMPLICIT REAL*8(A-H,O-Z) 00216470 INTEGER PROP(2,10),PCODE,ECODE 00216480 DATA PROP/4HCOND,4HT ,4HSPHT,4H ,4HDENS,4H ,4HALPH,4HZM ,00216490 X 4HMODU,4HE ,4HYDST,4HR ,4HPRAT,4HO ,4HBIYL,4HD ,00216500 X 4HPLAS,4HTC ,4HHBIY,4HLD / 00216510 IF(ECODE.GT.1)GO TO 10 00216520 RETURN 00216530 10 WRITE(6,30)(PROP(I,PCODE),I=1,2),MCODE,ECODE,TEMP 00216540 RETURN 00216550 20 FORMAT(//,68H **** WARNING - YOU HAVE ENTERED THE LMFBR MARERIAL L00216560 2IBRARY ROUTINE ,2A4,18HWITH A TEMPERATURE,F7.0,20H OUT OF VALID RA00216570 3NGE.,/,42H PLEASE CHECK YOUR INPUT. MATERIAL CODE =,I3,/) 00216580 30 FORMAT(//,66H **** ERROR - YOU HAVE ENTERED THE LMFBR MATERIAL LIB00216590 2RARY ROUTINE ,2A4,23HWITH A MATERIAL CODE OF,I5,/,20HONLY CODES 1 00216600 3THROUGH,I3,43H ARE VALID. JOB TERMINATED. TEMPERATURE =,F7.0,/) 00216610 END 00216620 DOUBLE PRECISION FUNCTION SD(TT,M) 00227010 IMPLICIT REAL*8 (A-H,O-Z) 00227020 COMMON/JUNK/EXT(180) ,HED(9),D(6),W,SS,SI,TI,X,MM,L,K,NTAG 00227030 $,IXX(2),ND,IOPT,NFUN,ITYPE 00227040 COMMON /QTSARG/T(100,3),S(100,3),SFTR(3),NPT(3) 00227050 COMMON / PREP / ZD(2),MODEX 00227060 IF (NTAG.EQ.1) GO TO 120 00227070 NTAG=1 00227080 DO 110 J=1,NFUN 00227090 WRITE(6,100)J 00227100 100 FORMAT(//10X, 15HFUNCTION NUMBER,I2/) 00227110 READ (5,150) HED 00227120 WRITE (6,180) HED 00227130 READ(5,160)NPT(J),SFTR(J) 00227140 IF( DABS(SFTR(J)).LT.1.D-12) SFTR(J)=1.E0 00227150 WRITE(6,190)NPT(J),SFTR(J) 00227160 NPTS=NPT(J) 00227170 READ (5,170)(T(I,J),S(I,J) ,I=1,NPTS) 00227180 WRITE(6,200)(I,T(I,J),S(I,J),I=1,NPTS) 00227190 110 CONTINUE 00227200 IF (MODEX.EQ.1) RETURN 00227210 120 CONTINUE 00227220 NPTS=NPT(M) 00227230 K=0 00227240 DO 130 I=1,NPTS 00227250 K=K+1 00227260 IF(TT.LT.T(I,M))GO TO 140 00227270 130 CONTINUE 00227280 WRITE(6,220)TT,T(NPTS,M) 00227290 STOP 00227300 140 CONTINUE 00227310 IF(K.EQ.1) GO TO 145 00227320 IF(ITYPE.EQ.1) GO TO 141 00227330 TK=T(K,M)-T(K-1,M) 00227340 SK=S(K,M)-S(K-1,M) 00227350 SS=S(K-1,M)+SK*(TT-T(K-1,M))/TK 00227360 SD=SFTR(M)*SS 00227370 GO TO 300 00227380 141 CONTINUE 00227390 SS=S(K-1,M)*DEXP(DLOG(S(K,M)/S(K-1,M))*DLOG(TT/T(K-1,M))/ 00227400 *DLOG(T(K,M)/T(K-1,M))) 00227410 SD=SFTR(M)*SS 00227420 GO TO 300 00227430 145 CONTINUE 00227440 WRITE(6,210)TT,T(K,M),TT 00227450 STOP 00227460 150 FORMAT (9A8) 00227470 160 FORMAT (I5,F10.0) 00227480 170 FORMAT (2F10.0) 00227490 180 FORMAT (//17H SPECTRUM TABLE (, 9A8,1H),/ 1X) 00227500 190 FORMAT (5X,18HNUMBER OF POINTS =, I4/ 00227510 $ 5X,18HSCALE FACTOR = ,E14.5 / 1X ) 00227520 200 FORMAT (6H INPUT,20X,8HSPECTRUM, / 6H POINT,8X,6HPERIOD,9X, 00227530 $ 5HVALUE, / (I6,2E14.4) ) 00227540 210 FORMAT(5X,26H*** ERROR *** : THE PERIOD,2X,E12.5,5X, 00227550 1 39HIS LESS THAN THE LOWEST INPUT PERIOD OF,2X,E12.5,/, 00227560 2 5X,51HFOR THE SPECTRUM. HENCE INPUT SPECTRUM VALUES OF T, 00227570 3 11H LOWER THAN,2X,E12.5) 00227580 220 FORMAT(5X,26H*** ERROR *** : THE PERIOD,2X,E12.5,5X, 00227590 1 43HIS GREATER THAN THE HIGHEST INPUT PERIOD OF,2X,E12.5 00227600 2 ,/,5X,51HFOR THE SPECTRUM. HENCE INPUT SPECTRUM VALUES OF T, 00227610 3 12H HIGHER THAN,2X,E12.5) 00227620 300 CONTINUE 00227630 RETURN 00227640 END 00227650 SUBROUTINE ELOUTS (KD,L,IELT,M,NS) 00079810 IMPLICIT REAL*8 (A-H,O-Z) 00079820 DIMENSION KD(2,1) 00079830 DIMENSION SY(25,7),SZ(26,9),LAB(25),HD(20,4),HH(8,2) 00079840 DATA SY( 1,1) /3H / 00079850 DATA SY( 2,1) /3H P1/, SY( 2,2) /3H V2/, SY( 2,3) /3H V3/, 00079860 $ SY( 2,4) /3H T1/, SY( 2,5) /3H M2/, SY( 2,6) /3H M3/ 00079870 DATA SY( 3,1) /3HXX-/, SY( 3,2) /3HYY-/, SY( 3,3) /3HXY-/ 00079880 DATA SY( 4,1) /3HRR-/, SY( 4,2) /3HZZ-/, SY( 4,3) /3HTH-/, 00079890 $ SY( 4,4) /3HRZ-/ 00079900 DATA SY( 5,1) /3HXX-/, SY( 5,2) /3HYY-/, SY( 5,3) /3HZZ-/, 00079910 $ SY( 5,4) /3HXY-/, SY( 5,5) /3HYZ-/, SY( 5,6) /3HZX-/ 00079920 DATA SY( 6,1) /3HXX-/, SY( 6,2) /3HYY-/, SY( 6,3) /3HXY-/ 00079930 DATA SY( 7,1) /3H / 00079940 DATA SY( 8,1) /3HXX-/, SY( 8,2) /3HYY-/, SY( 8,3) /3HXY-/ 00079950 DATA SY( 9,1) /3H PX/, SY( 9,2) /3H VY/, SY( 9,3) /3H VZ/, 00079960 $ SY( 9,4) /3H TX/, SY( 9,5) /3H MY/, SY( 9,6) /3H MZ/ 00079970 DATA SY(10,1) /3HXX-/, SY(10,2) /3HYY-/, SY(10,3) /3HZZ-/, 00079980 $ SY(10,4) /3HXY-/, SY(10,5) /3HYZ-/, SY(10,6) /3HZX-/ 00079990 DATA SY(11,1) /3HRR-/, SY(11,2) /3HZZ-/, SY(11,3) /3HRZ-/, 00080000 $ SY(11,4) /3HTH-/ 00080010 DATA SY(12,1) /3HYY-/, SY(12,2) /3HZZ-/, SY(12,3) /3HYZ-/, 00080020 $ SY(12,4) /3HXX-/ 00080030 DATA SY(13,1) /3HYY-/, SY(13,2) /3HZZ-/, SY(13,3) /3HYZ-/, 00080040 $ SY(13,4) /3HXX-/ 00080050 DATA SY(14,1) /3HFX-/, SY(14,2) /3HFY-/, SY(14,3) /3HFZ-/, 00080060 $ SY(14,4) /3HMX-/, SY(14,5) /3HMY-/, SY(14,6) /3HMZ-/ 00080070 DATA SY(21,1) /3HS13/, SY(21,2) /3HS14/, SY(21,3) /3HS15/, 00080080 $ SY(21,4) /3HS16/, SY(21,5) /3HS17/, SY(21,6) /3HS18/, 00080090 $ SY(21,7) /3HS19/ 00080100 DATA SY(22,1) /3HS20/, SY(22,2) /3HS21/, SY(22,3) /3HS22/, 00080110 $ SY(22,4) /3HS23/, SY(22,5) /3HS24/, SY(22,6) /3HS25/, 00080120 $ SY(22,7) /3HS26/ 00080130 DATA SY(23,1) /3HS19/, SY(23,2) /3HS20/, SY(23,3) /3HS21/, 00080140 $ SY(23,4) /3HS22/, SY(23,5) /3HS23/, SY(23,6) /3HS24/, 00080150 $ SY(23,7) /3HS25/ 00080160 DATA SY(24,1) /3HS26/, SY(24,2) /3HS27/, SY(24,3) /3HS28/, 00080170 $ SY(24,4) /3HS29/, SY(24,5) /3HS30/, SY(24,6) /3HS31/, 00080180 $ SY(24,7) /3HS32/ 00080190 DATA SY(25,1) /3HS33/, SY(25,2) /3HS34/, SY(25,3) /3HS35/, 00080200 $ SY(25,4) /3HS36/, SY(25,5) /3HS37/, SY(25,6) /3HS38/, 00080210 $ SY(25,7) /3HS39/ 00080220 DATA SZ( 1,1) /3HP/A/, SZ( 1,2) /3HP / 00080230 DATA SZ( 2,1) /3H(I)/, SZ( 2,2) /3H(J)/ 00080240 DATA SZ( 3,1) /3H0 / 00080250 DATA SZ( 4,1) /3HS0 /, SZ( 4,2) /3HS1 /, SZ( 4,3) /3HS2 /, 00080260 $ SZ( 4,4) /3HS3 /, SZ( 4,5) /3HS4 / 00080270 DATA SZ( 5,1) /3HSL1/, SZ( 5,2) /3HSL2/ 00080280 DATA SZ( 6,1) /3HMEM/, SZ( 6,2) /3HBEN/ 00080290 DATA SZ( 7,1) /3H /, SZ( 7,2) /3H / 00080300 DATA SZ( 8,1) /3H0 / 00080310 DATA SZ( 9,1) /3H(I)/, SZ( 9,2) /3H(C)/, SZ( 9,3) /3H(J)/ 00080320 DATA SZ(10,1) /3H0 /, SZ(10,2) /3H1 /, SZ(10,3) /3H2 / 00080330 DATA SZ(10,4) /3H3 /, SZ(10,5) /3H4 /, SZ(10,6) /3H5 / 00080340 DATA SZ(10,7) /3H6 /, SZ(10,8) /3H7 /, SZ(10,9) /3H8 / 00080350 DATA SZ(11,1) /3H0 /, SZ(11,2) /3H1 /, SZ(11,3) /3H2 / 00080360 DATA SZ(11,4) /3H3 /, SZ(11,5) /3H4 /, SZ(11,6) /3H5 / 00080370 DATA SZ(11,7) /3H6 /, SZ(11,8) /3H7 /, SZ(11,9) /3H8 / 00080380 DATA SZ(12,1) /3H0 /, SZ(12,2) /3H1 /, SZ(12,3) /3H2 / 00080390 DATA SZ(12,4) /3H3 /, SZ(12,5) /3H4 /, SZ(12,6) /3H5 / 00080400 DATA SZ(12,7) /3H6 /, SZ(12,8) /3H7 /, SZ(12,9) /3H8 / 00080410 DATA SZ(13,1) /3H0 /, SZ(13,2) /3H1 /, SZ(13,3) /3H2 / 00080420 DATA SZ(13,4) /3H3 /, SZ(13,5) /3H4 /, SZ(13,6) /3H5 / 00080430 DATA SZ(13,7) /3H6 /, SZ(13,8) /3H7 /, SZ(13,9) /3H8 / 00080440 DATA SZ(14,1) /3H / 00080450 DATA LAB/1,6,3,4,6,3,1,3,6,6,4,4,4,1,6*0,5*7/ 00080460 DATA HD( 1,1)/6HT R U /,HD( 1,2)/6HS S /,HD( 1,3)/6H / 00080470 DATA HD( 2,1)/6HB E A /,HD( 2,2)/6HM /,HD( 2,3)/6H / 00080480 DATA HD( 3,1)/6H2/D /,HD( 3,2)/6HP L A /,HD( 3,3)/6HN A R / 00080490 DATA HD( 4,1)/6HA X I /,HD( 4,2)/6HS Y M /,HD( 4,3)/6HM E T / 00080500 DATA HD( 5,1)/6H3/D /,HD( 5,2)/6HB R I /,HD( 5,3)/6HC K / 00080510 DATA HD( 6,1)/6HP L A /,HD( 6,2)/6HT E / /,HD( 6,3)/6HS H E / 00080520 DATA HD( 7,1)/6H /,HD( 7,2)/6H /,HD( 7,3)/6H / 00080530 DATA HD( 8,1)/6H2/D /,HD( 8,2)/6HP L A /,HD( 8,3)/6HN A R / 00080540 DATA HD( 9,1)/6H3/D /,HD( 9,2)/6HP I P /,HD( 9,3)/6HE / 00080550 DATA HD(10,1)/6H3/D CU/,HD(10,2)/6HRVED S/,HD(10,3)/6HOLID E/ 00080560 DATA HD(11,1)/6HAXISYM/,HD(11,2)/6HMMETRI/,HD(11,3)/6HC ELEM/ 00080570 DATA HD(12,1)/6HPLANE /,HD(12,2)/6HSTRESS/,HD(12,3)/6H ELEME/ 00080580 DATA HD(13,1)/6HPLANE /,HD(13,2)/6HSTRAIN/,HD(13,3)/6H ELEME/ 00080590 DATA HD(14,1)/6HSIX BY/,HD(14,2)/6H SIX M/,HD(14,3)/6HATRIX / 00080600 DATA HD( 1,4)/6H / 00080610 DATA HD( 2,4)/6H / 00080620 DATA HD( 3,4)/6H / 00080630 DATA HD( 4,4)/6HR I C / 00080640 DATA HD( 5,4)/6H / 00080650 DATA HD( 6,4)/6HL L / 00080660 DATA HD( 7,4)/6H / 00080670 DATA HD( 8,4)/6H / 00080680 DATA HD( 9,4)/6H / 00080690 DATA HD(10,4)/6HLEMENT/ 00080700 DATA HD(11,4)/6HENT / 00080710 DATA HD(12,4)/6HNT / 00080720 DATA HD(13,4)/6HNT / 00080730 DATA HD(14,4)/6HFORCES/ 00080740 IF(L.LT.1) RETURN 00080750 KEL = IELT 00080760 WRITE (6,100) 00080770 100 FORMAT (42H1T I M E H I S T O R Y R E S P O N S E, / 1X) 00080780 WRITE (6,110) (HD(IELT,K),K=1,4), M 00080790 110 FORMAT (15H ELEMENT TYPE (,4A6,24H) / / / OUTPUT SET =,I4/ 1X)00080800 WRITE (6,120) 00080810 120 FORMAT (13X,40H *ELEMENT NUMBER* - (*STRESS COMPONENT*), 1X) 00080820 DO 130 N=1,L 00080830 KELL=KEL 00080840 IF(KEL.EQ.2 .AND. KD(2,N).GT.12) KELL = 21 00080850 IF(KEL.EQ.2 .AND. KD(2,N).GT.19) KELL = 22 00080860 IF(KEL.EQ.9 .AND. KD(2,N).GT.18) KELL = 23 00080870 IF(KEL.EQ.9 .AND. KD(2,N).GT.25) KELL = 24 00080880 IF(KEL.EQ.9 .AND. KD(2,N).GT.32) KELL = 25 00080890 N1=LAB(KEL) 00080900 IF(KELL.GT.20)N1=LAB(KELL) 00080910 KD2N = KD(2,N) 00080920 IF(KD2N.GT.12.AND.KEL.EQ.2) KD2N=KD2N-12 00080930 IF(KD2N.GT.18.AND.KEL.EQ.9) KD2N=KD2N-18 00080940 J = (KD2N-1)/ N1 + 1 00080950 HH(N,2) = SZ(KEL,J) 00080960 J = KD2N - (J-1) * N1 00080970 HH(N,1) = SY(KELL,J) 00080980 130 CONTINUE 00080990 WRITE (6,140) (KD(1,I),HH(I,1),HH(I,2),I=1,L) 00081000 140 FORMAT (8X, 4HTIME,2X, 8(I5,1H-,2A3) ) 00081010 RETURN 00081020 END 00081030 SUBROUTINE FCOPY(ID,IF) 00086440 RETURN 00086450 END 00086460 SUBROUTINE PLOTDY (IT,JT,NDS,ISP) 00172750 IMPLICIT REAL*8 (A-H,O-Z) 00172760 COMMON/QTSARG/PP(101),KD(3,8),XM(8),TM(8),IP(8),X(8),RRQTSA(859) R0172770 COMMON /DYN/ NT,NOT,DAMP,DT,RRDYN(3) R0172780 DIMENSION SM(8) 00172790 DATA SM /1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8 / 00172800 DATA BL /1H /,V /1HX/,AST /1H*/ 00172810 LINE=53 00172820 READ (IT) KD,XM,TM,L 00172830 WRITE (6,260) (KD(1,I),KD(2,I),XM(I),TM(I),I,I=1,L) 00172840 DO 100 K=1,L 00172850 TT = XM(K) 00172860 IF( DABS(TT).GT.1.0E-8 ) XM(K) = 50.0E0/ TT 00172870 100 CONTINUE 00172880 TT=0.E0 00172890 WRITE (6,220) 00172900 110 FORMAT(/4X,47HNOTE - AN * INDICATES MORE THAN ONE PLOT SYMBOL) 00172910 WRITE (6,230) 00172920 WRITE (6,240) TT,(V,I=1,101),TT 00172930 LLCT=9 00172940 K=1 00172950 DO 120 I=2,100 00172960 120 PP(I)=BL 00172970 DO 210 N=1,NDS 00172980 READ (JT) X 00172990 PP(1)=V 00173000 PP(51)=V 00173010 PP(101)=V 00173020 130 II=ISP 00173030 140 IF(II.LE.0) GO TO 150 00173040 WRITE (6,250) PP 00173050 LLCT=LLCT+1 00173060 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173070 IF(LLCT.EQ.LINE) WRITE(6,230) 00173080 IF(LLCT.EQ.LINE) WRITE(6,110) 00173090 IF(LLCT.EQ.LINE) WRITE(6,220) 00173100 IF(LLCT.EQ.LINE) WRITE(6,230) 00173110 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173120 IF(LLCT.EQ.LINE) LLCT=9 00173130 II=II-1 00173140 GO TO 140 00173150 150 TT=TT+DT 00173160 DO 170 I=1,L 00173170 XX=XM(I)*X(I) 00173180 M=XX 00173190 M=M+51 00173200 IP(I)=M 00173210 IF(PP(M).EQ.V .OR. PP(M).EQ.BL) GO TO 160 00173220 PP(M) = AST 00173230 GO TO 170 00173240 160 PP(M) = SM(I) 00173250 170 CONTINUE 00173260 IF(K.LT.10) GO TO 180 00173270 K=1 00173280 WRITE (6,240) TT,PP,TT 00173290 LLCT=LLCT+1 00173300 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173310 IF(LLCT.EQ.LINE) WRITE(6,230) 00173320 IF(LLCT.EQ.LINE) WRITE(6,110) 00173330 IF(LLCT.EQ.LINE) WRITE(6,220) 00173340 IF(LLCT.EQ.LINE) WRITE(6,230) 00173350 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173360 IF(LLCT.EQ.LINE) LLCT=9 00173370 GO TO 190 00173380 180 WRITE (6,250) PP 00173390 LLCT=LLCT+1 00173400 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173410 IF(LLCT.EQ.LINE) WRITE(6,230) 00173420 IF(LLCT.EQ.LINE) WRITE(6,110) 00173430 IF(LLCT.EQ.LINE) WRITE(6,220) 00173440 IF(LLCT.EQ.LINE) WRITE(6,230) 00173450 IF(LLCT.EQ.LINE) WRITE(6,250) (V,I=1,101) 00173460 IF(LLCT.EQ.LINE) LLCT=9 00173470 K=K+1 00173480 190 DO 200 I=1,L 00173490 M=IP(I) 00173500 200 PP(M)=BL 00173510 210 CONTINUE 00173520 TT=TT+DT 00173530 WRITE (6,240) TT,(V,I=1,101),TT 00173540 WRITE (6,230) 00173550 WRITE(6,110) 00173560 RETURN 00173570 220 FORMAT (1X ,57X,15HO R D I N A T E ) 00173580 230 FORMAT ( / 1H ,3X,7HT I M E,2X,4H-1.0,21X,4H-0.5,22X,3H0.0,22X, 00173590 $ 3H0.5,22X,3H1.0,4X,7HT I M E, 1X) 00173600 240 FORMAT (1H ,F10.4,4X,101A1,F12.4) 00173610 250 FORMAT (1H ,14X,101A1) 00173620 260 FORMAT (I8,12X,I3,1P2E14.4,3X,I6) 00173630 END 00173640