Liren Large Software Subsidy 9

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

/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 11.ddi / HISTRYT.FOR < prev

Wrap

Text File | 1987-05-25 | 67.0 KB | 838 lines

SUBROUTINE HISTRY 00112590 IMPLICIT REAL*8(A-H,O-Z) 00112600 REAL*8 NPAR 00112610 COMMON A(1) 00112620 COMMON / MISC / NBLOCK,NEQB,LL,NF,LB 00112630 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00112640 & ,RRELPA(24) R0112641 COMMON /QTSARG/ AT(400),RRQTSA(600) R0112650 COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3) R0112660 COMMON / JUNK / NARB,NGM,RRJUNK(226) R0112670 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0112680 DIMENSION T(7) 00112690 CALL FILES(15) 00112700 CALL SECOND (T(1)) 00112710 N2=N1+NF 00112720 N3=N2+LL*NF 00112730 N4=N3+LL*LL 00112740 N5=N4+LL*LL 00112750 N6=N5+LL*LL 00112760 N7=N6+NEQB 00112770 N8=N7+NEQB*LL 00112780 N9=N8+NEQB*LL 00112790 IF(N9.GT.MTOT) CALL ERROR(N9-MTOT) 00112800 100 CONTINUE 00112810 READ (5,160) NFN,NGM,NAT,NT,NOT,DT,DAMP 00112820 IF(NAT.EQ.0) NAT=1 00112830 IF(NOT.EQ.0) NOT=1 00112840 IF(KSKIP.GT.0) GO TO 111 00112850 REWIND 10 00112860 N3=N2-1 00112870 READ (10) (A(I),I=N1,N3) 00112880 NWORD=4*NEQB*NF 00112890 IF(NBLOCK.GT.1) NWORK=4*NEQB*NV 00112900 DO 105 I=1,NBLOCK 00112910 105 READ (10) 00112920 TPI=6.2831852 00112930 N2=0 00112940 TT=DT*5.0 00112950 DO 110 I=N1,N3 00112960 N4=I-N1+1 00112970 IF(TPI/A(I).GT.TT) N2=N4 00112980 110 CONTINUE 00112990 NF=N2 00113000 111 CONTINUE 00113010 WRITE(6,170) NFN,NGM,NAT,NT,NOT,DT,DAMP,NF 00113020 IF(NF.GT.0) GO TO 1110 00113030 WRITE(6,190) 00113040 STOP 00113050 1110 CONTINUE 00113060 NT=NT+1 00113070 CALL SECOND (T(2)) 00113080 T(1)=T(2)-NPAR(1) 00113090 N2=N1+3*NEQ 00113100 IF(N2.GT.MTOT) CALL ERROR(N2-MTOT) 00113110 N2=N1+3*NUMNP 00113120 N3=N2+NFN*NEQB 00113130 N4=N3+NFN*NEQB 00113140 IF(N4.GT.MTOT) CALL ERROR(MTOT-N4) 00113150 CALL LOAD1(A(N1),A(N2),A(N3),NUMNP,NEQB,NEQ,NFN,A(N1),A(N1)) 00113160 IF(NGM.EQ.0) GO TO 130 00113170 IF (KSKIP.EQ.1) GO TO 120 00113180 CALL EMID (A(N1),A(N2),NUMNP,NEQB) 00113190 120 CONTINUE 00113200 N2A=N2+NEQB*NFN 00113210 N3=N2A+NEQB*NFN 00113220 N4=N3+NEQB 00113230 N5=N4+NEQB 00113240 IF(N5.GT.MTOT) CALL ERROR(N5-MTOT) 00113250 CALL GMTN (A(N1),A(N2),A(N2A),A(N3),A(N4),NEQB,NFN,NBLOCK,NUMNP) 00113260 130 N2=N1+NFN*NF*NAT 00113270 N3=N2+NEQB*NF 00113280 N4=N3+NEQB*NFN 00113290 N5=N4+NEQB*NFN 00113300 IF(N5.GT.MTOT) CALL ERROR (N5-MTOT) 00113310 N6=N2+NT*NFN 00113320 MAX=(MTOT-N6)/2 00113330 N7=N6+MAX 00113340 N8=N6+NT 00113350 IF(N8.GT.MTOT) CALL ERROR (N8-MTOT) 00113360 CALL LOAD2 (A(N2),A(N3),A(N4),A(N2),A(N6),A(N7), 00113370 $ A(N6),NEQB,NF,NFN,NT,MAX,NBLOCK,NAT) 00113380 CALL SECOND (T(3)) 00113390 NDS=(NT-1)/NOT 00113400 N2=N1+NF 00113410 N3=N2+NT 00113420 N4=N3+NF*NDS*3 00113430 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00113440 IF (KSKIP.EQ.1) GO TO 140 00113450 CALL RESPON (A(N1),A(N2),A(N3),NF,NT,NDS) 00113460 CALL SECOND (T(4)) 00113470 N2=N1+3*NUMNP 00113480 N3=N2+6*NF 00113490 140 CONTINUE 00113500 CALL SECOND (T(5)) 00113510 NSB=NEQB*NBLOCK 00113520 N2=N1+8*NF 00113530 N3=N2+NF*NDS 00113540 IF(N3.GT.MTOT) CALL ERROR(N3-MTOT) 00113550 N4=N1+3*NUMNP 00113560 N5=N4+NUMNP 00113570 IF(N5.GT.MTOT) CALL ERROR(N5-MTOT) 00113580 CALL DSPLRS(A(N1),A(N1),A(N2),A(N2),NEQB,NF,NDS,NUMNP,NBLOCK, 00113590 $NSB,A(N4)) 00113600 CALL SECOND (T(6)) 00113610 N2=N1+1 00113620 N3=N2+8*NF 00113630 N4=N3+NSB*NF 00113640 N5=N3+NF*NDS 00113650 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00113660 IF(N5.GT.MTOT) CALL ERROR(N5-MTOT) 00113670 CALL STRSD1 00113680 $ (A(N1),A(N2),A(N3),A(N3),NF,NSB,NDS,NEQB,NBLOCK,A(1)) 00113690 CALL SECOND (T(7)) 00113700 TT=0. 00113710 DO 150 I=1,6 00113720 T(I)=T(I+1)-T(I) 00113730 150 TT=TT + T(I) 00113740 T(7)=TT 00113750 WRITE (6,180) T 00113760 RETURN 00113770 160 FORMAT (5I5,2F10.0) 00113780 170 FORMAT (28H1NUMBER OF DYNAMIC INPUTS..=,I5// 00113790 $ 28H GROUND MOTION INDICATOR...=,I5// 00113800 $ 28H NUMBER OF ARRIVAL TIMES...=,I5// 00113810 $ 28H NUMBER OF TIME STEPS......=,I5// 00113820 $ 28H OUTPUT INTERVAL...........=,I5// 00113830 $ 28H TIME INCREMENT............=,1PE9.2// 00113840 $ 28H DAMPING FACTOR............=,1PE9.2// 00113850 $ 19H ADJUSTED NUMBER OF / 00113860 $ 28H FREQUENCIES...............=,I5) 00113870 180 FORMAT(27H1....TIME LOG (CPU SECONDS) /// 00113880 $ 33H MODE SHAPES AND FREQUENCIES... ,F8.2 // 00113890 $ 33H FORM DYNAMIC LOADS............ ,F8.2 // 00113900 $ 33H MODAL RESPONSE................ ,F8.2 // 00113910 $ 33H PRINT MODE SHAPES............. ,F8.2 // 00113920 $ 33H DISPLACEMENT OUTPUT........... ,F8.2 // 00113930 $ 33H STRESS OUTPUT................. ,F8.2 // 00113940 $ 33H TOTAL FOR RESPONSE ANALYSIS... ,F8.2 //) 00113950 190 FORMAT(5X,43H*** ERROR *** TIME INCREMENT (DT) TOO LARGE, 00113960 1 49H 5*DT IS .GT. FUNDAMENTAL PERIOD OF THE STRUCTURE,/, 00113970 219X,49HHENCE ADJUSTED FREQUENCIES = 0. CHOOSE A SMALLER, 00113980 3 10H DT VALUE.) 00113990 END 00114000 FUNCTION IDIST(NS,ML,MAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC,NN) 00114010 IMPLICIT REAL*8(A-H,O-Z) 00114020 INTEGER*2 IC,IDEG,IDIS,IW,ICC 00114030 INTEGER*2 IG 00114040 DIMENSION IG(II1,1),IC(1),IDEG(1),IDIS(1),IW(1),ICC(1) 00114050 ICN=IC(NS) 00114060 NNC=ICC(ICN+1)-ICC(ICN) 00114070 DO 110 I=1,NN 00114080 IF(IC(I)-IC(NS)) 110,100,110 00114090 100 IDIS(I)=0 00114100 110 CONTINUE 00114110 LL=1 00114120 L=0 00114130 KI=0 00114140 KO=1 00114150 ML=0 00114160 IW(1)=NS 00114170 IDIS(NS)=-1 00114180 120 KI=KI+1 00114190 IF(KI-LL)150,130,150 00114200 130 L=L+1 00114210 LL=KO+1 00114220 K=KO-KI+1 00114230 IF(K-ML) 150,150,140 00114240 140 ML=K 00114250 IF(ML-MAXLEV) 150,150,230 00114260 150 II=IW(KI) 00114270 N=IDEG(II) 00114280 IF(N)160,220,160 00114290 160 DO 180 I=1,N 00114300 IA = IG(II,I) 00114310 IF(IDIS(IA))180,170,180 00114320 170 IDIS(IA)=L 00114330 KO=KO+1 00114340 IW(KO)=IA 00114350 180 CONTINUE 00114360 IF(KO-NNC)120,190,190 00114370 190 IDIST=L 00114380 IDIS(NS)=0 00114390 K=KO-LL+1 00114400 IF(K-ML) 210,210,200 00114410 200 ML=K 00114420 210 CONTINUE 00114430 RETURN 00114440 220 L=0 00114450 GO TO 190 00114460 230 IDIST=1 00114470 RETURN 00114480 END 00114490 SUBROUTINE LOAD1 (ID,FF,IFF,NUMNP,NEQB,NEQ,NFN,COD,ISIR) 00126060 IMPLICIT REAL*8(A-H,O-Z) 00126070 REAL*8 ID 00126080 REAL*8 IFF 00126090 INTEGER*2 ISIR 00126100 DIMENSION ID(NUMNP,3),FF(NEQB,NFN),IFF(NEQB,NFN) 00126110 COMMON / JUNK / NARB,NGM,RRJUNK(226) R0126120 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0126130 DIMENSION ISIR(NUMNP),COD(NEQ,3) 00126140 COMMON /BAND/ KOPT,NRBAND(7) R0126150 NT=2 00126160 REWIND NT 00126170 REWIND 8 00126180 RDN=0.01745329251 00126190 KT=3 00126200 LT=17 00126210 MT=18 00126220 REWIND MT 00126230 IF(KSKIP.EQ.1) GO TO 5 00126240 IF(KOPT.GT.0) REWIND LT 00126250 IF(KOPT.GT.0) READ(LT) 00126260 IF(KOPT.GT.0) READ (LT) (ISIR(II),II=1,NUMNP) R0126270 5 CONTINUE 00126280 WRITE (6,220) 00126290 NARB=1 00126300 KOUNT=0 00126310 50 READ(5,60)NP,IC,IFN,IAT,P,THET,PHI,KN 00126320 60 FORMAT(4I5,3F10.0,I5) 00126330 ICI=IC 00126340 IF(IAT.EQ.0)IAT=1 00126350 DPH=0.0 00126360 DTH=0.0 00126370 DP =0.0 00126380 I=1 00126390 IF(KN.EQ.0) GO TO 80 00126400 IF(MOD((NP-NPL),KN).NE.0) KN=0 00126410 IF(KN.EQ.0) KSKIP=1 00126420 IF(KN.EQ.0) WRITE(6,20)NP 00126430 20 FORMAT(/20X,45HTHE GENERATION PARAMETER IS INCORRECT ON NODE,I5/) 00126440 IF(KN.EQ.0) GO TO 80 00126450 I=(NP-NPL)/KN 00126460 DTH=(THET-THETL)/I 00126470 DPH=(PHI-PHIL)/I 00126480 DP=(P-PL)/I 00126490 THET=THETL 00126500 PHI=PHIL 00126510 P=PL 00126520 NP=NPL 00126530 80 DO 90 J=1,I 00126540 NP=NP+KN 00126550 P=P+DP 00126560 PHI=PHI+DPH 00126570 THET=THET+DTH 00126580 K=1 00126590 KI=1 00126600 IF(THET.NE.0.0.OR.PHI.NE.0.0) K=3 00126610 IF(THET.NE.0.0.AND.PHI.EQ.90.0) K=2 00126620 IF(THET.EQ.90.0.AND.PHI.NE.0.0) KI=2 00126630 DO 90 L=KI,K 00126640 IF(L.EQ.1) PX=P*DSIN(PHI*RDN)*DCOS(THET*RDN) 00126650 IF(L.EQ.2) PX=P*DSIN(PHI*RDN)*DSIN(THET*RDN) 00126660 IF(L.EQ.3) PX=P*DCOS(PHI*RDN) 00126670 IF(K.EQ.1) PX=P 00126680 IC=ICI 00126690 IF(K.NE.1) IC=L 00126700 IF(NP.LE.0) GO TO 100 00126710 WRITE(6,230)NP,IC,IFN,IAT,PX 00126720 NODE=NP 00126730 IF(KOPT.GT.0) NODE=ISIR(NP) 00126740 KOUNT=KOUNT+1 00126750 WRITE (MT) NODE,IC,IFN,IAT,PX 00126760 90 CONTINUE 00126770 THETL=THET 00126780 PHIL=PHI 00126790 PL=P 00126800 NPL=NP 00126810 GO TO 50 00126820 100 IF(KOUNT.EQ.0) NARB=0 00126830 IF(KOUNT.EQ.0) RETURN 00126840 IF(KSKIP.EQ.1) RETURN 00126850 READ (8) ID 00126860 REWIND MT 00126870 REWIND KT 00126880 DO 110 I=1,KOUNT 00126890 READ (MT) NODE,IC,IFN,IAT,P 00126900 CALL UNPKID(ID,NUMNP,W,WX,2,NODE,IC) 00126910 IC=W 00126920 IF(IC.GT.0) GO TO 110 00126930 WRITE(6,115)NODE 00126940 110 WRITE (KT) IC,IFN,IAT,P 00126950 115 FORMAT(/20X,4HNODE,I5,35H WAS GIVEN A LOAD ON A DOF THAT WAS, 00126960 $12H CONSTRAINED/20X,35HIF THE GEOMETRY HAS BEEN RENUMBERED, 00126970 $41H, THE NODE NO. IS THE RENUMBERED NODE NO.//) 00126980 IF(KSKIP.EQ.1) RETURN 00126990 REWIND KT 00127000 ZER=0.0E0 00127010 NWDS=NEQ*3 00127020 CALL QVSET(ZER,COD(1,1),NWDS) 00127030 DO 140 I=1,KOUNT 00127040 READ (KT) IC,IFN,IAT,P 00127050 IF(COD(IC,1).LE.0.0) GO TO 130 00127060 KSKIP=1 00127070 WRITE(6,120)IC 00127080 120 FORMAT(/20X,10HDOF NUMBER,I5,31H HAS HAD MORE THAN ONE FUNCTION, 00127090 $15H APPLIED TO IT./) 00127100 130 COD(IC,1)=IFN 00127110 COD(IC,2)=IAT 00127120 COD(IC,3)=P 00127130 140 CONTINUE 00127140 IF(KSKIP.EQ.1) RETURN 00127150 REWIND MT 00127160 KOUNT=0 00127170 DO 150 I=1,NEQ 00127180 IF(COD(I,1).LE.0.0) GO TO 150 00127190 WRITE (MT) I,(COD(I,J),J=1,3) 00127200 KOUNT=KOUNT+1 00127210 150 CONTINUE 00127220 NWDS=2*NFN*NEQB 00127230 CALL QVSET(ZER,FF(1,1),NWDS) 00127240 NS=1 00127250 NE=NEQB 00127260 KNT=1 00127270 REWIND MT 00127280 READ (MT) NEQN,XIFN,XIAT,XP 00127290 DO 190 I=1,NEQ 00127300 160 IF(I.LE.NE) GO TO 170 00127310 WRITE(NT) FF,IFF 00127320 NS=NS+NEQB 00127330 NE=NE+NEQB 00127340 CALL QVSET(ZER,FF(1,1),NWDS) 00127350 170 IF(NEQN.EQ.I) GO TO 180 00127360 GO TO 190 00127370 180 M=NEQN-NS+1 00127380 IFN=XIFN 00127390 FF(M,IFN)=XP 00127400 IFF(M,IFN)=XIAT 00127410 IF(KNT.GE.KOUNT) GO TO 190 00127420 READ (MT)NEQN,XIFN,XIAT,XP 00127430 KNT=KNT+1 00127440 190 CONTINUE 00127450 IF (KSKIP.EQ.1)RETURN 00127460 WRITE (NT) FF,IFF 00127470 RETURN 00127480 200 FORMAT (4I5,F10.2) 00127490 210 FORMAT (18H0DATA OUT OF ORDER ) 00127500 220 FORMAT (19H1DYNAMIC LOAD INPUT // 00127510 $ 57H NODE DISPLACEMENT FUNCTION ARRIVAL TIME FUNCTION / 00127520 $ 60H NUMBER COMPONENT NUMBER NUMBER MULTIPLIER /)00127530 230 FORMAT (I6,2I11,I14,F15.3) 00127540 END 00127550 SUBROUTINE EMID(ID,MASS,NUMNP,NEQB) 00085680 IMPLICIT REAL*8(A-H,O-Z) 00085690 REAL*8 MASS 00085700 REAL*8 ID 00085710 COMMON/PREP/XMX,XAD,KSKIP,NDY ,I1,RRPREP(7) R0085720 DIMENSION ID(NUMNP,3),MASS(NEQB) 00085730 IWRITE=0 00085740 REWIND 3 00085750 REWIND 8 00085760 READ (8) ID 00085770 DO 100 L=1,NEQB 00085780 100 MASS(L)=0.0D0 00085790 NT=1 00085800 DO 140 N=1,NUMNP 00085810 DO 130 I=1,6 00085820 NEQBS=NEQB*(NT-1) 00085830 NEQBE=NEQB*NT 00085840 CALL UNPKID(ID,NUMNP,W,WX,2,N,I) 00085850 NNN=W 00085860 IF(NNN.LE.0) GO TO 130 00085870 IF(NNN.GT.NEQBS.AND.NNN.LE.NEQBE) GO TO 110 00085880 IF(NNN.LE.NEQBS) GO TO 130 00085890 NT=NT+1 00085900 DO 105 M=1,NEQB 00085910 105 MASS(M)=0.0D0 00085920 110 IF(I.GT.3) GO TO 120 00085930 L=NNN-(NT-1)*NEQB 00085940 MASS(L)=I 00085950 120 IF(NNN.EQ.NEQBE) WRITE(3) MASS 00085960 IF(NNN.EQ.NEQBE) IWRITE=IWRITE+1 00085970 130 CONTINUE 00085980 140 CONTINUE 00085990 IF(IWRITE.LT.NT) WRITE(3) MASS 00086000 RETURN 00086010 END 00086020 SUBROUTINE GMTN (ID,FF,IFF,XM,MASS,NEQB,NFN,NBLOCK,NUMNP) 00107300 IMPLICIT REAL*8(A-H,O-Z) 00107310 REAL*8 ID 00107320 REAL*8 MASS 00107330 REAL*8 IFF 00107340 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0107350 COMMON / JUNK / NARB,NGM,JFN(3),JAT(3),RRJUNK(223) R0107360 DIMENSION FF(NEQB,NFN),IFF(NEQB,NFN),MASS(NEQB),XM(NEQB) 00107370 1,ID(NUMNP,3),XX(3) 00107380 JT=4 00107390 IT=2 00107400 IF (KSKIP.EQ.1) GO TO 100 00107410 REWIND IT 00107420 REWIND JT 00107430 REWIND 3 00107440 REWIND 9 00107450 100 CONTINUE 00107460 IF(NGM.LE.1) GO TO 105 00107470 REWIND 8 00107480 READ (8) ID 00107490 GO TO 1120 00107500 105 CONTINUE 00107510 READ (5,180) JFN,JAT 00107520 DO 120 I=1,3 00107530 IF(JAT(I)) 110,110,120 00107540 110 JAT(I)=1 00107550 120 CONTINUE 00107560 GO TO 1180 00107570 1120 READ (5,1010) NFNR,NATR,IAX,XREF,YREF,ZREF 00107580 IF(NFNR.EQ.0) NFNR=1 00107590 IF(NATR.EQ.0) NATR=1 00107600 IF (IAX.GT.0.AND.IAX.LT.4) GO TO 1130 00107610 WRITE(6,1020) IAX 00107620 STOP 00107630 1130 WRITE (6,2010) NFNR,NATR,IAX,XREF,YREF,ZREF 00107640 DO 1140 I=1,3 00107650 JFN(I)=NFNR 00107660 1140 JAT(I)=NATR 00107670 GO TO 1190 00107680 1180 CONTINUE 00107690 WRITE (6,190) JFN,JAT 00107700 1190 CONTINUE 00107710 IF (KSKIP.EQ.1)RETURN 00107720 NNN=NFN*NEQB 00107730 DO 170 N=1,NBLOCK 00107740 NEQBS=NEQB*(N-1) 00107750 NEQBE=NEQB*N 00107760 READ (3) MASS 00107770 READ (9) XM 00107780 IF(NARB.EQ.0) GO TO 130 00107790 READ (IT) FF,IFF 00107800 GO TO 150 00107810 130 DO 140 I=1,NEQB 00107820 DO 140 J=1,NFN 00107830 FF(I,J)=0 00107840 140 IFF(I,J)=0 00107850 150 DO 160 I=1,NEQB 00107860 NEQBC=NEQBS+I 00107870 J=MASS(I) 00107880 IF(J.EQ.0) GO TO 160 00107890 JJ=JFN(J) 00107900 IF(JJ.LE.0) GO TO 160 00107910 IF(NGM.EQ.1) GO TO 1390 00107920 DO 1240 NRK=1,NUMNP 00107930 DO 1230 IRK=1,6 00107940 CALL UNPKID(ID,NUMNP,W,WX,2,NRK,IRK) 00107950 NNN=W 00107960 IF(NNN.LE.0) GO TO 1230 00107970 IF(NNN.NE.NEQBC) GO TO 1230 00107980 NODE=NRK 00107990 GO TO 1250 00108000 1230 CONTINUE 00108010 1240 CONTINUE 00108020 1250 CONTINUE 00108030 DO 1260 NRK=1,3 00108040 CALL UNPKID(ID,NUMNP,W,WX,1,NODE,NRK) 00108050 XX(NRK)=WX 00108060 1260 CONTINUE 00108070 GO TO (1310,1320,1330),IAX 00108080 1310 IF(J.EQ.2) XM(I)=-XM(I)*(XX(3)-ZREF) 00108090 IF(J.EQ.3) XM(I)= XM(I)*(XX(2)-YREF) 00108100 GO TO 1390 00108110 1320 IF(J.EQ.3) XM(I)=-XM(I)*(XX(1)-XREF) 00108120 IF(J.EQ.1) XM(I)= XM(I)*(XX(3)-ZREF) 00108130 GO TO 1390 00108140 1330 IF(J.EQ.1) XM(I)=-XM(I)*(XX(2)-YREF) 00108150 IF(J.EQ.2) XM(I)= XM(I)*(XX(1)-XREF) 00108160 1390 CONTINUE 00108170 FF(I,JJ)=-XM(I) 00108180 IFF(I,JJ)=JAT(J) 00108190 160 CONTINUE 00108200 170 WRITE (JT) FF,IFF 00108210 RETURN 00108220 180 FORMAT (6I5) 00108230 190 FORMAT (////30H1...GROUND MOTION INPUT KEY.../// 00108240 $ 23X,9HDIRECTION / 00108250 $ 22X,11HX Y Z // 00108260 $ 20H FUNCTION NUMBER...,I3,2I5/ 00108270 $ 20H ARRIVAL TIME...... ,I3,2I5) 00108280 1010 FORMAT(3I5,3F10.0) 00108290 2010 FORMAT(////,1X,24HROTATION OF THE SUPPORT ,//, 00108300 1 10X, 24HTIME FUNCTION NUMBER = ,I3,/, 00108310 2 10X, 24HARRIVAL TIME NUMBER = ,I3,/, 00108320 3 10X, 24HROTATIONAL AXIS = ,I3,/, 00108330 4 10X, 24HREFERENCE POINT ,3HX =,F12.4,/, 00108340 5 34X,3HY =,F12.4,/,34X,3HZ =,F12.4) 00108350 1020 FORMAT (1X,30H**** ERROR, ROTATIONAL AXIS =,I13) 00108360 END 00108370 SUBROUTINE LOAD2 (FI,FF,IFF,PP,T,P,PD,NEQB,NF,NFN,NT,MAX, 00127560 $ NBLOCK,NAT) 00127570 IMPLICIT REAL*8(A-H,O-Z) 00127580 REAL*8 IFF 00127590 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0127600 COMMON /QTSARG/ AT(400),RRQTSA(600) R0127610 DIMENSION FI(NEQB,NF),FF(NEQB,NFN),IFF(NEQB,NFN),PP(NFN,1),T(1), 00127620 $ P(1),PD(NT) 00127630 COMMON / DYN / JT,NOT,DAMP,DT,RRDYN(3) R0127640 COMMON / JUNK / NARB,NGM,HED(12),RRJUNK(214) R0127650 COMMON /SSIT/ NV 00127660 COMMON A(1) 00127670 READ (5,280) (AT(I),I=1,NAT) 00127680 WRITE(6,320)(I,AT(I),I=1,NAT) 00127690 IF (KSKIP.EQ.1) GO TO 130 00127700 MT=4 00127710 IF(NGM.EQ.0) MT=2 00127720 REWIND MT 00127730 NE=NAT*NF*NFN 00127740 DO 100 I=1,NE 00127750 100 A(I)=0. 00127760 KK=NF*NFN 00127770 L10RC=NEQB*NF*4 00127780 L10RC2=L10RC 00127790 IF(NBLOCK.GT.1) L10RC=NEQB*NV*4 00127800 DO 120 N=1,NBLOCK 00127810 BACKSPACE 10 00127820 READ (10) FI 00127830 BACKSPACE 10 00127840 READ (MT) FF,IFF 00127850 NN=-KK 00127860 DO 110 I=1,NF 00127870 DO 110 J=1,NFN 00127880 NN=NN+1 00127890 DO 110 L=1,NEQB 00127900 LL=IFF(L,J) 00127910 IF(LL.EQ.0) GO TO 110 00127920 K=NN+LL*KK 00127930 A(K)=A(K) + FI(L,I)*FF(L,J) 00127940 110 CONTINUE 00127950 120 CONTINUE 00127960 130 CONTINUE 00127970 TH=1.4E0 00127980 DTA=DT*(TH - 1.E0) 00127990 DO 210 I=1,NFN 00128000 READ (5,260) NLP,SFTR,HED,IFOR 00128010 WRITE (6,290) I,HED,NLP,SFTR 00128020 IF(NLP.GT.0)GO TO 139 00128030 TPI=6.2831852 00128040 READ(5,1002)FREQ,PHASE,BSN,CSN 00128050 WRITE(6,2010)FREQ,PHASE,BSN,CSN 00128060 1002 FORMAT(8F10.0) 00128070 2010 FORMAT(11X,27HSINUSOIDAL FORCING FUNCTION/ 00128080 & 15X,48HFUNCTION --((SFTR+BSN*TIME)*(EXP(CSN*TIME)))*SIN 00128090 & ,29H(2*PI*FREQ*TIME+PHASE*PI/180)/ 00128100 & 15X,10HFREQUENCY=,G12.5,6H HERTZ/ 00128110 & 15X,12HPHASE ANGLE=,F8.3,5H DEG./ 00128120 & 15X,4HBSN=,G13.5/15X,4HCSN=,G13.5) 00128130 FREQ=FREQ*TPI 00128140 PHASE=PHASE*TPI/360. 00128150 DO 132 J=1,NT 00128160 TIME=DT*FLOAT(J) 00128170 PP(I,J)=(SFTR+BSN*TIME)*DEXP(CSN*TIME)*DSIN(FREQ*TIME+PHASE) 00128180 132 CONTINUE 00128190 GO TO 210 00128200 139 CONTINUE 00128210 IF(SFTR.EQ.0.) SFTR=1.0 00128220 IF(NLP.LE.MAX) GO TO 140 00128230 L=2*(NLP-MAX) 00128240 CALL ERROR(L) 00128250 140 IU=5 00128260 IF(IFOR.EQ.2.OR.IFOR.EQ.3) IU=11 00128270 IF(IFOR.GT.0) READ (IU,265)(T(L),P(L),L=1,NLP) 00128280 IF(IFOR.EQ.0) READ(5, 270)(T(L),P(L),L=1,NLP) 00128290 IF(IFOR.NE.3) WRITE(6, 300)(T(L),P(L),L=1,NLP) 00128300 TIME=T(1) 00128310 TIMEP=TIME + DTA 00128320 L=1 00128330 K=1 00128340 150 L=L+1 00128350 DDT=T(L)-T(L-1) 00128360 DDP=P(L)-P(L-1) 00128370 IF(DDT) 160,150,170 00128380 160 WRITE (6,310) 00128390 170 SLOPE=DDP/DDT 00128400 180 IF (T(L)-TIME) 150,190,190 00128410 190 PP(I,K)=P(L-1)+(TIMEP-T(L-1))*SLOPE 00128420 PP(I,K)=PP(I,K)*SFTR 00128430 200 TIME=TIME+DT 00128440 TIMEP=TIME+DTA 00128450 K=K+1 00128460 IF (NT-K) 210,180,180 00128470 210 CONTINUE 00128480 IF (KSKIP.EQ.1)RETURN 00128490 MT=4 00128500 REWIND MT 00128510 LL=NF*NFN 00128520 DO 250 K=1,NF 00128530 DO 220 I=1,NT 00128540 220 PD(I)=0. 00128550 INC=(K-1)*NFN 00128560 DO 240 J=1,NAT 00128570 LT=AT(J)/DT + 1 00128580 N=0 00128590 DO 230 NN=LT,NT 00128600 N=N+1 00128610 DO 230 I=1,NFN 00128620 II=INC+I 00128630 230 PD(NN)=PD(NN) + A(II)*PP(I,N) 00128640 240 INC=INC+LL 00128650 250 WRITE (MT) PD 00128660 RETURN 00128670 260 FORMAT(I5,F10.0,12A5,I5) 00128680 265 FORMAT(6F12.0,8X) 00128690 270 FORMAT (12F6.0) 00128700 280 FORMAT (8F10.2) 00128710 290 FORMAT ( 26H1.... TIME FUNCTION NUMBER ,I2,6X,12HHEADING ... , 00128720 $ 12A5//6X,23HNUMBER OF LOAD POINTS = ,I4,/ 00128730 $ 6X,23HSCALE FACTOR..........= ,F30.7//) 00128740 300 FORMAT (5( 19H TIME INPUT )/(5(F10.6,F7.2,2X))) 00128750 310 FORMAT (15H0BAD LOAD DATA ) 00128760 320 FORMAT (//////14H DELAY TIMES //10X,7H DELAY / 00128770 $ 16H NUMBER TIME / (I6,F10.2)) 00128780 END 00128790 SUBROUTINE RESPON(W,P,X,NF,NT,NDS) 00208770 IMPLICIT REAL*8(A-H,O-Z) 00208780 REAL*8 KAP 00208790 DIMENSION W(NF),P(NT),X(NF,NDS,3) 00208800 COMMON / DYN / MT,NOT,XSI ,DT,RRDYN(3) R0208810 COMMON /JUNK/ BET,KAP,A(3,3),B(3),U(3),UO(3),RRJUNK(207) R0208820 REWIND 10 00208830 REWIND 4 00208840 READ (10)W 00208850 TH=1.4E0 00208860 DO 140 N=1,NF 00208870 READ (4) P 00208880 K=1 00208890 NOUT=NOT+1 00208900 BET = 1.E0 / (TH/(W(N)*W(N)*DT*DT) + XSI*TH*TH/(W(N)*DT) + TH*TH*T00208910 $H/6 ) 00208920 KAP=XSI*BET/(W(N)*DT) 00208930 A(1,1)=1.E0 - BET*TH*TH/3.E0 - 1.E0/TH - KAP*TH 00208940 A(2,1)=DT*(1.E0 - 1.E0/(2.E0*TH) - BET*TH*TH/6.E0 - KAP*TH/2.E0) 00208950 A(3,1)=DT*DT*(0.5E0 - 1.E0/(6.E0*TH) - BET*TH*TH/18.E0 - KAP*TH/6.00208960 $E0) 00208970 A(1,2)=(-BET*TH - 2.E0*KAP)/DT 00208980 A(2,2)=1.E0 - BET*TH/2.E0 - KAP 00208990 A(3,2)=DT*(1.E0 - BET*TH/6.E0 - KAP/3.E0) 00209000 A(1,3)=-BET/(DT*DT) 00209010 A(2,3)=-BET/(2.E0*DT) 00209020 A(3,3)=1.E0 - BET/6.E0 00209030 B(1)=BET/(W(N)*W(N)*DT*DT) 00209040 B(2)=BET/(2.E0*W(N)*W(N)*DT) 00209050 B(3)=BET/(6.E0*W(N)*W(N)) 00209060 DO 100 J=1,3 00209070 UO(J)=0.E0 00209080 100 U(J)=0.E0 00209090 UO(1)=P(1) 00209100 DO 140 I=2,NT 00209110 DO 110 L=1,3 00209120 U(L)=B(L)*P(I) 00209130 DO 110 LL=1,3 00209140 110 U(L)=U(L) + A(L,LL)*UO(LL) 00209150 DO 120 L=1,3 00209160 120 UO(L)=U(L) 00209170 IF(NOUT.NE.I) GO TO 140 00209180 DO 130 L=1,3 00209190 130 X(N,K,L)=U(L) 00209200 K=K+1 00209210 NOUT=NOUT+NOT 00209220 140 CONTINUE 00209230 REWIND 4 00209240 WRITE (4) X 00209250 RETURN 00209260 END 00209270 SUBROUTINE DSPLRS(ID,F,FI,X,NEQB,NF,NDS,NUMNP,NBLOCK,NSB,ISIR) 00064050 IMPLICIT REAL*8(A-H,O-Z) 00064060 REAL*8 ID 00064070 INTEGER*2 ISIR 00064080 DIMENSION ID(NUMNP,3),F(8,NF),FI(NSB ,NF),X(NF,NDS) 00064090 COMMON/JUNK/JJ, NP,IC(6),D(8),L, II,MSB,NS,NE,N,DDT,TIME, 00064100 $ M,J,K,MM,KD(3,8),DD,XUM,IEQ,NRD 00064110 $ ,DM(8),TM(8),RRJUNK(177) R0064120 COMMON / DYN / NT,NOT,DAMP,DT,RRDYN(3) R0064130 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0064140 COMMON /BAND/ KOPT,NRBAND(7) R0064150 COMMON /SSIT/ NV 00064160 DIMENSION ISIR(NUMNP) 00064170 DT=DT*NOT 00064180 1 READ (5,230) KKK,ISP,ISD,NEXT 00064190 IF(ISD.EQ.0)ISD=2 00064200 IF(KKK.EQ.0) RETURN 00064210 REWIND 9 00064220 REWIND 8 00064230 READ (8) ID 00064240 NT1=17 00064250 IF(KOPT.GT.0) REWIND NT1 00064260 IF(KSKIP.EQ.1) GO TO 5 00064270 IF(KOPT.GT.0) READ (NT1) 00064280 IF(KOPT.GT.0) READ (NT1) ISIR 00064290 5 CONTINUE 00064300 L=0 00064310 NUM = 0 00064320 WRITE (6,220) 00064330 100 READ (5,230) NP,IC 00064340 IF(NP.GT.0) WRITE(6,240)NP,IC 00064350 IF(NP.GT.0) GO TO 120 00064360 IF(L.EQ.0) GO TO 160 00064370 IF (KSKIP.EQ.1) GO TO 110 00064380 WRITE (9) KD,L 00064390 110 CONTINUE 00064400 NUM = NUM + 1 00064410 GO TO 160 00064420 120 DO 150 I=1,6 00064430 II=IC(I) 00064440 IF(II.EQ.0) GO TO 100 00064450 130 L=L+1 00064460 KD(1,L)=NP 00064470 N=NP 00064480 IF(KOPT.GT.0) NP=ISIR(N) 00064490 KD(2,L)=II 00064500 CALL UNPKID ( ID,NUMNP,W ,WX ,2,NP,II) 00064510 NP=N 00064520 NNN=W 00064530 KD(3,L)=NNN 00064540 IF(NNN.LE.0) L=L-1 00064550 IF(L.LT.8) GO TO 150 00064560 IF (KSKIP.EQ.1) GO TO 140 00064570 WRITE (9) KD,L 00064580 140 CONTINUE 00064590 NUM = NUM + 1 00064600 L=0 00064610 150 CONTINUE 00064620 GO TO 100 00064630 160 IF(NUM .EQ. 0) GO TO 205 00064640 WRITE (6,250) KKK,ISP 00064650 IF (KSKIP.EQ.1)RETURN 00064660 REWIND 3 00064670 REWIND 9 00064680 REWIND 10 00064690 READ (10) 00064700 NE=NSB 00064710 NS=NE+1-NEQB 00064720 DO 170 I=1,NBLOCK 00064730 READ (10)((FI(J,K),J=NS,NE),K=1,NF) 00064740 NS=NS-NEQB 00064750 170 NE=NE-NEQB 00064760 DO 190 N=1,NUM 00064770 READ (9) KD,L 00064780 DO 180 I=1,L 00064790 II=KD(3,I) 00064800 DO 180 J=1,NF 00064810 180 F(I,J)=FI(II,J) 00064820 190 WRITE (3) L,KD,F 00064830 200 CONTINUE 00064840 CALL DISPLY (X,F,NF,NDS,NUM,1,KKK,ISD,ISP) 00064850 205 IF(NEXT.NE.0)GO TO 1 00064860 210 RETURN 00064870 220 FORMAT (35H1DISPLACEMENT COMPONENTS FOR WHICH / 00064880 $ 26H TIME HISTORY IS REQUIRED // 00064890 $ 31H NODE DISPLACEMENT COMPONENTS /) 00064900 230 FORMAT (7I5) 00064910 240 FORMAT (I5,4X,6I3) 00064920 250 FORMAT (/16H OUTPUT TYPE....,I1/ 00064930 $ 16H PLOT SPACING...,I1) 00064940 END 00064950 SUBROUTINE STRSD1 (T ,SF,FI,X,NF,NSB,NDS,NEQB,NBLOCK,SA) 00280950 IMPLICIT REAL*8(A-H,O-Z) 00280960 REAL*8 NPAR 00280970 DIMENSION NUM(1),SF(8,NF),FI(NSB,NF),X(NF,NDS) 00280980 DIMENSION SA(1) 00280990 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00281000 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00281010 COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1,RRPREP(7) R0281020 COMMON / JUNK / N,NEL,IS(12),M,I,L,KS(3,8),II,K,J,SS,JJ 00281030 $ ,NUME,NE,NRJUNK(405) R0281040 COMMON /SSIT/ NV 00281050 NT1=1 00281060 READ (5,190) KKK,ISP 00281070 IF(KKK.EQ.0) RETURN 00281080 N=1 00281090 IF (KSKIP.EQ.1) GO TO 105 00281100 REWIND 10 00281110 READ (10) 00281120 NE=NSB 00281130 NS1=NE+1-NEQB 00281140 DO 100 I=1,NBLOCK 00281150 READ (10)((FI(J,K),J=NS1,NE),K=1,NF) 00281160 NS1=NS1-NEQB 00281170 100 NE=NE-NEQB 00281180 105 CONTINUE 00281190 CALL RDWRT(NT1,SA,1,6,JK) 00281200 REWIND 3 00281210 WRITE (6,210) 00281220 WRITE (6,220) 00281230 READ (5,190) NEL,IS 00281240 WRITE (6,200) NEL,IS 00281250 NUME=NUMEL+NUMEL2 00281260 L=0 00281270 NUM(N)=0 00281280 DO 170 M=1,NUME 00281290 IF (KSKIP.EQ.1) GO TO 110 00281300 CALL RDWRT(NT1,SA,NEMN,0,KOUNT) 00281310 110 CONTINUE 00281320 NS1=SA(KOUNT-1) 00281330 ND1=SA(KOUNT-2) 00281340 IF(NEL.NE.M) GO TO 170 00281350 IF(KSKIP.EQ.1) GO TO 155 00281360 DO 150 I=1,NS1 00281370 II=IS(I) 00281380 IF(II.EQ.0) GO TO 160 00281390 NPN=ND1+II 00281400 L=L+1 00281410 KS(1,L)=NEL 00281420 KS(2,L)=II 00281430 DO 140 K=1,NF 00281440 SS=0. 00281450 DO 130 J=1,ND1 00281460 NELM=NPN+(J-1)*NS1 00281470 JJ=SA(J) 00281480 IF(JJ) 130,130,120 00281490 120 SS = SS + SA(NELM)*FI(JJ,K) 00281500 130 CONTINUE 00281510 140 SF(L,K)=SS 00281520 IF(L.LT.8) GO TO 150 00281530 WRITE (3) L,KS,SF 00281540 L=0 00281550 NUM(N)=NUM(N) + 1 00281560 150 CONTINUE 00281570 155 CONTINUE 00281580 160 READ (5,190) NEL,IS 00281590 IF(NEL.GT.0) WRITE(6,200)NEL,IS 00281600 170 CONTINUE 00281610 IF(L.EQ.0) GO TO 180 00281620 IF (KSKIP.EQ.1) GO TO 180 00281630 WRITE (3) L,KS,SF 00281640 NUM(N)=NUM(N) + 1 00281650 180 CONTINUE 00281660 WRITE (6,230) KKK,ISP 00281670 IF (KSKIP.EQ.1)RETURN 00281680 NELTYP=1 00281690 CALL DISPLY (X,SF,NF,NDS,NUM,NELTYP,KKK,1,ISP) 00281700 RETURN 00281710 190 FORMAT (13I5) 00281720 200 FORMAT (I6,4X,12I3) 00281730 210 FORMAT (28H1STRESS COMPONENTS FOR WHICH / 00281740 $ 25H TIME HISTORY IS REQUIRED ) 00281750 220 FORMAT (/16H ELEMENT TYPE .. ,F4.2// 00281760 $ 38H ELEMENT DESIRED STRESS COMPONENTS ) 00281770 230 FORMAT (/16H OUTPUT TYPE....,I1/ 00281780 $ 16H PLOT SPACING...,I1) 00281790 END 00281800