      PROGRAM SAP6P2                                                    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 (' **************    PROGRAM SAP6P2 STARTING    *********')R0001612
        KZN(1)=2                                                        00001880
        KZN(2)=7                                                        00001890
        KZN(3)=1                                                        00001900
        KZN(4)=2                                                        00001910
        KZN(5)=7                                                        00001920
        KZN(6)=7                                                        00001930
        KZN(7)=10                                                       00001940
        KZN(8)=7                                                        00001950
        KZN(9)=21                                                       00001960
        KZN(10)=1177                                                    00001970
        KZN(11)=6                                                       00001980
        KZN(12)=51                                                      00001990
        KZN(13)=10                                                      00002000
        KZN(14)=21                                                      00002010
        KZN(15)=9                                                       00002020
        KZN(16)=7                                                       00002030
        KZN(17)=8                                                       00002040
        KZN(18)=5                                                       00002050
        KZN(19)=0                                                       00002060
        KZN(20)=0                                                       00002070
      MKZ=20                                                            00002090
      CALL SIZER2                                                       R0002091
      MTOTR = MTOT                                                      R0002091
      CALL COMMRW(1)                                                    R0002092
      MTOT = MTOTR                                                      R0002093
        NDSSS=NDYN                                                      00002250
        IF(NDYN.NE.12)GO TO 115                                         00002260
        NDSSS=12                                                        00002270
        KDSSS=KDYN                                                      00002280
        NDYN=6                                                          00002290
        KDYN=6                                                          00002300
        IF(KDSSS.LT.0)KDYN=-6                                           00002310
115     CONTINUE                                                        00002320
      CALL RDWRT(1,A(1),1,11,I)                                         00002330
      IF(NTYP.EQ.0) GO TO 170                                           00002340
        REWIND 3                                                        00002350
      NEMN=(MXDF+LL)*(NSMX+MXDF)+MXDF*2+NDMX*LL                         00002360
      IF(LMASS.EQ.1) NEMN=NEMN+MXDF*(MXDF-1)                            00002370
      IF(NDYN.EQ.11) GEOST=.TRUE.
      IF(GEOST) WRITE(6,2009) NDYN
 2009 FORMAT (5X,'****** SAP6PC2 NDYN ********',I5/)
      IF(GEOST)                                                         00002380
     $ NEMN=NEMN+3*(MXDF*MXDF)                                          00002390
      NEMN=NEMN+3                                                       00002400
      NI=1+NEMN                                                         00002410
      DO 120 I=1,MKZ                                                    00002420
  120 KZ(I,1)=KZ(I,1)+NEMN                                              00002430
      NTYP=NTYP+NEMN                                                    00002440
      N1P =N1P +NEMN                                                    00002450
      N2P =N2P +NEMN                                                    00002460
      N3P =N3P +NEMN                                                    00002470
      M1P = M1P + NEMN                                                  00002480
      M2P = M2P + NEMN                                                  00002490
      M3P = M3P + NEMN                                                  00002500
  130 J=0                                                               00002510
      DO 140 I=1,MKZ                                                    00002520
      IF(KZ(I,1).EQ.NI) J=I                                             00002530
  140 CONTINUE                                                          00002540
      IF(J.GT.0) GO TO 150                                              00002550
      NF=NTRI*4+NMRI*3+NI-1                                             00002560
      GO TO 160                                                         00002570
  150 NTY=KZN(J)                                                        00002580
      IF(J.EQ.16) NTY=NTY*LL                                            00002590
      NF=NI+KZ(J,2)*NTY-1                                               00002600
      IF(ICOMP.EQ.1.AND.J.EQ.7)NF=NI+MTRI*9+MMRI*3-1                    00002610
  160 READ (3) (A(I),I=NI,NF)                                           00002620
      WRITE(6,2002) N1P,N2P,N3P,NI,NF,NTYP
      WRITE(6,2001) (A(II),II=NI,NF)
 2001 FORMAT (1X,'**S2**',12E10.4/)
 2002 FORMAT (5X,'** N1P N2P N3P NI NF NTYP **',6I5/)
      NI=NF+1                                                           00002630
      IF(NF.LT.NTYP) GO TO 130                                          00002640
  170 CONTINUE                                                          00002650
      N1=NTYP+1                                                         00002660
      N2=N1+NUMNP*3                                                     00002670
      N3=N1+NUMEL*13                                                    00002680
      IF(N2.GT.MTOT) CALL ERROR(N2-MTOT)                                00002690
      N4=N3+NTERM*NADND                                                 00002700
      N5=N4+NSLAVE*4                                                    00002710
      NSLDM=NSLAVE                                                      00002720
      IF(NSLDM.EQ.0) NSLDM=1                                            00002730
      IF(N5.GT.MTOT) CALL ERROR(N5-MTOT)                                00002740
      KRK1 = N5                                                         R0002741
  180 CALL INPTN (A(N1),A(N1),A(N3),NUMEL,NUMEL2,NUMNP,NTERM,NADND,     00002750
     $NEQ,I,A(N4),NSLDM)                                                00002760
      NBLANK=I                                                          00002770
      IF(NEQ.EQ.0) KSKIP=1                                              00002780
      IF(KSKIP.EQ.1.AND.NEQ.EQ.0) NEQ=1                                 00002790
      CALL SECOND(T(2))                                                 00002800
        DO 9180 I=3,10                                                  00002810
9180    T(I)=T(2)                                                       00002820
      IF(KSKIP.EQ.1) GO TO 185                                          00002830
      NEMNM=NEMN-NDMX*LL-2                                              00002840
      IF(.NOT.GEOST) GO TO 1180                                         00002850
      NEMNM=NEMNM-3*(MXDF*MXDF)                                         00002860
 1180 CONTINUE                                                          00002870
      IF(KELRST.NE.2) GO TO 181                                         00002880
      NNRRC = 183                                                       R0002881
      GO TO 183                                                         00002890
  181 CONTINUE                                                          00002900
      KAPG=N4                                                           00002910
        KAPG1=KAPG+NUMNP                                                00002920
      KRK1=KAPG1+NSLAVE*4                                               00002930
        IF(KRK1 .GT.MTOT)CALL ERROR(KRK1-MTOT)                          00002940
      NBLANK=0                                                          00002950
      MAXDF=0                                                           00002960
      CALL ELSTF(NDMX,LL,A(NEMNM),NBLANK,NTERM,ZD(1),NADND              00002970
     &  ,A(KAPG),NUMNP,A(KAPG1),NSLDM)                                  00002980
      IF(NSELEM.LE.0) GO TO 183                                         00002990
      IF(LMASS.NE.-1) GO TO 1190                                        00003000
      IF(NDYN.NE.8) GO TO 1190                                          00003010
      WRITE(6,550)NDYN,LMASS                                            00003020
      KSKIP = 1                                                         00003030
 1190 CONTINUE                                                          00003040
      N3=N1                                                             00003050
      N1=1                                                              00003060
      N2=KZ(6,1)                                                        00003070
      N4=7*LL                                                           00003080
      CALL QVCOPY(A(N2),A(N1),N4)                                       00003090
      N2=N4+1                                                           00003100
      N4=NUMNP*3                                                        00003110
      CALL QVCOPY(A(N3),A(N2),N4)                                       00003120
      N3=N2+N4                                                          00003130
      CALL SUPSTF(NSELEM,A(N1),A(N2),A(N3),LL,NUMNP,MTOT,MBAND,MAXDF)   00003140
      N5=7*LL                                                           00003150
      CALL QVCOPY(A(N1),A(N3),N5)                                       00003160
      KZ(6,1)=N3                                                        00003170
      CALL QVCOPY(A(N2),A(N1),N4)                                       00003180
      N2=N1+N4                                                          00003190
  550 FORMAT(5X,47H ** ERROR.  ONLY ONE LEVEL OF SUBSTRUCTURING IS,     00007710
     $18HALLOWED WHEN NDYN=,I3,2X,10HAND LMASS=,I3)                     00007720
  183 CONTINUE
  185 CONTINUE
      WRITE (*,1095) N2,N4,N5,KRK1
 1095 FORMAT (5X,'****** N2,N4,N5,KRK1 ******',4I5)
      CALL COMMRW(0)
      WRITE (*,1099)
 1099 FORMAT (5X,'********** SAP6P2 FINISHED ***********')
