      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
