      PROGRAM SAP6P3                                                    R0001101
      IMPLICIT REAL*8(A-H,O-Z)                                          00001100
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH,DEFPCH,GEOST                    00001110
      COMMON A(1)                                                       R0001550
      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,NRC1                  R0001370
     $       /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         R0001522
      COMMON /AAA1/ ATR(8000)                                           R0001523
      COMMON /AAA2/ RKFT(4),RLDG(300),RMHI(300),B(600)                  R0001524
      COMMON /AAA3/ TMASS(350,1),BBR(200,5)                             R0001525
      DIMENSION KZN(20),ZD(31)                                          00001530
      DIMENSION NEXPDT(2),NOWDTE(4)                                     00001540
      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 SAP6PC3 STARTING **********'/)  R0001612
      CALL SIZER3                                                       00001610
      MTOTR = MTOT                                                      R0001612
      CALL COMMRW(1)                                                    R0001611
      MTOT = MTOTR                                                      R0001613
      WRITE (6,991) MTOT                                                R0001614
  991 FORMAT (5X,'********* MTOT IN SAP6PC3 =  ',I5/)                   R0001615
      IF (KSKIP .EQ. 1) GO TO 185                                       R0001613
      IF (NNRRC .EQ. 183) GO TO 183                                     R0001612
      IF(NSELEM.LE.0) GO TO 183                                         00002990
  183 NUMET=NUMEL+NUMEL2-NBLANK+NSELEM                                  00003200
      MBMAX=20000                                                       00003210
      IF(MBAND.LE.0.OR.MBAND.GT.MBMAX) KSKIP=1                          00003220
      IF(MBAND.LE.0.OR.MBAND.GT.MBMAX) WRITE(6,184)MBAND                00003230
  184 FORMAT(1X ,29HERROR--BANDWIDTH OF MESH WAS ,I6,14H.  THIS IS NOT, 00003240
     $ 32H A VALID VALUE.  JOB TERMINATED.)                             00003250
  185 IF(MXDF.EQ.42.OR.MXDF.EQ.33) MXDF=24                              00003260
      IF(KELRST.NE.1) GO TO 189                                         00003270
      WRITE(6,186)MBAND,MAXDF                                           00003280
  186 FORMAT(1X ,20X,40HTHE STIFFNESS AND LOAD MATRICES HAVE BEE,       00003290
     111HN COMPUTED.,                                                   00003300
     $/20X,6HMBAND=,I5,11H AND MAXDF=,I5,                               00003310
     230H . THEY ARE TO BE INPUT ON THE,                                00003320
     $16H EXECUTE- CARD.///)                                            00003330
      CALL SECOND(T(3))                                                 00003340
      T(6)=T(3)                                                         00003350
      T(4)=T(3)                                                         00003360
      T(5)=T(3)                                                         00003370
      NNRRC = 330                                                       R0003371
      GO TO 330                                                         00003380
  189 CONTINUE                                                          00003390
      NEMN=(MXDF*MXDF-MXDF)/2+MXDF*(LL+3)+1                             00003400
      IF(LMASS.EQ.1) NEMN=NEMN+MXDF*(MXDF-1)                            00003410
      IF(GEOST)NEMN=NEMN+3*(MXDF*MXDF)+1                                00003420
      NEMNM=NSMX*(MXDF+LL)+MXDF+3+10*LL                                 00003430
      IF(NDYN.EQ.3.OR.NDYN.EQ.6) NEMNM=NSMX*(MXDF+LL)+MXDF+13+10*NFREQ  00003440
      IF(NEMNM.GT.NEMN) NEMN=NEMNM                                      00003450
      IF(NSELEM.GT.0) NEMNM=MAXDF+(MAXDF*MAXDF-MAXDF)/2+MAXDF*(LL+2)+1  00003460
      IF(LMASS.EQ.1.AND.NSELEM.GT.0)                                    00003470
     $ NEMNM=NEMNM+MAXDF*(MAXDF-1)                                      00003480
      IF(GEOST.AND.NSELEM.GT.0)NEMNM=NEMNM+3*MAXDF*MAXDF                00003490
      NEMN=NEMN+3                                                       00003500
      IF(NEMNM.GT.NEMN) NEMN=NEMNM                                      00003510
      MDYN=NDYN+1                                                       00003520
      NF=NFREQ                                                          00003530
      MODEX=KSKIP                                                       00003540
        IF(NDYN.GT.11) GO TO 330                                        00003550
        IF(NDYN.EQ.10) GO TO 320                                        00003560
  190 NEQB=(MTOT-NEMN)/(MBAND+LL+1)/2                                   00003570
      IF(LMASS.EQ.1.OR.GEOST)                                           00003580
     $NEQB=(MTOT-NEMN)/(2*MBAND+LL)/2                                   00003590
      IF(KEQB.LT.0.AND.KEQB.NE.-99999) NEQB=-KEQB                       00003600
      IF(NELGEO.EQ.1) GO TO 200                                         00003610
      GO TO (200,200,200,200,210,210,210,240,200,200,200,200,210),MDYN  00003620
  200 CONTINUE                                                          00003630
      NEQB1=(MTOT-MBAND-NEMN-LL*(MBAND+2))/(3*LL+MBAND+1)               00003640
      IF(LMASS.EQ.1.OR.GEOST)                                           00003650
     $NEQB1=(MTOT-MBAND-NEMN-LL*(MBAND+2))/(3*LL+2*MBAND)               00003660
      IF(NEQB1.LT.NEQB) NEQB=NEQB1                                      00003670
      NBLOCK=(NEQ-1)/NEQB +1                                            00003680
      IF (NEQB.GT.NEQ) NEQB=NEQ                                         00003690
      IF(NDYN.GT.3.AND.NDYN.LT.7) GO TO 210                             00003700
      IF(NDYN.GT.0.AND.NDYN.LT.8) GO TO 250                             00003710
      IF(KEQB.EQ.-99999) GO TO 250                                      00003720
      IF(NDYN.EQ.11) GO TO 220                                          00003730
      CALL SECOND(T(3))                                                 00003740
      N1=1                                                              00003750
      N2=KZ(6,1)+LL*4                                                   00003760
      N3=LL*3                                                           00003770
      CALL QVCOPY(A(N2),SET4(1),N3)                                     00003780
      N2=NUMNP*3+N1                                                     00003790
      N3=N2+NEQ                                                         00003800
      N4=N3+NEMN                                                        00003810
      IF(N4.GT.MTOT) CALL ERROR(N4-MTOT)                                00003820
      IF(KSKIP.EQ.1) GO TO 201                                          00003830
      CALL CBLOK(A(N2),A(N3),LL,NBLOCK,MCB,NUMET,MTB,MVT,NEMN)          00003840
      MT2B=MTB*2                                                        00003850
      WRITE(6,510)NEQ,MBAND,MCB,NBLOCK                                  00003860
  201 CALL SECOND(T(4))                                                 00003870
      IF(KSKIP.EQ.1) GO TO 202                                          00003880
      N2=N1+4                                                           00003890
      N3=N2+MCB                                                         00003900
      N4=N3+MCB                                                         00003910
      N5=N1                                                             R0003920
      N6=N5+4                                                           00003930
      N7=N6+MCB                                                         00003940
      N8=N7+MCB                                                         00003950
      N9=N4+MTB                                                         R0003960
      N10=N9+NEMN                                                       00003970
      IF(N10.GT.MTOT) CALL ERROR(N10-MTOT)                              00003980
      NN5=MCB*LL                                                        00003990
      NN6=4+2*MCB+MTB                                                   00004000
      CALL TOTSTF(                                    A(N5),A(N5),      R0004010
     $A(N6),A(N7),A(N8),A(N8),A(N9),NBLOCK,MT2B,NUMET,LL,MTB,           R0004020
     $MCB,NEMN,NN5,NN6)                                                 00004030
  202 CALL SECOND(T(5))                                                 00004040
      IF(KSKIP.EQ.1) GO TO 209                                          00004050
      MLT=MAX0(MTB,NEQ-2*MCB)                                           00004060
      MM1=3                                                             00004070
      MM2=4                                                             00004080
      MM3=62                                                            R0004090
      MM4=10                                                            00004100
      NEQB=10                                                           00004110
  205 NN2=NEQB                                                          00004120
      NEQB=10+NEQB                                                      00004130
      IF(NEQB.GT.NEQ) GO TO 206                                         00004140
      NN1=NEMN+LL*(NEQ+NEQB+26)+NUMNP                                   00004150
      NN3=LL*(NEQB+16)+NUMNP*3                                          00004160
      IF(NN3.LT.MTOT.AND.NN1.LT.MTOT) GO TO 205                         00004170
  206 NEQB=NN2                                                          00004180
      IF(NEQB.GT.NEQ) NEQB=NEQ                                          00004190
      NBLK2=(NEQ-1)/NEQB+1                                              00004200
      N1=1+10*LL                                                        00004210
      N2=N1+4                                                           00004220
      N3=N2+MCB                                                         00004230
      N4=N3+MCB                                                         00004240
      N5=N1                                                             R0004250
      N6=N5+MLT                                                         00004260
      N7=N6+4                                                           00004270
      N8=N7+MCB                                                         00004280
      N9=N8+MCB                                                         00004290
      N10=N9+LL                                                         00004300
      IF(N10.GT.MTOT) CALL ERROR(N10-MTOT)                              00004310
      NN4=1+10*LL+NEQB*LL+NEQ                                           00004320
      IF(NN4.GT.MTOT) CALL ERROR(NN4-MTOT)                              00004330
      N10=N10-NEQ                                                       00004340
      NN1=2*MCB+4                                                       00004350
      NN2=MCB+MCB+MTB+4                                                 00004360
      NN3=MCB+MCB+MLT+4                                                 00004370
      IF(KSKIP.EQ.1) GO TO 320                                          00004380
      IF(NDYN.NE.8) GO TO 207                                           00004390
      N11=N10+2*NEQ                                                     00004400
      N12=N11                                                           00004410
      IF(LMASS.EQ.-1) N12=N11+NEQ                                       00004420
      IF(N11.GT.MTOT) CALL ERROR(N11-MTOT)                              00004430
      IF(N12.GT.MTOT) CALL ERROR(N12-MTOT)                              00004440
      IF(KSKIP.EQ.1) GO TO 320                                          00004450
      N11=N11-NEQ                                                       00004460
      N12=N12-NEQ                                                       00004470
      CALL CNDNS(                                    A(N5),A(N5),A(N11),00004480
     $A(N6),A(N6),A(N7),A(N8),A(N9),LL,NBLOCK,NEQ,MTB,MCB,MVT,MLT,MM1,  00004490
     $MM2,MM3,MM4,NN1,NN2,NN3,NEQB,NBLK2,A(N10),A(N1),A(1),A(1),NUMNP   00004500
     $,A(N12))                                                          00004510
      GO TO 208                                                         00004520
  207 CONTINUE                                                          00004530
      CALL SLOWR (                                    A(N5),A(N5),A(N5),R0004540
     $A(N6),A(N6),A(N7),A(N8),A(N9),LL,NBLOCK,NEQ,MTB,MCB,MVT,MLT,MM1,  00004550
     $MM2,MM3,MM4,NN1,NN2,NN3,NEQB,NBLK2,A(N10),A(N1),A(1))             00004560
  208 CONTINUE                                                          00004570
      NBLOCK=NBLK2                                                      00004580
      N1=1+NEMN                                                         00004590
      IF(NDYN.EQ.9)NDYN=0                                               00004600
  209 CALL SECOND(T(6))                                                 00004610
      IF(NDYN.EQ.8) GO TO 330                                           00004620
      NNRRC1 = 320                                                      R0004621
      GO TO 320                                                         00004630
  210 IF (NEQB.LT.NEQ) GO TO 220                                        00004640
        IF(NOSS.EQ.1)GO TO 220                                          00004650
      NIM=3                                                             00004660
      NC=NF + NIM                                                       00004670
      NVM=6                                                             00004680
      NCA=NEQ*MAX0(MBAND,NC)                                            00004690
      NTOT=NCA + 4*NEQ + 2*NVM*NEQ + 5*NC                               00004700
      IF(LMASS.EQ.1.OR.NDYN.EQ.11)NTOT=NTOT+NEQ*(MBAND-1)               00004710
      NEIG=0                                                            00004720
      IF(NTOT.LE.MTOT) GO TO 230                                        00004730
  220 NV=MIN0(2*NF,NF+8)                                                00004740
        IF(NFVC.GT.0) NAD=NFVC                                          00004750
        IF(NFVC.GT.0) NFVC=0                                            00004760
      IF (NAD.NE.0) NV=NAD                                              00004770
      NEQB1=(MTOT - MBAND)/(2*MBAND + 1)                                00004780
      IF(LMASS.EQ.1.OR.NDYN.EQ.11)                                      00004790
     $NEQB1=(MTOT - MBAND)/(3*MBAND)                                    00004800
      NEQB2=(MTOT - MBAND - 2*NV - NV*(MBAND-2))/(3*NV + MBAND + 1)     00004810
      IF(LMASS.EQ.1.OR.NDYN.EQ.11)                                      00004820
     $NEQB2=(MTOT - MBAND - 2*NV - NV*(MBAND-2))/(3*NV + 2*MBAND)       00004830
      NEQB3=(MTOT - 3*NV*NV - 3*NV)/(2*NV + 1)                          00004840
      NEQB4=(MTOT - 6*NV)/(1 + MBAND)                                   00004850
      IF(LMASS.EQ.1.OR.NDYN.EQ.11)                                      00004860
     $NEQB4=(MTOT-6*NV)/(2*MBAND)                                       00004870
      IF (NEQB1.LT.NEQB) NEQB=NEQB1                                     00004880
      IF (NEQB2.LT.NEQB) NEQB=NEQB2                                     00004890
      IF (NEQB3.LT.NEQB) NEQB=NEQB3                                     00004900
      IF (NEQB4.LT.NEQB) NEQB=NEQB4                                     00004910
      NEIG=1                                                            00004920
  230 CONTINUE                                                          00004930
      NBLOCK = (NEQ-1)/NEQB +1                                          00004940
      IF (NEQB.GE.NEQ) NEQB=NEQ                                         00004950
      IF(NDYN.EQ.11) GO TO 250                                          00004960
      KREM = 1000                                                       00004970
      NTOT = NBLOCK*NEQB*NF + KREM                                      00004980
      IF(MTOT.LT.NTOT)                                                  00004990
     $WRITE (6,540)NTOT,MTOT                                            00005000
      IF(MTOT.LT.NTOT)KSKIP=1                                           00005010
      GO TO 250                                                         00005020
  240 CONTINUE                                                          00005030
      NN2 = NEQ                                                         00005040
      NN3 = NEQ                                                         00005050
      NEQB1 = (MTOT-NN2-NN3-NEQ-MBAND)/(2*MBAND+1)                      00005060
      NEQB2 = (MTOT-MBAND-2*(NN2+NN3)-5*NEQ)/(MBAND+1)                  00005070
      IF(NEQB1.LT.NEQB) NEQB = NEQB1                                    00005080
      IF(NEQB2.LT.NEQB) NEQB = NEQB2                                    00005090
      IF(NEQB.GT.NEQ)   NEQB = NEQ                                      00005100
      NBLOCK = (NEQ-1)/NEQB +1                                          00005110
      NN2 = 10                                                          00005120
      NN3 = 40                                                          00005130
      NN4 = 3*NUMNP + 2*NN2*NEQ                                         00005140
      IF(NN4.GT.MTOT)                                                   00005150
     $WRITE (6,540)NN4,MTOT                                             00005160
      IF(NN4.GT.MTOT)KSKIP=1                                            00005170
      NN4 = NEQ*2*(NN2+1) + NN2*(1+2*NN3)                               00005180
      IF(NN4.GT.MTOT)                                                   00005190
     $WRITE (6,540)NN4,MTOT                                             00005200
        IF(NN4.GT.MTOT)KSKIP=1                                          00005210
  250 CONTINUE                                                          00005220
      MMA=1                                                             00005230
      IF(LMASS.EQ.1) MMA=MBAND                                          00005240
      N4=N2+NEQB*LL                                                     00005250
      N3=N4+NEQB*MMA                                                    00005260
      N5=N3+6*LL                                                        00005270
      NSLDM=NSLAVE                                                      00005280
      IF(NSLDM.EQ.0) NSLDM=1                                            00005290
      N6=N5+NSLDM*4                                                     00005300
      IF(N6.GT.MTOT) CALL ERROR(N6-MTOT)                                00005310
      WRITE (6,510) NEQ,MBAND,NEQB,NBLOCK                               00005320
      CALL SECOND(T(3))                                                 00005330
      IF(NLC.LE.0.AND.KSKIP.EQ.1) GO TO 255                             00005340
      CALL INL(A(N1),A(N2),A(N3),A(N4),NUMNP,NEQB,LL,MMA,A(N6),NSLDM)   R0005350
  255 CONTINUE                                                          00005360
      NE2B=2*NEQB                                                       00005370
      N1=1+NEMN                                                         00005380
      CALL SECOND(T(4))                                                 00005390
      IF(KSKIP.EQ.1) GO TO 270                                          00005400
      NY=NUMET                                                          00005410
      IF(NUMET.LE.0) WRITE(6,260)                                       00005420
      IF(NUMET.LE.0) KSKIP=1                                            00005430
  260 FORMAT(//20X, 23H ALL ELEMENTS ARE BLANK//)                       00005440
       NN2=N1+NEQB*MBAND                                                00005450
      NN3=NN2+NEQB*LL                                                   00005460
      NLCMR2 = NN2                                                      R0005451
      DO 264 JJ=1,LL                                                    R0005452
      DO 263 II=1,NEQB                                                  R0005453
      BBR(II,JJ) = A(NLCMR2)                                            R0005454
  263 NLCMR2 = NLCMR2 + 1                                               R0005455
  264 CONTINUE                                                          R0005456
      WRITE (6,2003) NN1,NN2,NN3
 2003 FORMAT (5X,'*** NN1 NN2 NN3 ***',3I5/)
CC    WRITE (6,2001) (BBR(II,JJ),II=1,NEQB)     
C2001 FORMAT (1X,'**B B B**',11E10.3/)
      NLCMR3 = NN3                                                      R0005461
      DO 265 II=1,NEQB                                                  R0005461
      TMASS(II,1) = A(NLCMR3)                                           R0005462
      NLCMR3 = NLCMR3 + 1                                               R0005463
  265 CONTINUE                                                          R0005464
CC    WRITE (6,2002) (TMASS(II,1),II=1,NEQB)
C2002 FORMAT (1X,'**TMASS**',11E10.3/)
      NN4=N1                                                            R0005470
      IF(LMASS.EQ.1) NN4=NN3 + NEQB * MBAND                             R0005480
      MMA=1                                                             00005490
      IF(LMASS.EQ.1) MMA=MBAND                                          00005500
      NN5=NN4+NEQB*MBAND                                                00005510
      NN6=NN5+NEQB*LL                                                   00005520
      CALL ADDSTF(                    A(NN4),              NUMET,NBLOCK,R0005530
     $NE2B,LL,MBAND,NEQB,NEMN,ANORM,NVV,MMA)                            00005540
  270 CALL SECOND(T(5))                                                 00005550
      MODEX=KSKIP                                                       00005560
  280 CONTINUE                                                          00005570
CCR   IF(NELGEO.EQ.1) GO TO 290                                         R0005580
  320 CONTINUE                                                          R0005581
  330 CONTINUE                                                          R0005582
      CALL COMMRW(0)                                                    R0005583
      WRITE (*,1099)                                                    R0005584
 1099 FORMAT (5X,'************ SAP6PC3 FINISHED ************')          R0005585
  510 FORMAT(34H1 TOTAL NUMBER OF EQUATIONS      =,I5,                  00007430
     $      /34H  BANDWIDTH                      =,I5,                  00007440
     $      /34H  NUMBER OF EQUATIONS IN A BLOCK =,I5,                  00007450
     $      /34H  NUMBER OF BLOCKS               =,I5)                  00007460
  540 FORMAT (// 47H ** WARNING.  ESTIMATE OF STORAGE FOR A DYNAMIC,    00007670
     $           32H ANALYSIS EXCEEDS AVAILABLE CORE,                   00007680
     &/31H  CONTINUE IN THE READDATA MODE/15H MTOT REQUIRED=,           00007690
     &I10,/17H MTOT AVAILABLE =,I10)                                    00007700
CC    STOP                                                              R0007771
      END                                                               00007780
      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 TOTSTF (                   AT2,JFT,LDG2,MHI2,A2,B2,SS,NR0308420
     1BLOCK,MT2B,NUMEL,LL,MTB,MCB,NEMN,LBRD,NWTOT)                      00308430
      IMPLICIT REAL*8(A-H,O-Z)                                          00308440
      REAL*8 NPAR                                                       00308450
      REAL*8 MHI,KFT,LDG,JFT,LDG2,MHI2                                  00308460
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH                                 00308470
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00308480
      COMMON /PREP/ XD(2),NSTOP,NDYN,NRPREP(15)                         R0308490
      COMMON /SQZ/ ISQZ,NRSQZ(5),NRC1                                   R0308510
      COMMON /JUNK/ NC1,NC2,NC,NORDER(200),LP1,KST,KST2,KND,KND2,LBK,LT,00308520
     1N,K,II,JLOC,ND,NDP,KK,JJ,KCOL,MADD,LMI,LMII,IJ,NRJUNK(231)        R0308530
      COMMON /ELPAR/ NPAR(14),NUMNP,MBAND,NELTYP,N1,N2,N3,N4,N5,MTOT,NEQ00308540
     & ,RRELPA(24)                                                      R0308541
      COMMON /FORCE/ NLC,NELD                                           00308550
      COMMON /AAA1/ A(8000)                                             R0308551
      COMMON /AAA2/ KFT(4),LDG(300),MHI(300),B(600)                     R0308552
CC    DIMENSION MHI(MCB), LDG(MCB), B(LBRD), A(MTB), SS(1)              R0308560
      DIMENSION MHI2(MCB), LDG2(MCB), B2(LBRD), A2(MTB), SS(1)          R0308570
      DIMENSION        JFT(4), AT2(NWTOT)                               R0308580
        CALL FILES(3)                                                   00308590
      NRC2 = 0                                                          R0308600
      NRC3 = 1                                                          R0308610
      ZER=0.0                                                           00308620
      ANORM=0.0D0                                                       00308630
      AMIN=1.0D30                                                       00308640
      AMAX=-AMIN                                                        00308650
      NDEG=0                                                            00308660
      IF (NSTOP.GT.0) RETURN                                            00308670
      NTA=4                                                             00308680
      CALL RDWRT (NTA,AT,1,6,INUM)                                      00308690
      LP1=1+LL                                                          00308700
      NT2=2                                                             00308710
      REWIND 3                                                          00308720
      X=NBLOCK                                                          00308730
      MB=DSQRT(X)                                                       00308740
      MB=MB/2+1                                                         00308750
      MM=1                                                              00308760
      NTMM=3                                                            00308770
      NEBB=NEQ                                                          00308780
      KINC=NBLOCK*20/100                                                00308790
      IF (KINC.LT.1) KINC=1                                             00308800
      NORED=0                                                           00308810
      DO 360 N=1,NBLOCK,2                                               00308820
         CALL QVSET (ZER,A,MTB)                                         00308830
         CALL QVSET (ZER,A2,MTB)                                        00308840
         READ (3) NC1,INUM,KFT,(LDG(IR),IR=1,MCB),(MHI(IR),IR=1,MCB),
     $ (B(IR),IR=1,LBRD)
         RKND=KFT(4)                                                    R0308860
         RKST=KFT(3)                                                    R0308870
         KND = RKND
         KST = RKST
         KST2=KST                                                       00308880
         KND2=KND                                                       00308890
         NC2=0                                                          00308900
         IF (N.EQ.NBLOCK) GO TO 120                                     00308910
         READ (3) NC2,NEBB,JFT,LDG2,MHI2,B2                             R0308920
         RKST2=JFT(3)                                                   R0308930
         RKND2=JFT(4)                                                   R0308940
         KST2 = RKST2
         KND2 = RKND2
         LBK=NC2*LL+1                                                   00308950
         NC2P=NC2+1                                                     00308960
         DO 110 KK=1,NC2                                                00308970
            K=NC2P-KK                                                   00308980
           RLDGK=LDG2(K)                                                R0308990
           LDGK = RLDGK
         DO 110 II=1,LL                                                 00309000
            I=LP1-II                                                    00309010
            LBK=LBK-1                                                   00309020
            A2(LDGK+I)=B2(LBK)                                          00309030
110      B2(LBK)=0.0                                                    00309040
120      NC=NC1                                                         00309050
      IF (NRC3 .EQ. 1) WRITE (6,1002) KFT,JFT
 1002 FORMAT (1X,'****** KFT JFT ***',8E11.4/)
         IF (N.EQ.NBLOCK) NEBB=NEQ                                      00309060
         LBK=NC*LL+1                                                    00309070
         NC1P=NC1+1                                                     00309080
         DO 130 KK=1,NC                                                 00309090
            K=NC1P-KK                                                   00309100
           RLDGK=LDG(K)                                                 R0309110
           LDGK = RLDGK
         DO 130 II=1,LL                                                 00309120
            I=LP1-II                                                    00309130
            LBK=LBK-1                                                   00309140
            A(LDGK+I)=B(LBK)                                            00309150
130      B(LBK)=0.0                                                     00309160
         CALL RDWRT (NT2,A,1,6,INUM)                                    00309170
         NT=0                                                           00309180
         REWIND 10                                                      00309190
         LT=0                                                           00309200
         CALL RDWRT (NTMM,A,1,6,INUM)                                   00309210
         NUME=NUM10                                                     00309220
         IDELT=1                                                        00309230
         NEND=NEQ+1                                                     00309240
         IF (MM.NE.1) GO TO 140                                         00309250
         NUME=NUMEL                                                     00309260
         IDELT=100                                                      00309270
         NUM10=0                                                        00309280
140      DO 300 K=1,NUME,IDELT                                          00309290
            NUM=MIN0(NUMEL-LT*100,100)                                  00309300
            IF (MM.GT.1) NUM=1                                          00309310
            LT=LT+1                                                     00309320
            IF (NORED.EQ.0.AND.MM.EQ.1) READ (10) NORDER                00309330
            DO 290 NT=1,NUM                                             00309340
               IF (NBLOCK.LE.2) GO TO 150                               00309350
               IF (MM.GT.1) GO TO 160                                   00309360
               NNT=NT*2                                                 00309370
               NST=NORDER(NNT-1)                                        00309380
               NEND=NORDER(NNT)                                         00309390
               IF (NST.GT.KND2.AND.NST.LE.NEBB) GO TO 270               00309400
               IF (NST.GT.NEBB.OR.NEND.LT.KST) GO TO 260                00309410
  150 CALL RDWRT(NT2,SS,NEMN,0,KOUNT)                                   00309420
               GO TO 170                                                00309430
160            CALL RDWRT (NTMM,SS,NEMN,0,KOUNT)                        00309440
170            ND=SS(KOUNT)                                             00309450
               IF (SS(ND).LT.KST) GO TO 290                             00309460
               NDP=ND+1                                                 00309470
               NTOT=(ND*ND-ND)/2+ND                                     00309480
               KK=NTOT+1                                                00309490
               DO 240 I=1,ND                                            00309500
                  JLOC=I                                                00309510
                  LMI=SS(I)                                             00309520
                  IF (LMI.LT.KST) GO TO 230                             00309530
                  IF (LMI.GT.KND) GO TO 200                             00309540
                  KCOL=LMI-KST+1                                        00309550
                  RENUM = LDG(KCOL)
                  MA= RENUM   -LMI                                      R0309560
                  DO 180 II=1,I                                         00309570
                     JLOC=JLOC+NDP-II                                   00309580
                     LMII=SS(II)                                        00309590
                     MADD=MA+LMII                                       00309600
180               A(MADD)=A(MADD)+SS(JLOC)                              00309610
      IF(NELD.EQ.1) GO TO 185                                           00309620
      MA=MADD+LL                                                        00309630
      IF(NDYN.EQ.8) A(MA)=A(MA)+SS(KK+ND)                               00309640
      GO TO 230                                                         00309650
  185 CONTINUE                                                          00309660
                  J=KK                                                  00309670
                  DO 190 LC=1,LL                                        00309680
                     MA=MADD+LC                                         00309690
                     J=J+ND                                             00309700
190               A(MA)=A(MA)+SS(J)                                     00309710
      IF(NDYN.EQ.8) A (MA)=A (MA)+SS(J+ND)-SS(J)                        00309720
                  GO TO 230                                             00309730
200               CONTINUE                                              00309740
                  IF (LMI.GT.KND2) GO TO 250                            00309750
                  KCOL=LMI-KST2+1                                       00309760
                  RENUM2 = LDG2(KCOL)
                  MA= RENUM2   -LMI                                     R0309770
                  DO 210 II=1,I                                         00309780
                     JLOC=JLOC+NDP-II                                   00309790
                     LMII=SS(II)                                        00309800
                     MADD=MA+LMII                                       00309810
210               A2(MADD)=A2(MADD)+SS(JLOC)                            00309820
      IF(NELD.EQ.1) GO TO 215                                           00309830
      MA=MADD+LL                                                        00309840
      IF(NDYN.EQ.8) A2(MA)=A2(MA)+SS(KK+ND)                             00309850
      GO TO 230                                                         00309860
  215 CONTINUE                                                          00309870
                  J=KK                                                  00309880
                  DO 220 LC=1,LL                                        00309890
                     MA=MADD+LC                                         00309900
                     J=J+ND                                             00309910
220               A2(MA)=A2(MA)+SS(J)                                   00309920
      IF(NDYN.EQ.8) A2(MA)=A2(MA)+SS(J+ND)-SS(J)                        00309930
230               KK=KK+1                                               00309940
240            CONTINUE                                                 00309950
250            CONTINUE                                                 00309960
               IF (MM.NE.1) GO TO 290                                   00309970
               IF (NEND.GT.KND2.AND.NST.LE.NEBB) GO TO 280              00309980
               GO TO 290                                                00309990
  260 CALL RDWRT(NT2,SS,1,3,KOUNT)                                      00310000
               GO TO 290                                                00310010
270            CALL RDWRT (NT2,SS,NEMN,0,KOUNT)                         00310020
280            CALL RDWRT (NTMM,SS,KOUNT,1,INUM)                        00310030
               NUM10=NUM10+1                                            00310040
290         CONTINUE                                                    00310050
            IF (NUMEL.LE.100) NORED=1                                   00310060
300      CONTINUE                                                       00310070
         DO 310 IJ=1,NC1                                                00310080
           RMNM=LDG(IJ)                                                 R0310090
           MNM = RMNM
            IF (A(MNM).GT.0.) GO TO 1005                                00310100
            I=KST+IJ-1                                                  00310110
            WRITE(6,340) I                                              00310120
            NSTOP=1                                                     00310130
 1005 ANORM=ANORM+A(MNM)                                                00310140
      IF(A(MNM).NE.0.0D0.AND.A(MNM).LT.AMIN) AMIN=A(MNM)                00310150
      IF(A(MNM).GT.AMAX) AMAX=A(MNM)                                    00310160
      IF(A(MNM).NE.0)NDEG=NDEG+1                                        00310170
310      CONTINUE                                                       00310180
      IF(.NOT.GENPRT) GO TO 1100                                        00310190
      WRITE(6,1500)N                                                    00310200
      DO 1010 IJ=1,NC1                                                  00310210
      I=KST+IJ-1                                                        00310220
      RMNM=LDG(IJ)                                                      R0310230
      MNM = RMNM
      MAXH=MHI(IJ)                                                      00310240
      KL=MNM-MAXH                                                       00310250
      IF(GENPCH) WRITE(7,1520)I,MAXH                                    00310260
      IF(GENPCH) WRITE(7,1510)(A(KL+J),J=1,MAXH)                        00310270
      WRITE(6,1520)I,MAXH                                               00310280
      WRITE(6,1530)(A(KL+J),J=1,MAXH)                                   00310290
 1010 CONTINUE                                                          00310300
      WRITE(6,1550)                                                     00310310
      DO 1020 IJ=1,NC1                                                  00310320
      I=KST+IJ-1                                                        00310330
      RMNM=LDG(IJ)                                                      R0310340
      MNM = RMNM
      IF(GENPCH) WRITE(7,1510)(A(MNM+J),J=1,LL)                         00310350
 1020 WRITE(6,1540)I,(A(MNM+J),J=1,LL)                                  00310360
 1100 CONTINUE                                                          00310370
         IF (N.EQ.NBLOCK) GO TO 330                                     00310380
         DO 320 IJ=1,NC2                                                00310390
           RMNM=LDG2(IJ)                                                R0310400
           MNM = RMNM
            IF (A2(MNM).GT.0.0) GO TO 1105                              00310410
            I=KST2+IJ-1                                                 00310420
            WRITE(6,340) I                                              00310430
            NSTOP=1                                                     00310440
 1105 ANORM=ANORM+A2(MNM)                                               00310450
      IF(A2(MNM).NE.0.0D0.AND.A2(MNM).LT.AMIN) AMIN=A2(MNM)             00310460
      IF(A2(MNM).GT.AMAX) AMAX=A2(MNM)                                  00310470
      IF(A2(MNM).NE.0)NDEG=NDEG+1                                       00310480
320      CONTINUE                                                       00310490
      IF(.NOT.GENPRT) GO TO 1200                                        00310500
      MP1=N+1                                                           00310510
      WRITE(6,1500)MP1                                                  00310520
      DO 1110 IJ=1,NC2                                                  00310530
      I=KST2+IJ-1                                                       00310540
      RMNM=LDG2(IJ)                                                     R0310550
       MNM = RMNM
      MAXH=MHI2(IJ)                                                     00310560
      KL=MNM-MAXH                                                       00310570
      IF(GENPCH) WRITE(7,1520)I,MAXH                                    00310580
      IF(GENPCH) WRITE(7,1510)(A(KL+J),J=1,MAXH)                        00310590
      WRITE(6,1520)I,MAXH                                               00310600
      WRITE(6,1530)(A2(KL+J),J=1,MAXH)                                  00310610
 1110 CONTINUE                                                          00310620
      WRITE(6,1550)                                                     00310630
      DO 1120 IJ=1,NC2                                                  00310640
      I=KST2+IJ-1                                                       00310650
      RMNM=LDG2(IJ)                                                     R0310660
      MNM = RMNM
      IF(GENPCH) WRITE(7,1510)(A(MNM+J),J=1,LL)                         00310670
 1120 WRITE(6,1540)I,(A2(MNM+J),J=1,LL)                                 00310680
 1200 CONTINUE                                                          00310690
330      CONTINUE                                                       00310700
         IF (NSTOP.EQ.1) GO TO 360                                      00310710
340   FORMAT (/31H ZERO DIAGONAL EQUATION NUMBER ,I5,21H EXECUTION TERMI00310720
     1NATED)                                                            00310730
CC       CALL SQEEZE (AT,NWTOT,NTA,ISQZ)                                00310740
         NRC1 = 0                                                       R0310741
         IF (MTB .GT. 8000) NRC1 = 1                                    R0310742
         IF (NRC3 .EQ. 1) WRITE (6,1007) NRC1,NRC2
         NRC2 = NRC2 + 1
 1007    FORMAT (5X,'**** NRC1 NRC2 ****',2I5/)
         WRITE (4) KFT,(LDG(IR),IR=1,MCB),(MHI(IR),IR=1,MCB)            R0310743
         IF (NRC1 .EQ. 1) WRITE (4) (A(IR),IR=1,8000)                   R0310744
         IF (NRC1 .EQ. 1) WRITE (4) (A(IR),IR=8000,MTB)                 R0310745
         IF (NRC1 .EQ. 0) WRITE (4) (A(IR),IR=1,MTB)                    R0310745
         IF (N.EQ.NBLOCK) GO TO 360                                     00310750
         IF (MM.EQ.MB) MM=0                                             00310760
         MM=MM+1                                                        00310770
      IF(KPR.EQ.0)  WRITE(6,350)PER                                     00310780
CC       CALL SQEEZE (AT2,NWTOT,NTA,ISQZ)                               R0310790
         WRITE (4) JFT,(LDG2(IR),IR=1,MCB),(MHI2(IR),IR=1,MCB)          R0310791
         IF (NRC1 .EQ. 1) WRITE (4) (A2(IR),IR=1,8000)                  R0310791
         IF (NRC1 .EQ. 1) WRITE (4) (A2(IR),IR=8000,MTB)                R0310792
         IF (NRC1 .EQ. 0) WRITE (4) (A2(IR),IR=1,MTB)                   R0310793
         PER=(N+1)*100.0/X                                              00310800
         KPR=MOD(N+1,KINC)                                              00310810
350   FORMAT (20X,F7.2,41H PERCENT OF THE MASTER STIFFNESS AND LOAD,    00310820
     130H MATRICES HAVE BEEN ASSEMBLED.///)                             00310830
360   CONTINUE                                                          00310840
      IF(NDEG.GT.0) GO TO 1300                                          00310850
      WRITE(6,1560)                                                     00310860
      STOP                                                              00310870
 1300 ANORM=(ANORM/NDEG)*1.0D-8                                         00310880
      RATIO=1.0D30                                                      00310890
      IF(AMIN.NE.0.0D0) RATIO=AMAX/AMIN                                 00310900
      AAVG=ANORM*1.0D8                                                  00310910
      WRITE(6,1570)AMIN,AMAX,RATIO,AAVG                                 00310920
      WRITE(6,370)                                                      00310930
370   FORMAT (20X,48HTHE MASTER STIFFNESS AND LOAD MATRICES HAVE BEEN,  00310940
     111H ASSEMBLED.//)                                                 00310950
      RETURN                                                            00310960
 1500 FORMAT(17H OVERALL MATRICES,1X,5HBLOCK,I3,//,                     00310970
     117H STIFFNESS MATRIX)                                             00310980
 1510 FORMAT((1P8E10.3))                                                00310990
 1520 FORMAT (1X,17HEQUATION NUMBER =,I5,5X,15HHT. OF COLUMN =,I5)      00311000
 1530 FORMAT (  (1X ,1P10E13.4))                                        00311010
 1540 FORMAT(  (1X,I5,1P10E12.4,/(6X,1P10E12.4)))                       00311020
 1550 FORMAT(///,12H LOAD MATRIX)                                       00311030
 1560 FORMAT (51H0STRUCTURE WITH NO DEGREES OF FREEDOM CHECK DATA     ) 00311040
 1570 FORMAT(5X,27HSTIFFNESS MATRIX PARAMETERS,//,                      00311050
     1 15X,34HMINIMUM NON-ZERO DIAGONAL ELEMENT=,1PD10.3,/,             00311060
     2 15X,34HMAXIMUM DIAGONAL ELEMENT         =,  D10.3,/,             00311070
     3 15X,34HMAXIMUM/MINIMUM                  =,  D10.3,/,             00311080
     4 15X,34HAVERAGE DIAGONAL ELEMENT         =,  D10.3)               00311090
      END                                                               00311100
      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                                                                       
      FUNCTION GETWRD(GET001)                                           00105400
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW           00105410
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1             00105420
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,                       00105430
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,                            00105440
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT                      00105450
      GETWRD = .FALSE.                                                  00105460
      LENGTH = 0                                                        00105470
      IF (EOL) RETURN                                                   00105480
      DO 100 BEGIN = POINT,80                                           00105490
      IF (LINE(BEGIN).NE.BLANK) GO TO 110                               00105500
100   CONTINUE                                                          00105510
      EOL = .TRUE.                                                      00105520
      POINT = 80                                                        00105530
      RETURN                                                            00105540
110   DO 170 POINT = BEGIN,80                                           00105550
      IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA)                00105560
     1GO TO 180                                                         00105570
      LENGTH = POINT - BEGIN + 1                                        00105580
      MAXSTR = LENGTH                                                   00105590
170   CONTINUE                                                          00105600
      GETWRD = .TRUE.                                                   00105610
      EOL = .TRUE.                                                      00105620
      RETURN                                                            00105630
180   IP = POINT                                                        00105640
      DO 200 POINT = POINT,80                                           00105650
      IF (LINE(POINT).EQ.ICOMMA) GO TO 210                              00105660
      IF (LINE(POINT).NE.BLANK) GO TO 190                               00105670
200   CONTINUE                                                          00105680
      GETWRD = .TRUE.                                                   00105690
      EOL =.TRUE.                                                       00105700
      RETURN                                                            00105710
190   POINT = IP                                                        00105720
      GETWRD = .TRUE.                                                   00105730
      RETURN                                                            00105740
210   POINT = POINT + 1                                                 00105750
      GETWRD = .TRUE.                                                   00105760
      RETURN                                                            00105770
      END                                                               00105780