CC    STOP
      END
      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 INPTN(ID,ID2,ID4,NUMEL,NUMEL2,NUMNP,NTERM,NADND,NEQ,I, 00118260
     1ISL,NSLDM)                                                        00118270
      IMPLICIT REAL*8(A-H,O-Z)                                          00118280
      REAL*8  ID3,ID2                                                   R0118290
      REAL*8  ID                                                        00118300
      REAL*8  ID4                                                       R0118310
      LOGICAL ISLAVE                                                    R0118311
      COMMON /GPS/ NEQ4(10),NRGPS(10)                                   R0118320
      COMMON /PREP/ XMX,XAD,KSKIP,NDYN,I1,I99,POS,PRTCOD                00118330
     $              ,POSSAV,PRTOFF,PRTON,PRTDUM,IDIRC                   00118340
      COMMON /SUPEL/NSELEM,NEQL,NODESE,NRSUPE(3)                        R0118350
      COMMON/SLVE/NSLAVE                                                00118360
      COMMON /ELARRY/NELAR(4,20)                                        00118390
      DIMENSION ID4(NADND)                                              R0118370
      DIMENSION ID(NUMNP,3)                                             R0118380
      DIMENSION IX(6)                                                   R0118390
      DIMENSION IZ(6)                                                   00118400
      DIMENSION ID3(9),ID2(13),ISL(NSLDM,4)                             R0118410
        CALL FILES(7)                                                   00118430
      REWIND 8                                                          00118440
      READ (8) ((ID(I,J),J=1,3),I=1,NUMNP)                              RR118450
      IF(NSLAVE.NE.0) REWIND 30                                         00118460
      IF(NSLAVE.NE.0) READ(30)((ISL(I,J),J=1,4),I=1,NSLAVE)             RR118470
      IF(KSKIP.EQ.1) GO TO 90                                           00118480
      IF(PRTCOD.EQ.PRTOFF) GO TO 95                                     00118490
      IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 95                    00118500
   90  WRITE(6,100)                                                     00118510
   95 CONTINUE                                                          00118520
  100 FORMAT(1X ,35X,28HEQUATION NUMBERS VS. DEGREES,1X,                00118530
     110HOF FREEDOM,/26X,58(1H-)                                        00118540
     2       //15X,2(40HNODE     X     Y     Z    XX    YY    ZZ,10X)/) 00118550
  110 FORMAT(15X,I5,6I6)                                                00118560
  111 FORMAT(1H+,64X,I5,6I6)                                            00118570
      I1I1=-I1*I1                                                       00118580
      DO 120 I=1,10                                                     00118590
  120 NEQ4(I)=I1I1                                                      00118600
      NG=1000                                                           00118610
      NEQ=0                                                             00118620
      DO 190 I=1,NUMNP                                                  00118630
      ISLAVE=.FALSE.                                                    00118640
      IF(NSLAVE.EQ.0) GO TO 1150                                        00118650
      DO 1120 J=1,NSLAVE                                                00118660
      IF(I.EQ.ISL(J,1)) GO TO 1140                                      00118670
 1120 CONTINUE                                                          00118680
      GO TO 1150                                                        00118690
 1140 ISLAVE=.TRUE.                                                     00118700
      ISLRF=J                                                           00118710
 1150 CONTINUE                                                          00118720
      DO 160 K=1,3                                                      00118730
      NNN=ID(I,K)                                                       00118740
      NNN= MOD(NNN,I1)                                                  00118750
      IF(NNN.EQ.1) GO TO 150                                            00118760
      IF(.NOT.ISLAVE) GO TO 1160                                        00118770
      JJ=ISL(ISLRF,(K+1))                                               00118780
      JJ=MOD(JJ,10000)                                                  00118790
      IF(JJ.EQ.0) GO TO 1160                                            00118800
      GO TO 1170                                                        00118810
 1160 CONTINUE                                                          00118820
      NEQ=NEQ+1                                                         00118830
      NEQ1=NEQ                                                          00118840
      IF(NNN.EQ.0) GO TO 140                                            00118850
      NEQ2=NNN/NG                                                       00118860
      IF(NEQ4(NEQ2).GT.0) GO TO 130                                     00118870
      NEQ4(NEQ2)=NEQ1                                                   00118880
      GO TO 140                                                         00118890
  130 NEQ=NEQ1-1                                                        00118900
      NEQ1=NEQ4(NEQ2)                                                   00118910
  140 IX(K)=NEQ1                                                        00118920
      GO TO 1175                                                        00118930
  150 IX(K  )=0                                                         00118940
      GO TO 1175                                                        00118950
 1170 IZ(K)=-JJ                                                         00118960
      IX(K)=0                                                           00118970
      GO TO 160                                                         00118980
 1175 IZ(K)=IX(K)                                                       00118990
  160 CONTINUE                                                          00119000
      DO 180 K=1,3                                                      00119010
      NNN=ID(I,K)                                                       00119020
      NN2=NNN                                                           00119030
      NNN=NNN/I1                                                        00119040
      IF(NNN.GT.0) GO TO 170                                            00119050
      IF(.NOT.ISLAVE) GO TO 1180                                        00119060
      JJ=ISL(ISLRF,(K+1))/10000                                         00119070
      IF(JJ.EQ.0) GO TO 1180                                            00119080
      GO TO 1190                                                        00119090
 1180 CONTINUE                                                          00119100
      NEQ=NEQ+1                                                         00119110
      IX(K+3)=0                                                         00119120
      IF(IX(K).GT.0) IX(K+3)=NEQ-IX(K)                                  00119130
      IF(IX(K).EQ.0.AND. NEQ.EQ.1) IX(K)=I1                             00119140
      IF(IX(K).EQ.0)IX(K)=-NEQ                                          00119150
      IZ(K+3)=NEQ                                                       00119160
      GO TO 180                                                         00119170
  170 IX(K+3)=0                                                         00119180
      IZ(K+3)=0                                                         00119190
      GO TO 180                                                         00119200
 1190 IX(K+3)=0                                                         00119210
      IZ(K+3)=-JJ                                                       00119220
  180 ID(I,K)=(ID(I,K)-NN2)+IX(K)+IX(K+3)*I1                            00119230
      IF(KSKIP.EQ.1) GO TO 186                                          00119240
      IF(PRTCOD.EQ.PRTOFF) GO TO 190                                    00119250
      IF(POS.EQ.PRTDUM.AND.PRTCOD.NE.PRTON) GO TO 190                   00119260
  186 CONTINUE                                                          00119270
      IF(MOD(I,2)) 184,185,184                                          00119280
  184 WRITE(6,110) I,IZ                                                 00119290
      GO TO 190                                                         00119300
  185 WRITE(6,111) I,IZ                                                 00119310
  190 CONTINUE                                                          00119320
      IF(NSLAVE.EQ.0)GO TO 1350                                         00119330
      DO 1300 I=1,NSLAVE                                                00119340
      ISLN=ISL(I,1)                                                     00119350
      DO 1265 K=1,3                                                     00119360
      JJ=ISL(I,(K+1))                                                   00119370
      JJ=MOD(JJ,10000)                                                  00119380
      CALL UNPKID(ID,NUMNP,W,WX,2,ISLN,K)                               00119390
      NEQSL=W                                                           00119400
      IF(JJ.EQ.0) GO TO 1260                                            00119410
      NNN=ID(JJ,K)                                                      00119420
      NNN=MOD(NNN,I1)                                                   00119430
      CALL UNPKID(ID,NUMNP,W,WX,2,JJ,K)                                 00119440
      NEQM=W                                                            00119450
 1250 IX(K)=NEQM                                                        00119460
      IZ(K)=NEQM                                                        00119470
      GO TO 1265                                                        00119480
 1260 CONTINUE                                                          00119490
      IX(K)=NEQSL                                                       00119500
      IZ(K)=NEQSL                                                       00119510
 1265 CONTINUE                                                          00119520
      DO 1280 K=1,3                                                     00119530
      NNS=ID(ISLN,K)                                                    00119540
      NNN=NNS/I1                                                        00119550
      CALL UNPKID(ID,NUMNP,W,WX,2,ISLN,K+3)                             00119560
      NEQSL=W                                                           00119570
      CALL UNPKID(ID,NUMNP,W,COORD,1,ISLN,K)                            00119580
      JJ=ISL(I,K+1)/10000                                               00119590
      IF(JJ.EQ.0) GO TO 1270                                            00119600
      NNN=ID(JJ,K)                                                      00119610
      NNN=NNN/I1                                                        00119620
      CALL UNPKID(ID,NUMNP,W,WX,2,JJ,K+3)                               00119630
      NEQM=W                                                            00119640
      IX(K+3)=0                                                         00119650
      IZ(K+3)=NEQM                                                      00119660
      IF(NEQM.EQ.0) GO TO 1280                                          00119670
      GO TO 1275                                                        00119680
 1270 CONTINUE                                                          00119690
      IX(K+3)=0                                                         00119700
      IZ(K+3)=NEQSL                                                     00119710
      NEQM=NEQSL                                                        00119720
      IF(NEQM.EQ.0) GO TO 1280                                          00119730
 1275 CONTINUE                                                          00119740
      IF(IX(K).GT.0.AND.IX(K).GT.NEQM) GO TO 1277                       00119750
      IF(IX(K).GT.0) IX(K+3)=NEQM-IX(K)                                 00119760
      IF(IX(K).EQ.0.AND.NEQM.EQ.1) IX(K)=I1                             00119770
      IF(IX(K).EQ.0) IX(K)=-NEQM                                        00119780
      GO TO 1280                                                        00119790
 1277 IX(K)=-IX(K)                                                      00119800
      IX(K+3)=-NEQM                                                     00119810
 1280 ID(ISLN,K)=COORD/XMX+XAD+IX(K)+IX(K+3)*I1                         00119820
      IF(MOD(I,2))1290,1295,1290                                        00119830
 1290 CONTINUE                                                          00119840
      GO TO 1300                                                        00119850
 1295 CONTINUE                                                          00119860
 1300 CONTINUE                                                          00119870
 1350 CONTINUE                                                          00119880
      PRTCOD = POS                                                      00119890
      IF(NSLAVE.EQ.0) GO TO 1410                                        00119900
      WRITE(6,310)                                                      00119910
      DO 1400 I=1,NUMNP                                                 00119920
      DO 1360 K=1,6                                                     00119930
      IZ(K)=0                                                           00119940
      CALL UNPKID(ID,NUMNP,W,WX,2,I,K)                                  00119950
      IZ(K)=W                                                           00119960
 1360 CONTINUE                                                          00119970
      IF(MOD(I,2))1390,1395,1390                                        00119980
 1390 WRITE(6,110)I,IZ                                                  00119990
      GO TO 1400                                                        00120000
 1395 WRITE(6,111)I,IZ                                                  00120010
 1400 CONTINUE                                                          00120020
 1410 CONTINUE                                                          00120030
      IF (KSKIP.EQ.1.AND.NDYN.NE.2) GO TO 250                           00120040
      NEQL=0                                                            00120050
      IF(NDYN.NE.8.AND.NDYN.NE.9) GO TO 196                             00120060
      DO 192 K=1,6                                                      00120070
      CALL UNPKID(ID,NUMNP,W,WX,2,NODESE,K)                             00120080
      IF(W.GT.0.0)GO TO 194                                             00120090
  192 CONTINUE                                                          00120100
  194 NEQL=W-1                                                          00120110
      WRITE(6,195)NEQL                                                  00120120
  195 FORMAT(/20X,37HTHE LAST EQUATION TO BE ELIMINATED IS,I5//)        00120130
  196 CONTINUE                                                          00120140
      REWIND 8                                                          00120150
      WRITE (8) ID                                                      00120160
  200 REWIND 4                                                          00120170
      NBLANK=0                                                          00120180
      DO 210 I=1,NUMEL                                                  R0120181
      READ (4) ID2                                                      R0120190
      IF(NTERM.GT.1) READ (4) ID4                                       RR120200
CC    DO 210 I=1,NUMEL                                                  00120210
      MT=ID2(13)                                                        R0120220
      IF(MT.EQ.7) NBLANK=NBLANK+1                                       00120230
CC    WRITE (6,1009) I,ID2                                              R0120232
      WRITE (68) ID2                                                    R0120240
      IF(NTERM.GT.1.AND.NELAR(1,MT).GT.8) WRITE (68) ID4                R0120250
  210 CONTINUE                                                          00120260
  220 IF(NUMEL2.EQ.0) GO TO 240                                         00120270
      REWIND 9                                                          00120280
      DO 230 I=1,NUMEL2                                                 00120290
      READ (9) ID3                                                      00120300
  230 WRITE (8) ID3                                                     00120310
  240 REWIND 8                                                          00120320
CC    REWIND 68                                                         R0120321
      I=NBLANK                                                          00120330
      READ (8) ID                                                       00120340
  250 CONTINUE                                                          00120350
      RETURN                                                            00120360
  300 FORMAT(1X ,36X,28HEQUATION NUMBERS VS. DEGREES,1X,                00120370
     131HOF FREEDOM FOR SLAVE NODES ONLY,/37X,60(1H-)                   00120380
     2       //15X,2(40HNODE     X     Y     Z    XX    YY    ZZ,10X)/) 00120390
  310 FORMAT(1X ,20X,28HEQUATION NUMBERS VS. DEGREES,1X,                00120400
     157HOF FREEDOM AFTER THE DECOMPOSTION OF SLAVE NODE EQUATIONS,     00120410
     2/11X,105(1H-)                                                     00120420
     2       //15X,2(40HNODE     X     Y     Z    XX    YY    ZZ,10X)/) 00120430
C1009 FORMAT (1X,'IN INPTN OF ELEMENT RANGE  ',I5,13F7.1/)              R0120431
      END                                                               00120440
      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 FILES (NOPEN)                                          00087420
        RETURN                                                          00087430
        END                                                             00087440
      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 CLOSE
      RETURN
      END
      SUBROUTINE EXIT
      WRITE (6,101)
 101  FORMAT (5X,'********  SAP6 PROGRAM STOP  ********')
      STOP
      END
      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                                                               R0234310
      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 ALPHZH(T,M,ALPHZM)                                     00017030
      IMPLICIT REAL*8(A-H,O-Z)                                          00017040
      DIMENSION COEF(11,8)                                              00017050
      DATA COEF/                                                        00017060
     1 7.0,100.0,1500.0,8.971084,1.541013E-3,4.438142E-6,-2.33287E-8,   00017070
     1 4.508292E-11,-4.192721E-14,1.877651E-17,-3.252818E-21,           00017080
     2 7.0,100.0,1500.0,8.971084,1.541013E-3,4.438142E-6,-2.33287E-8,   00017090
     2 4.508292E-11,-4.192721E-14,1.877651E-17,-3.252818E-21,           00017100
     3 0.0,0.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                  00017110
     4 4.0,75.0,1400.0,6.971162,2.609495E-3,-3.323012E-6,               00017120
     4     2.919442E-9,-8.657382E-13,0.0,0.0,0.0,                       00017130
     5 4.0,100.0,800.0,5.839035,3.176186E-3,-3.025846E-6,               00017140
     5 3.570877E-9,-1.518135E-12,0.0,0.0,0.0,                           00017150
     6 4.0,100.0,800.0,5.839035,3.176186E-3,-3.025846E-6,               00017160
     6 3.570877E-9,-1.518135E-12,0.0,0.0,0.0,                           00017170
     7 4.0,100.0,800.0,5.839035,3.176186E-3,-3.025846E-6,               00017180
     7 3.570877E-9,-1.518135E-12,0.0,0.0,0.0,                           00017190
     8 0.0,0.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/                  00017200
      ICODE=4                                                           00017210
      IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8)                      00017220
      N=COEF(1,M)                                                       00017230
      T1=COEF(2,M)                                                      00017240
      T2=COEF(3,M)                                                      00017250
      IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1)                    00017260
      ALPHZM=COEF(N+4,M)                                                00017270
      IF(N.EQ.0)RETURN                                                  00017280
      DO 10 I=1,N                                                       00017290
   10 ALPHZM=ALPHZM*T+COEF(N-I+4,M)                                     00017300
      RETURN                                                            00017310
      END                                                               00017320
      SUBROUTINE ALPHZL(T,M,ALPHZM)                                     00017330
      IMPLICIT REAL*8(A-H,O-Z)                                          00017340
      IF(M.LT.1.OR.M.GT.15) GO TO 1000                                  00017350
      IF(M.EQ.1) ALPHZM=6.12                                            00017360
      IF(M.EQ.1) RETURN                                                 00017370
 1000 WRITE(6,1010) M                                                   00017380
 1010 FORMAT(1X ,88HERROR--YOU HAVE ENTERED MATERIAL PROPERTY ROUTINE AL00017390
     1PHZM WITH A MATERIAL CODE NUMBER OF ,I5,1H./8X,74HONLY VALUES BETW00017400
     2EEN 1 AND 15 ARE VALID.  CHECK YOUR INPUT, JOB TERMINATED.)       00017410
      RETURN                                                            00017420
      END                                                               00017430
      DOUBLE PRECISION FUNCTION ALPHZM(T,M)                             00017440
      IMPLICIT REAL*8(A-H,O-Z)                                          00017450
      COMMON/MATL/MATLCO                                                00017460
      DATA NHIGH/4HHIGH/                                                00017470
      IF(MATLCO.NE.NHIGH)GO TO 10                                       00017480
      CALL ALPHZH(T,M,X)                                                00017490
      ALPHZM=X*1.0D-6                                                   00017500
      RETURN                                                            00017510
   10 CALL ALPHZL(T,M,X)                                                00017520
      ALPHZM=X*1.0D-6                                                   00017530
      RETURN                                                            00017540
      END                                                               00017550
      SUBROUTINE DENS1  (T,M,DENS  )                                    00056740
      IMPLICIT REAL*8(A-H,O-Z)                                          00056750
      IF(M.LT.1.OR.M.GT.15) GO TO 1000                                  00056760
      IF(M.EQ.1) DENS=490.9                                             00056770
      IF(M.EQ.1) RETURN                                                 00056780
 1000 WRITE(6,1010) M                                                   00056790
 1010 FORMAT(1X ,86HERROR--YOU HAVE ENTERED MATERIAL PROPERTY ROUTINE DE00056800
     1NS WITH A MATERIAL CODE NUMBER OF ,  I5,1H./8X,74HONLY VALUES BETW00056810
     2EEN 1 AND 15 ARE VALID.  CHECK YOUR INPUT, JOB TERMINATED.)       00056820
      RETURN                                                            00056830
      END                                                               00056840
      SUBROUTINE DENS2  (T,M,DENS  )                                    00056850
      IMPLICIT REAL*8(A-H,O-Z)                                          00056860
      DIMENSION COEF(11,8)                                              00056870
      DATA COEF/                                                        00056880
     1 1.0,100.0,1500.0,502.5447,-1.603769E-2,0.0,0.0,0.0,0.0,0.0,0.0,  00056890
     2 1.0,100.0,1500.0,498.5886,-1.537035E-2,0.0,0.0,0.0,0.0,0.0,0.0,  00056900
     3 3.0,32.0,2500.0,59.566,-7.9504E-3,-2.872E-7,6.035E-11,0.0,0.0,   00056910
     3 0.0,0.0,                                                         00056920
     4 2.0,75.0,1400.0,526.1008,-1.345453E-2,-1.194367E-7,0.0,0.0,0.0,  00056930
     4 0.0,0.0,                                                         00056940
     5 1.0,100.0,800.0,491.8014,-1.287008E-2,0.0,0.0,0.0,0.0,0.0,0.0,   00056950
     6 1.0,100.0,800.0,491.8014,-1.287008E-2,0.0,0.0,0.0,0.0,0.0,0.0,   00056960
     7 4.0,100.0,800.0,492.0608,-1.713633E-2,1.997181E-5,-3.37813E-8,   00056970
     7 1.874099E-11,0.0,0.0,0.0,                                        00056980
     8 4.0,0.0,2500.0,8.591723E-2,-1.737652E-4,2.648259E-7,-.2314231E-9,00056990
     8 8.177454E-14,0.0,0.0,0.0/                                        00057000
      ICODE=3                                                           00057010
      IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8)                      00057020
      N=COEF(1,M)                                                       00057030
      T1=COEF(2,M)                                                      00057040
      T2=COEF(3,M)                                                      00057050
      IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1)                    00057060
      IF(T.GT.208.OR.M.NE.3)GO TO 5                                     00057070
      DENS=60.93-6.792E-3*T-2.9E-6*T*T                                  00057080
      RETURN                                                            00057090
    5 CONTINUE                                                          00057100
      DENS  =COEF(N+4,M)                                                00057110
      IF(N.EQ.0)RETURN                                                  00057120
      DO 10 I=1,N                                                       00057130
   10 DENS  =DENS  *T+COEF(N-I+4,M)                                     00057140
      RETURN                                                            00057150
      END                                                               00057160
      DOUBLE PRECISION FUNCTION DENS  (T,M)                             00056620
      IMPLICIT REAL*8(A-H,O-Z)                                          00056630
      COMMON/MATL/MATLCO                                                00056640
      DATA NHIGH/4HHIGH/                                                00056650
      IF(MATLCO.NE.NHIGH)GO TO 10                                       00056660
      CALL DENS2  (T,M,X)                                               00056670
      DENS=X                                                            00056680
      RETURN                                                            00056690
   10 CALL DENS1  (T,M,X)                                               00056700
      DENS=X                                                            00056710
      RETURN                                                            00056720
      END                                                               00056730
      SUBROUTINE MODUE1 (T,M,MODUE )                                    00150370
      IMPLICIT REAL*8(A-H,O-Z)                                          00150380
      REAL*8MODUE                                                       00150390
      IF(M.LT.1.OR.M.GT.15) GO TO 1000                                  00150400
      IF(M.EQ.1) MODUE=29.665                                           00150410
      IF(M.EQ.1) RETURN                                                 00150420
 1000 WRITE(6,1010) M                                                   00150430
 1010 FORMAT(1X ,87HERROR--YOU HAVE ENTERED MATERIAL PROPERTY ROUTINE MO00150440
     1DUE WITH A MATERIAL CODE NUMBER OF , I5,1H./8X,74HONLY VALUES BETW00150450
     2EEN 1 AND 15 ARE VALID.  CHECK YOUR INPUT, JOB TERMINATED.)       00150460
      RETURN                                                            00150470
      END                                                               00150480
      SUBROUTINE MODUE2 (T,M,MODUE )                                    00150490
      IMPLICIT REAL*8(A-H,O-Z)                                          00150500
      REAL*8 MODUE                                                      00150510
      DIMENSION COEF(11,8)                                              00150520
      DATA COEF/                                                        00150530
     1 3.0,100.0,1500.0,28.33669,-2.882211E-3,-3.697849E-6,7.709188E-10,00150540
     1 0.0,0.0,0.0,0.0,                                                 00150550
     2 3.0,100.0,1500.0,28.33669,-2.882211E-3,-3.697849E-6,7.709188E-10,00150560
     2 0.0,0.0,0.0,0.0,                                                 00150570
     3 0.0,32.0,2500.0,0.01,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                00150580
     4 7.0,75.0,1600.0,32.17532,-8.441689E-3,1.0776E-5,1.433823E-9,     00150590
     4 -3.887096E-11,5.191192E-14,-2.767454E-17,5.402884E-21,           00150600
     5 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9,   00150610
     5 -6.323402E-12,0.0,0.0,0.0,                                       00150620
     6 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9,   00150630
     6 -6.323402E-12,0.0,0.0,0.0,                                       00150640
     7 4.0,100.0,800.0,30.28987,-3.658438E-3,-2.600385E-6,4.86326E-9,   00150650
     7 -6.323402E-12,0.0,0.0,0.0,                                       00150660
     8 0.0,0.0,2500.0,0.01,0.0,0.0,0.0,0.0,0.0,0.0,0.0/                 00150670
      ICODE=5                                                           00150680
      IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8)                      00150690
      N=COEF(1,M)                                                       00150700
      T1=COEF(2,M)                                                      00150710
      T2=COEF(3,M)                                                      00150720
      IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1)                    00150730
      MODUE =COEF(N+4,M)                                                00150740
      IF(N.EQ.0)RETURN                                                  00150750
      DO 10 I=1,N                                                       00150760
   10 MODUE =MODUE *T+COEF(N-I+4,M)                                     00150770
      RETURN                                                            00150780
      END                                                               00150790
      DOUBLE PRECISION FUNCTION MODUE (T,M)                             00150250
      IMPLICIT REAL*8(A-H,O-Z)                                          00150260
      COMMON/MATL/MATLCO                                                00150270
      DATA NHIGH/4HHIGH/                                                00150280
      IF(MATLCO.NE.NHIGH)GO TO 10                                       00150290
      CALL MODUE2 (T,M,X)                                               00150300
      MODUE=X*1.0D6                                                     00150310
      RETURN                                                            00150320
   10 CALL MODUE1 (T,M,X)                                               00150330
      MODUE=X*1.0D6                                                     00150340
      RETURN                                                            00150350
      END                                                               00150360
      SUBROUTINE PRATO1 (T,M,PRATO )                                    00175250
      IMPLICIT REAL*8(A-H,O-Z)                                          00175260
      IF(M.LT.1.OR.M.GT.15) GO TO 1000                                  00175270
      GO TO(841,842,843,844,845,846,847,848,849,850,851,852,853,854,855)00175280
     1,M                                                                00175290
  841 PRATO = 0.3                                                       00175300
      RETURN                                                            00175310
  842 PRATO = 0.3                                                       00175320
      RETURN                                                            00175330
  843 PRATO = 0.3                                                       00175340
      RETURN                                                            00175350
  844 PRATO = 0.3                                                       00175360
      RETURN                                                            00175370
  845 PRATO = 0.3                                                       00175380
      RETURN                                                            00175390
  846 PRATO = 0.3                                                       00175400
      RETURN                                                            00175410
  847 PRATO = 0.3                                                       00175420
      RETURN                                                            00175430
  848 PRATO = 0.3                                                       00175440
      RETURN                                                            00175450
  849 PRATO = 0.0                                                       00175460
      RETURN                                                            00175470
  850 PRATO = 0.0                                                       00175480
      RETURN                                                            00175490
  851 PRATO = 0.3                                                       00175500
      RETURN                                                            00175510
  852 PRATO = 0.3                                                       00175520
      RETURN                                                            00175530
  853 PRATO = 0.0                                                       00175540
      RETURN                                                            00175550
  854 PRATO = 0.0                                                       00175560
      RETURN                                                            00175570
  855 PRATO = 0.0                                                       00175580
      RETURN                                                            00175590
 1000 WRITE(6,1010) M                                                   00175600
 1010 FORMAT(1X ,88HERROR--YOU HAVE ENTERED MATERIAL PROPERTY ROUTINE PR00175610
     1ATO WITH A MATERIAL CODE NUMBER OF  ,I5,1H./8X,74HONLY VALUES BETW00175620
     2EEN 1 AND 15 ARE VALID.  CHECK YOUR INPUT, JOB TERMINATED.)       00175630
      RETURN                                                            00175640
      END                                                               00175650
      SUBROUTINE PRATO2(T,M,PRATO)                                      00175660
      IMPLICIT REAL*8(A-H,O-Z)                                          00175670
      DIMENSION COEF(11,8)                                              00175680
      DATA COEF/                                                        00175690
     1 3.0,100.0,1500.0,2.596489E-1,6.268223E-5,-2.928358E-8,           00175700
     1 1.156704E-11,0.0,0.0,0.0,0.0,                                    00175710
     2 1.0,100.0,1500.0,2.624811E-1,4.265787E-5,0.0,0.0,0.0,0.0,0.0,0.0,00175720
     3 0.0,32.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                 00175730
     4 3.0,75.0,1600.0,2.867834E-1,5.339406E-5,-8.19186E-10,            00175740
     4 4.805192E-12,0.0,0.0,0.0,0.0,                                    00175750
     5 0.0,100.0,800.0,0.3,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                 00175760
     6 0.0,100.0,800.0,0.3,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                 00175770
     7 0.0,100.0,800.0,0.3,0.0,0.0,0.0,0.0,0.0,0.0,0.0,                 00175780
     8 0.0,0.0,2500.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0/                  00175790
      ICODE=7                                                           00175800
      IF(M.LT.1.OR.M.GT.8)CALL RPZLVZ(M,T,ICODE,8)                      00175810
      N=COEF(1,M)                                                       00175820
      T1=COEF(2,M)                                                      00175830
      T2=COEF(3,M)                                                      00175840
      IF(T.LT.T1.OR.T.GT.T2)CALL RPZLVZ(M,T,ICODE,1)                    00175850
      PRATO =COEF(N+4,M)                                                00175860
      IF(N.EQ.0)RETURN                                                  00175870
      DO 10 I=1,N                                                       00175880
   10 PRATO =PRATO *T+COEF(N-I+4,M)                                     00175890
      RETURN                                                            00175900
      END                                                               00175910
      SUBROUTINE RPZLVZ(MCODE,TEMP,PCODE,ECODE)                         00216460
      IMPLICIT REAL*8(A-H,O-Z)                                          00216470
      INTEGER PROP(2,10),PCODE,ECODE                                    00216480
      DATA PROP/4HCOND,4HT   ,4HSPHT,4H    ,4HDENS,4H    ,4HALPH,4HZM  ,00216490
     X          4HMODU,4HE   ,4HYDST,4HR   ,4HPRAT,4HO   ,4HBIYL,4HD   ,00216500
     X          4HPLAS,4HTC  ,4HHBIY,4HLD  /                            00216510
      IF(ECODE.GT.1)GO TO 10                                            00216520
      RETURN                                                            00216530
   10 WRITE(6,30)(PROP(I,PCODE),I=1,2),MCODE,ECODE,TEMP                 00216540
      RETURN                                                            00216550
   20 FORMAT(//,68H **** WARNING - YOU HAVE ENTERED THE LMFBR MARERIAL L00216560
     2IBRARY ROUTINE ,2A4,18HWITH A TEMPERATURE,F7.0,20H OUT OF VALID RA00216570
     3NGE.,/,42H PLEASE CHECK YOUR INPUT.  MATERIAL CODE =,I3,/)        00216580
   30 FORMAT(//,66H **** ERROR - YOU HAVE ENTERED THE LMFBR MATERIAL LIB00216590
     2RARY ROUTINE ,2A4,23HWITH A MATERIAL CODE OF,I5,/,20HONLY CODES 1 00216600
     3THROUGH,I3,43H ARE VALID.  JOB TERMINATED.  TEMPERATURE =,F7.0,/) 00216610
      END                                                               00216620
      SUBROUTINE POSINV (A,NMAX,NDD)                                    00174950
        IMPLICIT REAL*8 (A-H,O-Z)                                       00174960
      DIMENSION A(NDD,NDD)                                              00174970
      DO 150 N=1,NMAX                                                   00174980
      D=A(N,N)                                                          00174990
      DO 100 J=1,NMAX                                                   00175000
  100 A(N,J)=-A(N,J)/D                                                  00175010
      DO 140 I=1,NMAX                                                   00175020
      IF(N-I) 110,140,110                                               00175030
  110 DO 130 J=1,NMAX                                                   00175040
      IF(N-J) 120,130,120                                               00175050
  120 A(I,J)=A(I,J)+A(I,N)*A(N,J)                                       00175060
  130 CONTINUE                                                          00175070
  140 A(I,N)=A(I,N)/D                                                   00175080
      A(N,N)=1.0E0/D                                                    00175090
  150 CONTINUE                                                          00175100
      RETURN                                                            00175110
      END                                                               00175120
      DOUBLE PRECISION FUNCTION PRATO (T,M)                             00175130
      IMPLICIT REAL*8(A-H,O-Z)                                          00175140
      COMMON/MATL/MATLCO                                                00175150
      DATA NHIGH/4HHIGH/                                                00175160
      IF(MATLCO.NE.NHIGH)GO TO 10                                       00175170
      CALL PRATO2 (T,M,X)                                               00175180
      PRATO=X                                                           00175190
      RETURN                                                            00175200
   10 CALL PRATO1 (T,M,X)                                               00175210
      PRATO=X                                                           00175220
      RETURN                                                            00175230
      END                                                               00175240
      SUBROUTINE SUPSTF(NSELEM,PROP6,ID,LM,LL,NUMNP,MTOT,MBAND,MAXDF )  00286490
      IMPLICIT REAL*8(A-H,O-Z)                                          00286500
      REAL*8 LM(1),ID(NUMNP,3),JD                                       00286510
      LOGICAL ELPRT,ELPCH,GENPRT,GENPCH                                 00286520
      DIMENSION PROP6(LL,7)                                             00286530
      COMMON/QTSARG/ NOD(1000),RRQTSA(500)                              R0286540
      COMMON /CG/ SCG(4),RRCG(2)                                        R0286550
      COMMON/CTL/ELPRT,ELPCH,GENPRT,GENPCH                              00286560
      COMMON/FORCE/NLC,NELD                                             00286570
      COMMON/MASS/LMASS                                                 00286580
      COMMON /TRASH/JD(100,3),KCF,KP,KAX,KAY,KAZ,KT,KM,LT,NWDS,L,I,J,K  00286590
     $KN,ND,NDF,KS,KE,JR,IR,IC,JC,KC,LC,NDL,JM1,IK,JK,KJ,KI,NDIF,IM1,IP100286600
     & ,RRTRAS(174)                                                     R0286601
      COMMON /JUNK/ PM,T,TYPE,TIME,W,WX,EMAX,RRJUNK(220)                R0286610
      COMMON /PREP/ ZD(2),KSKIP,RRPREP(8)                               R0286620
        CALL FILES(2)                                                   00286630
      NT2=1                                                             00286640
      NT1=2                                                             00286650
      MAXDF=0                                                           00286660
      MAX=MTOT-3*NUMNP-7*LL                                             00286670
      NSE=16                                                            00286680
      NT20=20                                                           00286690
      ZER=0.0                                                           00286700
      REWIND NSE                                                        00286710
      DO 1000 L=1,NSELEM                                                00286720
      READ (NSE) MATNO,NUM,(NOD(J),J=1,NUM)                             00286730
      REWIND NT20                                                       00286740
  200 READ (NT20,END=9000)M,NDF,KT,LT                                   00286750
  205 CONTINUE                                                          00286760
      IF(M.EQ.MATNO) GO TO 210                                          00286770
      LT=LT+2                                                           00286780
      IF(LMASS.EQ.1) LT=LT+1                                            00286790
      DO 206 J=1,LT                                                     00286800
  206 READ (NT20)                                                       00286810
      GO TO 200                                                         00286820
  210 ND=NDF                                                            00286830
      NDM=ND-1                                                          00286840
      NWDS=ND+(ND*ND-ND)/2                                              00286850
      IF(LMASS.EQ.1) GO TO 1210                                         00286860
      IF(NWDS.LE.MAX) GO TO 230                                         00286870
      GO TO 215                                                         00286880
 1210 IF(2*NWDS.LE.MAX) GO TO 230                                       00286890
  215 WRITE(6,220)M,L                                                   00286900
  220 FORMAT (/20X,6HMATRIX,I4,20H ON SUPERELEMENT NO.,I4,              00286910
     $47H IS TOO LARGE FOR THE AMOUNT OF CORE AVAILABLE.//)             00286920
      KSKIP=1                                                           00286930
      RETURN                                                            00286940
  230 KN=KT                                                             00286950
      IF(KT.EQ.0) KN=1                                                  00286960
      KS=ND+1                                                           00286970
      KE=KS+NWDS-1                                                      00286980
      READ (NT20) KCF,KP,KAX,KAY,KAZ,KM,KBE,((JD(J,K),K=1,3),J=1,KN)    00286990
      READ (NT20)                                                       00287000
     $ (LM(J),J=KS,KE)                                                  00287010
  240 JLOCI=KE                                                          00287020
      LC=0                                                              00287030
      NTERM=ND*(LL+1)                                                   00287040
      IF(LMASS.EQ.1) NTERM=NTERM+JLOCI                                  00287050
      IF(JLOCI+NTERM.GT.MAX) GO TO 215                                  00287060
      JLOC=JLOCI+1                                                      00287070
      CALL QVSET(ZER,LM(JLOC),NTERM)                                    00287080
      IF(KCF.LE.0) GO TO 260                                            00287090
      DO 250 J=1,KCF                                                    00287100
      KS=JLOCI+(J-1)*ND+1                                               00287110
      KE=KS+NDM                                                         00287120
  250 READ (NT20) (LM(K),K=KS,KE)                                       00287130
  260 CONTINUE                                                          00287140
      IF(KCF.EQ.LT) GO TO 390                                           00287150
      LC=KCF                                                            00287160
  270 LC=LC+1                                                           00287170
      IF(LC.GT.LT)  GO TO 390                                           00287180
      IF(KM.EQ.LC)  GO TO 280                                           00287190
      IF(KP.EQ.LC)  GO TO 290                                           00287200
      IF(KAX.EQ.LC) GO TO 310                                           00287210
      IF(KAY.EQ.LC) GO TO 330                                           00287220
      IF(KAZ.EQ.LC) GO TO 350                                           00287230
      IF(KBE.EQ.LC) GO TO 361                                           00287240
      IF(KT.EQ.0) GO TO 276                                             00287250
      DO 275 K=1,KT                                                     00287260
      KE=K                                                              00287270
      KS=JD(K,1)                                                        00287280
      IF(KS.EQ.LC) GO TO 370                                            00287290
  275 CONTINUE                                                          00287300
  276 READ (NT20)                                                       00287310
      GO TO 270                                                         00287320
  280 CONTINUE                                                          00287330
      KS=JLOCI+ND*LL+1                                                  00287340
      KE=KS+NDM                                                         00287350
      READ (NT20) (LM(K),K=KS,KE)                                       00287360
      GO TO 270                                                         00287370
  290 READ (NT20)(LM(K),K=1,ND)                                         00287380
      DO 300 K=1,LL                                                     00287390
      PM=-PROP6(K,1)                                                    00287400
      IF(PM.EQ.0.0) GO TO 300                                           00287410
      KS=JLOCI+ND*(K-1)+1                                               00287420
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287430
  300 CONTINUE                                                          00287440
      GO TO 270                                                         00287450
  310 READ (NT20)(LM(K),K=1,ND)                                         00287460
      DO 320 K=1,LL                                                     00287470
      PM=-PROP6(K,5)                                                    00287480
      IF(PM.EQ.0.0) GO TO 320                                           00287490
      KS=JLOCI+ND*(K-1)+1                                               00287500
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287510
  320 CONTINUE                                                          00287520
      GO TO 270                                                         00287530
  330 READ (NT20)(LM(K),K=1,ND)                                         00287540
      DO 340 K=1,LL                                                     00287550
      PM=-PROP6(K,6)                                                    00287560
      IF(PM.EQ.0.0) GO TO 340                                           00287570
      KS=JLOCI+ND*(K-1)+1                                               00287580
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287590
  340 CONTINUE                                                          00287600
      GO TO 270                                                         00287610
  350 READ (NT20)(LM(K),K=1,ND)                                         00287620
      DO 360 K=1,LL                                                     00287630
      PM=-PROP6(K,7)                                                    00287640
      IF(PM.EQ.0.0) GO TO 360                                           00287650
      KS=JLOCI+ND*(K-1)+1                                               00287660
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287670
  360 CONTINUE                                                          00287680
      GO TO 270                                                         00287690
  361 READ (NT20) (LM(K),K=1,ND)                                        00287700
      DO 365 K=1,LL                                                     00287710
      PM=-PROP6(K,4)                                                    00287720
      IF(PM.EQ.0.0) GO TO 365                                           00287730
      KS=JLOCI+ND*(K-1)+1                                               00287740
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287750
  365 CONTINUE                                                          00287760
      GO TO 270                                                         00287770
  370 READ (NT20)(LM(K),K=1,ND)                                         00287780
      TIME=JD(KE,3)                                                     00287790
      TYPE=JD(KE,2)                                                     00287800
      DO 380 K=1,LL                                                     00287810
      PM=PROP6(K,2)                                                     00287820
      IF(PM.NE.TYPE)GO TO 380                                           00287830
      PM=PROP6(K,3)                                                     00287840
      IF(PM.NE.TIME)GO TO 380                                           00287850
      KS=JLOCI+ND*(K-1)+1                                               00287860
      PM=-1.0                                                           00287870
      CALL QMR2(LM(KS),LM(KS),PM,LM(1),ND,1,1,1)                        00287880
  380 CONTINUE                                                          00287890
      GO TO 270                                                         00287900
  390 CONTINUE                                                          00287910
      IF(LMASS.NE.1) GO TO 1390                                         00287920
      KS=JLOCI+ND*LL+1                                                  00287930
      KE=KS+NWDS-1                                                      00287940
      READ(NT20)(LM(K),K=KS,KE)                                         00287950
 1390 CONTINUE                                                          00287960
      JM1=JLOCI+NDF*LL                                                  00287970
      ND=0                                                              00287980
      DO 405 J=1,NUM                                                    00287990
      NODE=NOD(J)                                                       00288000
      KN=0                                                              00288010
      DO 400 K=1,6                                                      00288020
      CALL UNPKID(ID,NUMNP,W,WX,2,NODE,K)                               00288030
      IF(W.LE.0.0) GO TO 400                                            00288040
      ND=ND+1                                                           00288050
      IF(K.GT.3) GO TO 395                                              00288060
      JC=JM1+ND                                                         00288070
      IF(LMASS.EQ.1) JC=JM1+ND*(ND+1)/2                                 00288080
      IF(LM(JC).EQ.0.0) GO TO 395                                       00288090
      CALL UNPKID(ID,NUMNP,WX,T,1,NODE,K)                               00288100
      SCG(K)=SCG(K)+LM(JC)*T                                            00288110
      IF(KN.EQ.0) SCG(4)=SCG(4)+LM(JC)                                  00288120
      KN=1                                                              00288130
  395 CONTINUE                                                          00288140
      IF(ND.GT.NDF) GO TO 410                                           00288150
      LM(ND)=W                                                          00288160
  400 CONTINUE                                                          00288170
  405 CONTINUE                                                          00288180
      IF(ND.EQ.NDF) GO TO 430                                           00288190
  410 WRITE(6,420)M,NDF,L,ND                                            00288200
  420 FORMAT(/20X,9HMATRIX NO,I4,4H HAS,I4,                             00288210
     127H DEGREES-OF-FREEDOM AND THE,1X,                                00288220
     $32HNODES LISTED FOR SUPERELEMENT NO,I4/20X,5H HAVE,I4,5H DOF.//)  00288230
      KSKIP=1                                                           00288240
  430 CONTINUE                                                          00288250
      PM=LM(ND+1)                                                       00288260
      T =LM(ND+2)                                                       00288270
      LM(ND+1)=MATNO                                                    00288280
      LM(ND+2)=ND                                                       00288290
      KOUNT=ND+2                                                        00288300
      CALL RDWRT(NT2,LM,KOUNT,1,K)                                      00288310
      LM(ND+1)=PM                                                       00288320
      LM(ND+2)=T                                                        00288330
      I=ND                                                              00288340
      NDP=ND+1                                                          00288350
  440 EMAX=LM(1)                                                        00288360
      J=1                                                               00288370
      DO 450 K=1,I                                                      00288380
      IF(LM(K).LT.EMAX) GO TO 450                                       00288390
      EMAX=LM(K)                                                        00288400
      J=K                                                               00288410
  450 CONTINUE                                                          00288420
      IF(I.EQ.J) GO TO 490                                              00288430
      IC=I*ND+I-(I*I-I)/2                                               00288440
      JC=J *ND+J-(J*J-J)/2                                              00288450
      JM1=J-1                                                           00288460
      IF(JM1.LT.1) GO TO 460                                            00288470
      IK=ND+I                                                           00288480
      JK=ND+J                                                           00288490
      DO 455 K=1,JM1                                                    00288500
      T=LM(IK)                                                          00288510
      LM(IK)=LM(JK)                                                     00288520
      LM(JK)=T                                                          00288530
      NDK=ND-K                                                          00288540
      IK=IK+NDK                                                         00288550
  455 JK=JK+NDK                                                         00288560
  460 JP1=J+1                                                           00288570
      IM1=I-1                                                           00288580
      IF(JP1.GT.IM1) GO TO 470                                          00288590
      KJ=JC                                                             00288600
      IK=KJ+I-J                                                         00288610
      DO 465 K=JP1,IM1                                                  00288620
      IK=IK+NDP-K                                                       00288630
      KJ=KJ+1                                                           00288640
      T=LM(KJ)                                                          00288650
      LM(KJ)=LM(IK)                                                     00288660
  465 LM(IK)=T                                                          00288670
  470 IP1=I+1                                                           00288680
      IF(IP1.GT.ND) GO TO 478                                           00288690
      KJ=JC+I-J                                                         00288700
      KI=IC                                                             00288710
      DO 475 K=IP1,ND                                                   00288720
      KJ=KJ+1                                                           00288730
      KI=KI+1                                                           00288740
      T=LM(KI)                                                          00288750
      LM(KI)=LM(KJ)                                                     00288760
  475 LM(KJ)=T                                                          00288770
  478 T=LM(I)                                                           00288780
      LM(I)=LM(J)                                                       00288790
      LM(J)=T                                                           00288800
      T=LM(IC)                                                          00288810
      LM(IC)=LM(JC)                                                     00288820
      LM(JC)=T                                                          00288830
      IR=JLOCI+I                                                        00288840
      JR=JLOCI+J                                                        00288850
      DO 480 K=1,LL                                                     00288860
      KC=(K-1)*ND                                                       00288870
      IK=IR+KC                                                          00288880
      JK=JR+KC                                                          00288890
      T=LM(IK)                                                          00288900
      LM(IK)=LM(JK)                                                     00288910
  480 LM(JK)=T                                                          00288920
      IF(LMASS.EQ.1) GO TO 1450                                         00288930
      IR=JLOCI+ND*LL+I                                                  00288940
      JR=JLOCI+ND*LL+J                                                  00288950
      T=LM(IR)                                                          00288960
      LM(IR)=LM(JR)                                                     00288970
      LM(JR)=T                                                          00288980
      GO TO 490                                                         00288990
 1450 CONTINUE                                                          00289000
      IC=JLOCI+ND*LL+(I-1)*ND+I-(I*I-I)/2                               00289010
      JC=JLOCI+ND*LL+(J-1)*ND+J-(J*J-J)/2                               00289020
      JM1=J-1                                                           00289030
      IF(JM1.LT.1) GO TO 1460                                           00289040
      IK=JLOCI+ND*LL+I                                                  00289050
      JK=JLOCI+ND*LL+J                                                  00289060
      DO 1455 K=1,JM1                                                   00289070
      T=LM(IK)                                                          00289080
      LM(IK)=LM(JK)                                                     00289090
      LM(JK)=T                                                          00289100
      NDK=ND-K                                                          00289110
      IK=IK+NDK                                                         00289120
 1455 JK=JK+NDK                                                         00289130
 1460 JP1=J+1                                                           00289140
      IM1=I-1                                                           00289150
      IF(JP1.GT.IM1) GO TO 1470                                         00289160
      KJ=JC                                                             00289170
      IK=KJ+I-J                                                         00289180
      DO 1465 K=JP1,IM1                                                 00289190
      IK=IK+NDP-K                                                       00289200
      KJ=KJ+1                                                           00289210
      T=LM(KJ)                                                          00289220
      LM(KJ)=LM(IK)                                                     00289230
 1465 LM(IK)=T                                                          00289240
 1470 IP1=I+1                                                           00289250
      IF(IP1.GT.ND) GO TO 1478                                          00289260
      KJ=JC+I-J                                                         00289270
      KI=IC                                                             00289280
      DO 1475 K=IP1,ND                                                  00289290
      KJ=KJ+1                                                           00289300
      KI=KI+1                                                           00289310
      T=LM(KI)                                                          00289320
      LM(KI)=LM(KJ)                                                     00289330
 1475 LM(KJ)=T                                                          00289340
 1478 CONTINUE                                                          00289350
      T=LM(IC)                                                          00289360
      LM(IC)=LM(JC)                                                     00289370
      LM(JC)=T                                                          00289380
  490 I=I-1                                                             00289390
      IF(I.GT.0) GO TO 440                                              00289400
      NDIF=LM(ND)-LM(1)+1                                               00289410
      IF(NDIF.GT.MBAND) MBAND=NDIF                                      00289420
      IF(ND.GT.MAXDF) MAXDF=ND                                          00289430
      IF(.NOT.ELPRT) GO TO 1600                                         00289440
      WRITE(6,660)MATNO,ND                                              00289450
      IF(ELPCH) WRITE(7,680)MATNO,ND                                    00289460
      WRITE(6,670)(LM(I),I=1,ND)                                        00289470
      IF(ELPCH)WRITE(7,690)(LM(I),I=1,ND)                               00289480
      WRITE(6,770)                                                      00289490
      IK=0                                                              00289500
      DO 1510 I=1,ND                                                    00289510
      JJ=ND-I+1                                                         00289520
      IF(ELPCH) WRITE(7,780)(LM(ND+IK+J),J=1,JJ)                        00289530
      WRITE(6,790)(LM(ND+IK+J),J=1,JJ)                                  00289540
 1510 IK=IK+JJ                                                          00289550
      INLL=8                                                            00289560
      IF(LL.LT.8) INLL=LL                                               00289570
      DO 1520 J=1,LL,INLL                                               00289580
      K=J+INLL-1                                                        00289590
      WRITE(6,720)J,K                                                   00289600
      JK=(J-1)*ND+JLOCI                                                 00289610
      DO 1540 I=1,ND                                                    00289620
      IK=JK+I-1                                                         00289630
      IKK=INLL*ND                                                       00289640
      IF(ELPCH) WRITE(7,780)(LM(IK+LRK),LRK=1,IKK,ND)                   00289650
 1540 WRITE(6,790)(LM(IK+LRK),LRK=1,IKK,ND)                             00289660
 1520 CONTINUE                                                          00289670
      IK=JLOCI+ND*LL                                                    00289680
      IF(LMASS.NE.1) GO TO 1570                                         00289690
      WRITE(6,730)                                                      00289700
      DO 1560 I=1,ND                                                    00289710
      JJ=ND-I+1                                                         00289720
      IF(ELPCH) WRITE(7,780)(LM(IK+J),J=1,JJ)                           00289730
      WRITE(6,790)(LM(IK+J),J=1,JJ)                                     00289740
 1560 IK=IK+JJ                                                          00289750
      GO TO 1600                                                        00289760
 1570 CONTINUE                                                          00289770
      WRITE(6,740)                                                      00289780
      IF(ELPCH) WRITE(7,780)(LM(IK+J),J=1,ND)                           00289790
      WRITE(6,790)(LM(IK+J),J=1,ND)                                     00289800
 1600 CONTINUE                                                          00289810
      KJ=LL                                                             00289820
      IF(NELD.EQ.1) GO TO 510                                           00289830
      KJ=0                                                              00289840
      IF(LMASS.EQ.1) GO TO 1680                                         00289850
      DO 500 I=1,ND                                                     00289860
      IR=JLOCI+I                                                        00289870
      JR=IR+ND*LL                                                       00289880
  500 LM(IR)=LM(JR)                                                     00289890
      GO TO 510                                                         00289900
 1680 KL=0                                                              00289910
      DO 1690 I=1,ND                                                    00289920
      DO 1690 J=I,ND                                                    00289930
      KL=KL+1                                                           00289940
      IR=JLOCI+KL                                                       00289950
      JR=IR+ND*LL                                                       00289960
 1690 LM(IR)=LM(JR)                                                     00289970
  510 KOUNT=JLOCI+ND*(KJ+1)+1                                           00289980
      IF(LMASS.EQ.1) KOUNT=JLOCI+ND*KJ+ND*(ND+1)/2 +1                   00289990
      LM(KOUNT)=ND                                                      00290000
 1000 CALL RDWRT(NT1,LM,KOUNT,1,I)                                      00290010
      RETURN                                                            00290020
  660 FORMAT(5X,11HMATRIX NO =,I4,5X,20HDEGREES OF FREEDOM =,I4)        00290030
  670 FORMAT(/1X,29HSUPER ELEMENT LOCATION MATRIX/(1H ,10F13.0))        00290040
  680 FORMAT(2I5)                                                       00290050
  690 FORMAT((1P8E10.3))                                                00290060
  720 FORMAT(/1X,32HELEMENT LOAD MATRIX - LOAD CASES,I5,3X,2HTO,I5)     00290070
  730 FORMAT(/1X,41HELEMENT MASS MATRIX - LOWER TRIANGLE ONLY)          00290080
  740 FORMAT(/1X,19HELEMENT MASS MATRIX)                                00290090
  770 FORMAT(/1X,30HSUPER ELEMENT STIFFNESS MATRIX,                     00290100
     11X,21H- LOWER TRIANGLE ONLY)                                      00290110
  780 FORMAT((1P8E10.3))                                                00290120
  790 FORMAT((1X ,1P10E13.4))                                           00290130
 9000 WRITE(6,9010) MATNO,NT20,L                                        00290140
 9010 FORMAT(//20X,6HMATRIX ,I5,27H COULD NOT BE FOUND ON TAPE,I5,      00290150
     $21H FOR SUPERELEMENT NO.,I5//)                                    00290160
      KSKIP=1                                                           00290170
      RETURN                                                            00290180
      END                                                               00290190
