Liren Large Software Subsidy 9

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

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

Wrap

Text File | 1980-01-04 | 39.6 KB | 510 lines

PROGRAM SAP6P4 R0001101 IMPLICIT REAL*8(A-H,O-Z) 00001100 LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST 00001110 COMMON/BMDATA/IAISC,ILDTYP,ILDMUL,IBMSEC,NLWAVE,ILOCAL 00001120 COMMON/EQUILB/NEQIL,NX43 00001130 COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH 00001140 COMMON / JUNK / DUK(227) 00001150 REAL*8 NPAR 00001160 COMMON /QTSARG/ QQQ(1000) 00001170 COMMON/DYN3/ NEIG,NAD,ANORM,NVV,NFO 00001180 COMMON /DYN4/KDYN,NRESS,NCRD,NCWT,NRESS1 00001190 COMMON /DYN5/FRSHFT,FRINIT,FREND,MODEFR,NOSS 00001200 COMMON /TAPES/NSTIF,NRED,NL,NR,NT,NMASS 00001210 COMMON /EXTRA/MODEX,NT8,N10SV,NT10,KEQB,NY,T(10) 00001220 COMMON/GEOSTF/GEOST,NELGEO 00001230 COMMON/MASS/LMASS 00001240 COMMON/MATL/MATLCO R0001241 COMMON/SIZE/NDMX,MXDF,NSMX,NTERM,NADND 00001250 COMMON/SLVE/NSLAVE 00001260 COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00001270 $ ,N2P,N3P,NMRI,NTRI,N1P,NUMEL,NUMEL2,KZ(20,2),NEMN 00001280 COMMON / MISC / NBLOCK,NEQB,LL,NFREQ,LB 00001290 COMMON/AMB/ GRAV,REFT,JROT 00001300 COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00001310 $ ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00001320 COMMON /DYN/ IFIL1(11),IFIL2 00001330 COMMON/ELARRY/NELAR(4,20) 00001340 COMMON /ELTEMP/ SET1(103) 00001350 $ /OUT/KSET2(6),KELRST,MAXDF,IFIL3(2) 00001360 $ /SQZ/ SET3,LIST,LISTC,LISTB,LISTA 00001370 $ /TRASH/ SET4(490) 00001380 $ /GPS/ SET5(10) 00001390 $ /CG/ SET6(4),RFIL1(2) 00001400 $ /TAPES/ SET7(6) 00001410 $ /DYN2/KSET8(3),NFVC,SET8(12) 00001420 COMMON /WORDS/ NWDS(30,2) 00001430 COMMON /BAND/ NRNM(3),IRSK,IFIL4(4) 00001440 COMMON /HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00001450 COMMON /SUPEL/ NSELEM,NEQL,NODESE 00001460 $,KSET(3) 00001470 COMMON/FORCE/ NLC,NELD 00001480 COMMON/DAPG/NQ1,NQX,DUMY(210) 00001490 COMMON/VAXPLT/IVPLT,XVB(6),XVA(4),MINX,MINY,LEN 00001500 COMMON /ICM/ICOMP,MMRI,MTRI,M1P,M2P,M3P 00001510 COMMON/PLOTH/IPLT,IPLWRT 00001520 COMMON/COMMT/NTYP,NUMET,NNRRC,NNRRC1 R0001521 COMMON/COMMT1/NDSSS,KDSSS,NTY,NSLDM,NBLANK,MDYN,NE2B,KRK1,MCB,MLT R0001522 DIMENSION KZN(20),ZD(31) 00001530 DIMENSION NEXPDT(2),NOWDTE(4) 00001540 COMMON A(1) 00001550 DATA KZN/2,7,1,2,7,7,10,7,21,1177,6,51,10,21,9,7,8,5,0,0/ 00001560 DATA NEXPDT/78,222/ 00001570 WRITE (*,990) R0001611 990 FORMAT (5X,'********** PROGRAM SAP6PC4 STARTING *********') R0001612 CALL SIZER4 R0001612 MTOTR = MTOT R0001613 CALL COMMRW(1) R0001612 MTOT = MTOTR R0001613 IF (NNRRC .EQ. 330) GO TO 330 R0001613 IF (NDYN .GT. 11) GO TO 330 R0001614 IF (NDYN .EQ. 10) GO TO 320 R0001615 IF (KSKIP .EQ. 1) GO TO 320 R0001616 IF (NDYN .EQ. 8) GO TO 330 R0001617 IF (NNRRC1 .EQ. 320) GO TO 320 R0001618 IF(NELGEO.EQ.1) GO TO 290 00005580 GO TO (290,290,290,290,350,360,410,460,290,290,290,290,410),MDYN 00005590 290 IF(MODEX.EQ.0) GO TO 310 00005600 DO 300 I=6,10 00005610 300 T(I) = T(5) 00005620 GO TO 320 00005630 310 CONTINUE 00005640 NSB=(MBAND+LL)*NEQB 00005650 IF (KSKIP.EQ.1) GO TO 320 00005660 NSBB=NEQB*LL*(2+(MBAND-1)/NEQB) 00005670 IF(NSBB.LT.NSB) NSBB=NSB 00005680 N1=1+10*LL 00005690 N4=N1+NSB 00005700 N3=N4+NEQB 00005710 IF(NDYN.LT.1) GO TO 1310 00005720 IF(NDYN.GT.3) GO TO 1320 00005730 CALL USOL(A(N1),A(N3),A(N4),NEQB,MBAND,LL,NBLOCK,NSB,4,3,10,22,22,00005740 $A(1)) 00005750 GO TO 1330 00005760 1310 CONTINUE 00005770 CALL USOL(A(N1),A(N3),A(N4),NEQB,MBAND,LL,NBLOCK,NSB,4,3,10,22,18,00005780 $A(1)) 00005790 GO TO 1325 00005800 1320 CONTINUE 00005810 NWA=MBAND*NEQB 00005820 MI=MBAND+NEQB-1 00005830 N1=1+10*LL 00005840 N4=N1+NWA 00005850 N3=N4+MI 00005860 NTB=(MBAND-2)/NEQB+1 00005870 IF(NTB.GE.NBLOCK) NTB=NBLOCK-1 00005880 CALL GDCOMP(A(N1),A(N3),A(N4),NEQB,MBAND,NBLOCK,NWA,NTB,NSCH, 00005890 1NEQ,MI) 00005900 NWV=LL*NEQB 00005910 NWVV=NWV*(NTB+1) 00005920 N4=N1+NWA 00005930 N2=N4+MI 00005940 N3=N2+NWV 00005950 CALL GREDBK(A(N1),A(N2),A(N3),A(N4),NEQB,LL,NWA,NWV, 00005960 1NWVV,NTB,NBLOCK,MI,MBAND) 00005970 1325 CONTINUE 00005980 CALL GSTATC(A(1),LL,NBLOCK,NEQB,18,22) 00005990 1330 CONTINUE 00006000 N1=1+NEMN 00006010 320 CALL SECOND(T(6)) 00006020 IF (NDYN.LE.1.AND.KSKIP.EQ.1) GO TO 330 00006030 IF(NDYN.EQ.0.OR.NDYN.EQ.11.OR.NELGEO.EQ.1) CALL STATIC 00006040 IF(NDYN.GT.0.AND.NDYN.LT.4.AND.KSKIP.EQ.0) CALL MODES 00006050 IF(NDYN.NE.11.AND.NELGEO.NE.1) GO TO 1410 00006060 CALL SECOND(T(7)) 00006070 NN2=N1+NEQB*MBAND 00006080 NN3=NN2+NEQB*LL 00006090 NN4=NN3+NEQB*MBAND R0006100 NN5=NN4+NEQB*MBAND 00006110 NN6=NN5+NEQB*LL 00006120 MGA=MBAND 00006130 CALL ADDGEO(A(N1),A(NN2),A(NN3),A(NN4),A(NN5),A(NN6),NUMET,NBLOCK,00006140 $NE2B,LL,MBAND,NEQB,NEMN,ANORM,NVV,MGA) R0006150 330 CONTINUE R0006151 350 CONTINUE R0006152 360 CONTINUE R0006153 410 CONTINUE R0006154 460 CONTINUE R0006155 1410 CONTINUE R0006156 CALL COMMRW(0) R0007771 WRITE (*,1081) R0007772 1081 FORMAT (5X,'*********** SAP6PC4 FINISHED ***********') R0007773 STOP R0007775 END R0007774 SUBROUTINE FILES(NN) RETURN END BLOCKDATA 00007790 IMPLICIT REAL*8(A-H,O-Z) 00007800 COMMON/HEADIN/TITLE1(20),TITLE2(5),TITLE3(10) 00007810 COMMON/ELARRY/NELAR(4,20) 00007820 COMMON /GASS/ XK(4,4),WGT(4,4),IPERM(3) 00007830 COMMON/GASS2/A5(7,2),W5(7) 00007840 COMMON /PREP/XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD 00007850 1,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC 00007860 DATA XK / 0.D0, 0.D0, 0.D0, 0.D0,00007870 $ -.5773502691896D0, .5773502691896D0, 0.D0, 0.D0,00007880 $ -.7745966692415D0, .0000000000000D0, .7745966692415D0, 0.D0,00007890 $ -.8611363115941D0,-.3399810435849D0, .3399810435849D0, 00007900 $.8611363115941D0/ 00007910 DATA WGT / 2.000D0, 0.D0, 0.D0, 0.D0, 00007920 $ 1.0000000000000D0,1.0000000000000D0, 0.D0, 0.D0, 00007930 $ .5555555555556D0, .8888888888889D0, .5555555555556D0,0.D0, 00007940 $ .3478548451375D0, .6521451548625D0, .6521451548625D0, 00007950 $ .3478548451375D0/ 00007960 DATA IPERM / 2,3,1 / 00007970 DATA A5(1,1)/-0.333333333333D0/,A5(2,1)/-0.88056825640D0/ 00007980 DATA A5(3,1)/-0.05971587178D0/,A5(4,1)/-0.05971587178D0/ 00007990 DATA A5(5,1)/ 0.59485397070D0/, A5(6,1)/-0.79742698530D0/ 00008000 DATA A5(7,1)/-0.79742698530D0/, A5(1,2)/-0.333333333333D0/ 00008010 DATA A5(2,2)/-0.05971587178D0/, A5(3,2)/-0.88076825640D0/ 00008020 DATA A5(4,2)/-0.05971587178D0/ ,A5(5,2)/-0.79742698530D0/ 00008030 DATA A5(6,2)/ 0.59485397070D0/ ,A5(7,2)/-0.79742698530D0/ 00008040 DATA W5(1)/ 0.225 D0/, W5(2)/ 0.13239415 D0/ 00008050 DATA W5(3)/ 0.13239415 D0/, W5(4)/ 0.13239415 D0/ 00008060 DATA W5(5)/ 0.12593918 D0/, W5(6)/ 0.12593918 D0/ 00008070 DATA W5(7)/ 0.12593918 D0/ 00008080 DATA NELAR / 00008090 $ 2, 2, 6, 2, 00008100 $ 3, 2, 12, 28, 00008110 $ 4, 4, 12, 8, 00008120 $ 4, 4, 8, 4, 00008130 $ 8, 8, 33, 54, 00008140 $ 4, 4, 42, 24, 00008150 $ 1, 1, 1, 1, 00008160 $ 4, 4, 8, 4, 00008170 $ 3, 2, 12, 39, 00008180 $ 20, 20, 60, 54, 00008190 $ 8, 8, 16, 52, 00008200 $ 8, 8, 16, 52, 00008210 $ 8, 8, 16, 52, 00008220 $ 4, 1, 6, 6, 00008230 $ 8, 8, 48, 6, 00008240 $ 20*0/ 00008250 DATA TITLE2/4H ,4HSAP6,4H ,4HVER.,4H 2.0/ 00008260 DATA TITLE3(3)/4H LPI/,TITLE3(4)/4HAUTO/,TITLE3(5)/54./ 00008330 DATA POS/3H /,PRTCOD/3H / 00008340 DATA POSSAV/3H /,PRTOFF/3HOFF/,PRTON/3HON-/,PRTDUM/3HDUM/ 00008350 DATA IDIRC/0/ 00008360 END 00008370 SUBROUTINE CLOSE RETURN END SUBROUTINE EXIT WRITE (6,101) 101 FORMAT (5X,'******** SAP6 PROGRAM STOP ********') STOP END SUBROUTINE RECUVR(B,D,SA,DISP,DISP2,LB,LL,NEQ,NEQB,NBLKS,MAXDF) 00200150 IMPLICIT REAL*8(A-H,O-Z) 00200160 DIMENSION D(NEQ,LB),B(NEQB,LL) 00200170 &,SA(1),DISP(1),DISP2(1),IU(11) 00200180 COMMON /PREP/XZ(2),KSKIP,NDYN,NRPREP(15) R0200190 COMMON /ELPAR/ XP(14),IDUM(15),NUMEL,NUMEL2,NRELPA(41) R0200200 COMMON /SUPEL/NSELEM,NRSUPE(5) R0200210 DATA IU/15,10,-1, 2,10,-1, 2,-1,-1,15,2/ 00200220 CALL FILES(6) 00200230 IF(KSKIP.EQ.1) RETURN 00200240 IF(NSELEM.LE.0) RETURN 00200250 NT=IU(NDYN+1) 00200260 IF(NT.LE.0) RETURN 00200270 NUMET=NUMEL+NUMEL2 00200280 NEMN=MAXDF+2 00200290 NT1=1 00200300 N18=18 00200310 N17=17 00200320 N27=27 00200330 N1=N18 00200340 N2=N17 00200350 LH=0 00200360 MT=(LL-1)/LB+1 00200370 REWIND N1 00200380 REWIND N2 00200390 REWIND NT 00200400 DO 190 II=1,MT 00200410 LT=LH+1 00200420 LLT=1-LT 00200430 LH=LT+LB-1 00200440 IF(LH.GT.LL) LH=LL 00200450 IF(NT.EQ.15) GO TO 120 00200460 REWIND NT 00200470 NQ=NEQB*NBLKS 00200480 NWRDS=LL*4 00200490 READ (NT) 00200500 DO 110 NN=1,NBLKS 00200510 READ (NT) B 00200520 N=NEQB 00200530 IF(NN.EQ.1) N=NEQ-NQ+NEQB 00200540 NQ=NQ-NEQB 00200550 DO 110 J=1,N 00200560 I=NQ+J 00200570 DO 110 L=LT,LH 00200580 K=LLT+L 00200590 110 D(I,K)=B(J,L) 00200600 GO TO 140 00200610 120 DO 130 L=LT,LH 00200620 K=L+LLT 00200630 130 READ(NT) (D(I,K),I=1,NEQ) 00200640 140 CALL RDWRT(NT1,SA,1,6,J) 00200650 DO 150 I=1,NUMET 00200660 150 CALL RDWRT(NT1,SA,1,3,KOUNT) 00200670 DO 180 I=1,NSELEM 00200680 IF(II.EQ.1) GO TO 160 00200690 READ (N1)M,N,ND,LX 00200700 NWD=ND*LX 00200710 READ (N1) (DISP(J),J=1,NWD) 00200720 160 CONTINUE 00200730 CALL RDWRT(NT1,SA,NEMN,0,KOUNT) 00200740 ND=SA(KOUNT) 00200750 M= SA(KOUNT-1) 00200760 DO 170 J=1,ND 00200770 JJ=SA(J) 00200780 DO 170 L=LT,LH 00200790 K=L+LLT 00200800 NWD=J+ND*(L-1) 00200810 170 DISP(NWD)=D(JJ,K) 00200820 WRITE (N2) M,I,ND,LL 00200830 NWD=ND*LL 00200840 WRITE (N2) (DISP(N),N=1,NWD) 00200850 180 CONTINUE 00200860 IF(II.EQ.MT) GO TO 190 00200870 REWIND N1 00200880 REWIND N2 00200890 LX=N1 00200900 N1=N2 00200910 N2=LX 00200920 190 CONTINUE 00200930 REWIND N27 00200940 NEL=0 00200950 200 READ (N27,END=220) M,N,ND,LX 00200960 210 IF(M.LE.0) GO TO 220 00200970 NEL=NEL+1 00200980 WRITE(N2) M,N,ND,LX 00200990 NWD=ND*LX 00201000 READ (N27) (DISP2(J),J=1,NWD) 00201010 WRITE(N2) (DISP2(J),J=1,NWD) 00201020 GO TO 200 00201030 220 REWIND N27 00201040 REWIND N2 00201050 IF(NEL.EQ.0) GO TO 240 00201060 DO 230 I=1,NEL 00201070 READ (N2) M,N,ND,LX 00201080 WRITE(N27)M,N,ND,LX 00201090 NWD=ND*LX 00201100 READ (N2) (DISP2(J),J=1,NWD) 00201110 230 WRITE(N27) (DISP2(J),J=1,NWD) 00201120 240 DO 250 I=1,NSELEM 00201130 READ (N2) M,N,ND,LX 00201140 WRITE(N27)M,N,ND,LX 00201150 NWD=ND*LX 00201160 READ (N2) (DISP2(J),J=1,NWD) 00201170 250 WRITE(N27) (DISP2(J),J=1,NWD) 00201180 RETURN 00201190 END 00201200 SUBROUTINE SECOND(T) 00234270 IMPLICIT REAL*8 (A-H,O-Z) 00234280 CALL GETTIM(NA,NB,NC,ND) R0234281 AA = NA * 100.0 R0234282 CC = NC R0234283 CC = CC / 100.0 R0234284 T = AA + NB + CC R0234285 RETURN 00234300 END R0234286 SUBROUTINE ERROR(I) 00086230 IMPLICIT REAL*8(A-H,O-Z) 00086240 REAL*8 X 00086250 COMMON /EXTRA/ MODEX,NREXTR(25) R0086260 COMMON /PREP/ X(2),KSKIP,RRPREP(8) R0086270 KSKIP=1 00086280 MODEX=1 00086290 WRITE(6,100)I 00086300 100 FORMAT (1H0//1X,30HALLOCATED STORAGE EXCEEDED BY ,I7,6H WORDS) 00086310 WRITE(6,110) 00086320 110 FORMAT(/1X, 29HNO EXECUTION WILL BE ALLOWED./) 00086330 RETURN 00086340 END 00086350 SUBROUTINE UNPKID(ID,NUMNP,X,COORD,MODE,N,IDOF) 00317660 IMPLICIT REAL*8 (A-H ,O-Z) 00317670 REAL*8 ID 00317680 DIMENSION ID(NUMNP,3) 00317690 COMMON /PREP/XMX,XAD,J1(2),I1,RRPREP(7) R0317700 GO TO (100,110),MODE 00317710 100 X=ID(N,IDOF) 00317720 K=X 00317730 IF(X.LT.0.0) K=K-1 00317740 COORD=(X-K-XAD)*XMX 00317750 RETURN 00317760 110 JJ=IDOF 00317770 IF(IDOF.GE.4) GO TO 120 00317780 NNN=ID(N,JJ) 00317790 IF(NNN.LT.0) GO TO 115 00317800 NNN= MOD(NNN,I1) 00317810 GO TO 117 00317820 115 CONTINUE 00317830 IF(IABS(NNN).GT.I1) GO TO 116 00317840 NNN=MOD(NNN,I1) 00317850 IF(NNN.LT.0) NNN=0 00317860 GO TO 117 00317870 116 NNN=1-NNN 00317880 NNN=MOD(NNN,I1) 00317890 GO TO 117 00317900 117 X=NNN 00317910 RETURN 00317920 120 JJ=JJ-3 00317930 NNN=ID(N,JJ) 00317940 00317950 IF(NNN.GE.0) GO TO 130 00317960 IF(IABS(NNN).LT.I1) GO TO 130 00317970 NN2=NNN/I1 00317980 NNN=-NN2 00317990 GO TO 140 00318000 130 CONTINUE 00318010 NN2=MOD(NNN,I1) 00318020 NNN=NNN/I1 00318030 IF(NNN.GT.0) NNN=NNN+NN2 00318040 IF(NN2.LT.0) NNN=1-NN2 00318050 140 CONTINUE 00318060 X=NNN 00318070 RETURN 00318080 END 00318090 SUBROUTINE QVCOPY(FROM,TO,N) 00193850 REAL*8 FROM,TO 00193860 DIMENSION FROM(1),TO(1) 00193870 DO 100 I=1,N 00193880 100 TO(I)=FROM(I) 00193890 RETURN 00193900 END 00193910 SUBROUTINE QMR2(C,D,FAC,B,N,JC,KC,JB) 00186840 IMPLICIT REAL*8(A-H,O-Z) 00186850 DIMENSION B(1),C(1),D(1) 00186860 IB=1 00186870 IC=1 00186880 DO 100 I=1,N 00186890 C(IC)=D(IC)-FAC*B(IB) 00186900 IB=IB+JB 00186910 100 IC=IC+JC 00186920 RETURN 00186930 END 00186940 SUBROUTINE QVSET(C,A,N) 00194580 REAL*8 C,A 00194590 DIMENSION A(1) 00194600 DO 100 I=1,N 00194610 100 A(I)=C 00194620 RETURN 00194630 END 00194640 SUBROUTINE RDWRT(JT,A,NUM,N,J) 00199630 IMPLICIT REAL*8(A-H,O-Z) 00199640 REAL*8 A 00199650 COMMON /WORDS/ NWDS(30,2) 00199660 DIMENSION A(NUM) 00199670 DIMENSION IUNIT(41) 00199680 DATA 00199690 $ IUNIT/21,22,23,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19, 00199700 $20,1,62,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41/ R0199710 NT=IUNIT(JT) 00199720 K=N+1 00199730 LNTRC=NUM*8 00199740 WRITE (6,109) NT,J,K,JT,N,NUM GO TO (100,110,120,130,230,140,150, 00199750 $230,230,230,230, 00199760 $160,180,210,220),K 00199770 100 CONTINUE READ (NT) J R0199780 CALL RDA(NT,A,J) 00199790 WRITE (6,109) NT,J,K,JT,N,NUM CC WRITE (6,1010) (A(IIR),IIR=1,J) C1010 FORMAT (1X,'**RD**',12E10.4/) 109 FORMAT (5X,'****** NT,J,K,JT,N NUM ******* =', 6I5) RETURN 00199800 110 CONTINUE R0199801 CC WRITE (6,1009) NT,J,K,JT,N,NUM C1009 FORMAT (5X,'****** WRITE (NT,J,K,JT,N) ******* =', 6I5) CC IF (NT.EQ.10) WRITE(6,1009) (A(II),II=1,NUM) C1009 FORMAT (1X,'**RD10**',12E10.4/) WRITE (NT) NUM R0199810 WRITE (NT) A 00199820 NWDS(NT,1)=NWDS(NT,1)+NUM 00199830 RETURN 00199840 120 CONTINUE R0199841 CC WRITE (6,1008) NT,J,K,JT,N C1008 FORMAT (5X,'****** BACKSPACE (NT,J,K,JT,N) ******* =', 5I5) BACKSPACE NT R0199850 BACKSPACE NT 00199860 RETURN 00199870 130 READ (NT) 00199880 READ (NT) 00199890 RETURN 00199900 140 READ (NT) J,A 00199910 RETURN 00199920 150 REWIND NT 00199930 IF(NWDS(NT,1).GT.NWDS(NT,2)) NWDS(NT,2)=NWDS(NT,1) 00199940 NWDS(NT,1)=0 00199950 RETURN 00199960 160 DO 170 I=1,20 00199970 DO 170 J=1,2 00199980 170 NWDS(I,J)=0 00199990 RETURN 00200000 180 DO 200 I=1,20 00200010 J=NWDS(I,1) 00200020 IF(NWDS(I,2).GT.J) J=NWDS(I,2) 00200030 IF(J.GT.0) WRITE(6,190)I,J 00200040 190 FORMAT(//20X,13HDISK FILE NO.,I3,25H WAS REQUIRED TO STORE A, 00200050 $12H MAXIMUM OF,1X,I9,18H WORDS OF STORAGE./) 00200060 200 CONTINUE 00200070 RETURN 00200080 210 WRITE(NT) A 00200090 NWDS(NT,1)=NWDS(NT,1)+NUM 00200100 RETURN 00200110 220 READ(NT)A 00200120 230 RETURN 00200130 END 00200140 SUBROUTINE RDA(NT,A,NUM) 00196460 REAL*8 A 00196470 DIMENSION A(NUM) 00196480 READ (NT) A 00196490 RETURN 00196500 END 00196510 SUBROUTINE SQEEZE(A,NUM,NT,KOD) 00254540 IMPLICIT REAL*8(A-H,O-Z) 00254550 REAL*8 A 00254560 DIMENSION A(1) 00254570 IF(KOD.GT.0) GO TO 100 00254580 CALL SQISH(A,NUM,N) 00254590 CALL RDWRT(NT,A,N,1,K) 00254600 RETURN 00254610 100 CALL RDWRT(NT,A,NUM,1,K) 00254620 RETURN 00254630 END 00254640 SUBROUTINE EXPAND(A,NUM,NT) 00086360 IMPLICIT REAL*8(A-H,O-Z) 00086370 REAL*8 A 00086380 DIMENSION A(1) 00086390 CALL RDWRT(NT,A,NUM,0,J) 00086400 IF(J.EQ.NUM) RETURN 00086410 RETURN 00086420 END 00086430 SUBROUTINE MEMSET (KONST,IARRAY,NWDS) 00135760 REAL*8 IARRAY, KONST 00135770 DIMENSION IARRAY(1) 00135780 DO 100 I=1,NWDS 00135790 100 IARRAY(I)=KONST 00135800 RETURN 00135810 END 00135820 SUBROUTINE QVDOT(C,A,B,N,JA,JB) 00193990 REAL*8 A,B,C 00194000 DIMENSION A(1),B(1) 00194010 IA=1 00194020 IB=1 00194030 C=0.0 00194040 DO 100 I=1,N 00194050 C=C+A(IA)*B(IB) 00194060 IA=IA+JA 00194070 100 IB=IB+JB 00194080 RETURN 00194090 END 00194100 SUBROUTINE SQISH(A,I,J) 00254650 REAL*8 A 00254660 J=I 00254670 RETURN 00254680 END 00254690