Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1987-04-23 | 89.7 KB | 1,121 lines

SUBROUTINE STEP 00266470 IMPLICIT REAL*8 (A-H,O-Z) 00266480 COMMON /ELPAR/ XPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00266490 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00266500 COMMON /JUNK/ KK1,KK2,ISP1,ISP2,NSD,NSS,NBL,LAST,JUM(40), 00266510 $ NUA(100),DUM(1),NRJUNK(304) R0266520 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00266530 $NAT,NT,NOT,NRDYN2(9) R0266540 COMMON /MISC/ NBLOCK,NEQB,LL,NF,LB R0266550 COMMON/DYN4/KSET(3),NCWT,NRDYN4 R0266560 COMMON /OUT/MZ(2),NDIS,NROUT(7) R0266570 COMMON /EXTRA/ MODEX,NT8,N10SV,NT10,KEQB,NUMEX,T(10) 00266580 DIMENSION PT(7) 00266590 COMMON A(1) 00266600 CALL FILES(17) 00266610 PT(1) = T(9) 00266620 N1=1 00266630 NELTYP=1 00266640 N10SV=0 00266650 NT10=0 00266660 NDIS=0 00266670 IF(NCWT.GT.0) NDIS=14 00266680 IF(NDIS.GT.0) N10SV=-MZ(2) 00266690 IF(NDIS.GT.0.AND.N10SV.EQ.0) N10SV=1 00266700 IF(NDIS.GT.0) N10SV=1000000*N10SV+1000*N10SV+N10SV 00266710 IF(NDIS.GT.0) NT10=NDIS 00266720 IF(NAT.EQ.0) NAT=1 00266730 N2=N1+3*NUMNP 00266740 N3=N2+NEQ 00266750 N4=N3+NEQB 00266760 IF(N4.GT.MTOT) CALL ERROR (N4-MTOT) 00266770 IF(MODEX.EQ.0) 00266780 $CALL ADDMAS (A(N2),A(N3),NEQ,NEQB,NBLOCK) 00266790 IF(NFN.GE.1) GO TO 100 00266800 WRITE (6,250) 00266810 MODEX=1 00266820 100 N3=N1+NFN*NEQ 00266830 N4=N3+NFN*NEQ 00266840 IF(N4.GT.MTOT) CALL ERROR(N4-MTOT) 00266850 IF(N2+NUMNP.GT.MTOT) CALL ERROR(N2+NUMNP-MTOT) 00266860 CALL PLOAD (A(N1),A(N1),A(N3),NUMNP,NEQ,NFN,A(N2)) 00266870 IF(NGM.EQ.0) GO TO 110 00266880 IF(MODEX.EQ.0) 00266890 $CALL EMIDS (A(N1),A(N2),NUMNP,NEQ) 00266900 N2=N1+NEQ*NFN 00266910 N3=N2+NEQ*NFN 00266920 N4=N3+NEQ 00266930 N5=N4+NEQ 00266940 IF(N5.GT.MTOT) CALL ERROR (N5-MTOT) 00266950 CALL GROUND (A(N1),A(N2),A(N3),A(N4),NEQ,NFN) 00266960 110 N2=N1+NEQ*NFN 00266970 N3=N2+NEQ*NFN 00266980 N4=N3+NAT 00266990 IF(N4.GT.MTOT) CALL ERROR (N4-MTOT) 00267000 CALL INDLY (A(N1),A(N2),A(N3),NEQ,NFN,NAT,MAXD) 00267010 N2=N1+NFN 00267020 KN=2*NFN 00267030 CALL INTHIS (A(N1),A(N2),NFN,MXLP,KN) 00267040 N3=N2+KN*MXLP 00267050 N4=N3+NEQ 00267060 N5=N4+NFN*NEQ 00267070 N6=N5+NFN*NEQ 00267080 N7=N6+NEQ 00267090 IF(N7.GT.MTOT) CALL ERROR (N7-MTOT) 00267100 IF(MODEX.EQ.1) GO TO 120 00267110 CALL LOADV (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),NEQ,NFN,KN) 00267120 120 CALL SECOND (PT(2)) 00267130 N2=N1+NEQ 00267140 N3=N2+NEQ+1 00267150 N4=N2+3*NUMNP 00267160 IF(NUMNP+N4.GT.MTOT) CALL ERROR(NUMNP+N4-MTOT) 00267170 CALL INOUT (A(N1),A(N2),A(N2),NUMNP,A(N3),A(N4)) 00267180 CALL SECOND (PT(3)) 00267190 N2 = N1+NSD 00267200 N3 = N2+NSS 00267210 N4 = N3+NEQ 00267220 IF(MODEX.EQ.1) GO TO 130 00267230 REWIND 3 00267240 MM = N4-1 00267250 READ (3) (A(K),K=N3,MM) 00267260 130 CONTINUE 00267270 K1 = NEQB*(2*MBAND+1)+MBAND+N4 00267280 K2 = 4*NEQ+NSD+NSS+NEQB*(MBAND+1)+MBAND+N4 00267290 K = K1 00267300 IF(K2.GT.K1) K = K2 00267310 IF(K.GT.MTOT) 00267320 $CALL ERROR (K-MTOT) 00267330 NTB = (MBAND-2)/NEQB +1 00267340 IF(NTB.GE.NBLOCK) NTB = NBLOCK -1 00267350 WRITE (6,240) NEQ,MBAND,NEQB,NBLOCK,NTB 00267360 MI = NEQB+MBAND-1 00267370 NWA = NEQB*MBAND 00267380 N6=N4+NWA 00267390 N5=N6+MI 00267400 N7=N5+NWA 00267410 IF(N7.GT.MTOT) CALL ERROR (N7-MTOT) 00267420 IF(MODEX.EQ.1) GO TO 140 00267430 CALL TRIFAC (A(N4),A(N5),A(N6),NEQB,MBAND,NBLOCK,NWA,NTB,NEQ,MI) 00267440 140 CALL SECOND (PT(4)) 00267450 N5 = N4+NEQ 00267460 N6 = N5+NEQ 00267470 N7 = N6+NEQ 00267480 N8 = N7+NEQ 00267490 N9 = N8+NWA 00267500 N10= N9+MI 00267510 MM = MTOT-N10 00267520 NN = NSD+NSS 00267530 IF(NN.GT.MM) CALL ERROR (NN-MM) 00267540 MM = MM/NN 00267550 NPT = NT/NOT 00267560 IF(MM.GT.NPT) MM=NPT 00267570 N11= N10+MM*NSD 00267580 IF(MODEX.EQ.1) GO TO 150 00267590 CALL SOLSTP (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),A(N7),A(N8), 00267600 $ A(N9),A(N10),A(N11),NSD,NSS,NEQ,NEQB,MBAND,NWA,MI, 00267610 $ MM,NBLOCK) 00267620 150 CALL SECOND (PT(5)) 00267630 REWIND 9 00267640 IF(MODEX.EQ.1) GO TO 180 00267650 DT = FLOAT(NOT)* DT 00267660 IF(NPT.LT.1) GO TO 180 00267670 NBL = (NPT-1)/MM +1 00267680 IF(NSD.LT.1) GO TO 180 00267690 NUM = (NSD-1)/8 +1 00267700 IF(NBL.EQ.1) GO TO 160 00267710 N2 = N1+MM*NSD 00267720 MREM = MTOT-N2 00267730 MMX = MREM/NSD 00267740 MMX = MMX/MM 00267750 MMX = MMX*MM 00267760 K = NBL*MM 00267770 IF(MMX.GT.K) MMX = K 00267780 NK = 2*MM 00267790 IF(MMX.GE.NK) GO TO 170 00267800 160 CONTINUE 00267810 N2 = N1 00267820 MMX= MM 00267830 170 CALL SDSPLY (A(N1),A(N2),MMX,MM,NSD,NUM,1,KK1,2,ISP1,NPT,4) 00267840 180 CALL SECOND(PT(6)) 00267850 IF(MODEX.EQ.1) GO TO 210 00267860 IF(NPT.LT.1) GO TO 210 00267870 IF(NSS.LT.1) GO TO 210 00267880 IF(NBL.EQ.1) GO TO 190 00267890 N2 = N1+MM*NSS 00267900 MREM = MTOT-N2 00267910 MMX = MREM/NSS 00267920 MMX = MMX/MM 00267930 MMX = MMX*MM 00267940 K = NBL*MM 00267950 IF(MMX.GT.K) MMX = K 00267960 NK = 2*MM 00267970 IF(MMX.GT.NK) GO TO 200 00267980 190 CONTINUE 00267990 N2 = N1 00268000 MMX= MM 00268010 200 CALL SDSPLY (A(N1),A(N2),MMX,MM,NSS,NUA,NELTYP,KK2,1,ISP2,NPT,10) 00268020 210 CALL SECOND (PT(7)) 00268030 DUM(1) = 0.0E0 00268040 DO 220 I=1,6 00268050 PT(I) = PT(I+1)-PT(I) 00268060 220 DUM(1) = DUM(1)+PT(I) 00268070 PT(7) = DUM(1) 00268080 WRITE (6,230) PT 00268090 230 FORMAT (41H1T I M E L O G (PARTICULAR SOLUTION), // 00268100 $ 5X,29HFORM DYNAMIC LOADS =,F9.2 / 00268110 $ 5X,29HPROCESS OUTPUT REQUESTS =,F9.2 / 00268120 $ 5X,29HMATRIX DECOMPOSITION =,F9.2 / 00268130 $ 5X,29HSTEP-BY-STEP INTEGRATION =,F9.2 / 00268140 $ 5X,29HDISPLACEMENT OUTPUT =,F9.2 / 00268150 $ 5X,29HELEMENT STRESS OUTPUT =,F9.2 // 00268160 $ 5X,29HTOTAL STEP-BY-STEP ANALYSIS =,F9.2 //// 1X) 00268170 240 FORMAT (38H1E Q U A T I O N P A R A M E T E R S, // 00268180 $ 5X,33HTOTAL NUMBER OF EQUATIONS =, I5 / 00268190 $ 5X,33H1/2 EQUATION BANDWIDTH =, I5 / 00268200 $ 5X,33HNUMBER OF EQUATIONS PER BLOCK =, I5 / 00268210 $ 5X,33HTOTAL NUMBER OF EQUATION BLOCKS =, I5 / 00268220 $ 5X,33HNUMBER OF COUPLING BLOCKS =, I5 // 1X) 00268230 250 FORMAT (42H0*** ERROR NO DYNAMIC FUNCTIONS (INPUTS), / 1X) 00268240 RETURN 00268250 END 00268260 SUBROUTINE ADDMAS (TMASS,BLKMAS,NEQ,NEQB,NBLOCK) 00010850 IMPLICIT REAL*8 (A-H,O-Z) 00010860 DIMENSION TMASS(NEQ),BLKMAS(NEQB) 00010870 NT3 = 3 00010880 REWIND NT3 00010890 NT9 = 9 00010900 REWIND NT9 00010910 KSHIFT = 0 00010920 DO 110 K=1,NBLOCK 00010930 READ (NT9) BLKMAS 00010940 K1 = KSHIFT 00010950 DO 100 L=1,NEQB 00010960 K1 = K1+1 00010970 IF(K1.GT.NEQ) GO TO 120 00010980 TMASS(K1) = BLKMAS(L) 00010990 100 CONTINUE 00011000 KSHIFT = KSHIFT+NEQB 00011010 110 CONTINUE 00011020 120 WRITE (NT3) TMASS 00011030 RETURN 00011040 END 00011050 SUBROUTINE PLOAD(ID,FF,IFF,NUMNP,NEQ,NFN,ISIR) 00169970 IMPLICIT REAL*8 (A-H,O-Z) 00169980 INTEGER*2 ISIR 00169990 REAL*8 ID 00170000 COMMON /EXTRA/ MODEX,NT8,NREXTR(24) R0170010 DIMENSION ISIR(NUMNP) 00170020 COMMON /BAND/ KOPT,NRBAND(7) R0170030 DIMENSION ID(NUMNP,3),FF(NEQ,NFN),IFF(NEQ,NFN) 00170040 RDN=0.01745329251 00170050 NT=2 00170060 REWIND NT 00170070 REWIND 8 00170080 KT=10 00170090 LT=17 00170100 MT=18 00170110 REWIND MT 00170120 IF(MODEX.EQ.1) GO TO 5 00170130 IF(KOPT.GT.0) REWIND LT 00170140 IF(KOPT.GT.0) READ(LT) 00170150 IF(KOPT.GT.0) READ (LT) ISIR 00170160 5 CONTINUE 00170170 WRITE(6,220) 00170180 KOUNT=0 00170190 50 READ(5,60)NP,IC,IFN,IAT,P,THET,PHI,KN 00170200 60 FORMAT(4I5,3F10.0,I5) 00170210 ICI=IC 00170220 IF(IAT.EQ.0)IAT=1 00170230 DPH=0.0 00170240 DTH=0.0 00170250 DP =0.0 00170260 I=1 00170270 IF(KN.EQ.0) GO TO 80 00170280 IF(MOD((NP-NPL),KN).NE.0) KN=0 00170290 IF(KN.EQ.0) MODEX=1 00170300 IF(KN.EQ.0) WRITE(6,20)NP 00170310 20 FORMAT(/20X,45HTHE GENERATION PARAMETER IS INCORRECT ON NODE,I5/) 00170320 IF(KN.EQ.0) GO TO 80 00170330 I=(NP-NPL)/KN 00170340 DTH=(THET-THETL)/I 00170350 DPH=(PHI-PHIL)/I 00170360 DP=(P-PL)/I 00170370 NP=NPL 00170380 THET=THETL 00170390 PHI=PHIL 00170400 P= PL 00170410 80 DO 90 J=1,I 00170420 NP=NP+KN 00170430 IF(NP.LE.0) GO TO 100 00170440 IF(NP.LE.NUMNP) GO TO 81 00170450 WRITE(6,250)NP 00170460 MODEX=1 00170470 GO TO 50 00170480 81 CONTINUE 00170490 IF(IC.GT.0.AND.IC.LT.7) GO TO 82 00170500 WRITE(6,260)IC 00170510 MODEX=1 00170520 GO TO 50 00170530 82 CONTINUE 00170540 IF(IFN.GT.0.AND.IFN.LE.NFN) GO TO 83 00170550 WRITE(6,270)IFN 00170560 MODEX=1 00170570 83 CONTINUE 00170580 P=P+DP 00170590 PHI=PHI+DPH 00170600 THET=THET+DTH 00170610 K=1 00170620 KI=1 00170630 IF(THET.NE.0.0.OR.PHI.NE.0.0) K=3 00170640 IF(THET.NE.0.0.AND.PHI.EQ.90.0) K=2 00170650 IF(THET.EQ.90.0.AND.PHI.NE.0.0) KI=2 00170660 DO 90 L=KI,K 00170670 IF(L.EQ.1) PX=P*DSIN(PHI*RDN)*DCOS(THET*RDN) 00170680 IF(L.EQ.2) PX=P*DSIN(PHI*RDN)*DSIN(THET*RDN) 00170690 IF(L.EQ.3) PX=P*DCOS(PHI*RDN) 00170700 IF(K.EQ.1) PX=P 00170710 IC=ICI 00170720 IF(K.NE.1) IC=L 00170730 WRITE(6,230)NP,IC,IFN,IAT,PX 00170740 NODE=NP 00170750 IF(KOPT.GT.0) NODE=ISIR(NP) 00170760 KOUNT=KOUNT+1 00170770 WRITE (MT) NODE,IC,IFN,IAT,PX 00170780 90 CONTINUE 00170790 THETL=THET 00170800 PHIL=PHI 00170810 PL=P 00170820 NPL=NP 00170830 GO TO 50 00170840 100 IF(KOUNT.EQ.0) GO TO 116 00170850 IF(MODEX.EQ.1) RETURN 00170860 READ (8) ID 00170870 REWIND MT 00170880 REWIND KT 00170890 DO 110 I=1,KOUNT 00170900 READ (MT) NODE,IC,IFN,IAT,P 00170910 CALL UNPKID(ID,NUMNP,W,WX,2,NODE,IC) 00170920 IC=W 00170930 IF(IC.GT.0) GO TO 110 00170940 WRITE(6,115)NODE 00170950 110 WRITE (KT) IC,IFN,IAT,P 00170960 115 FORMAT(/20X,4HNODE,I5,35H WAS GIVEN A LOAD ON A DOF THAT WAS, 00170970 $11HCONSTRAINED/20X,40HIF THE GEOMETRY HAS BEEN RENUMBERED, THE, 00170980 $36H NODE NO. IS THE RENUMBERED NODE NO.//) 00170990 IF(MODEX.EQ.1) RETURN 00171000 116 CONTINUE 00171010 NNN=NEQ*NFN 00171020 CALL MEMSET(0.0E0,FF(1,1),NNN) 00171030 DO 120 I=1,NEQ 00171040 DO 120 J=1,NFN 00171050 120 IFF(I,J)=1 00171060 IF(KOUNT.EQ.0) GO TO 150 00171070 REWIND KT 00171080 DO 140 I=1,KOUNT 00171090 READ (KT) IC,IFN,IAT,P 00171100 FF(IC,IFN)=P 00171110 140 IFF(IC,IFN)=IAT 00171120 150 CONTINUE 00171130 WRITE (NT) FF,IFF 00171140 REWIND 8 00171150 READ (8) ID 00171160 RETURN 00171170 210 FORMAT (4I5,F10.2) 00171180 220 FORMAT (36H1D Y N A M I C L O A D I N P U T, // 3X,4HNODE,3X, 00171190 $ 9HDEGREE OF,3X,8HFUNCTION,3X,12HARRIVAL TIME,5X, 00171200 $ 8HFUNCTION,/ 7H NUMBER,5X,7HFREEDOM,2X,9HREFERENCE,9X, 00171210 $ 6HNUMBER,3X,10HMULTIPLIER, / 1X) 00171220 230 FORMAT (I7,7X,I5,6X,I5,10X,I5,E13.4) 00171230 240 FORMAT (46H0*** ERROR LOAD APPLIED TO A CONSTRAINED DOF, / 00171240 $ 13X,6HNODE (,I5,14H) COMPONENT (,I5,1H), / 1X) 00171250 250 FORMAT (19H0*** ERROR NODE (,I5,15H) OUT OF RANGE., / 1X) 00171260 260 FORMAT (24H0*** ERROR COMPONENT (,I5,13H) IS ILLEGAL., / 1X) 00171270 270 FORMAT (33H0*** ERROR FUNCTION REFERENCE (,I5,9H) IS BAD., / 1X)00171280 END 00171290 SUBROUTINE EMIDS(ID,MASS,NUMNP,NEQ) 00086030 IMPLICIT REAL*8 (A-H,O-Z) 00086040 REAL*8 ID 00086050 REAL*8 MASS 00086060 DIMENSION ID(NUMNP,3),MASS(NEQ) 00086070 NT=10 00086080 REWIND NT 00086090 DO 50 N=1,NEQ 00086100 50 MASS(N)=0.0D0 00086110 DO 130 N=1,NUMNP 00086120 DO 120 I=1,3 00086130 CALL UNPKID(ID,NUMNP,W,WX,2,N,I) 00086140 NN=W 00086150 IF(NN.LE.0) GO TO 120 00086160 MASS(NN)=I 00086170 120 CONTINUE 00086180 130 CONTINUE 00086190 WRITE (NT) MASS 00086200 RETURN 00086210 END 00086220 SUBROUTINE GROUND (FF,IFF,XM,MASS,NEQ,NFN) 00109960 IMPLICIT REAL*8 (A-H,O-Z) 00109970 REAL*8 MASS 00109980 COMMON /JUNK/ JFN(3),JAT(3),RRJUNK(224) R0109990 COMMON /EXTRA/ MODEX,NT8,NREXTR(24) R0110000 DIMENSION FF(NEQ,NFN),IFF(NEQ,NFN),XM(NEQ),MASS(NEQ) 00110010 IF(MODEX.EQ.1) GO TO 100 00110020 NT=3 00110030 IT=2 00110040 KT=10 00110050 REWIND NT 00110060 REWIND KT 00110070 REWIND IT 00110080 100 READ (5,140) JFN,JAT 00110090 DO 120 I=1,3 00110100 IF(JAT(I)) 110,110,120 00110110 110 JAT(I)=1 00110120 120 CONTINUE 00110130 WRITE (6,150) JFN,JAT 00110140 IF(MODEX.EQ.1) RETURN 00110150 READ (KT) MASS 00110160 READ (NT) XM 00110170 READ (IT) FF,IFF 00110180 REWIND IT 00110190 DO 130 I=1,NEQ 00110200 J=MASS(I) 00110210 IF(J.EQ.0) GO TO 130 00110220 JJ=JFN(J) 00110230 IF(JJ.LE.0) GO TO 130 00110240 FF(I,JJ) =-XM(I) 00110250 IFF(I,JJ)=JAT(J) 00110260 130 CONTINUE 00110270 WRITE (IT) FF,IFF 00110280 RETURN 00110290 140 FORMAT (6I5) 00110300 150 FORMAT (38H1G R O U N D M O T I O N I N P U T, // 21X, 00110310 $ 9HDIRECTION, / 21X,1HX,3X,1HY,3X,1HZ, / 00110320 $ 19H FUNCTION NUMBERS =, I3,2I4 / 00110330 $ 19H ARRIVAL TIMES =, I3,2I4 // 1X) 00110340 END 00110350 SUBROUTINE INDLY (FF,IFF,AT,NEQ,NFN,NAT,MAXD) 00114500 IMPLICIT REAL*8 (A-H,O-Z) 00114510 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,RRDYN2(9) R0114520 COMMON /EXTRA/ MODEX,NT8,NREXTR(24) R0114530 DIMENSION FF(NEQ,NFN),IFF(NEQ,NFN),AT(NAT) 00114540 IF(MODEX.EQ.1) GO TO 100 00114550 KT=2 00114560 REWIND KT 00114570 100 READ (5,140) ( AT(I),I=1,NAT) 00114580 WRITE (6,150) (I,AT(I),I=1,NAT) 00114590 MAXD=0 00114600 IF(MODEX.EQ.1) RETURN 00114610 DO 110 I=1,NAT 00114620 110 AT(I)=AT(I)/DT 00114630 READ (KT) FF,IFF 00114640 REWIND KT 00114650 DO 130 NF=1,NFN 00114660 DO 120 N=1,NEQ 00114670 J=IFF(N,NF) 00114680 JAT=AT(J) 00114690 IF((AT(J)-JAT).GE.0.5E0) JAT=JAT+1 00114700 JAT=JAT+1 00114710 IF(JAT.GT.MAXD) MAXD=JAT 00114720 120 IFF(N,NF) = JAT 00114730 130 CONTINUE 00114740 WRITE (KT) FF,IFF 00114750 RETURN 00114760 140 FORMAT (8F10.2) 00114770 150 FORMAT (//// 38H A R R I V A L T I M E V A L U E S, // 00114780 $ 6H INPUT,5X,12HARRIVAL TIME,/ 6H ORDER,12X,5HVALUE, // 00114790 $ (I6,E17.4) ) 00114800 END 00114810 SUBROUTINE INTHIS (NLP,P,NFN,MXLP,KN) 00120450 IMPLICIT REAL*8 (A-H,O-Z) 00120460 DIMENSION NLP(NFN),P(KN,1) 00120470 COMMON /ELPAR/ XPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00120480 & ,RRELPA(24) R0120481 COMMON /JUNK/ HED(8),RRJUNK(219) R0120490 COMMON /EXTRA/ MODEX,NT8,NREXTR(24) R0120500 MXLP=0 00120510 NF=1 00120520 WRITE (6,180) 00120530 100 NF2=2*NF 00120540 NF1=NF2-1 00120550 READ(5,140)NLP(NF),SFTR,HED,IFOR 00120560 IF( DABS(SFTR).LT.1.0D-8) SFTR = 1.0D0 00120570 IF(NLP(NF).GT.MXLP) MXLP = NLP(NF) 00120580 WRITE (6,160) NF,NLP(NF),SFTR,HED 00120590 N3 = N2+KN*MXLP 00120600 IF(N3.GT.MTOT) CALL ERROR (N3-MTOT) 00120610 NN=NLP(NF) 00120620 IU=5 00120630 IF(IFOR.EQ.2.OR.IFOR.EQ.3) IU=11 00120640 IF(IFOR.GT.0) READ(IU, 145)(P(NF1,L),P(NF2,L),L=1,NN) 00120650 IF(IFOR.EQ.0) READ(5,150)(P(NF1,L),P(NF2,L),L=1,NN) 00120660 IF(IFOR.NE.3) WRITE(6, 170)(L,P(NF1,L),P(NF2,L),L=1,NN) 00120670 IF(MODEX.EQ.1) GO TO 120 00120680 DO 110 K=1,NN 00120690 110 P(NF2,K) = P(NF2,K)* SFTR 00120700 120 IF( DABS(P(NF1,1)) .LT. 1.0D-8) GO TO 130 00120710 WRITE (6,190) NF 00120720 MODEX=1 00120730 130 CONTINUE 00120740 NF=NF+1 00120750 IF(NF.LE.NFN) GO TO 100 00120760 RETURN 00120770 140 FORMAT(I5,F10.0,8A8,I1) 00120780 145 FORMAT(6F12.0,8X) 00120790 150 FORMAT (12F6.0) 00120800 160 FORMAT (// 26H TIME FUNCTION NUMBER = (,I3,1H), // 00120810 $ 5X,21HNUMBER OF POINTS = (, I3, 1H), / 00120820 $ 5X,21HSCALE FACTOR = (,E12.4, 1H), / 00120830 $ 5X,21HDESCRIPTION = (, 8A8, 1H), // 00120840 $ 8X,5HINPUT,8X,4HTIME,4X,8HFUNCTION, / 8X,5HORDER, 00120850 $ 2(7X,5HVALUE), / 1X) 00120860 170 FORMAT (8X,I5,2E12.4) 00120870 180 FORMAT (36H1T I M E F U N C T I O N D A T A, / 1X) 00120880 190 FORMAT (30H0*** ERROR FUNCTION NUMBER (,I4,10H) DOES NOT, 00120890 $ 20H BEGIN AT TIME ZERO., / 1X) 00120900 END 00120910 SUBROUTINE INOUT (IDIS,ID,ISTR,NUMNP,SA,ISIR) 00116550 IMPLICIT REAL*8 (A-H,O-Z) 00116560 INTEGER*2 ISIR 00116570 REAL*8 IDIS,ISTR 00116580 REAL*8 ID 00116590 DIMENSION IDIS(1),ID(NUMNP,3),ISTR(1) 00116600 DIMENSION SA(1) 00116610 DIMENSION ISIR(NUMNP) 00116620 COMMON /BAND/ KOPT,NRBAND(7) R0116630 COMMON /JUNK/ KK1,KK2,ISP1,ISP2,NSD,NSS,IC(6),KD(2,8),IS(12), 00116640 $ MUM(8),NUM(100),RRJUNK(153) R0116650 COMMON /ELPAR/ XPAR(14),IDUM1,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00116660 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00116670 COMMON /QTSARG/ SSA(8,60),KLM(8,60),RRQTSA(280) R0116680 COMMON /EXTRA/ MODEX,NT8,NREXTR(24) R0116690 NT1=1 00116700 CALL RDWRT(NT1,SA,1,6,J) 00116710 REWIND 8 00116720 REWIND 9 00116730 IF(MODEX.EQ.1) GO TO 5 00116740 LT=17 00116750 IF(KOPT.GT.0) REWIND LT 00116760 IF(KOPT.GT.0) READ(LT) 00116770 IF(KOPT.GT.0) READ (LT) (ISIR(II),II=1,NUMNP) R0116780 5 CONTINUE 00116790 READ (8) ID 00116800 REWIND 8 00116810 100 L=0 00116820 K=0 00116830 WRITE (6,300) 00116840 READ (5,320) KK1,ISP1 00116850 WRITE (6,360) KK1,ISP1 00116860 WRITE (6,310) 00116870 110 READ (5,320) NP,IC 00116880 IF(NP.GT.0) WRITE(6,330)NP,IC 00116890 IF(NP.GT.0) GO TO 120 00116900 IF(L.EQ.0) GO TO 180 00116910 IF(MODEX.EQ.0) 00116920 $WRITE (9) KD,L 00116930 GO TO 180 00116940 120 IF(NP.LE.NUMNP) GO TO 140 00116950 WRITE (6,130) NP 00116960 130 FORMAT (19H0*** ERROR NODE (,I5,15H) IS TOO LARGE., / 1X) 00116970 MODEX=1 00116980 140 DO 170 I=1,6 00116990 II=IC(I) 00117000 IF(II.EQ.0 .OR. II.GT.6) GO TO 110 00117010 K=K+1 00117020 L=L+1 00117030 KD(1,L)=NP 00117040 N=NP 00117050 IF(KOPT.GT.0) NP=ISIR(N) 00117060 KD(2,L)=II 00117070 CALL UNPKID(ID,NUMNP,W,WX,2,NP,II) 00117080 NP=N 00117090 JJ=W 00117100 IF(JJ.GT.0) GO TO 150 00117110 L = L-1 00117120 K=K-1 00117130 GO TO 160 00117140 150 IDIS(K)=JJ 00117150 160 IF(L.LT.8) GO TO 170 00117160 IF(MODEX.EQ.0) 00117170 $WRITE (9) KD,L 00117180 L=0 00117190 170 CONTINUE 00117200 GO TO 110 00117210 180 NSD=K 00117220 WRITE (6,340) 00117230 READ (5,320) KK2,ISP2 00117240 WRITE (6,360) KK2,ISP2 00117250 K = 1 00117260 ISTR(1) = 0 00117270 N=1 00117280 WRITE(6,350) 00117290 READ (5,320) NEL,IS 00117300 IF(NEL.GT.0) WRITE(6,330)NEL,IS 00117310 NUME=NUMEL+NUMEL2 00117320 L=0 00117330 NUM(N)=0 00117340 MTYPL=0 00117350 NDL=0 00117360 DO 250 M=1,NUME 00117370 IF(MODEX.EQ.0) 00117380 $CALL RDWRT(NT1,SA,NEMN,0,KOUNT) 00117390 IF(NEL.NE.M) GO TO 250 00117400 MTYPE=SA(KOUNT) 00117410 IF(MTYPE.EQ.7.AND.M.LE.NUMEL) GO TO 240 00117420 NS=SA(KOUNT-1) 00117430 ND=SA(KOUNT-2) 00117440 IF(L.EQ.0) GO TO 190 00117450 IF(MTYPL.EQ.MTYPE.AND.ND.EQ.NDL) GO TO 190 00117460 WRITE (9) KD,L 00117470 WRITE (8)NDL,((SSA(II,JJ),II=1,8),JJ=1,NDL), 00117480 $ ((KLM(II,JJ),II=1,8),JJ=1,NDL),MTYPL 00117490 L=0 00117500 NUM(N) = NUM(N) + 1 00117510 190 CONTINUE 00117520 MTYPL=MTYPE 00117530 NDL=ND 00117540 KS = NS 00117550 IF(KS.GT.12) KS = 12 00117560 DO 230 I=1,KS 00117570 II=IS(I) 00117580 IF(II.EQ.0) GO TO 240 00117590 IF(II.GT.NS) GO TO 230 00117600 L=L+1 00117610 KD(1,L)=NEL 00117620 KD(2,L)=II 00117630 NPN=ND+II 00117640 DO 210 J=1,ND 00117650 NELM=NPN+(J-1)*NS 00117660 IF(MODEX.EQ.0) 00117670 $SSA(L,J) = SA(NELM) 00117680 KLM(L,J)=0 00117690 JJ=SA(J) 00117700 IF(JJ.LE.0) GO TO 210 00117710 DO 200 NK=1,K 00117720 ISTRNK=ISTR(NK) 00117730 IF(ISTRNK .NE.JJ) GO TO 200 00117740 KLM(L,J)=NK 00117750 GO TO 210 00117760 200 CONTINUE 00117770 ISTR(K)=JJ 00117780 KLM(L,J)=K 00117790 K=K+1 00117800 ISTR(K)=0 00117810 210 CONTINUE 00117820 IF(L.LT.8) GO TO 230 00117830 IF(MODEX.EQ.1) GO TO 220 00117840 WRITE (9) KD,L 00117850 WRITE (8) ND,((SSA(II,JJ),II=1,8),JJ=1,ND), 00117860 $ ((KLM(II,JJ),II=1,8),JJ=1,ND),MTYPE 00117870 220 L=0 00117880 NUM(N)=NUM(N)+1 00117890 230 CONTINUE 00117900 240 READ (5,320) NEL,IS 00117910 IF(NEL.GT.0) WRITE(6,330)NEL,IS 00117920 IF(NEL.EQ.0) GO TO 260 00117930 250 CONTINUE 00117940 260 CONTINUE 00117950 IF(L.EQ.0) GO TO 280 00117960 IF(MODEX.EQ.1) GO TO 270 00117970 WRITE (9) KD,L 00117980 WRITE (8) ND,((SSA(II,JJ),II=1,8),JJ=1,ND), 00117990 $ ((KLM(II,JJ),II=1,8),JJ=1,ND),MTYPE 00118000 270 NUM(N) = NUM(N) + 1 00118010 280 CONTINUE 00118020 NSS=K-1 00118030 IF(NSS.LT.1) RETURN 00118040 DO 290 L=1,NSS 00118050 J = NSD+L 00118060 290 IDIS(J) = ISTR(L) 00118070 RETURN 00118080 300 FORMAT (44H1D I S P L A C E M E N T C O M P O N E N T,3X, 00118090 $ 29HO U T P U T R E Q U E S T S, // 1X) 00118100 310 FORMAT (4X,4HNODE,2X,22HDISPLACEMENT COMPONENT, / 2X,6HNUMBER, 00118110 $ 6(3X,1H*), / 1X) 00118120 320 FORMAT (13I5) 00118130 330 FORMAT (I8,12I4) 00118140 340 FORMAT (46H1S T R E S S C O M P O N E N T O U T P U T,3X, 00118150 $ 15HR E Q U E S T S, // 1X) 00118160 350 FORMAT (// 00118170 $ 8H ELEMENT,9X,33HDESIRED ELEMENT STRESS COMPONENTS, / 00118180 $ 8H NUMBER,12(3X,1H*), / 1X) 00118190 360 FORMAT (// 25H CODE FOR OUTPUT TYPE =, I2 / 00118200 $ 3X,19HEQ.1, HISTORY TABLE, / 00118210 $ 3X,18HEQ.2, PRINTER PLOT, / 00118220 $ 3X,17HEQ.3, MAXIMA ONLY, / 00118230 $ 25H PRINTER PLOT SPACING =, I2 / 1X) 00118240 END 00118250 SUBROUTINE LOADV (NLP,P,B,FF,IFF,LDOF,NEQ,NFN,KN) 00128800 IMPLICIT REAL*8 (A-H,O-Z) 00128810 DIMENSION NLP(NFN),P(KN,1),B(NEQ),FF(NEQ,NFN),IFF(NEQ,NFN), 00128820 $ LDOF(NEQ) 00128830 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFX,NGM, 00128840 $NAT,NT,NOT,MIND,TLAST,NRDYN2(6) R0128850 COMMON /EXTRA/ MODEX,NREXTR(25) R0128860 KT=2 00128870 REWIND KT 00128880 READ (KT) FF,IFF 00128890 REWIND KT 00128900 TETA=1.4E0 00128910 DEL=TETA*DT-DT 00128920 IF(MIND.GT.0)DEL=0.0D0 00128930 KLOAD = 0 00128940 DO 110 K=1,NEQ 00128950 B(K) = 0.0E0 00128960 DUM = 0.0E0 00128970 IDUM = 0 00128980 DO 100 I=1,NFN 00128990 IF(IFF(K,I).GT.NT) GO TO 100 00129000 IDUM = IDUM +1 00129010 100 DUM = DUM + DABS(FF(K,I)) 00129020 IF(DUM.LT.1.0E-8) GO TO 110 00129030 IF(IDUM.LT.1) GO TO 110 00129040 KLOAD = KLOAD +1 00129050 LDOF(KLOAD) = K 00129060 110 CONTINUE 00129070 IF(KLOAD.GT.0) GO TO 130 00129080 WRITE (6,120) 00129090 120 FORMAT (32H0*** ERROR SOLUTION TERMINATED, / 00129100 $ 13X,35HNO FORCES APPLIED TO THE STRUCTURE., / 1X) 00129110 MODEX=1 00129120 RETURN 00129130 130 CONTINUE 00129140 TT = 0.0E0 00129150 DO 200 KK=1,NT 00129160 TT = TT+DT 00129170 DO 190 KD=1,KLOAD 00129180 KEQ = LDOF(KD) 00129190 B(KEQ) = 0.0E0 00129200 DO 180 KF=1,NFN 00129210 IF( DABS(FF(KEQ,KF)).LT.1.0D-8) GO TO 180 00129220 I = IFF(KEQ,KF) -1 00129230 IF(I.GT.KK) GO TO 180 00129240 TR = TT - FLOAT(I)* DT 00129250 J = NLP(KF) 00129260 TF = P(2*KF-1,J) 00129270 IF(TF.LT.TR) GO TO 180 00129280 NF2 = 2*KF 00129290 NF1 = NF2-1 00129300 DO 160 L=2,J 00129310 IF(TR.GT.P(NF1,L)) GO TO 160 00129320 RT = P(NF1,L)-P(NF1,L-1) 00129330 IF(RT.GT.1.0E-8) GO TO 150 00129340 M = L-1 00129350 WRITE (6,140) M,L,KF 00129360 140 FORMAT (53H0*** ERROR ZERO OR NEGATIVE TIME DIFFERENCE BETWEEN, 00129370 $ 9H POINTS (,I3,7H) AND (,I3,1H), / 13X,8HFUNCTION, 00129380 $ 9H NUMBER (,I3,1H), / 1X) 00129390 MODEX=1 00129400 RETURN 00129410 150 RF = P(NF2,L)-P(NF2,L-1) 00129420 FV = P(NF2,L-1) + (TR-P(NF1,L-1)+DEL)* RF/ RT 00129430 IF(MIND.EQ.0) GO TO 170 00129440 IF(FV.EQ.0.0)FV=1.0D-14 00129450 GO TO 170 00129460 160 CONTINUE 00129470 170 B(KEQ) = B(KEQ) + FF(KEQ,KF)* FV 00129480 180 CONTINUE 00129490 190 CONTINUE 00129500 WRITE (KT) (B(II),II=1,NEQ) R0129510 200 CONTINUE 00129520 RETURN 00129530 END 00129540 SUBROUTINE TRIFAC (A,B,MAXA,NEQB,MA,NBLOCK,NWA,NTB,NEQ,MI) 00314610 IMPLICIT REAL*8 (A-H,O-Z) 00314620 REAL*8 MAXA 00314630 DIMENSION A(NWA),B(NWA),MAXA(MI) 00314640 DIMENSION ICOO(10),IFORM(4) 00314650 COMMON /TAPES/ NSTIF,NRED,NL,NR,NT,NMASS R0314660 COMMON /EXTRA/ MODEX,NREXTR(25) R0314670 COMMON /SQZ/ ISQZ,NRSQZ(5) R0314680 DATA ICOO /3H001,3H013,3H025,3H037,3H049,3H061,3H073,3H085,3H097, 00314690 $ 3H109/ 00314700 DATA IFORM(1),IFORM(3),IFORM(4) /4H(1H+,4HX,F7,4H.2) / 00314710 NWANM=NWA+MI 00314720 MA2=MA - 2 00314730 IF(MA2.EQ.0) MA2 = 1 00314740 INC=NEQB - 1 00314750 NSTIF = 4 00314760 NRED = 3 00314770 NL = 1 00314780 NR=10 00314790 N1=NL 00314800 N2=NR 00314810 CALL RDWRT(NSTIF,A,1,6,I) 00314820 CALL RDWRT(NRED ,A,1,6,I) 00314830 CALL RDWRT(N1 ,A,1,6,I) 00314840 CALL RDWRT(N2 ,A,1,6,I) 00314850 WRITE(6,80) 00314860 80 FORMAT(1H1) 00314870 WRITE(6,90) 00314880 90 FORMAT( // 10X,48HTHE LAST NUMBER PRINTED IS THE PERCENT OF THE FO00314890 $ ,40HRWARD REDUCTION THAT HAS BEEN COMPLETED.//) 00314900 ICO=1 00314910 DO 420 NJ=1,NBLOCK 00314920 IF (NJ.NE.1) GO TO 100 00314930 CALL EXPAND(A,NWA,NSTIF) 00314940 GO TO 110 00314950 100 IF (NTB.EQ.1) GO TO 110 00314960 CALL RDWRT(N1 ,A,1,6,I) 00314970 CALL RDWRT(N2 ,A,1,6,I) 00314980 CALL EXPAND(A,NWA,N1) 00314990 110 KU=1 00315000 KM=MIN0(MA,NEQB) 00315010 MAXA(1)=1 00315020 DO 170 N=2,MI 00315030 IF (N-MA) 120,120,130 00315040 120 KU=KU + NEQB 00315050 KK=KU 00315060 MM = MIN0(N,KM) 00315070 GO TO 150 00315080 130 KU=KU + 1 00315090 KK=KU 00315100 IF (N-NEQB) 150,150,140 00315110 140 MM=MM - 1 00315120 150 DO 160 K=1,MM 00315130 IF (A(KK)) 170,160,170 00315140 160 KK=KK - INC 00315150 170 MAXA(N)=KK 00315160 IF(A(1)) 190,180,200 00315170 180 KK = (NJ-1)*NEQB +1 00315180 IF(KK.GT.NEQ) GO TO 390 00315190 WRITE (6,430) KK 00315200 MODEX=1 00315210 RETURN 00315220 190 KK = (NJ-1)*NEQB +1 00315230 WRITE (6,440) KK 00315240 WRITE(6,90) 00315250 ICO=1 00315260 200 DO 280 N=2,NEQB 00315270 NH=MAXA(N) 00315280 IF (NH-N) 280,280,210 00315290 210 KL=N + INC 00315300 KU=NH 00315310 K=N 00315320 D=0.E0 00315330 DO 220 KK=KL,KU,INC 00315340 K=K - 1 00315350 C=A(KK)/A(K) 00315360 D=D + C*A(KK) 00315370 220 A(KK)=C 00315380 A(N)=A(N) - D 00315390 IF (A(N)) 240,230,250 00315400 230 KK=(NJ-1)*NEQB + N 00315410 IF (KK.GT.NEQ) GO TO 390 00315420 WRITE (6,430) KK 00315430 MODEX=1 00315440 RETURN 00315450 240 KK = (NJ-1)*NEQB +N 00315460 WRITE (6,440) KK 00315470 WRITE(6,90) 00315480 ICO=1 00315490 250 IC=NEQB 00315500 DO 270 J=1,MA2 00315510 MJ=MAXA(N+J) - IC 00315520 IF (MJ-N) 270,270,260 00315530 260 KU=MIN0(MJ,NH) 00315540 KN=N + IC 00315550 C=0.E0 00315560 CONST=C 00315570 CALL QVDOT(C,A(KL),A(KL+IC), (KU-KL)/INC+1,INC,INC) 00315580 C=CONST-C 00315590 A(KN)=A(KN)+C 00315600 270 IC=IC + NEQB 00315610 280 CONTINUE 00315620 IF(NJ.EQ.NBLOCK) CALL SQEEZE(A,NWANM,NRED,ISQZ) 00315630 IF(NJ.EQ.NBLOCK) GO TO 400 00315640 290 DO 380 NK=1,NTB 00315650 IF ((NK+NJ).GT.NBLOCK) GO TO 380 00315660 NI=N1 00315670 IF ((NJ.EQ.1).OR.(NK.EQ.NTB)) NI=NSTIF 00315680 CALL EXPAND(B,NWA,NI) 00315690 ML=NK*NEQB + 1 00315700 MR=MIN0((NK+1)*NEQB,MI) 00315710 MD = MI-ML 00315720 KL=NEQB + (NK-1)*NEQB*NEQB 00315730 N=1 00315740 DO 360 M=ML,MR 00315750 NH=MAXA(M) 00315760 KL=KL + NEQB 00315770 IF(NH-KL) 350,300,300 00315780 300 KU=NH 00315790 K=NEQB 00315800 D=0.E0 00315810 DO 310 KK=KL,KU,INC 00315820 C=A(KK)/A(K) 00315830 D=D + C*A(KK) 00315840 A(KK)=C 00315850 310 K=K - 1 00315860 B(N)=B(N) - D 00315870 IF (MD) 360,360,320 00315880 320 IC=NEQB 00315890 DO 340 J=1,MD 00315900 MJ=MAXA(M+J) - IC 00315910 IF (MJ-KL) 340,330,330 00315920 330 KU=MIN0(MJ,NH) 00315930 KN=N + IC 00315940 C=0.E0 00315950 CONST=C 00315960 CALL QVDOT(C,A(KL),A(KL+IC), (KU-KL)/INC+1,INC,INC) 00315970 C=CONST-C 00315980 B(KN)=B(KN)+C 00315990 340 IC=IC + NEQB 00316000 350 MD = MD-1 00316010 360 N=N + 1 00316020 IF (NTB.NE.1) GO TO 370 00316030 CALL SQEEZE(A,NWANM,NRED,ISQZ) 00316040 CALL MEMOVE(B(1),A(1),NWA) 00316050 GO TO 400 00316060 370 CALL SQEEZE(B,NWA,N2,ISQZ) 00316070 380 CONTINUE 00316080 M=N1 00316090 N1=N2 00316100 N2=M 00316110 390 CALL SQEEZE(A,NWANM,NRED,ISQZ) 00316120 400 CONTINUE 00316130 PER=NJ*100.0/NBLOCK 00316140 IFORM(2)=ICOO(ICO) 00316150 WRITE (6,IFORM) PER 00316160 ICO=ICO+1 00316170 IF(ICO.LT.11) GO TO 420 00316180 WRITE(6,410) 00316190 410 FORMAT(1H ) 00316200 ICO=1 00316210 420 CONTINUE 00316220 430 FORMAT (44H0STOP. ZERO PIVOT ENCOUNTERED AT EQUATION (,I5,1H) ) 00316230 440 FORMAT (52H0WARNING. NEGATIVE PIVOT ENCOUNTERED DURING MATRIX, 00316240 $ 35H DECOMPOSITION AT EQUATION NUMBER (,I5,1H), 1X) 00316250 WRITE(6,450) 00316260 450 FORMAT(////20X,37(1H*)/20X,37HFORWARD REDUCTION HAS BEEN COMPLETED00316270 $./20X,37(1H*)) 00316280 RETURN 00316290 END 00316300 SUBROUTINE SOLSTP (IDIS,ISTR,MASS,B,X0,X1,X2,A,MAXA,SDIS,SSTR, 00246870 $ NSD,NSS,NEQ,NEQB,MBAND,NWA,MI,MM,NBLOCK) 00246880 IMPLICIT REAL*8 (A-H,O-Z) 00246890 REAL*8 IDIS,ISTR 00246900 REAL*8 MASS,MAXA 00246910 DIMENSION IDIS(NSD),ISTR(NSS),MASS(NEQ),B(NEQ),X0(NEQ), 00246920 $ X1(NEQ),X2(NEQ),A(NWA),MAXA(MI),SDIS(MM,NSD), 00246930 $ SSTR(MM,NSS),ISAVE(3) 00246940 COMMON /DYN2/IFPR,IFSS,NITEM,NFO,RTOL,COFQ,DT,ALFA,BETA,NFN,NGM, 00246950 $NAT,NT,NOT,MIND,TLAST,NRDYN2(6) R0246960 COMMON /EXTRA/ MODEX,NT8,N10SV,NT10,NREXTR(22) R0246970 JT = 4 00246980 IT=10 00246990 KT = 2 00247000 REWIND JT 00247010 REWIND KT 00247020 REWIND IT 00247030 IF(N10SV.GT.0) REWIND NT10 00247040 I = N10SV 00247050 L = 4 00247060 DO 100 K=1,3 00247070 L = L-1 00247080 ISAVE(L) = I - I/1000*1000 00247090 100 I = I/1000 00247100 DO 110 I=1,NEQ 00247110 X0(I)=0.0E0 00247120 X1(I)=0.0E0 00247130 110 X2(I)=0.0E0 00247140 IF(TLAST.EQ.0.0) GO TO 114 00247150 NT14=14 00247160 REWIND NT14 00247170 NREC=3*((NEQ-1)/5+1) 00247180 111 READ (NT14,140,END=112) TIME 00247190 901 IF(DABS(TIME-TLAST).LT.1.0D-8) GO TO 115 00247200 DO 905 I=1,NREC 00247210 READ (NT14,140,END=112)X0 00247220 READ (NT14,140,END=112)X1 00247230 READ (NT14,140,END=112)X2 00247240 905 CONTINUE 00247250 GO TO 111 00247260 115 READ(NT14,140,END=112) X0 00247270 902 READ(NT14,140,END=112) X1 00247280 903 READ(NT14,140,END=112) X2 00247290 904 REWIND NT14 00247300 GO TO 114 00247310 112 WRITE(6,113)TLAST 00247320 113 FORMAT(//10X,47HTHE RESTART TAPE ENDED BEFORE FINDING THE RIGHT/00247330 $ 10X,49HTIME REQUESTED FOR A RESTART, EXECUTION WILL STOP/ 00247340 $ 10X,37HTHE LAST TIME FOUND ON THE TAPE WAS =,E16.10//) 00247350 MODEX=1 00247360 RETURN 00247370 114 CONTINUE 00247380 DELT=DT 00247390 TETA=1.4E0 00247400 DELT1=TETA*DELT 00247410 DELT2=DELT1**2 00247420 A0=(6.E0+3.E0*ALFA*DELT1)/(DELT2+3.E0*BETA*DELT1) 00247430 B0=ALFA-BETA*A0 00247440 A1=6.E0/DELT2+3.E0*B0/DELT1 00247450 A2=6.E0/DELT1+B0+B0 00247460 A3=2.E0+B0*DELT1/2.E0 00247470 A4=6.E0/(3.E0*BETA*DELT1+DELT2)/TETA 00247480 B1=BETA*A4 00247490 A5=3.E0*B1/DELT1-6.E0/DELT2/TETA 00247500 A6=2.E0*B1-6.E0/DELT1/TETA 00247510 A7=.5E0*B1*DELT1+1.E0-3.E0/TETA 00247520 A8=0.5E0*DELT 00247530 A9=DELT**2/3.0E0 00247540 A10=0.5E0*A9 00247550 IK=0 00247560 KINC=NT*20/100 00247570 IF(KINC.LT.1) KINC=1 00247580 DO 240 K=1,NT 00247590 TIME=DT*K 00247600 READ (KT) B 00247610 IF(MIND.EQ.0) GO TO 124 00247620 DO 121 I=1,NEQ 00247630 IF(B(I).EQ.0.0) GO TO 120 00247640 IF(K.EQ.1) GO TO 119 00247650 GO TO 121 00247660 119 MASS(I)=MASS(I)*A0 00247670 MASS(I)=-MASS(I) 00247680 IF(MASS(I).EQ.0.0) MASS(I)=-1.0D-20 00247690 GO TO 121 00247700 120 B(I)=B(I)+MASS(I)*(A1*X0(I)+A2*X1(I)+A3*X2(I)) 00247710 121 CONTINUE 00247720 GO TO 126 00247730 124 DO 125 I=1,NEQ 00247740 125 B(I)=B(I)+MASS(I)*(A1*X0(I)+A2*X1(I)+A3*X2(I)) 00247750 126 CONTINUE 00247760 CALL REDVK (A,B,MAXA,NEQB,NWA,NEQ,NBLOCK,MI,MBAND,K) 00247770 DO 131 I=1,NEQ 00247780 ACC=A4*B(I)+A5*X0(I)+A6*X1(I)+A7*X2(I) 00247790 X0(I)=X0(I)+DELT*X1(I)+A9*X2(I)+A10*ACC 00247800 X1(I)=X1(I)+A8*(X2(I)+ACC) 00247810 130 X2(I)=ACC 00247820 IF(MASS(I).LT.0.0) X0(I)=B(I) 00247830 131 CONTINUE 00247840 IF(N10SV.LT.1) GO TO 170 00247850 IF(ISAVE(1).LT.1) GO TO 150 00247860 I = K -K/ISAVE(1)*ISAVE(1) 00247870 140 FORMAT(5E16.9) 00247880 IF(I.EQ.0) WRITE (NT10,140) TIME 00247890 IF(I.EQ.0) WRITE (NT10,140) X0 00247900 150 IF(ISAVE(2).LT.1) GO TO 160 00247910 I = K -K/ISAVE(2)*ISAVE(2) 00247920 IF(I.EQ.0) WRITE (NT10,140) X1 00247930 160 IF(ISAVE(3).LT.1) GO TO 170 00247940 I = K -K/ISAVE(3)*ISAVE(3) 00247950 IF(I.EQ.0) WRITE (NT10,140) X2 00247960 170 CONTINUE 00247970 L = K - K/NOT*NOT 00247980 IF(L.NE.0) GO TO 220 00247990 IK=IK+1 00248000 IF(NSD.LT.1) GO TO 190 00248010 DO 180 I=1,NSD 00248020 J=IDIS(I) 00248030 180 SDIS(IK,I)=X0(J) 00248040 190 IF(NSS.LT.1) GO TO 210 00248050 DO 200 I=1,NSS 00248060 J=ISTR(I) 00248070 200 SSTR(IK,I)=X0(J) 00248080 210 IF(IK.NE.MM) GO TO 220 00248090 IK=0 00248100 IF(NSD.GT.0) WRITE (JT) SDIS 00248110 IF(NSS.GT.0) WRITE (IT) SSTR 00248120 220 CONTINUE 00248130 PER=K*100.0/NT 00248140 KPR= MOD(K,KINC) 00248150 IF(KPR.EQ.0) WRITE(6,230)PER 00248160 230 FORMAT(/20X,F7.2, 47H PERCENT OF THE INTEGRATION HAS BEEN COMPLETE00248170 $D./) 00248180 240 CONTINUE 00248190 IF(NT10.EQ.14.AND.N10SV.GE.1)ENDFILE NT10 00248200 WRITE(6,250) 00248210 250 FORMAT(/20X, 31HINTEGRATION HAS BEEN COMPLETED.//) 00248220 IF(IK.EQ.0) RETURN 00248230 IF(NSD.GT.0) WRITE (JT) SDIS 00248240 IF(NSS.GT.0) WRITE (IT) SSTR 00248250 RETURN 00248260 END 00248270 SUBROUTINE REDVK (A,VV,MAXA,NEQB,NWA,NEQ,NBLOCK,MI,MA,NCALL) 00202770 IMPLICIT REAL*8 (A-H,O-Z) 00202780 REAL*8 MAXA 00202790 DIMENSION A(NWA),VV(NEQ),MAXA(MI) 00202800 COMMON /TAPES/ NSTIF,NRED,NL,NR,NT,NMASS R0202810 COMMON /SQZ/ ISQZ,NRSQZ(5) R0202820 NWANM=NWA+MI 00202830 INC=NEQB - 1 00202840 MA1 = MA-1 00202850 IF(NBLOCK.EQ.1 .AND. NCALL.GT.1) GO TO 100 00202860 CALL RDWRT(NRED ,A,1,6,I) 00202870 CALL EXPAND(A,NWANM,NRED) 00202880 100 ISA = 1 00202890 KSTART = 2 00202900 KEND = NEQB 00202910 110 N = 1 00202920 DO 130 K=KSTART,KEND 00202930 N = N+1 00202940 KL=N + INC 00202950 KU=MAXA(N) 00202960 IF (KU-KL) 130,120,120 00202970 120 CONST=VV(K) 00202980 CALL QVDOT(VV(K ),A(KL),VV(K-1), (KU-KL)/INC+1,INC,-1) 00202990 VV(K )=CONST-VV(K ) 00203000 130 CONTINUE 00203010 IF(ISA.EQ.NBLOCK) GO TO 160 00203020 KL = NEQB 00203030 ML = KEND+1 00203040 MR = MIN0(KEND+MA1,NEQ) 00203050 N = NEQB 00203060 DO 150 K=ML,MR 00203070 N = N+1 00203080 KL=KL + NEQB 00203090 KU=MAXA(N) 00203100 IF (KU-KL) 150,140,140 00203110 140 CONST=VV(K) 00203120 CALL QVDOT(VV(K ),A(KL),VV(KEND), (KU-KL)/INC+1,INC,-1) 00203130 VV(K )=CONST-VV(K ) 00203140 150 CONTINUE 00203150 160 KST = KSTART-1 00203160 N = 0 00203170 DO 180 K=KST,KEND 00203180 N = N+1 00203190 C = A(N) 00203200 IF (C) 170,180,170 00203210 170 VV(K) = VV(K)/C 00203220 180 CONTINUE 00203230 190 IF(ISA.EQ.NBLOCK) GO TO 200 00203240 CALL EXPAND(A,NWANM,NRED) 00203250 ISA=ISA+1 00203260 KSTART = KSTART+NEQB 00203270 KEND = MIN0(KEND+NEQB,NEQ) 00203280 GO TO 110 00203290 200 IF(ISA.GT.1) 00203300 $CALL RDWRT(NRED ,A,1,2,I) 00203310 ISA=1 00203320 NN = NEQ-(NBLOCK-1)*NEQB 00203330 KEND = NEQ 00203340 GO TO 240 00203350 210 KEND = KEND-NN 00203360 NN = NEQB 00203370 KL=NEQB 00203380 MR = MIN0(NEQ,KEND+MA1) 00203390 ML = KEND+1 00203400 N = NEQB 00203410 DO 230 K=ML,MR 00203420 N = N+1 00203430 KL=KL+NEQB 00203440 KU=MAXA(N) 00203450 IF (KU-KL) 230,220,220 00203460 220 CALL QMR2(VV(KEND),VV(KEND),VV(K ),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00203470 230 CONTINUE 00203480 240 N = NN 00203490 K = KEND 00203500 DO 270 L=2,NN 00203510 KL=N + INC 00203520 KU=MAXA(N) 00203530 IF (KU-KL) 260,250,250 00203540 250 CALL QMR2(VV(K-1 ),VV(K-1 ),VV(K ),A(KL),(KU-KL)/INC+1,-1,-1,INC) 00203550 260 N=N - 1 00203560 270 K = K-1 00203570 IF (ISA.EQ.NBLOCK) GO TO 280 00203580 CALL RDWRT(NRED ,A,1,2,I) 00203590 CALL EXPAND(A,NWANM,NRED) 00203600 CALL RDWRT(NRED ,A,1,2,I) 00203610 ISA=ISA+1 00203620 GO TO 210 00203630 280 RETURN 00203640 END 00203650