C***ADD:CDC***
CDECK TEXT
C***END:CDC***
      SUBROUTINE TEXT
C
      DIMENSION ISTRIV(1)
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON /ERROR/ IERROR
C
      EQUIVALENCE (ISTRIV(1),IANUMV(1,5))
      DATA IPLOFF,IPLON/4,5/
C
C          PARAM 1: NSUBF
C
      CALL SUBF (1)
      IF (IERROR.NE.0) GOTO 900
C
C          PARAM 2,3,4,5:  XPT, YPT, ANGLE, TEXTSTRING
C
      XPT = REALV(2)
      YPT = REALV(3)
      IF (XPT.LT.0 .OR. XPT.GT.XPMAX) GOTO 100
      IF (YPT.LT.0 .OR. YPT.GT.YPMAX) GOTO 100
      GOTO 200
  100   WRITE (NFLOG,2000)
        GOTO 800
C
  200 ANGLE = REALV(4)
      IF (LGHSTR.EQ.0) GOTO 850
      CALL CGRAPH (IPLON)
      DO 300 I=1,LGHSTR
        ICHAR = ISTRIV(I)
        CALL APCHAR(ICHAR)
        CALL AGRAPH (XPT,YPT,HEIGHT,ICHAR,0.0,ANGLE,1,1)
        XPT = 999.0
        YPT = 999.0
  300   CONTINUE
      CALL CGRAPH (IPLOFF)
      GOTO 900
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT (48H ***ERROR: XPT OR YPT NOT WITHIN SUBFRAME LIMITS)
      END
C***ADD:CDC***
CDECK MESH1
C***END:CDC***
      SUBROUTINE MESH1
C
      DIMENSION IA(1)
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /ERROR/ IERROR
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      DATA KMODE/19/
C
C          PARAM 1:ZONENAME
C          GET ZONE BIT NUMBER(IBITZ), 0 = WHOLE MODEL
C
      CALL ZGETNB
      IF (IERROR.NE.0) GOTO 900
C
C          PARAM 14: NSUBF
C
      CALL SUBF(15)
      IF (IERROR.NE.0) GOTO 900
C
C          BLANK COMMON LAYOUT FOR NODE PLOT ARRAYS
C          LENGTH = SUM OF NODE POINTS IN ALL REUSED STRUCTURES
C
      NODSUM = 0
C
      DO 100 ISTRI=1,NSTRI
        NRUSE = IA(I06+ISTRI-1)
        NUMNP = IA(I08+ISTRI-1)
  100   NODSUM = NODSUM + NRUSE * NUMNP
C
C                                                XPLOT
      N2 = N1 + NODSUM
C                                                YPLOT
      N3 = N2 + NODSUM
C                                                XPLOTD
      N4 = N3 + NODSUM
C                                                YPLOTD
      N5 = N4 + NODSUM
      N6 = N5
      N7 = N6
      IF (NCMD.NE.KMODE) GOTO 200
C                                                XPLOTR
      N6 = N5 + NODSUM
C                                                YPLOTR
      N7 = N6 + NODSUM
C
C          BLANK COMMON AREAS FOR DATABASE NODE RECORDS
C
C                                                XYZ, DISP, PHI
  200 N8 = N7 + MXNP * MAX0(3,NDOF)
C                                                RSDCOS
      I10 = (N8 + NSKEWS * 9) * ISURL
C                                                NZONE
      I11 = I10
      IF (IBITZ.NE.IWHOLE) I11 = I10 + MXNP
C                                                IDRN
      I12 = I11
      IF (NSKEWS.GT.0)  I12 = I11 + (NDOF + 2) * MXNP
C
C          BLANK COMMON AREAS FOR DATABASE ELEMENT RECORDS
C
      I13 = N7 * ISURL
C                                                IEZONE
      I14 = I13
      IF (IBITZ.NE.IWHOLE) I14 = I13 + MXEL
C                                                NPAR
      I15 = I14 + NELPAR * MXEG
C                                                NOD
      I16 = I15 + MXELNP
C
C          TEMPORARY STORAGE FOR  TIMEN AND VIEW RECORDS
C
C                                                TIMEN
      I19 = I1 + (ISURL + 1) * NSTEN
C                                                VIEW
      I20 = I1 + MVIEW * 9
C
C          MORE MEMORY MAY BE REQUESTED IN MESH2 AND PLOTL
      I20 = MAX0(I12,I16,I19,I20)
      CALL SIZE (I20)
        IF (IERROR.NE.0) GOTO 900
C
      CALL MESH2 (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),
     1            A(N7),A(N7),NDOF,A(N8),IA(I10),IA(I11),
     2            IA(I13),IA(I14),NELPAR,IA(I15),
     3            IA(I1),IA(I1),IA(I06),IA(I07),IA(I08),IA(I010))
C
  900 RETURN
      END
C***ADD:CDC***
CDECK MESH2
C***END:CDC***
      SUBROUTINE MESH2 (XPLOT,YPLOT,XPLOTD,YPLOTD,XPLOTR,YPLOTR,
     1                 XYZ,DISP,NDOFD,RSDCOS,NZONE,IDRN,
     2                  IEZONE,NPAR,NPARD,NOD,
     3                  VIEWDB,TIMEN,NRUSES,NEGS,NUMNPS,MAXMSS)
C
      DIMENSION IA(1),XPLOT(1),YPLOT(1),XPLOTD(1),YPLOTD(1),
     -          XPLOTR(1),YPLOTR(1),
     1          XYZ(1),DISP(NDOFD,1),RSDCOS(9,1),NZONE(1),IDRN(1),
     2          IEZONE(1),NPAR(NPARD,1),NOD(1),MAXMSS(1),
     3          TIMEN(1),VIEWDB(9,1),VIEWA(1),VIEWD(36),
     4          NRUSES(1),NEGS(1),NUMNPS(1),VDIR(6)
      DIMENSION IHDEFO(4),IHDTIM(7),IHDMOD(4),IHDORI(4),IHDEFM(5),
     1          IHDGS(4),IHDDS(4),IHDMAX(4),IAXES(3),IHDREF(5)
      DIMENSION LTRUSS(5),L2DIM(10),L3DIM(32),LBEAM(3),
     1          LPLATE(5),MIDEL(15),MXNODA(15)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      EQUIVALENCE (VIEW(1,1),VIEWA(1))
C
C          DEFAULT VIEW MATRICES FOR NVIEW=0  (OMITTED), -1, -2, -3
C
C          MATRIX ELEMENT ORDER IN DEFAULT ARRAY:
C
C          (1,1) (2,1) (3,1)  (1,2) (2,2) (3,2)  (1,3) (2,3) (3,3)
C
      DATA VIEWD/-.707107,-.408248, .577350,
     -            .707107,-.408248, .577350,
     -            .0     , .816701, .577350,
     1           0.,0.,1.,1.,0.,0.,0.,1.,0.,
     2          -1.,0.,0.,0.,0.,1.,0.,1.,0.,
     3           1.,0.,0.,0.,1.,0.,0.,0.,1./
C
      DATA KMESH,KMODE,IHYPH,BIG,SMALL/18,19,1H-,9.E20,.001/
      DATA ZERON,IPLOFF,IPLON/1.E-30,4,5/
C
      DATA IHDEFO/4,4,4HDEFO,4HRMED/
      DATA IHDEFM/5,3,3HMOD,3HESH,3HAPE/
      DATA IHDTIM/7,1,1HT,1HI,1HM,1HE,1H /
      DATA IHDMOD/4,4,4HMODE,4HNO  /
      DATA IHDORI/4,4,4HORIG,4HINAL/
      DATA IHDREF/5,3,3HREF,3HERE,3HNCE/
      DATA IHDGS/4,4,4H GSC,4HALE /
      DATA IHDDS/4,4,4H DSC,4HALE /
      DATA IHDMAX/4,4,4H   D,4HMAX /
C
      DATA IAXES/1HX,1HY,1HZ/
      DATA IUP,IDOWN/3,2/
      DATA ITRUSS,ISOBEA,I2DIM,I2DIMF,I3DIM,I3DIMF/1,5,2,11,3,12/
      DATA IBEAM,IPLATE,ISHELL/4,6,7/
C
      DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
      DATA MIDEL /2,4,8,2,2,3,4,0,0,0,4,8,0,0,0/
C
      DATA LTRUSS/1,-3,-4,-2,999/
      DATA L2DIM/1,-5,2,-6,3,-7,4,-8,1,999/
      DATA L3DIM/1,-9,2,-10,3,-11,4,-12,1,-17,5,-13,6,-14,7,-15,
     1           8,-16,5,0,2,-18,6,0,3,-19,7,0,4,-20,8,999/
      DATA LBEAM/1,2,999/
      DATA LPLATE/1,2,3,1,999/
C
C          PARAM 2: NVIEW
      IF (ITYPE(2).EQ.IOMIT .AND. REALV(6).LT.0.0) GOTO 150
      NVIEW = INTV(2)
      IF (NVIEW.GE.-3 .AND. NVIEW.LE.MVIEW) GOTO 110
        WRITE (NFLOG,2100) MVIEW
        GOTO 800
  110 IF (NVIEW.GT.0) GOTO 125
C
C          COPY DEFAULT OR NEGATIVE VIEW FROM ARRAY VIEWD
C
      IF (ITYPE(2).NE.IOMIT) GOTO 115
      IF (IDOF(3).EQ.1) NVIEW = -3
      IF (IDOF(2).EQ.1) NVIEW = -2
      IF (IDOF(1).EQ.1) NVIEW = -1
  115 NVIEW = - NVIEW * 9
      DO 120 I=1,9
  120   VIEWA(I) = VIEWD(NVIEW+I)
      GOTO 150
C
C          READ VIEW FROM DATABASE
C
  125 IF (IXGP(KVIEW).EQ.0) GOTO 140
      CALL DBREAD (VIEWDB,KVIEW,1,0)
        IF (IERROR.NE.0) GOTO 900
      IVAL = 0
      DO 130 I=1,9
        V = VIEWDB(I,NVIEW)
        IF (V.NE.0.0) IVAL = 1
  130   VIEWA(I) = V
      IF (IVAL.EQ.1) GOTO 150
  140   WRITE (NFLOG,2110)
        GOTO 800
C
C          PARAM 3: TIME OR MODENO
C
  150 TIME = 9E15
      ISTEN = 1
      MODENO = 1
C
      MORIG = 1
      MDEFOR = 0
      IF (ITYPE(3).EQ.IOMIT) GOTO 152
      MORIG = 0
      MDEFOR = 1
      TIME = REALV(3)
  152 CONTINUE
C
      IF (NCMD.EQ.KMODE) GOTO 180
C
      IF (NSTEN.GT.0) GOTO 160
  155   WRITE (NFLOG,2120)
        GOTO 800
  160 IF (TIME.EQ.TSTART) GOTO 190
      CALL DBREAD (TIMEN,KTIMEN,1,0)
        IF (IERROR.NE.0) GOTO 900
      IF (ITYPE(3).EQ.IOMIT) TIME = TIMEN(NSTEN)
      TDIFFO = BIG
      DO 170 I=1,NSTEN
        TDIFF = ABS(TIME-TIMEN(I))
        IF (TDIFF.GE.TDIFFO) GOTO 170
          TDIFFO = TDIFF
          ISTEN = I
  170   CONTINUE
      TIME = TIMEN(ISTEN)
      GOTO 190
C
  180 MODENO = INTV(3)
      IF (MODENO.LT.1) MODENO = 1
      IF (MODENO.GT.NFREQ) MODENO = NFREQ
C
C          PARAM 6: GSCALE
C
  190 GSCAIN = REALV(6)
C
C          PARAM 7: DMAX
C
  200 DMAX = REALV(7)
      IF (DMAX.GE.0.0) GOTO 210
        WRITE (NFLOG,2140)
        GOTO 800
C
C          PARAM 4,5,8,9,10,11: MORIG,MDEFOR,NUMNPL,NUMEPL,
C                                  LTEXT,INDAX
C
  210 IF (ITYPE(4).EQ.INTEG) MORIG = INTV(4)
      IF (ITYPE(5).EQ.INTEG) MDEFOR = INTV(5)
      NUMNPL = INTV(8)
      NUMEPL = INTV(9)
      LTEXT = 1
      INDAX = 1
      IF (GSCAIN.GE.0) GOTO 212
      LTEXT = 0
      INDAX = 0
  212 IF (ITYPE(10).EQ.INTEG) LTEXT = INTV(10)
      IF (ITYPE(11).EQ.INTEG) INDAX = INTV(11)
C
C          PARAM 12,13: XPV, YPV (SEE COMPUTATION OF SCALE)
C
      LINES = INTV(14)
C
      IF (MORIG .LT.0 .OR. MORIG .GT.2) GOTO 850
      IF (MDEFOR.LT.0 .OR. MDEFOR.GT.2) GOTO 850
C
C          CHECK THAT DISPLACEMENTS ARE SAVED IN DATABASE
C
      IF (MDEFOR.EQ.0) GOTO 217
      IF (NCMD.EQ.KMODE) GOTO 215
        IF (NSTEN.EQ.0) GOTO 155
        GOTO 217
  215 IF (IXGP(KPHI).NE.0) GOTO 217
        WRITE (NFLOG,2150)
        GOTO 800
  217 CONTINUE
      LINORI = MORIG * 2
      LINDEF = MDEFOR * 2
C
C
C**************   READ NODE RECORDS AND COMPUTE NODE PLOT ARRAYS
C
C
      ISTART = 0
      IXARAY = 0
      ISTRUC = 0
      ISRSDC = 0
      ISIDRN = 0
      DISMAX = 0.0
      XDMIN = 0.0
      YDMIN = 0.0
      XDMAX = 0.0
      YDMAX = 0.0
      DO 220 I=N1,N7
  220   A(I) = BIG
C
C          DO FOR ALL INDEPENDENT STRUCTURES
C
      DO 440 ISTRI=1,NSTRI
C
      NRUSE  = NRUSES(ISTRI)
      NUMNP  = NUMNPS(ISTRI)
C
C          DO FOR ALL TIMES A STRUCTURE IS REUSED
C
      DO 430 IRUSE=1,NRUSE
      ISTRUC = ISTRUC + 1
C
C          READ NZONE IF ZONE IS REQUIRED
C
      IF (IBITZ.NE.IWHOLE)
     1  CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
        IF (IERROR.NE.0) GOTO 900
C
C          GET PLOT COORDINATES XPLOT AND YPLOT FOR ALL NODES IN ZONE
C
      ISXYZ = 0
      DO 270 NP=1,NUMNP
      IF (IBITZ.EQ.IWHOLE) GOTO 250
      CALL BITGET (NZONE(NP),IBITZ,ISELEC)
      IF (ISELEC.EQ.0) GOTO 270
C
C          READ XYZ
C
  250 IF (ISTRUC.NE.ISXYZ)
     1  CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
        IF (IERROR.NE.0) GOTO 900
        ISXYZ = ISTRUC
C
      X = XYZ(NP)
      I = NUMNP + NP
      Y = XYZ(I)
      Z = XYZ(I+NUMNP)
C
C          TRANSFORMATION TO PLOT COORDINATES
C
      XC = VIEW(1,1) * X + VIEW(1,2) * Y + VIEW(1,3) * Z
      YC = VIEW(2,1) * X + VIEW(2,2) * Y + VIEW(2,3) * Z
C
      IF (ISTART.EQ.1) GOTO 260
      ISTART = 1
      XMIN = XC
      YMIN = YC
      XMAX = XC
      YMAX = YC
  260 IF (XC.LT.XMIN) XMIN = XC
      IF (YC.LT.YMIN) YMIN = YC
      IF (XC.GT.XMAX) XMAX = XC
      IF (YC.GT.YMAX) YMAX = YC
C
      IX = IXARAY + NP
      XPLOT(IX) = XC
      YPLOT(IX) = YC
  270 CONTINUE
C
C          GET PLOT DISPLACEMENTS XPLOTD AND Y D
C
      IF (MDEFOR.EQ.0 .AND. NCMD.NE.KMODE) GOTO 425
      IREAD = KMESH
C
  275 ISDISP = 0
      DO 420 NP=1,NUMNP
C
      IF (IBITZ.EQ.IWHOLE) GOTO 280
        CALL BITGET (NZONE(NP),IBITZ,ISELEC)
        IF (ISELEC.EQ.0) GOTO 420
C
C          READ DISP OR PHI
C
  280 IF (ISTRUC.EQ.ISDISP) GOTO 290
      IF (IREAD.EQ.KMESH) CALL DBREAD (DISP,KDISP,ISTRUC,ISTEN)
      IF (IREAD.EQ.KMODE) CALL DBREAD (DISP,KPHI,MODENO,0)
      IF (IERROR.NE.0) GOTO 900
      ISDISP = ISTRUC
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  290 DO 300 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0) VDIR(I) = DISP(INDOF,NP)
  300   CONTINUE
C
C          IF SKEW COORDINATE SYSTEM:  TRANSFORM TO GLOBAL
C
      IF (NSKEWS.EQ.0) GOTO 310
      IF (ISIDRN.NE.ISTRI)
     1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
        ISIDRN = ISTRI
      IXNRST = NDOF * NUMNP
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.LE.0) GOTO 310
      IF (ISRSDC.EQ.0)
     1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        ISRSDC = 1
      CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
  310 X = VDIR(1)
      Y = VDIR(2)
      Z = VDIR(3)
      XD = VIEW(1,1) * X + VIEW(1,2) * Y + VIEW(1,3) * Z
      YD = VIEW(2,1) * X + VIEW(2,2) * Y + VIEW(2,3) * Z
C
      IX = IXARAY + NP
C
      IF (NCMD.EQ.KMODE .AND. IREAD.EQ.KMESH) GOTO 320
C
      IF (ABS(XD).GT.DISMAX) DISMAX = ABS(XD)
      IF (ABS(YD).GT.DISMAX) DISMAX = ABS(YD)
      IF (XD.LT.XDMIN) XDMIN = XD
      IF (YD.LT.YDMIN) YDMIN = YD
      IF (XD.GT.XDMAX) XDMAX = XD
      IF (YD.GT.YDMAX) YDMAX = YD
C
      XPLOTD(IX) = XD
      YPLOTD(IX) = YD
      GOTO 420
C
C          MODEPLOT: SAVE GEOMETRY AT TSTART IN XPLOTR,YPLOTR
C
  320 XD = XD + XPLOT(IX)
      YD = YD + YPLOT(IX)
      IF (XD.LT.XMIN) XMIN = XD
      IF (YD.LT.YMIN) YMIN = YD
      IF (XD.GT.XMAX) XMAX = XD
      IF (YD.GT.YMAX) YMAX = YD
C
      XPLOTR(IX) = XD
      YPLOTR(IX) = YD
C
C
  420 CONTINUE
C
C          GET MODAL DISPLACEMENT
C
      IF (NCMD.EQ.KMESH .OR. IREAD.EQ.KMODE) GOTO 425
      IREAD = KMODE
      IF (MDEFOR.NE.0) GOTO 275
C
  425 IXARAY = IXARAY + NUMNP
  430 CONTINUE
  440 CONTINUE
C
C
C***************    COMPUTE AVAILIBLE X AND Y PLOT LENGTHS
C
C
C
      XMARG = PMARG
      YMARG = PMARG
      IF (DISMAX.LT.ZERON) GOTO 500
        XMARG = PMARG - XDMIN / DISMAX * DMAX
        YMARG = PMARG - YDMIN / DISMAX * DMAX
  500 XPLEN = XPMAX - XMARG - PMARG
      YPLEN = YPMAX - YMARG - PMARG
      IF (DISMAX.LT.ZERON) GOTO 505
        XPLEN = XPLEN - XDMAX / DISMAX * DMAX
        YPLEN = YPLEN - YDMAX / DISMAX * DMAX
  505 IF (LTEXT.EQ.1) YPLEN = YPLEN - HEIGHT * 5.0
      IF (LTEXT.EQ.1 .AND. MDEFOR.NE.0) YPLEN = YPLEN - 4.0 * HEIGHT
      IF (XPLEN.GT.1.0 .AND. YPLEN.GT.1.0) GOTO 510
        WRITE (NFLOG,2160)
        GOTO 800
C
C          COMPUTE SCALE FACTORS
C
  510 IF (DMAX.GT.SMALL) GOTO 520
        XMIN = XMIN + XDMIN
        YMIN = YMIN + YDMIN
        XMAX = XMAX + XDMAX
        YMAX = YMAX + YDMAX
C
C          GSCALE.LT.0.0, USE SAME GSCALE,DSCALE,XPV,YPV
C          AS IN PREVIOUS PLOT
C
  520 IF (GSCAIN.LT.0.0) GOTO 525
      GSCALE = GSCAIN
      IF (GSCALE.GT.0.0) GOTO 522
      GSCALE = BIG
      XSPAN = ABS(XMAX - XMIN)
      YSPAN = ABS(YMAX - YMIN)
      IF (XSPAN*GSCALE .GT. XPLEN) GSCALE = XPLEN / XSPAN
      IF (YSPAN*GSCALE .GT. YPLEN) GSCALE = YPLEN / YSPAN
  522 XPV = XMARG - XMIN * GSCALE
      YPV = YMARG - YMIN * GSCALE
      DSCALE = GSCALE
  525 CONTINUE
      IF (ITYPE(12).EQ.IREAL) XPV = REALV(12)
      IF (ITYPE(13).EQ.IREAL) YPV = REALV(13)
      IF (DMAX.GT.SMALL .AND. DISMAX.GE.ZERON) DSCALE = DMAX / DISMAX
      WRITE (NFLOG,2190) GSCALE,XPV,YPV
      DMAX = DISMAX * DSCALE
      IF (MDEFOR.EQ.0) GOTO 528
      IF (NCMD.NE.KMODE) WRITE (NFLOG,2200) DSCALE,DMAX,TIME
      IF (NCMD.EQ.KMODE) WRITE (NFLOG,2210) DSCALE,DMAX,MODENO
  528 CONTINUE
C
C          PLOT HEADER TEXT AND SCALE
C
      CALL CGRAPH (IPLON)
      IF (LTEXT.EQ.0) GOTO 550
      XP = PMARG
      YP = YPMAX - PMARG - HEIGHT
      IF (MORIG.EQ.0) GOTO 530
      IF (NCMD.EQ.KMESH) CALL PLOTXT (XP,YP,IHDORI)
      IF (NCMD.EQ.KMODE) CALL PLOTXT (XP,YP,IHDREF)
      X = XP + 9.0 * HEIGHT
      CALL LCLIP (X,YP,IUP)
      X = XP + 13.0 * HEIGHT
      CALL LCLIP (X,YP,LINORI)
      YP = YP - HEIGHT - HEIGHT
  530 IF (MDEFOR.EQ.0) GOTO 540
      IF (NCMD.EQ.KMESH) CALL PLOTXT (XP,YP,IHDEFO)
      IF (NCMD.EQ.KMODE) CALL PLOTXT (XP,YP,IHDEFM)
      X = XP + 9.0 * HEIGHT
      CALL LCLIP (X,YP,IUP)
      X = XP + 13.0 * HEIGHT
      CALL LCLIP (X,YP,LINDEF)
      YP = YP - HEIGHT - HEIGHT
      IF (NCMD.EQ.KMODE) GOTO 535
      CALL PLOTXT (XP,YP,IHDTIM)
      I = 0
      IF (TIME.NE.0.0) I = MAX0 ( 0, 3 - INT( ALOG10(ABS(TIME))) )
      CALL AGRAPH (999.,999.,HEIGHT,0,TIME,0.,I,3)
      GOTO 540
  535 CALL PLOTXT (XP,YP,IHDMOD)
      FPN = MODENO
      CALL AGRAPH (999.,999.,HEIGHT,0,FPN,0.,-1,3)
C
C          '  GSCALE N.NNN  DSCALE N.NNN  DMAX N.NNN'
C
  540 XP = PMARG + 13.0 * HEIGHT
      YP = YPMAX - PMARG - HEIGHT
      CALL PLOTXT (XP,YP,IHDGS)
      I = MAX0 ( 0, 3 - INT( ALOG10 (GSCALE) ) )
      CALL AGRAPH (999.,999.,HEIGHT,0,GSCALE,0.,I,3)
      IF (MDEFOR.EQ.0) GOTO 550
      YP = YP - HEIGHT - HEIGHT
      CALL PLOTXT (XP,YP,IHDDS)
      I = MAX0 ( 0, 3 - INT( ALOG10 (DSCALE) ) )
      CALL AGRAPH (999.,999.,HEIGHT,0,DSCALE,0.,I,3)
      YP = YP - HEIGHT - HEIGHT
      CALL PLOTXT (XP,YP,IHDMAX)
      I = MAX0 ( 0, 3 - INT( ALOG10 (DMAX+SMALL) ) )
      CALL AGRAPH (999.,999.,HEIGHT,0,DMAX,0.,I,3)
C
C          PLOT X, Y AND Z AXES DIRECTIONS
C
  550 IF (INDAX.EQ.0) GOTO 600
      DO 570 I=1,3
      XP = PMARG + HEIGHT * 4.4
      XC = XPMAX - XP
      YC = YPMAX - XP
      IF (XC.GT.(FLOAT(LTEXT)*(PMARG+HEIGHT*30.0)))
     1  GOTO 560
      YC = YC - HEIGHT * 4.0
      IF (MDEFOR.GT.0) YC = YC - HEIGHT * 2.0
  560 CALL LCLIP (XC,YC,IUP)
      XP = XC + VIEW(1,I) * HEIGHT * 3.0
      YP = YC + VIEW(2,I) * HEIGHT * 3.0
      CALL LCLIP (XP,YP,IDOWN)
C
C          PLOT X, Y AND Z CHARACHTER AT AXES
C
      XDIFF = XP - XC
      YDIFF = YP - YC
      ALGH = SQRT (XDIFF*XDIFF + YDIFF*YDIFF)
      IF (ALGH.LT.SMALL) GOTO 570
      AFACT = (ALGH + HEIGHT) / ALGH
      XP = XC + AFACT * XDIFF - HEIGHT * 0.3
      YP = YC + AFACT * YDIFF - HEIGHT * 0.5
      NBCD = IAXES(I)
      CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
  570 CONTINUE
C
C
C**********    READ ELEMENT RECORDS AND DO PLOTTING
C
C
  600 ISTRUC = 0
      IEGIT = 0
      IEGAT = 0
      IXARAY = 0
      ISNOD  = 0
      ISEZON = 0
C
C          DO FOR ALL INDEPENDENT STRUCTURES
C
      DO 750 ISTRI=1,NSTRI
C
      NRUSE = NRUSES(ISTRI)
      NEG   = NEGS  (ISTRI)
      NUMNP = NUMNPS(ISTRI)
      NMID  = MAXMSS(ISTRI)
C
C          READ NPAR
C
      CALL DBREAD (NPAR,KNPAR,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL TIMES A STRUCTURE IS REUSED
C
      DO 740 IRUSE=1,NRUSE
      ISTRUC = ISTRUC + 1
C
C
C          DO FOR ALL SELECTED NODES IN REUSED STRUCTURE
C
C
      DO 630 NP=1,NUMNP
      IX = IXARAY + NP
      IF (XPLOT(IX).EQ.BIG) GOTO 630
C
C          TEST LIST OF VIEW COORDINATES BEFORE SCALING
C
      IF (NUMNPL.NE.-1) GOTO 610
      CALL CGRAPH (IPLOFF)
      ISUBST = ISTRI - 1
      IF (NP.EQ.1) WRITE (NFLOG,2170) ISUBST, IRUSE
      WRITE (NFLOG,2180) NP,XPLOT(IX),YPLOT(IX),XPLOTD(IX),YPLOTD(IX)
      IF (NCMD.EQ.KMODE) WRITE (NFLOG,2180) NP,XPLOTR(IX),YPLOTR(IX)
      CALL CGRAPH (IPLON)
C
C          COMPUTE SCALED PLOT COORDINATES
C
  610 XPLOT(IX) = XPLOT(IX) * GSCALE + XPV
      YPLOT(IX) = YPLOT(IX) * GSCALE + YPV
      XPLOTD(IX) = XPLOTD(IX) * DSCALE
      YPLOTD(IX) = YPLOTD(IX) * DSCALE
      IF (NCMD.NE.KMODE) GOTO 615
        XPLOTR(IX) = XPLOTR(IX) * GSCALE + XPV
        YPLOTR(IX) = YPLOTR(IX) * GSCALE + YPV
C
C          PLOT NODE NUMBERS AND SYMBOLS IF REQUESTED
C
  615 IF (NUMNPL.LE.0) GOTO 630
      XP = XPLOT(IX)
      YP = YPLOT(IX)
      IF (NCMD.NE.KMODE) GOTO 617
      XP = XPLOTR(IX)
      YP = YPLOTR(IX)
  617 IF (MDEFOR.EQ.0) GOTO 620
      XP = XPLOTD(IX) + XP
      YP = YPLOTD(IX) + YP
  620 IF (NUMNPL.LT.10) GOTO 625
      ISYMBL = 5
      IF (ISTRUC.GT.1) ISYMBL = 2
      H = HEIGHT * 0.6
      CALL AGRAPH (XP,YP,H,ISYMBL,0.0,0.0,-1,2)
  625 IF (NUMNPL.EQ.10) GOTO 630
      H = HEIGHT * 0.8
      XP = XP + HEIGHT
      YP = YP + H
      IF (ISTRUC.GT.1) YP = YP - H * 3.0
      FPN = NP
      CALL AGRAPH (XP,YP,H,0,FPN,0.0,-1,3)
  630 CONTINUE
C
C          FIRST DRAW ORIGINAL OR REFERENCE SHAPE
C
      IDEFOR = 0
      LINTYP = LINORI
  640 IXYSTA = I16 / ISURL
      IXYUSE = IXYSTA - 3
      IXYEND = IXYSTA
C
C
C          DO FOR ALL ELEMENT GROUPS IN REUSED STRUCTURE
C
C
      DO 730 IEG=1,NEG
      IEGAT = IEGAT + 1
      IEGIT = IEGIT + 1
      IF (IDEFOR.EQ.0 .AND. MORIG.EQ.0 .AND.
     1    (NUMEPL.EQ.0 .OR. MDEFOR.EQ.0)) GOTO 730
      ISEG = 0
C
      IELTYP = NPAR(1,IEG)
      MXNODS = MXNODA(IELTYP)
      NEL = NPAR(2,IEG)
C
      NTHICK = NPAR(14,IEG)
      MXMNOD = NPAR(8,IEG)
C
C          LAGRAN = 1 IF FREQUENCY MODE REFERENCES TSTART DISPL
C          LAGRAN = 0 IF FREQ. DISPL REFERENCES TO ORIGINAL MESH
C
      LAGRAN = 0
      NPAR3 = NPAR(3,IEG)
      IF (NPAR3.GT.1) LAGRAN = 1
      IF (IELTYP.EQ.I2DIMF .AND. NPAR3.EQ.1) LAGRAN = 1
      IF (IELTYP.EQ.I3DIMF .AND. NPAR3.EQ.1) LAGRAN = 1
C
C
C          READ IEZONE IF REQUIRED
C
      IF (IBITZ.NE.IWHOLE .AND. IEGAT.NE.ISEZON)
     1  CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
        IF (IERROR.NE.0) GOTO 900
        ISEZON = IEGAT
C
C          DO FOR ALL ELEMENTS IN GROUP AND ZONE
C
      DO 720 IEL=1,NEL
      IF (IBITZ.EQ.IWHOLE) GOTO 650
      CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
      IF (ISELEC.EQ.0) GOTO 720
C
C          READ NOD
C
  650 IF (ISNOD.EQ.IEGIT) GOTO 660
      ISNOD = IEGIT
      CALL DBREAD (NOD,KNOD,IEGIT,0)
        IF (IERROR.NE.0) GOTO 900
C
  660 I = IXARAY + 1
      IXNOD = MXNODS * (IEL - 1) + 1
      J = IXNOD
C
      NX = N1 + IXARAY
      NY = N2 + IXARAY
      IF (NCMD.NE.KMODE .OR. LAGRAN.NE.1) GOTO 665
      NX = N5 + IXARAY
      NY = N6 + IXARAY
C
  665 IF (MORIG.EQ.0 .AND. IDEFOR.EQ.0) GOTO 700
C
  670 IF (IELTYP.EQ.ITRUSS .OR. IELTYP.EQ.ISOBEA)
     1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LTRUSS)
      IF (IELTYP.EQ.I2DIM .OR. IELTYP.EQ.I2DIMF)
     1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),L2DIM)
      IF (IELTYP.EQ.I3DIM .OR. IELTYP.EQ.I3DIMF)
     1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),L3DIM)
      IF (IELTYP.EQ.IBEAM)
     1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LBEAM)
      IF (IELTYP.EQ.IPLATE)
     1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LPLATE)
C
C          SHELL ELEMENT PLOTTING
C
      IF (IELTYP.NE.ISHELL) GOTO 700
      IF (ISEG.EQ.IEGIT) GOTO 685
      I17 = I16
      I18 = I16
      I19 = I16
      I20 = I16
      IF (MIDSPL.EQ.1 .OR. IDEFOR.EQ.1) GOTO 685
C                                                EDATA
      I17 = I16 + (ISURL + 1) * NEL
C                                                ITHICK
      I18 = I17 + NEL
      CALL ALIGN(I18)
C                                                THICK
      I19 = I18 + MXMNOD * NTHICK * ISURL
C                                                TMIDSS
      I20 = I19 + NMID * 3 * ISURL
C                                                IDRN
      I21 = I20 + (NDOF + 1) * NUMNP
C                                                MIDS
      I22 = I21 + NUMNP
C
C          MOVE LINES ARRAY UP ABOVE SHELL AREAS IF REQUIRED
C
      CALL ALIGN (I22)
      IXOLAP = I22 / ISURL - IXYSTA
      IF (IXOLAP.LE.0) GOTO 685
      I22 = I22 + (IXYUSE - IXYSTA + 3) * ISURL
      CALL SIZE (I22)
      IF (IERROR.NE.0) GOTO 900
      IXYSTA = IXYSTA + IXOLAP
      IXYUSE = IXYUSE + IXOLAP
      IXYEND = IXYUSE + 3
      L = IXYEND
  680 L = L - 1
      IF (L.LT.IXYSTA) GOTO 685
      A(L) = A(L-IXOLAP)
      GOTO 680
C
  685 CALL SHELL (A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),
     1     IA(I16),IA(I17),IA(I18),IA(I19),IA(I20),IA(I21),
     2     IEGIT,NTHICK,ISTRI,IEL,MXMNOD,ISEG)
      IF (IERROR.NE.0) GOTO 900
C
C
C          PLOT ELEMENT NUMBER OR GROUP,ELEMENT IF REQUESTED
C
  700 IF (NUMEPL.EQ.0) GOTO 720
      IF (IDEFOR.EQ.0 .AND. MDEFOR.NE.0) GOTO 720
C
      H = HEIGHT
C
C          FIND MIDDLE POINT OF ELEMENTS FIRST NODES
C
      XP = 0.0
      YP = 0.0
      NMIDEL = MIDEL(IELTYP)
C
C          AXISYMMETRIC TRUSS (RING) HAS 1 NODE ONLY
      IF (IELTYP.EQ.ITRUSS .AND. NPAR(5,IEG).EQ.1) NMIDEL = 1
      DO 711 IMIDEL=1,NMIDEL
        IXNODN = NOD(IXNOD+IMIDEL-1) + IXARAY
        X = XPLOT(IXNODN)
        Y = YPLOT(IXNODN)
        IF (NCMD.NE.KMODE .OR. LAGRAN.EQ.0) GOTO 705
          X = XPLOTR(IXNODN)
          Y = YPLOTR(IXNODN)
  705 IF (MDEFOR.EQ.0) GOTO 707
      X = X + XPLOTD(IXNODN)
      Y = Y + YPLOTD(IXNODN)
  707 XP = XP + X
      YP = YP + Y
      IF (IMIDEL.NE.1) GOTO 709
      XP1 = X
      YP1 = Y
  709 IF (IMIDEL.NE.2) GOTO 711
      XP2 = X
      YP2 = Y
  711   CONTINUE
C
      XP = XP / FLOAT(NMIDEL) - H * 0.4
      YP = YP / FLOAT(NMIDEL) - H * 0.5
C
C          MOVE AWAY FROM MIDDLE OF LINE IF 2 NODES ONLY
C
      IF (NMIDEL.NE.2) GOTO 712
      XDIFF = XP2 - XP1
      YDIFF = YP2 - YP1
      ALGH = SQRT (XDIFF*XDIFF + YDIFF*YDIFF)
      IF (ALGH.LT.SMALL) GOTO 712
      XP = XP + HEIGHT * ABS(YDIFF) / ALGH
      YP = YP - HEIGHT * XDIFF * SIGN(1.0,YDIFF) / ALGH
C
  712 CONTINUE
      IF (NUMEPL.LE.1) GOTO 715
      FPN = IEG
      CALL AGRAPH (XP,YP,H,0,FPN,0.,-1,3)
      CALL AGRAPH (999.,999.,H,IHYPH,0.,0.,1,1)
      XP = 999.
      YP = 999.
  715 FPN = IEL
      CALL AGRAPH (XP,YP,H,0,FPN,0.,-1,3)
C
  720 CONTINUE
  730 CONTINUE
      IEGIT = IEGIT - NEG
C
C
C          END OF STRUCTURE, PLOT ELEMENT LINES HERE IF SAVED
C
      IF (LINES.EQ.0) GOTO 737
      I = IXYSTA - 3
  734 IFROM = 0
  735 I = I + 3
      IF (I.GT.IXYUSE) GOTO 737
      IF (NUMNPL.EQ.-2) WRITE (NFLOG,1234) A(I),A(I+1),A(I+2)
 1234 FORMAT(3(10X,G12.6))
      J = INT(A(I+2) + 0.2)
      IF (J.EQ.0) GOTO 734
      IF (J.GT.IABS(LINES)) GOTO 734
      IF (J.NE.LINES .AND. LINES.GT.0) GOTO 734
      IF (IFROM.EQ.0) CALL LCLIP (A(I-3),A(I-2),IUP)
      IFROM = 1
      CALL LCLIP (A(I),A(I+1),LINTYP)
      GOTO 735
C
C          GO BACK TO DRAW LINES OF DEFORMED SHAPE
C
  737 IF (MDEFOR.EQ.0) GOTO 739
      IF (IDEFOR.EQ.1) GOTO 739
      IDEFOR = 1
      LINTYP = LINDEF
      IEGAT = IEGAT - NEG
      GOTO 640
C
  739 IXARAY = IXARAY + NUMNP
  740 CONTINUE
      IEGIT = IEGIT + NEG
  750 CONTINUE
      GOTO 900
C
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 CALL CGRAPH (IPLOFF)
      RETURN
C
 2100 FORMAT(41H ***ERROR:  VIEW PARAMETER INVALID, -3 - ,I2)
 2110 FORMAT(28H ***ERROR:  VIEW NOT DEFINED)
 2120 FORMAT(43H ***ERROR: NO TIMESTEP SAVED FOR NODAL DATA)
 2140 FORMAT(29H ***ERROR: INVALID DMAX VALUE)
 2150 FORMAT(35H ***ERROR: NO MODAL TIMESTEPS SAVED)
 2160 FORMAT(44H ***ERROR: PLOT AREA (SUBFRAME) IS TOO SMALL)
 2170 FORMAT (/52H  NODE   XPLOT       YPLOT       XPLOTD       YPLOTD,
     1  12X,6HNSUB =,I5,10H  NREUSE =,I5/)
 2180 FORMAT(1X,I5,4(2X,E10.4))
 2190 FORMAT(13H    GSCALE = ,G10.4,9H   XPV = ,G10.4,
     1  9H   YPV = ,G10.4)
 2200 FORMAT(13H    DCSALE = ,G10.4,9H  DMAX = ,G10.4,
     1  9H  TIME = ,G10.5)
 2210 FORMAT(13H    DSCALE = ,G10.4,9H  DMAX = ,G10.4,
     1  11H  MODENO = ,I4)
      END
C***ADD:CDC***
CDECK PLOTXT
C***END:CDC***
      SUBROUTINE PLOTXT (XP,YP,IARRAY)
C
C          HORISONTAL PLOT OF TEXT FROM AN ARRAY WITH:
C          IARRAY(1) = TOTAL LENGTH OF ARRAY
C          IARRAY(2) = NUMBER OF CHARACTERS IN EACH ARRAY ENTRY TO PLOT
C          IARRAY(3-N) = TEXT TO BE PLOTTED
C
      DIMENSION IARRAY(1)
C
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
C
      LENGTH = IARRAY(1)
      NCHAR  = IARRAY(2)
      X = XP
      Y = YP
      DO 100 I=3,LENGTH
        NBCD = IARRAY(I)
        CALL AGRAPH (X,Y,HEIGHT,NBCD,0.,0.,NCHAR,1)
        X = 999.0
        Y = 999.0
  100   CONTINUE
      RETURN
      END
C***ADD:CDC***
CDECK PLOTL
C***END:CDC***
      SUBROUTINE PLOTL (XPLOT,YPLOT,XPLOTD,YPLOTD,NOD,NLINE)
C
      DIMENSION NLINE(1),XPLOT(1),YPLOT(1),NOD(1),XPLOTD(1),YPLOTD(1)
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /ERROR/ IERROR
      COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON A(1)
C
      DATA IUP,IPLOFF,IPLON/3,4,5/
C
      NPLINE = 0
C
C          DRAW A LINE BETWEEN NODES IN NLINE ARRAY
C
  50  IND = IUP
  100 NPLINE = NPLINE + 1
      NPEL = NLINE(NPLINE)
C
C          0 MEANS PEN UP FOR MOVE TO NEXT NODE
C          999 MEANS END OF LINE
C
      IF (NPEL.EQ.0) GOTO 50
      IF (NPEL.EQ.999) GOTO 800
      I = IABS(NPEL)
      NP = NOD(I)
C
C          NODE IS OPTIONAL (ZERO) IF NPEL IS NEGATIVE
C
      IF (NP.EQ.0 .AND. NPEL.LT.0) GOTO 100
      IF (NP.LT.1 .OR.NP.GT.NUMNP) GOTO 700
C
      XP = XPLOT(NP)
      YP = YPLOT(NP)
      IF (IDEFOR.NE.1) GOTO 200
      XP = XP + XPLOTD(NP)
      YP = YP + YPLOTD(NP)
C
C          IMMEDIATE PLOTTING OF ELEMENT LINES
C
  200 IF (LINES.NE.0) GOTO 300
      CALL LCLIP (XP,YP,IND)
C
  250 IND = LINTYP
      GOTO 100
C
C          ELEMENT LINES ARE SAVED IN AN ARRAY TO BE PLOTTED
C          AT END OF STRUCTURE DEPENDING ON LINES PARAMETER
C
  300 IF (IND.NE.IUP) GOTO 320
C
  310 XFROM = XP
      YFROM = YP
      GOTO 250
C
C          SKIP LINE OF ZERO LENGTH
C
  320 IF (ABS (XP - XFROM) .GT. EPS) GOTO 330
      IF (ABS (YP - YFROM) .LE. EPS) GOTO 310
C
C          EXPAND SIZE OR LINES ARRAY IN BLANK COMMON
C
  330 IF (IXYUSE+9 .LE. IXYEND) GOTO 400
      IXYEND = IXYEND + 300
      I = IXYEND * ISURL
      CALL SIZE(I)
      IF (IERROR.NE.0) GOTO 900
C
C          SCAN ARRAY FOR LINE START POINT XFROM,YFROM
C          FOR BETTER PREFORMACE SCAN IS BACKWARDS
C
  400 IXSCAN = IXYUSE + 3
      IXHIT = 0
C
  410 IXSCAN = IXSCAN - 3
      IF (IXSCAN.LT.IXYSTA) GOTO 500
      IF (ABS(XFROM - A(IXSCAN)) .GT. EPS) GOTO 410
      IF (ABS(YFROM - A(IXSCAN+1)) .GT. EPS) GOTO 410
C
C          XFROM,YFROM FOUND - LOOK IF PREVIOUS ENTRY IS XP,YP
C
  420 IF (IXSCAN.EQ.IXYSTA) GOTO 440
      IF (ABS(XP - A(IXSCAN-3)) .GT. EPS) GOTO 440
      IF (ABS(YP - A(IXSCAN-2)) .GT. EPS) GOTO 440
      IXHIT = IXSCAN + 2
      IF (A(IXHIT).EQ.0.0) GOTO 440
  430 IF (A(IXHIT).GE.0.0) A(IXHIT) = - A(IXHIT) - 1.
      GOTO 310
C
C          AND NOW LOOK FOR XP,YP IN NEXT ARRAY ENTRY
C
 440  IF (IXSCAN.GE.IXYUSE) GOTO 510
      IF (ABS(XP - A(IXSCAN+3)) .GT. EPS) GOTO 410
      IF (ABS(YP - A(IXSCAN+4)) .GT. EPS) GOTO 410
      IXHIT = IXSCAN + 5
      IF (A(IXHIT).EQ.0.0) GOTO 410
      GOTO 430
C
C          LINE NOT FOUND IN ARRAY - INSERT START POINT AT ARRAY END
C
  500 IF (IXHIT.GT.0) GOTO 430
      IF (IXHIT.EQ.-1) GOTO 520
      IXYUSE = IXYUSE + 3
      A(IXYUSE) = XFROM
      A(IXYUSE+1) = YFROM
      A(IXYUSE+2) = 0.
      IXSCAN = IXYUSE
      IXHIT = 1
      GOTO 420
C
C          LINE NOT FOUND IN ARRAY - INSERT LINE END AT ARRAY END
C
  510 IF (IXHIT.NE.0) GOTO 520
      IXHIT = -1
      GOTO 410
  520 IXYUSE = IXYUSE + 3
      A(IXYUSE) = XP
      A(IXYUSE+1) = YP
      A(IXYUSE+2) = -1.
      GOTO 310
C
  700 WRITE (NFLOG,2000) NPEL, NP
      IERROR = 1
      GOTO 900
  800 IF (LINES.EQ.0) GOTO 900
      DO 850 I=IXYSTA,IXYUSE,3
      J = I + 2
  850   A(J) = ABS(A(J))
  900 CONTINUE
      RETURN
 2000 FORMAT(26H ***ERROR: ELEMENT NODE NR,I3
     1  ,13H IS INVALID =,I5)
      END
C***ADD:CDC***
CDECK SHELL
C***END:CDC***
      SUBROUTINE SHELL (XPLOT,YPLOT,XPLOTD,YPLOTD,NOD,
     1                 EDATA,ITHICK,THICK,TMIDSS,IDRN,MIDS,
     2                 IEGIT,NTHICK,ISTRI,IEL,MXMNOD,ISEG)
C
      DIMENSION IA(1),XPLOT(1),YPLOT(1),XPLOTD(1),YPLOTD(1),NOD(1),
     1          EDATA(1),ITHICK(1),THICK(MXMNOD,1),TMIDSS(3,1),
     2          IDRN(1),MIDS(1)
      DIMENSION XSHELL(32),YSHELL(32),XSD(32),YSD(32),NODSH(32)
      DIMENSION LMID1(14),LMID2(72)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      DATA LMID1/1,-5,-9,2,-6,-10,3,-7,-11,4,-8,-12,1,999/
      DATA LMID2/1,-5,-9,2,-6,-10,3,-7,-11,4,-8,-12,
     -  1,17,-21,-25,18,-22,-26,19,-23,-27,20,-24,-28,17,
     1  0,-5,-21,0,-9,-25,0,2,18,0,-6,-22,0,-10,-26,0,3,19,
     2  0,-7,-23,0,-11,-27,0,4,20,0,-8,-24,0,-12,-28,0,-13,-29,
     3  0,-14,-30,0,-15,-31,0,-16,-32,999/
C
      NPSAVE = NUMNP
      NUMNP = 32
C
      DO 100 I=1,32
  100   NODSH(I) = 0
C
C
C          IF ORIGINAL SHAPE  AND
C          MIDSPL.EQ.0, TOP AND BOTTOM SURFACES ARE PLOTTED
C
C
      IF (MIDSPL.EQ.1) GOTO 500
      IF (IDEFOR.EQ.1) GOTO 500
C
C          READ THICKNESS AND MIDSURFACE NORMAL INFORMATION
C
      IDBMID = 0
      IF (NTHICK.EQ.0 .OR. NMID.EQ.0) GOTO 200
      IDBMID = 1
      IF (ISEG.EQ.IEGIT) GOTO 200
      ISEG = IEGIT
      CALL DBREAD(EDATA,KEDATA,IEGIT,0)
        IF (IERROR.NE.0) GOTO 900
C
      CALL DBREAD (THICK,KTHICK,IEGIT,0)
        IF (IERROR.NE.0) GOTO 900
C
      CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
C
      CALL DBREAD (TMIDSS,KTMIDS,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
C
C
C          GET ALL TOP AND BOTTOM NODES
C
  200 NTH = ITHICK(IEL)
      IF (NTH.EQ.0) GOTO 750
      ITHNOD = 0
      DO 400 NPEL=1,16
C
      NPTOP = NOD(NPEL)
      IF (NPTOP.EQ.0) GOTO 400
      NODSH(NPEL) = NPEL
      XSHELL(NPEL) = XPLOT(NPTOP)
      YSHELL(NPEL) = YPLOT(NPTOP)
      XSD   (NPEL) = XPLOTD(NPTOP)
      YSD   (NPEL) = YPLOTD(NPTOP)
C
      NPEL16 = NPEL + 16
      NPBOT = NOD(NPEL16)
      NODSH(NPEL16) = NPEL16
      IF (NPBOT.EQ.0) GOTO 300
C
C          BOTTOM NODE IS GIVEN, FIRST NOD WAS TOP
C
      XSHELL(NPEL16) = XPLOT(NPBOT)
      YSHELL(NPEL16) = YPLOT(NPBOT)
      XSD   (NPEL16) = XPLOTD(NPBOT)
      YSD   (NPEL16) = YPLOTD(NPBOT)
      GOTO 400
C
C          MIDSURFACE NODE IS GIVEN
C
  300 IF (IDBMID.EQ.0) GOTO 750
C
C          COMPUTE HALF THICKNESS AT THIS NODE
C
      ITHNOD = ITHNOD + 1
      THNESS = THICK(ITHNOD,NTH) * 0.5
C
C          GET MIDSURFACE NORMAL VECTOR IN THIS NODE
C          AND COMPUTE A VECTOR WITH HALF THICKNESS LENGTH
C
      IMID = MIDS(NPTOP)
      IF (IMID.EQ.0) GOTO 750
      X = TMIDSS(1,IMID) * THNESS
      Y = TMIDSS(2,IMID) * THNESS
      Z = TMIDSS(3,IMID) * THNESS
C
C          COMPUTE PLOT VIEW PROJECTION
C
      XD = (VIEW(1,1)*X + VIEW(1,2)*Y + VIEW(1,3)*Z)*GSCALE
      YD = (VIEW(2,1)*X + VIEW(2,2)*Y + VIEW(2,3)*Z)*GSCALE
C
C          COMPUTE TOP AND BOTTOM NODE PLOT COORDINATES
C
      XSHELL(NPEL) = XPLOT(NPTOP) + XD
      YSHELL(NPEL) = YPLOT(NPTOP) + YD
      XSHELL(NPEL16) = XPLOT(NPTOP) - XD
      YSHELL(NPEL16) = YPLOT(NPTOP) - YD
      XSD(NPEL16) = XPLOTD(NPTOP)
      YSD(NPEL16) = YPLOTD(NPTOP)
  400 CONTINUE
      CALL PLOTL (XSHELL,YSHELL,XSD,YSD,NODSH,LMID2)
      GOTO 900
C
C
C          IF DEFORMATION PLOT  OR
C          MIDSPL.EQ.1,  MIDSURFACE IS PLOTTED
C
C
  500 DO 600 NPEL=1,16
C
      NPTOP = NOD(NPEL)
      IF (NPTOP.EQ.0) GOTO 600
      NODSH(NPEL) = NPEL
      XSHELL(NPEL) = XPLOT(NPTOP)
      YSHELL(NPEL) = YPLOT(NPTOP)
      XSD   (NPEL) = XPLOTD(NPTOP)
      YSD   (NPEL) = YPLOTD(NPTOP)
      NPBOT = NOD(NPEL+16)
      IF (NPBOT.EQ.0) GOTO 600
C
C          COMPUTE MIDDLE FROM TOP AND BOTTOM NODE
C
      XSHELL(NPEL) = (XPLOT(NPTOP) + XPLOT(NPBOT)) * 0.5
      YSHELL(NPEL) = (YPLOT(NPTOP) + YPLOT(NPBOT)) * 0.5
      XSD(NPEL) = (XPLOTD(NPTOP) + XPLOTD(NPBOT)) * 0.5
      YSD(NPEL) = (YPLOTD(NPTOP) + YPLOTD(NPBOT)) * 0.5
  600 CONTINUE
C
  700 CALL PLOTL (XSHELL,YSHELL,XSD,YSD,NODSH,LMID1)
      GOTO 900
C
  750 WRITE (NFLOG,2000) NPTOP,NPBOT,NTH,IMID
  800 IERROR = 1
  900 NUMNP = NPSAVE
      RETURN
 2000 FORMAT(40H ***ERROR: IN SHELL ELEMENT DATA, NPTOP=,I4,
     1  7H,NPBOT=,I4,5H,NTH=,I4,6H,IMID=,I4)
      END
C***ADD:CDC***
CDECK EVECT1
C***END:CDC***
      SUBROUTINE EVECT1
C
      DIMENSION IA(1)
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /ERROR/ IERROR
      COMMON /CALLP/NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      CALL ZGETNB
      IF (IERROR.NE.0) GOTO 900
C
C          BLANK COMMON LAYOUT
C
C                                                IEZONE
      I3 = I1 + MXEL
      IF (IBITZ.EQ.IWHOLE) I3 = I1
C                                                XYZ
      I4 = I3 + MXNP * 3 * ISURL
C                                                NOD
      I5 = I4 + MXELNP
C                                                NPAR
      I6 = I5 + NELPAR * MXEG
C                                                EDATA
      I7 = I6 + MXEL * (ISURL + 2)
C                                                ITABLE
      I8 = I7 + MXITAB
C                                                SXYZ
      I9 = I8 + MXIDER * 3 * ISURL
C                                                NERPTS
      I10 = I9 + MXEL
C                                                IDERPT
      I11 = I10 + MXIDER
C                                                ERES
      I12 = I11 + MXERES * ISURL
C                                                TIMEE,NSTEPE (TEMPORARY
      I13 = I12 + NSTEE * (ISURL + 1)
C
C          MORE MEMORY IS REQUESTED DYNAMICALLY IN EVECT2
C
      CALL SIZE (I13)
      IF (IERROR.NE.0) GOTO 900
      CALL EVECT2 (IA(I1),IA(I3),IA(I4),NELPAR,IA(I5),IA(I6)
     1  ,IA(I7),IA(I8),IA(I9),IA(I10),IA(I11),IA(I12))
C
  900 RETURN
      END
C***ADD:CDC***
CDECK EVECT2
C***END:CDC***
      SUBROUTINE EVECT2 (IEZONE,XYZ,NOD,NPARD,NPAR,EDATA,
     1   ITABLE,SXYZ,NERPTS,IDERPT,ERES,TIMEE)
C
      DIMENSION IEZONE(1),XYZ(1),NOD(1),NPAR(NPARD,1),EDATA(1),
     1          ITABLE(1),SXYZ(3,1),NERPTS(1),IDERPT(1),ERES(1),
     2          TIMEE(1),IPSELE(3),SIGP(3),DIRCOS(3,3),IA(1)
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,PLATE,SHELL/1,2,3,4,5,6,7/
      DATA I2DIMF,I3DIMF/11,12/
      DATA IPLON,IPLOFF,IUP,ISOLID,ISPLIT/5,4,3,2,4/
C
C          PARAMETER: KIND
C
      KIND = INTV(2)
C
C          PARAMETER: TIME
C
      TIME = REALV(3)
      IF (ITYPE(3).EQ.IOMIT) TIME = 9E20
      IF (NSTEE.GT.0) GOTO 110
        WRITE (NFLOG,2000)
        GOTO 800
  110 CALL DBREAD (TIMEE,KTIMEE,1,0)
      IF (IERROR.NE.0) GOTO 900
      TDIFFO = 9E30
      DO 120 I=1,NSTEE
        TDIFF = ABS (TIME - TIMEE(I))
        IF (TDIFFO.LE.TDIFF) GOTO 120
        TDIFFO = TDIFF
        ITIME = I
  120   CONTINUE
      TIME = TIMEE(ITIME)
C
C          PARAMETER:  VLENGH
C
      VLENGH = REALV(4)
C
C          PARAMETER:  LIST
C
      LIST = INTV(5)
C
C          INITIALIZE
C
      ISEGIT = 0
      ISERES = 0
      IXVSTA = I12 / ISURL
      IXVNEX = IXVSTA
      IXVEND = I13 / ISURL
      ISTRUC = 0
      IEGIT = 0
      IEGAT = 0
      VMAX = 0.0
      IPSELE(1) = 1
      IPSELE(2) = 1
      IPSELE(3) = 1
      NUMP = 3
C
C          DO FOR EVERY STRUCTURE, REUSE AND EL GROUP
C
      DO 650 ISTRI=1,NSTRI
C
      CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
      I = ISTRI - 1
      NRUSE = IA(I06+I)
      NEG   = IA(I07+I)
      NUMNP = IA(I08+I)
C
      DO 640 IRUSE=1,NRUSE
C
      ISTRUC = ISTRUC + 1
C
      DO 630 IEG=1,NEG
C
      LSTEG = 1
      IEGIT = IEGIT + 1
      IEGAT = IEGAT + 1
      IELTYP = NPAR(1,IEG)
      NEL    = NPAR(2,IEG)
      INDNL  = NPAR(3,IEG)
      NTABLE = NPAR(13,IEG)
C
C          SKIP ELEMENT TYEPS NOT SUPPORTED
C
      IF (IELTYP.NE.I2DIM .OR. NPAR(5,IEG).EQ.3) GOTO 630
C
C          CHECK IF ANY ELEMENT IN GROUP BELONGS TO ZONE
C
      IF (IBITZ.EQ.IWHOLE) GOTO 160
      CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
      DO 150 IEL=1,NEL
        CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
        IF (ISELEC.EQ.1) GOTO 160
  150   CONTINUE
      GOTO 630
C
C          READ AND COMPUTE ELEMENT RESULT INFORMATION
C
  160 CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NEL+1),ITABLE,
     1  NTABLE,IEGIT,ISEGIT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
      IF (IERROR.NE.0) GOTO 900
      IF (NERES.EQ.0) GOTO 630
C
      CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL ELEMENTS IN GROUP
C
      IXIDER = 0
      IXERES = - NERKI
C
      DO 620 IEL=1,NEL
C
      NERPT = NERPTS(IEL)
      IF (NERPT.EQ.0) GOTO 620
      ISELEC = 1
      IF (IBITZ.NE.IWHOLE)
     1  CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
C
C          DO FOR ELEMENT STRESS POINTS
C
      DO 610 IERPT=1,NERPT
C
      IXIDER = IXIDER + 1
      IXERES = IXERES + NERKI
C
      IF (ISELEC.EQ.0) GOTO 610
C
C          SKIP UNBORN OR DEAD ELEMENT
C
      IDERES = IDERPT(IXIDER)
      IF (IDERES.LT.0) GOTO 610
C
C          READ ERES AND SXYZ
C
      IF (ISERES.EQ.IEGAT) GOTO 180
      ISERES = IEGAT
      CALL DBREAD (ERES,KERES,IEGAT,ITIME)
      IF (IERROR.NE.0) GOTO 900
      CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
C
  180 IF (ERES(IXERES+1).EQ.987654E32) GOTO 610
      DO 190 I=1,3
        SIGP(I) = 0.
        DO 190 J=1,3
  190     DIRCOS(I,J) = 0.
C
C
C          2-DIMENSIONAL SOLID WITH NPAR(5).NE.3
C          ELEMENT RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM
C
  200 YY = ERES(IXERES+1)
      ZZ = ERES(IXERES+2)
      YZ = ERES(IXERES+3)
      XX = ERES(IXERES+4)
C
C          FIND PRINCIPAL STRESSES
C
      AA = (YY + ZZ) * 0.5
      BB = (YY - ZZ) * 0.5
      CC = SQRT(BB*BB + YZ*YZ)
      SIGP(1) = AA + CC
      SIGP(2) = AA - CC
      SIGP(3) = XX
C
C          FIND DIRECTIONS OF THE PRINCIPAL STRESSES
C
      ANG = 45.0
      IF (YZ.EQ.0.) ANG = 0.00001
      IF (ABS(BB).LT.0.0000001) GOTO 210
      ANG = 28.6479 * ATAN ( ABS ( YZ / BB ) )
      IF ( (BB * YZ ) .LE. 0. ) ANG = 90.0 - ANG
      IF ( YZ.LE.0. )           ANG = 90.0 + ANG
C
  210 ANGRAD = ANG * 0.0174533
      PSIN = SIN(ANGRAD)
      PCOS = COS(ANGRAD)
      DIRCOS(2,1) = PCOS
      DIRCOS(3,1) = PSIN
      DIRCOS(2,2) = -PSIN
      DIRCOS(3,2) = PCOS
      DIRCOS(1,3) = 1.
C
C
  500 IF (LIST.EQ.0) GOTO 550
      WRITE (NFLOG,2010) ISTRI,IRUSE,IEG,IEL,IDERES,SIGP(1),SIGP(2),ANG
C
C          SAVE PRINCIPAL STRESSES FOR PLOTTING
C
  550 IF (VLENGH.LT.EPS) GOTO 610
C
C          IXY = 0 FOR STRESS POINT COORDINATES SXYZ
C          IXY = 1,2,3  FOR PRINCIPAL STRESSES DISPLACEMENTS (XYZ)
C
      IXY = 0
      X = SXYZ(1,IXIDER)
      Y = SXYZ(2,IXIDER)
      Z = SXYZ(3,IXIDER)
C
C          TRANSFORM X,Y,Z TO PLOT COORDINATES XP,YP
C
  560 XP = VIEW(1,1)*X + VIEW(1,2)*Y + VIEW(1,3)*Z
      YP = VIEW(2,1)*X + VIEW(2,2)*Y + VIEW(2,3)*Z
C
C          SAVE MAX LENGTH
C
      IF (IXY.EQ.0) GOTO 570
      XL = SQRT(XP*XP + YP*YP)
      IF (VMAX.LT.XL) VMAX = XL
C
C          IF TENSION, MAKE XP OR IF XP=0 YP POSITIVE
C
      IF (XP.GT.0.) GOTO 565
      IF (XP.LT.0.) GOTO 564
      IF (YP.GT.0.) GOTO 565
  564 XP = -XP
      YP = -YP
  565 IF (SIG.GE.0.) GOTO 570
      XP = -XP
      YP = -YP
C
C          SAVE XP,YP IN ARRAY
C
  570 IF (IXVNEX.LT.IXVEND) GOTO 580
      IXVEND = IXVEND + 200
      I = IXVEND * ISURL
      CALL SIZE(I)
      IF (IERROR.NE.0) GOTO 900
C
  580 A(IXVNEX) = XP
      A(IXVNEX+1) = YP
      IXVNEX = IXVNEX + 2
C
C          LOOP FOR SELECTED PRINCIPLE STRESSES
C
  590 IXY = IXY + 1
      IF (IXY.GT.3) GOTO 610
      IF (IPSELE(IXY).EQ.0) GOTO 590
C
C          COMPUTE X,Y,Z DISPLACEMENT FOR STRESS VECTOR
C
      SIG = SIGP(IXY)
      X = SIG * DIRCOS(1,IXY)
      Y = SIG * DIRCOS(2,IXY)
      Z = SIG * DIRCOS(3,IXY)
      GOTO 560
C
  610 CONTINUE
  620 CONTINUE
  630 CONTINUE
      IEGIT = IEGIT - NEG
  640 CONTINUE
      IEGIT = IEGIT + NEG
  650 CONTINUE
C
C
C          DO THE PLOTTING
C
      IF (VLENGH.LT.EPS) GOTO 900
      IF (VMAX.LT.EPS) GOTO 900
      VSCALE = VLENGH / VMAX * 0.5
      WRITE (NFLOG,2020) TIME,VSCALE
      CALL CGRAPH (IPLON)
      IX = IXVSTA
C
C          DO FOR ALL STRESS VECTORS SAVED IN ARRAY
C
  710 IF (IX.GE.IXVNEX) GOTO 790
      IXY = 0
      XPP = A(IX)   * GSCALE + XPV
      YPP = A(IX+1) * GSCALE + YPV
      IX = IX + 2
C
C          PLOT SELECTED PRINCIPAL STRESSES
C
  720 IXY = IXY + 1
      IF (IXY.GT.3) GOTO 710
      IF (IPSELE(IXY).EQ.0) GOTO 720
      XD = A(IX)   * VSCALE
      YD = A(IX+1) * VSCALE
      IX = IX + 2
C
C          SPLIT LINE FOR TENSION
C          SOLID LINE FOR COMPRESSION
C
      LINTYP = ISOLID
      IF (XD.GT.0. .OR. (XD.EQ.0. .AND.YD.GT.0.)) LINTYP = ISPLIT
C
C          DRAW A VECTOR
C
      XP = XPP + XD
      YP = YPP + YD
      CALL LCLIP (XP,YP,IUP)
      XP = XPP - XD
      YP = YPP - YD
      CALL LCLIP (XP,YP,LINTYP)
      GOTO 720
C
  790 CALL CGRAPH (IPLOFF)
      GOTO 900
  800 IERROR = 1
  900 RETURN
 2000 FORMAT(46H ***ERROR: NO TIMESTEP OF ELEMENT RESULT SAVED)
 2010 FORMAT(5I10,10(3X,G12.6))
 2020 FORMAT(4X,13HVECTOR  TIME=G12.4,9H  VSCALE=,G12.3)
      END
C***ADD:CDC***
CDECK NHIST1
C***END:CDC***
      SUBROUTINE NHIST1 (NUMNPS)
C
      DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),NUMNPS(1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          PARAM 12: SUBF
C
      CALL SUBF (12)
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 1: NODE
C
      NODE = INTV(1)
      IF (NODE.LT.1 .OR. NODE.GT.NUMNPS(INSTRI)) GOTO 850
C
C          PARAM 2, 3: NDIR, KIND
C
      NDIR = INTV(2)
      IF (ITYPE(2).EQ.IOMIT) NDIR = 1
      IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
      NDIRV(1) = NDIR
C
      KIND = INTV(3)
      IF (ITYPE(3).EQ.IOMIT) KIND = 1
      IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
      KINDV(1) = KIND
C
C          BLANK COMMON LAYOUT
C
C                                                TIMEN
      N12 = N1 + NSTEN
C                                                TIMEPL (FOR PLOT)
      N13 = N12 + NSTEN + 2
C                                                VARPL (FOR PLOT)
      N14 = N13 + NSTEN + 2
C                                                RSDCOS
      I15 = (N14 + NSKEWS * 9) * ISURL
C                                                IDRN
      I16 = I15
      IF (NSKEWS.GT.0)
     1  I16 = I15 + (NDOF + 2) * MXNP
      CALL SIZE (I16)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 4
      CALL NHIST2 (NODE,NDIRV,KINDV,VALUEV,A(N1),A(N12)
     1       ,A(N13),IA(I16),A(N14),IA(I15),IA(I16),IA(I16),IA(I16))
      GOTO 900
  850 IERROR = 2
  900 RETURN
      END
C***ADD:CDC***
CDECK NHIST2
C***END:CDC***
      SUBROUTINE NHIST2 (NP,NDIRV,KINDV,VALUEV,TIMEN
     1        ,TIMEPL,VARPL,IRPOL,RSDCOS,IDRN,LINEID,NODEP,NAMEP)
C
      DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),TIMEN(1),TIMEPL(1)
     1          ,VARPL(1),IXA(5),IREAD(5),KINDHD(3)
     2          ,IRPOL(1),RSDCOS(9,1),IDRN(1),VDIR(6),
     3           LINEID(3,1),NODEP(99,1),NAMEP(8,1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
      DATA IHDTIM/4HTIME/
      DATA IHDNOD/4HNODE/
      DATA IPLOFF/4/
C
C          PARAM TSTART, TEND, NTSKIP
C
      TSTA = REALV(IXPAR)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TSTART
      TEND = REALV(IXPAR+1)
      IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTART + DT * NSTE
      EPSVAL = DT * EPS
      NTSKIP = INTV(IXPAR+2)
      IF (NTSKIP.LT.0) GOTO 850
C
C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP
C
      NXAXIS = INTV(IXPAR+3)
      NYAXIS = INTV(IXPAR+4)
      ISYMBL = INTV(IXPAR+5)
      ISSKIP = INTV(IXPAR+6)
      LIST   = INTV(IXPAR+7)
C
      IF (NSTEN.GE.2) GOTO 2
        WRITE (NFLOG,2000)
        GOTO 800
C
C          READ NPOINT IF RHIST COMMAND
C
  2   ISTRUC = INSTRU
      ISTRI = INSTRI
C     IRUSE = INRUSE
      IF (ICALL.NE.ICALLR) GOTO 10
        IF (IXGP(KNPOIN).EQ.0) GOTO 5
        CALL DBREAD (LINEID,KNPOIN,1,0)
          IF (IERROR.NE.0) GOTO 900
        DO 5 ILINEN=1,MLINEN
          DO 3  J=1,8
            IF (NAMEP(J,ILINEN).NE.IANUMV(J,1)) GOTO 5
  3         CONTINUE
          NP = NODEP(1,ILINEN)
          ISTRI  = LINEID(1,ILINEN)
          ISTRUC = LINEID(2,ILINEN)
          IRUSE  = LINEID(3,ILINEN)
          GOTO 10
  5     CONTINUE
        WRITE (NFLOG,2120)
        GOTO 800
  10  NUMNP = IA(I08+ISTRI-1)
C
C          CHECK WHAT KINDS ARE NEEDED
C
      DO 20 KIND=1,5
  20    IXA(KIND) = 0
      IVAEND = 1
      IF (ICALL.EQ.ICALLR) IVAEND = MVAR
      DO 30 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.NE.0) IXA(KIND) = 1
        IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  30    CONTINUE
C
C          BLANK COMMON FOR DBREAD OF NEEDED KINDS
C
C                                                DISP
C                                                VEL
C                                                ACC
C                                                TEMP
C
      NIX = I16 / ISURL
      DO 60 KIND=1,5
        IF (IXA(KIND).EQ.0) GOTO 60
        IXA(KIND) = NIX
        IF (KIND.NE.KINXYZ) GOTO 40
        NIX = NIX + 3 * MXNP
          GOTO 60
  40    IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
          WRITE (NFLOG,2010)
          GOTO 800
  50    NIX = NIX + MXNP * NDOF
  60    CONTINUE
      CALL SIZE (NIX)
      IF (IERROR.NE.0) GOTO 900
C
C          READ TIMEN, NSTEPN
C
      CALL DBREAD (TIMEN,KTIMEN,1,0)
        IF (IERROR.NE.0) GOTO 900
      NPTS = 0
      ITSKIP = 0
      ISRSDC = 0
      ISIDRN = 0
      IREAD(KINXYZ) = 0
C
C          DO FOR ALL TIMESTEPS OF NODAL DATA
C
      DO 650 ITIME=1,NSTEN
C
      TIME = TIMEN(ITIME)
      IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
      IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
C
C          NTSKIP TIMESTEPS BETWEEN OUTPUT
C
      IF (ITIME.EQ.NSTEN) GOTO 120
      IF (TIMEN(ITIME+1).GT.TEND+EPSVAL) GOTO 120
      ITSKIP = ITSKIP - 1
      IF (ITSKIP.GE.0) GOTO 650
  120 ITSKIP = NTSKIP
      DO 125 KIND=1,4
  125   IREAD(KIND) = 0
C
C          READ VARIABLE VALUES FROM DATABASE
C
  200 IVPLUS = (NP - 1) * NDOF - 1
      DO 290 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 290
        IXAKIN = IXA(KIND)
        NDIR = NDIRV(IVAR)
        IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
        IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
            WRITE (NFLOG,2210)
            GOTO 800
  210     IF (KIND.NE.KINXYZ)
     1    CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
          IF (KIND.EQ.KINXYZ)
     1    CALL DBREAD (A(IXAKIN),KXYZ,ISTRUC,0)
          IF (IERROR.NE.0) GOTO 700
        IREAD(KIND) = ISTRUC
C
C          TEMPERATURE
C
  220 IF (KIND.NE.KINDT) GOTO 225
        VALUEV(IVAR) = A(IXAKIN+NP-1)
        GOTO 290
C
C          XYZ
C
  225 IF (KIND.NE.KINXYZ) GOTO 230
        IXW = IXAKIN + (NDIR - 1) * NUMNP  +  NP - 1
        VALUEV(IVAR) = A(IXW)
        GOTO 290
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  230 IXW = IXAKIN + IVPLUS
      DO 250 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  250   CONTINUE
C
C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
C
      IF (NSKEWS.EQ.0) GOTO 285
      IF (ISIDRN.NE.ISTRI)
     1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
        ISIDRN = ISTRI
      IXNRST = NDOF * NUMNP
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.LE.0 .OR. LSKEW.EQ.1) GOTO 285
      IF (ISRSDC.EQ.0)
     1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        ISRSDC = 1
      CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
  285 VALUEV(IVAR) = VDIR(NDIR)
  290   CONTINUE
C
C          EXECUTE RESULTANT COMPUTATION
C
      IF (ICALL.NE.ICALLR) GOTO 300
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 700
C
C          SAVE TIME AND VALUE FOR PLOT
C
  300 NPTS = NPTS + 1
      TIMEPL(NPTS) = TIME
      VARPL (NPTS) = VALUEV(1)
C
  650 CONTINUE
      IF (NPTS.GE.2) GOTO 700
        WRITE (NFLOG,2030)
        GOTO 800
C
C          LIST
C
  700   NDIR = NDIRV(1)
        KIND = KINDV(1)
        CALL KINDN (NDIR,KIND,KINDHD)
      LPOS1 = 1
      IF (LIST.NE.1) LPOS1 = 0
      DO 730 I=1,NPTS
        IF (LINE.LE.LINPAG) GOTO 710
          WRITE (NFLIST,2040) LPOS1,NP,KINDHD,NAMERC
          LINE = 5
          IF (ISTRI.EQ.1) GOTO 702
      ISUBST = ISTRI - 1
          WRITE (NFLIST,2345) ISUBST, IRUSE
          LINE = LINE + 2
  702     IF (NSKEWS.EQ.0 .OR. KIND.EQ.KINDT) GOTO 705
          IF (ISKEW.LE.0) WRITE (NFLIST,2550)
          IF (ISKEW.GT.0) WRITE (NFLIST,2551)
          LINE = LINE + 2
  705     IF (LIST.NE.1) GOTO 740
          WRITE (NFLIST,2050) KINDHD, NAMERC
  710   WRITE (NFLIST,2060) TIMEPL(I),VARPL(I)
        LINE = LINE + 1
  730   CONTINUE
C
  740 CALL XYPLOT (TIMEPL,VARPL,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
        IF (IERROR.NE.0) GOTO 900
C
C          PLOT TEXT 'TIME' BELOW X-AXIS IF AUTOM. SCALED
C
      IF (NXAXIS.NE.0) GOTO 750
      XP = PMARG + AXEDGE
      YP = PMARG
        CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
C
C          PLOT NODAL VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
C
  750 IF (NYAXIS.NE.0) GOTO 770
      XP = PMARG + HEIGHT
      YP = PMARG + AXEDGE
      IF (ICALL.EQ.ICALLR) GOTO 765
        DO 760 I=1,3
          NBCD = KINDHD(I)
          CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
          XP = 999.0
          YP = 999.0
  760   CONTINUE
        GOTO 770
  765 DO 767 I=1,8
        NBCD = NAMERC(I)
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.0,1,1)
        XP = 999.0
  767   YP = 999.0
C
C          PLOT 'NODE XXX' IN UPPER RIGHT CORNER
C
  770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
      XP = XPMAX - PMARG - HEIGHT * 8.0
      YP = YPMAX - PMARG - HEIGHT
      CALL AGRAPH (XP,YP,HEIGHT,IHDNOD,0.,0.,4,1)
      XP = XP + HEIGHT * 5.0
      FPN = NP
      CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
C
  780 CALL CGRAPH (IPLOFF)
      IF (LIST.NE.1) LINE = 32766
      GOTO 900
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT(32H ***ERROR: NO NODAL RESULT SAVED)
 2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
 2030 FORMAT(41H ***ERROR: LESS THAN 2 TIMESTEPS SELECTED)
 2040 FORMAT(I1,26H   TIME HISTORY FOR NODE =,I5,3X,3A4,8A1)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2050 FORMAT(/20H     TIME           ,3A4,8A1/)
 2060 FORMAT(5X,E10.4,5X,E12.6)
 2120 FORMAT (28H ***ERROR: PNAME NOT DEFINED)
 2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
 2550 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
     1  17HCOORDINATE SYSTEM)
 2551 FORMAT(40H    OUTPUT RESULTS ARE MEASURED IN SKEW ,
     1  17HCOORDINATE SYSTEM)
      END
C***ADD:CDC***
CDECK EHIST1
C***END:CDC***
      SUBROUTINE EHIST1
C
      DIMENSION IA(1),KINDV(1),VALUEV(1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          PARAM 13: SUBF
C
      CALL SUBF (13)
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 4: KIND
C
      KINDV(1) = INTV(4)
C
C          BLANK COMMON LAYOUT FOR EHIST2
C
C                                                TIMEE
      N12 = N1 + NSTEE
C                                                TIMEPL (FOR PLOT)
      N13 = N12 + NSTEE + 2
C                                                VARPL (FOR PLOT)
      N14 = N13 + NSTEE + 2
C                                                ERES
      I15 = (N14 + MXERES) * ISURL
C                                                EDATA
      I16 = I15 + (ISURL + 2) * MXEL
C                                                ITABLE
      I17 = I16 + MXITAB
C                                                NPAR
      I18 = I17 + NELPAR * MXEG
C                                                NERPTS
      I19 = I18 + MXEL
C                                                IDERPT
      I20 = I19 + MXIDER
C
      CALL SIZE (I20)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 5
      CALL EHIST2 (KINDV,VALUEV,A(N1),A(N12),A(N13),
     1     A(N14),IA(I15),IA(I16),NELPAR,IA(I17),IA(I18),IA(I19),
     2     IA(I20),IA(I20),IA(I20),IA(I06),IA(I07),
     3     IA(I20),IETYP)
  900 RETURN
      END
C***ADD:CDC***
CDECK EHIST2
C***END:CDC***
      SUBROUTINE EHIST2 (KINDV,VALUEV,TIMEE,TIMEPL,
     1  VARPL,ERES,EDATA,ITABLE,NPARD,NPAR,NERPTS,IDERPT,
     2  LINEID,NELP,NAMEP,NRUSES,NEGS,IRPOL,IETYP)
C
      DIMENSION IA(1),KINDV(1),VALUEV(1),TIMEE(1),TIMEPL(1),
     1     VARPL(1),ERES(1),EDATA(1),ITABLE(1),NPAR(NPARD,1),NERPTS(1),
     2         IDERPT(1),LINEID(4,1),NELP(98,1),NAMEP(8,1),
     3          NRUSES(1),NEGS(1),IRPOL(1),KINDHD(3)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      DATA ICALLS,ICALLR/1,2/
      DATA IHDTIM/4HTIME/
      DATA IHDEG,IHDE,IHDP/3HEG ,4H  E ,4H  P /
      DATA IPLOFF/4/
C
C          PARAM TSTART, TEND, NTSKIP
C
      TSTA = REALV(IXPAR)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TSTART
      TEND = REALV(IXPAR+1)
      IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTART + DT * NSTE
      EPSVAL = DT * EPS
      NTSKIP = INTV(IXPAR+2)
      IF (NTSKIP.LT.0) GOTO 850
C
C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP
C
      NXAXIS = INTV(IXPAR+3)
      NYAXIS = INTV(IXPAR+4)
      ISYMBL = INTV(IXPAR+5)
      ISSKIP = INTV(IXPAR+6)
      LIST   = INTV(IXPAR+7)
C
      IF (NSTEE.GE.1) GOTO 10
        WRITE (NFLOG,2000)
        GOTO 800
C
C          EHIST PARAM 1,2,3:  IEG, IEL, IDERES
C
  10  IF (ICALL.EQ.ICALLR) GOTO 20
      ISTRI = INSTRI
      IRUSE = INRUSE
      IEG   = INTV(1)
      IEL   = INTV(2)
      IDERES = INTV(3)
      IVAEND = 1
      GOTO 40
C
C          READ NPOINT IF RHIST COMMAND
C
  20  IVAEND = MVAR
      IF (IXGP(KEPOIN).EQ.0) GOTO 35
      CALL DBREAD (LINEID,KEPOIN,1,0)
        IF (IERROR.NE.0) GOTO 900
      DO 35 ILINEE=1,MLINEE
        DO 30 J=1,8
          IF (NAMEP(J,ILINEE).NE.IANUMV(J,1)) GOTO 35
  30      CONTINUE
        ISTRI  = LINEID(1,ILINEE)
        IRUSE  = LINEID(3,ILINEE)
        IEG    = LINEID(4,ILINEE)
        IEL    = NELP(1,ILINEE)
        IDERES = NELP(2,ILINEE)
        GOTO 40
  35  CONTINUE
      WRITE (NFLOG,2120)
      GOTO 800
C
C          CHECK ELEMENT GROUP NUMBER
C
  40  NEG = NEGS(ISTRI)
      IF (IEG.GE.1 .AND. IEG.LE.NEG) GOTO 60
  50    WRITE (NFLOG,2070) IEG, IEL
        GOTO 800
C
C          READ NPAR
C
  60  CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
      IELTYP = NPAR(1,IEG)
      NUME   = NPAR(2,IEG)
      INDNL  = NPAR(3,IEG)
      IDEATH = NPAR(4,IEG)
      NTABLE = NPAR(13,IEG)
      IF (IEL.LT.1 .OR. IEL.GT.NUME) GOTO 50
C
C          CHECK RESULTANT FORMULA IETYP
C
      IF (ICALL.NE.ICALLR .OR. IETYP.EQ.IELTYP) GOTO 65
        WRITE (NFLOG,2130) IETYP, IELTYP
        GOTO 800
C
C          COMPUTE IEGIT AND IEGAT
C
  65  IEGIT = IEG - NEG
      IEGAT = IEG - NEG * (NRUSES(ISTRI) - IRUSE + 1)
      DO 70 I=1,ISTRI
        IEGIT = IEGIT + NEGS(I)
  70    IEGAT = IEGAT + NEGS(I) * NRUSES(I)
      ISEDAT = 0
C
C          READ TIMEE, NSTEPE
C
      CALL DBREAD (TIMEE,KTIMEE,1,0)
        IF (IERROR.NE.0) GOTO 900
      NPTS = 0
      ITSKIP = 0
C
C          DO FOR ALL TIMESTEPS OF ELEMENT DATA
C
      DO 650 ITIME=1,NSTEE
C
      TIME = TIMEE(ITIME)
      IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
      IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
C
C          NTSKIP TIMESTEPS BETWEEN OUTPUT
C
      IF (ITIME.EQ.NSTEE) GOTO 120
      IF (TIMEE(ITIME+1).GT.TEND+EPSVAL) GOTO 120
      ITSKIP = ITSKIP - 1
      IF (ITSKIP.GE.0) GOTO 650
  120 ITSKIP = NTSKIP
C
C          UPDATE NERPTS,IDERPT ARRAYS AND NERES,NERKI
C
      IF (IDEATH.EQ.0 .AND. IEGIT.EQ.ISEDAT) GOTO 240
      CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NUME+1),ITABLE,NTABLE,
     1     IEGIT,ISEDAT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
      IF (IERROR.NE.0) GOTO 900
C
C          CHECK KINDV VALUES
C
      DO 200 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0 .AND. ICALL.EQ.ICALLR) GOTO 200
        IF (KIND.GE.1 .AND. KIND.LE.NERKI) GOTO 200
          WRITE (NFLOG,2080) KIND
          GOTO 800
  200   CONTINUE
C
C          FIND IDERES = ELEMENT RESULT POINT ID
C
  210 IXIDER = 1
      IXERES = 0
      DO 220 IELWK=1,IEL
        NERPT = NERPTS(IELWK)
        IXIDER = IXIDER + NERPT
  220   IXERES = IXERES + NERPT * NERKI
      IXIDER = IXIDER - NERPT
      IXERES = IXERES - NERPT * NERKI
      IF (NERPT.EQ.0) GOTO 235
C
      DO 230 IERPT=1,NERPT
        IDERPW = IDERPT(IXIDER)
C          SKIP UNBORN OR DEAD ELEMENT
        IF (IDERPW.LT.0) GOTO 650
        IF (IDERES.EQ.IDERPW) GOTO 240
        IXIDER = IXIDER + 1
  230   IXERES = IXERES + NERKI
C
C          IDERES POINT IS NOT FOUND
C
  235 WRITE (NFLOG,2085) IDERES
      GOTO 800
C
C          READ ERES
C
  240 CALL DBREAD (ERES,KERES,IEGAT,ITIME)
      IF (IERROR.NE.0) GOTO 900
C
      DO 250 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 250
        VALUEV(IVAR) = ERES(IXERES+KIND)
        IF (VALUEV(IVAR) .EQ. 987654E32) GOTO 235
  250   CONTINUE
C
C          EXECUTE RESULTANT COMPUTATION
C
      IF (ICALL.NE.ICALLR) GOTO 300
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 700
C
C          SAVE TIME AND VALUE FOR PLOT
C
  300 NPTS = NPTS + 1
      TIMEPL(NPTS) = TIME
      VARPL (NPTS) = VALUEV(1)
C
  650 CONTINUE
      IF (NPTS.GE.2) GOTO 700
        WRITE (NFLOG,2030)
        GOTO 800
C
C          LIST
C
  700 KIND = KINDV(1)
      CALL KINDE (IELTYP,INDNL,NTABLE,KIND,KINDHD)
      LPOS1 = 1
      IF (LIST.NE.1) LPOS1 = 0
      DO 730 I=1,NPTS
        IF (LINE.LE.LINPAG) GOTO 710
          WRITE (NFLIST,2040) LPOS1,IEG,IEL,IDERES,KINDHD,NAMERC
          IF (LOCALE.EQ.0) WRITE (NFLIST,2035)
          IF (LOCALE.EQ.1) WRITE (NFLIST,2036)
          LINE = 4
          IF (ISTRI.EQ.1) GOTO 705
            ISUBST = ISTRI - 1
            WRITE (NFLIST,2345) ISUBST, IRUSE
            LINE = LINE + 2
  705     IF (LIST.EQ.0) GOTO 740
          WRITE (NFLIST,2050) KINDHD, NAMERC
          LINE = LINE + 2
  710   WRITE (NFLIST,2060) TIMEPL(I),VARPL(I)
        LINE = LINE + 1
  730   CONTINUE
C
  740 CALL XYPLOT (TIMEPL,VARPL,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
        IF (IERROR.NE.0) GOTO 900
C
C          PLOT TEXT 'TIME' BELOW X-AXIS IF AUTOM. SCALED
C
      IF (NXAXIS.NE.0) GOTO 750
      XP = PMARG + AXEDGE
      YP = PMARG
        CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
C
C          PLOT ELEMENT VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
C
  750 IF (NYAXIS.NE.0) GOTO 770
      XP = PMARG + HEIGHT
      YP = PMARG + AXEDGE
      IF (ICALL.EQ.ICALLR) GOTO 765
        DO 760 I=1,3
          NBCD = KINDHD(I)
          CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
          XP = 999.0
          YP = 999.0
  760   CONTINUE
        GOTO 770
  765 DO 767 I=1,8
        NBCD = NAMERC(I)
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.0,1,1)
        XP = 999.0
  767   YP = 999.0
C
C          PLOT 'EG X  E XX  P XX' AT UPPER RIGHT CORNER
C
  770 IF (NPAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
      XP = XPMAX - PMARG - HEIGHT * 16.
      YP = YPMAX - PMARG - HEIGHT
      CALL AGRAPH (XP,YP,HEIGHT,IHDEG,0.,0.,3,1)
      XP = 999.0
      YP = 999.0
      FPN = IEG
      CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
      CALL AGRAPH (XP,YP,HEIGHT,IHDE,0.,0.,4,1)
      FPN = IEL
      CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
      CALL AGRAPH (XP,YP,HEIGHT,IHDP,0.,0.,4,1)
      FPN = IDERES
      CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
C
  780 CALL CGRAPH (IPLOFF)
      IF (LIST.NE.1) LINE = 32766
      GOTO 900
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT(34H ***ERROR: NO ELEMENT RESULT SAVED)
 2030 FORMAT(41H ***ERROR: LESS THAN 2 TIMESTEPS SELECTED)
 2035 FORMAT(/35H    RESULTS ARE MEASURED IN GLOBAL ,
     1  17HCOORDINATE SYSTEM)
 2036 FORMAT(/36H    RESULTS ARE MEASURED IN ELEMENT ,
     1  17HCOORDINATE SYSTEM)
 2040 FORMAT(I1,3X,32HTIME HISTORY FOR ELEMENT GROUP =,I3,
     1  11H  ELEMENT =,I4,9H  POINT =,I4,3X,3A4,8A1)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2050 FORMAT(/20H     TIME           ,3A4,8A1/)
 2060 FORMAT(5X,E11.5,5X,E12.6)
 2070 FORMAT(34H ***ERROR: INVALID ELEMENT GROUP =,I5,
     1  25H  OR INVALID ELEMENT NO =,I5)
 2080 FORMAT (25H ***ERROR: INVALID KIND =,I4)
 2085 FORMAT(44H ***ERROR: ELEMENT RESULT POINT NOT SAVED ON
     1   24H ADINA PORTHOLE, POINT =,I5)
 2120 FORMAT (28H ***ERROR: PNAME NOT DEFINED)
 2130 FORMAT(35H ***ERROR: RESULTANT ELEMENT TYPE =,I2,
     1 38H IS NOT SAME AS ELEMENT TYPE NPAR(1) =,I2)
      END
C***ADD:CDC***
CDECK NLINE1
C***END:CDC***
      SUBROUTINE NLINE1
C
      DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          PARAM 10: NSUBF
C
      CALL SUBF (10)
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 2, 3: NDIR, KIND
C
      NDIR = INTV(2)
      IF (ITYPE(2).EQ.IOMIT) NDIR = 1
      IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
      NDIRV(1) = NDIR
C
      KIND = INTV(3)
      IF (ITYPE(3).EQ.IOMIT) KIND = 1
      IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
      KINDV(1) = KIND
C
C          BLANK COMMON LAYOUT FOR NLINE2
C
C                                                TIMEN, NSTEPN
      N12 = N1 + NSTEN + NSTEN / ISURL + 1
C                                                XPLOT
      N13 = N12 + 101
C                                                YPLOT
      N14 = N13 + 101
C                                                XYZ
      N15 = N14 + MXNP * 3
C                                                RSDCOS
      I16 = (N15 + NSKEWS * 9) * ISURL
C                                                IDRN
      I17 = I16
      IF (NSKEWS.GT.0 .AND. LSKEW.EQ.0)
     1  I17 = I16 + (NDOF + 2) * MXNP
C                                                LINEID
      I18 = I17 + MLINEN * 3
C                                                NODEP
      I19 = I18 + MLINEN * 99
C                                                NAMEP
      I20 = I19 + MLINEN * 8
      CALL SIZE (I20)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 4
      CALL NLINE2 (NDIRV,KINDV,VALUEV,IA(I20),
     1     A(N1),A(N12),A(N13),A(N14),A(N15),IA(I16),IA(I17),
     2     IA(I18),IA(I19))
      GOTO 900
  850 IERROR = 2
  900 RETURN
      END
C***ADD:CDC***
CDECK NLINE2
C***END:CDC***
      SUBROUTINE NLINE2 (NDIRV,KINDV,VALUEV,IRPOL,TIMEN,
     1           XPLOT,YPLOT,XYZ,RSDCOS,IDRN,LINEID,NODEP,NAMEP)
C
      DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),IRPOL(1),TIMEN(1),
     1          XPLOT(1),YPLOT(1),XYZ(1),LINEID(3,1),NODEP(99,1),
     2          NAMEP(8,1),IXA(5),IREAD(5),KINDHD(3)
     3         ,RSDCOS(9,1),IDRN(1),VDIR(6),NAMEL(8)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
     1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
     2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
     3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
     4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
      DATA IHDNOD,IHDHYP/4HNODE,3H - /
      DATA IHDTIM/4HTIME/
      DATA IPLOFF,ISPACE/4,1H /
C
C          CHECK WHAT KINDS ARE NEEDED
C
  10  DO 20 KIND=1,5
        IREAD(KIND) = 0
  20    IXA(KIND) = 0
      IVAEND = 1
      IF (ICALL.EQ.ICALLR) IVAEND = MVAR
      DO 30 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.NE.0) IXA(KIND) = 1
        IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  30    CONTINUE
C
C          BLANK COMMON FOR DBREAD OF NEEDED KINDS
C
C                                                DISP
C                                                VEL
C                                                ACC
C                                                TEMP
C
      NIX = I20 / ISURL
      DO 60 KIND=1,5
        IF (IXA(KIND).EQ.0) GOTO 60
        IF (KIND.EQ.KINXYZ) GOTO 60
        IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
          WRITE (NFLOG,2010)
          GOTO 800
   50   IXA(KIND) = NIX
        NIX = NIX + MXNP * NDOF
  60    CONTINUE
      CALL SIZE (NIX)
      IF (IERROR.NE.0) GOTO 900
C
C          PARAM: TIME
C
      TIME = REALV(IXPAR)
      IF (NSTEN.GT.0) GOTO 120
        WRITE (NFLOG,2000)
        GOTO 800
  120 CALL DBREAD (TIMEN,KTIMEN,1,0)
        IF (IERROR.NE.0) GOTO 900
      IF (ITYPE(IXPAR).EQ.IOMIT) TIME = TIMEN(NSTEN)
      TDIFFO = 9E30
      DO 130 I=1,NSTEN
        TDIFF = ABS(TIME - TIMEN(I))
        IF (TDIFFO.LE.TDIFF) GOTO 130
        TDIFFO = TDIFF
        ITIME = I
  130   CONTINUE
      TIME = TIMEN(ITIME)
C
C          PARAM 1: PNAME
C
  135 IF (IXGP(KNPOIN).EQ.0) GOTO 160
      CALL DBREAD (LINEID,KNPOIN,1,0)
        IF (IERROR.NE.0) GOTO 900
      DO 150 ILINEN=1,MLINEN
        DO 140 I=1,8
          ICODE = NAMEP(I,ILINEN)
          IF (IANUMV(I,1).NE.ICODE) GOTO 150
          CALL APCHAR(ICODE)
          NAMEL(I) = ICODE
  140     CONTINUE
        ISTRI  = LINEID(1,ILINEN)
        NUMNP = IA(I08+ISTRI-1)
        ISTRUC = LINEID(2,ILINEN)
        IRUSE  = LINEID(3,ILINEN)
        GOTO 170
  150   CONTINUE
  160 WRITE (NFLOG,2020)
      GOTO 800
C
C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP, LIST
C
  170 NXAXIS = INTV(IXPAR+1)
      NYAXIS = INTV(IXPAR+2)
      ISYMBL = INTV(IXPAR+3)
      ISSKIP = INTV(IXPAR+4)
      LIST   = INTV(IXPAR+5)
C
C          READ XYZ
C
      CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
        IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL NODE POINTS IN LINE
C
      ISRSDC = 0
      ISIDRN = 0
      NPTS = 0
      XPOINT = 0.0
      DO 400 IPNODE=1,99
        NP = NODEP(IPNODE,ILINEN)
        IF (NP.EQ.0) GOTO 401
        NPTS = NPTS + 1
C
C          COMPUTE GEOMETRICAL DISTANCE (DEFORMATION NOT INCLUDED)
C
      XNOW = XYZ(NP)
      I = NUMNP + NP
      YNOW = XYZ(I)
      ZNOW = XYZ(I+NUMNP)
      IF (NPTS.EQ.1) GOTO 190
        XDIST = XNOW - XOLD
        YDIST = YNOW - YOLD
        ZDIST = ZNOW - ZOLD
        XPOINT = XPOINT + SQRT(XDIST*XDIST + YDIST*YDIST + ZDIST*ZDIST)
  190 XOLD = XNOW
      YOLD = YNOW
      ZOLD = ZNOW
      XPLOT(NPTS) = XPOINT
C
C          READ VARIABLE VALUES FROM DATABASE
C
  200 IVPLUS = (NP - 1) * NDOF - 1
      DO 290 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 290
        NDIR = NDIRV(IVAR)
        IXAKIN = IXA(KIND)
C
C          XYZ
C
        IF (KIND.NE.KINXYZ) GOTO 205
        IXW = (NDIR - 1) * NUMNP + NP
        VALUEV(IVAR) = XYZ(IXW)
        GOTO 290
  205   IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
        IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
            WRITE (NFLOG,2210)
            GOTO 800
  210     CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
          IF (IERROR.NE.0) GOTO 900
        IREAD(KIND) = ISTRUC
C
C          TEMPERATURE
C
  220 IF (KIND.NE.KINDT) GOTO 230
        VALUEV(IVAR) = A(IXAKIN+NP-1)
        GOTO 290
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  230 IXW = IXAKIN + IVPLUS
      DO 250 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  250   CONTINUE
C
C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
C
      IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 285
      IF (ISIDRN.NE.ISTRI)
     1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
        ISIDRN = ISTRI
      IXNRST = NDOF * NUMNP
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.LE.0) GOTO 285
      IF (ISRSDC.EQ.0)
     1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        ISRSDC = 1
      CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
  285 VALUEV(IVAR) = VDIR(NDIR)
  290   CONTINUE
C
C          EXECUTE RESULTANT COMPUTATION
C
      IF (ICALL.NE.ICALLR) GOTO 300
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 800
C
  300 YPLOT(NPTS) = VALUEV(1)
  400 CONTINUE
  401 CONTINUE
C
C          LIST
C
      NDIR = NDIRV(1)
      KIND = KINDV(1)
      CALL KINDN (NDIR,KIND,KINDHD)
C
      LPOS1 = 1
      IF (LIST.NE.1) LPOS1 = 0
      DO 730 I=1,NPTS
      IF (LINE.LE.LINPAG) GOTO 710
        WRITE (NFLIST,2030) LPOS1,NAMEL,TIME,KINDHD,NAMERC
        LINE = 2
        IF (NSKEWS.EQ.0 .OR. KIND.EQ.KINDT) GOTO 600
          IF (LSKEW.NE.1) WRITE (NFLIST,2550)
          IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
          LINE = LINE + 2
  600   IF (ISTRI.EQ.1) GOTO 705
        ISUBST = ISTRI - 1
          WRITE (NFLIST,2345) ISUBST, IRUSE
          LINE = LINE + 2
  705   IF (LIST.NE.1) GOTO 740
        WRITE (NFLIST,2040) (KINDHD(J),J=1,3), NAMERC
        LINE = LINE + 2
  710   WRITE (NFLIST,2050) NODEP(I,ILINEN),XPLOT(I),YPLOT(I)
        LINE = LINE + 1
C
  730 CONTINUE
  740 IF (NPTS.GE.2) GOTO 745
        WRITE (NFLOG,2070)
        GOTO 800
C
  745 CALL XYPLOT (XPLOT,YPLOT,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
        IF (IERROR.NE.0) GOTO 900
C
C          PLOT TEXT 'NAMEP  NODE NNNN - MMMM'
C          BELOW X-AXIS IF AUTOMATICALLY SCALED
C
      IF (NXAXIS.NE.0) GOTO 750
      XP = PMARG + AXEDGE
      YP = PMARG
      DO 747 I=1,8
        NBCD = NAMEL(I)
        IF (NBCD.EQ.ISPACE) GOTO 747
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
        XP = XP + HEIGHT
  747   CONTINUE
      XP = XP + HEIGHT + HEIGHT
        CALL AGRAPH (XP,YP,HEIGHT,IHDNOD,0.,0.,4,1)
      CALL AGRAPH (999.0,999.0,HEIGHT,IHDHYP,0.0,0.0,1,1)
        FPN = NODEP(1,ILINEN)
        CALL AGRAPH (999.0,999.0,HEIGHT,0,FPN,0.0,-1,3)
        CALL AGRAPH (999.0,999.0,HEIGHT,IHDHYP,0.0,0.0,3,1)
        FPN = NODEP(NPTS,ILINEN)
        CALL AGRAPH (999.0,999.0,HEIGHT,0,FPN,0.,-1,3)
C
C          PLOT NODAL VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
C
  750 IF (NYAXIS.NE.0) GOTO 770
      XP = PMARG + HEIGHT
      YP = PMARG + AXEDGE
      IF (ICALL.EQ.ICALLR) GOTO 765
        DO 760 I=1,3
          NBCD = KINDHD(I)
          CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
          XP = 999.0
          YP = 999.0
  760   CONTINUE
        GOTO 770
  765 DO 767 I=1,8
        NBCD = NAMERC(I)
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,1,1)
        XP = 999.0
  767   YP = 999.0
C
C          PLOT 'TIME X.XXX' IN UPPER RIGHT CORNER
C
  770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
      I = 0
      IF (TIME.NE.0.0) I = MAX0(0, 3 - INT(ALOG10(ABS(TIME))))
      XP = XPMAX - PMARG - HEIGHT * 10.0
      YP = YPMAX - PMARG - HEIGHT
      CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
      XP = XP + HEIGHT * 5.0
      CALL AGRAPH (XP,YP,HEIGHT,0,TIME,0.,I,3)
C
  780 CALL CGRAPH (IPLOFF)
      IF (LIST.NE.1) LINE = 32766
      GOTO 900
C
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (43H ***ERROR: NO TIMESTEP FOR NODAL DATA FOUND)
 2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
 2020 FORMAT(29H ***ERROR: LINENAME NOT FOUND)
 2030 FORMAT(I1,3X,28HNODAL RESULTS ALONG NLINE = ,8A1,
     1  11H  AT TIME =,G11.5,5X,3A4,8A1)
 2040 FORMAT(/20H  NODE   LINE COORD.,5X,3A4,8A1/)
 2050 FORMAT(1X,I5,3X,E12.6,3X,E12.6)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2070 FORMAT (38H ***ERROR: ONLY ONE NODE POINT IN LINE)
 2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
 2550 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
     1  17HCOORDINATE SYSTEM)
 2551 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
     1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
      END
C***ADD:CDC***
CDECK ELINE1
C***END:CDC***
      SUBROUTINE ELINE1
C
      DIMENSION IA(1),KINDV(1),VALUEV(1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          PARAM 9 : NSUBF
C
      CALL SUBF (9)
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 2 : KIND
C
      KINDV(1) = INTV(2)
C
C          BLANK COMMON LAYOUT FOR ELINE2
C
C                                                TIMEE, NSTEPE
      N12 = N1 + NSTEE + NSTEE / ISURL + 1
C                                                XPLOT
      N13 = N12 + 51
C                                                YPLOT
      N14 = N13 + 51
C                                                ERES
      I15 = (N14 + MXERES) * ISURL
C                                                EDATA
      I16 = I15 + (ISURL + 2) * MXEL
C                                                ITABLE
      I17 = I16 + MXITAB
C                                                NPAR
      I18 = I17 + NELPAR * MXEG
C                                                NERPTS
      I19 = I18 + MXEL
C                                                IDERPT
      I20 = I19 + MXIDER
C                                                SXYZ
      I21 = I20 + MXIDER * 3 * ISURL
C                                                LINEID
      I22 = I21 + MLINEE * 4
C                                                NELP
      I23 = I22 + MLINEE * 98
C                                                NAMEP
      I24 = I23 + MLINEE * 8
      CALL SIZE (I24)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 3
      CALL ELINE2 (IA(I06),IA(I07),IETYP,KINDV,VALUEV,
     -     IA(I24),
     1     A(N1),A(N12),A(N13),A(N14),IA(I15),IA(I16),NELPAR,IA(I17),
     2     IA(I18),IA(I19),IA(I20),IA(I21),IA(I22),IA(I23))
      GOTO 900
  900 RETURN
      END
C***ADD:CDC***
CDECK ELINE2
C***END:CDC***
      SUBROUTINE ELINE2 (NRUSES,NEGS,IETYP,KINDV,VALUEV,
     1           IRPOL,TIMEE,XPLOT,YPLOT,ERES,EDATA,ITABLE,NPARD,
     2           NPAR,NERPTS,IDERPT,SXYZ,LINEID,NELP,NAMEP)
C
      DIMENSION IA(1),KINDV(1),VALUEV(1),IRPOL(1),TIMEE(1),
     1     XPLOT(1),YPLOT(1),XYZ(1),LINEID(4,1),NELP(98,1),
     2    NAMEP(8,1),KINDHD(3),ERES(1),EDATA(1),ITABLE(1),NPAR(NPARD,1),
     3    NERPTS(1),IDERPT(1),SXYZ(3,1),NRUSES(1),NEGS(1),NAMEL(8)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
     1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
     2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
     3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
     4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      DATA ICALLS,ICALLR/1,2/
      DATA IPLOFF,ISPACE/4,1H /
      DATA IHDTIM/4HTIME/
C
C
C          PARAM: TIME
C
      TIME = REALV(IXPAR)
      IF (NSTEE.GT.0) GOTO 120
        WRITE (NFLOG,2000)
        GOTO 800
  120 CALL DBREAD (TIMEE,KTIMEE,1,0)
        IF (IERROR.NE.0) GOTO 900
      IF (ITYPE(IXPAR).EQ.IOMIT) TIME = TIMEE(NSTEE)
      TDIFFO = 9E30
      DO 130 I=1,NSTEE
        TDIFF = ABS (TIME - TIMEE(I))
        IF (TDIFFO.LE.TDIFF) GOTO 130
        TDIFFO = TDIFF
        ITIME = I
  130   CONTINUE
      TIME = TIMEE(ITIME)
C
C          PARAM 1: PNAME
C
  135 IF (IXGP(KEPOIN).EQ.0) GOTO 160
      CALL DBREAD (LINEID,KEPOIN,1,0)
        IF (IERROR.NE.0) GOTO 900
      DO 150 ILINEE=1,MLINEE
        DO 140 I=1,8
          ICODE = NAMEP(I,ILINEE)
          IF (IANUMV(I,1).NE.ICODE) GOTO 150
          CALL APCHAR(ICODE)
          NAMEL(I) = ICODE
  140     CONTINUE
        ISTRI  = LINEID(1,ILINEE)
        ISTRUC = LINEID(2,ILINEE)
        IRUSE  = LINEID(3,ILINEE)
        IEG    = LINEID(4,ILINEE)
        GOTO 170
  150   CONTINUE
  160 WRITE (NFLOG,2020)
      GOTO 800
C
C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP, LIST
C
  170 NXAXIS = INTV(IXPAR+1)
      NYAXIS = INTV(IXPAR+2)
      ISYMBL = INTV(IXPAR+3)
      ISSKIP = INTV(IXPAR+4)
      LIST   = INTV(IXPAR+5)
C
C          READ NPAR
C
  175 CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
      IELTYP = NPAR(1,IEG)
      NUME   = NPAR(2,IEG)
      INDNL  = NPAR(3,IEG)
      NTABLE = NPAR(13,IEG)
C
C          CHECK RESULTANT FORMULA IETYP
C
      IF (ICALL.NE.ICALLR .OR. IETYP.EQ.IELTYP) GOTO 180
        WRITE (NFLOG,2130) IETYP, IELTYP
        GOTO 800
C
C          COMPUTE IEGIT AND IEGAT
C
  180 NEG = NEGS(ISTRI)
      IEGIT = IEG - NEG
      IEGAT = IEG - NEG * (NRUSES(ISTRI) - IRUSE + 1)
      DO 190 I=1,ISTRI
        IEGIT = IEGIT + NEGS(I)
  190   IEGAT = IEGAT + NEGS(I) * NRUSES(I)
      ISEDAT = 0
C
C          UPDATE NERPTS,IDERPT ARRAYS AND NERES,NERKI
C
      CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NUME+1),ITABLE,NTABLE,
     1     IEGIT,ISEDAT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
      IF (IERROR.NE.0) GOTO 900
      IF (NERES.EQ.0) GOTO 235
C
C          CHECK KINDV VALUES
C
      IVAEND = 1
      IF (ICALL.EQ.ICALLR) IVAEND = MVAR
      DO 200 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0 .AND. ICALL.EQ.ICALLR) GOTO 200
        IF (KIND.GE.1 .AND. KIND.LE.NERKI) GOTO 200
          WRITE (NFLOG,2080) KIND
          GOTO 800
  200   CONTINUE
C
C          READ ERES
C
      CALL DBREAD (ERES,KERES,IEGAT,ITIME)
      IF (IERROR.NE.0) GOTO 900
C
C          READ SXYZ
C
      CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
      IF (SXYZ(1,1).EQ.987654E32)  WRITE (NFLOG,2150)
C
C          DO FOR ALL ELEMENT POINTS IN LINE
C
      NPTS = 0
      XPOINT = 0.0
      DO 400 IELP=1,98,2
        IEL    = NELP(IELP  ,ILINEE)
        IDERES = NELP(IELP+1,ILINEE)
        IF (IEL.EQ.0) GOTO 401
        NPTS = NPTS + 1
C
C          CHECK ELEMENT NUMBER
C
      IF (IEL.GE.1 .AND. IEL.LE.NUME) GOTO 210
        WRITE (NFLOG,2140) IEL
        GOTO 800
C
C          FIND IDERES = ELEMENT RESULT POINT ID
C
  210 IXIDER = 1
      IXERES = 0
      DO 220 IELWK=1,IEL
        NERPT = NERPTS(IELWK)
        IXIDER = IXIDER + NERPT
  220   IXERES = IXERES + NERPT * NERKI
      IXIDER = IXIDER - NERPT
      IXERES = IXERES - NERPT * NERKI
      IF (NERPT.EQ.0) GOTO 235
C
      DO 230 IERPT=1,NERPT
        IDERPW = IDERPT(IXIDER)
        IF (IDERPW.GT.0) GOTO 225
          WRITE (NFLOG,2086) IEL
          GOTO 900
  225   IF (IDERES.EQ.IDERPW) GOTO 240
        IXIDER = IXIDER + 1
  230   IXERES = IXERES + NERKI
C
C          IDERES POINT IS NOT FOUND
C
  235 WRITE (NFLOG,2085) IEG, IEL, IDERES
      GOTO 800
C
  240 DO 250 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 250
        VALUEV(IVAR) = ERES(IXERES+KIND)
        IF (VALUEV(IVAR) .EQ. 987654E32) GOTO 235
  250   CONTINUE
C
C          COMPUTE GEOMETRICAL DISTANCE (DEFORMATION NOT INCLUDED)
C
      XPLOT(NPTS) = FLOAT(NPTS)
      IF (SXYZ(1,1).EQ.987654E32) GOTO 295
      XNOW = SXYZ(1,IXIDER)
      YNOW = SXYZ(2,IXIDER)
      ZNOW = SXYZ(3,IXIDER)
      IF (NPTS.EQ.1) GOTO 290
        XDIST = XNOW - XOLD
        YDIST = YNOW - YOLD
        ZDIST = ZNOW - ZOLD
        XPOINT = XPOINT + SQRT(XDIST*XDIST + YDIST*YDIST + ZDIST*ZDIST)
  290 XOLD = XNOW
      YOLD = YNOW
      ZOLD = ZNOW
      XPLOT(NPTS) = XPOINT
C
C
C          EXECUTE RESULTANT COMPUTATION
C
  295 IF (ICALL.NE.ICALLR) GOTO 300
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 800
C
  300 YPLOT(NPTS) = VALUEV(1)
  400 CONTINUE
  401 CONTINUE
C
C          LIST
C
      KIND = KINDV(1)
      CALL KINDE (IELTYP,INDNL,NTABLE,KIND,KINDHD)
C
      LPOS1 = 1
      IF (LIST.NE.1) LPOS1 = 0
      DO 730 I=1,NPTS
      IF (LINE.LE.LINPAG) GOTO 710
        WRITE (NFLIST,2030) LPOS1,NAMEL,TIME,KINDHD,NAMERC
        LINE = 4
        IF (NSUBST.EQ.0) GOTO 705
          ISUBST = ISTRI - 1
          WRITE (NFLIST,2345) ISUBST, IRUSE
          LINE = LINE + 2
  705   IF (LOCALE.EQ.0) WRITE (NFLIST,2035) IEG
          IF (LOCALE.EQ.1) WRITE (NFLIST,2036) IEG
          IF (LIST.NE.1) GOTO 740
        WRITE (NFLIST,2040) KINDHD, NAMERC
        LINE = LINE + 3
  710   WRITE (NFLIST,2050) NELP(I*2-1,ILINEE),NELP(I*2,ILINEE),
     1              XPLOT(I),YPLOT(I)
        LINE = LINE + 1
C
  730 CONTINUE
  740 IF (NPTS.GE.2) GOTO 745
        WRITE (NFLOG,2070)
        GOTO 800
C
  745 CALL XYPLOT (XPLOT,YPLOT,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
        IF (IERROR.NE.0) GOTO 900
C
C          PLOT TEXT 'NAMEP  '
C          BELOW X-AXIS IF AUTOMATICALLY SCALED
C
      IF (NXAXIS.NE.0) GOTO 750
      XP = PMARG + AXEDGE
      YP = PMARG
      DO 747 I=1,8
        NBCD = NAMEL(I)
        IF (NBCD.EQ.ISPACE) GOTO 747
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
        XP = XP + HEIGHT
  747   CONTINUE
C
C          PLOT ELEMENT VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
C
  750 IF (NYAXIS.NE.0) GOTO 770
      XP = PMARG + HEIGHT
      YP = PMARG + AXEDGE
      IF (ICALL.EQ.ICALLR) GOTO 765
        DO 760 I=1,3
          NBCD = KINDHD(I)
          CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
          XP = 999.0
          YP = 999.0
  760   CONTINUE
        GOTO 770
  765 DO 767 I=1,8
        NBCD = NAMERC(I)
        CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,1,1)
        XP = 999.0
  767   YP = 999.0
C
C          PLOT 'TIME X.XXX' IN UPPER RIGHT CORNER
C
  770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
      I = 0
      IF (TIME.NE.0.0) I = MAX0(0, 3 - INT(ALOG10(ABS(TIME))))
      XP = XPMAX - PMARG - HEIGHT * 10.0
      YP = YPMAX - PMARG - HEIGHT
      CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
      XP = XP + HEIGHT * 5.0
      CALL AGRAPH (XP,YP,HEIGHT,0,TIME,0.,I,3)
C
  780 CALL CGRAPH (IPLOFF)
      IF (LIST.NE.1) LINE = 32766
      GOTO 900
C
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (45H ***ERROR: NO TIMESTEP FOR ELEMENT DATA FOUND)
 2020 FORMAT(29H ***ERROR: LINENAME NOT FOUND)
 2030 FORMAT(I1,3X,30HELEMENT RESULTS ALONG ELINE = ,8A1,
     1  10H  AT TIME=,G11.5,5X,3A4,8A1)
 2035 FORMAT(/19H    ELEMENT GROUP =,I4,
     1  52H    RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM)
 2036 FORMAT(/19H    ELEMENT GROUP =,I4,
     1  53H    RESULTS ARE MEASURED IN ELEMENT COORDINATE SYSTEM)
 2040 FORMAT(/35H ELEMENT   POINT       LINE COORD. ,5X,3A4,8A1/)
 2050 FORMAT(1X,I5,I10,6X,E12.6,3X,E12.6)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2070 FORMAT (41H ***ERROR: ONLY ONE ELEMENT POINT IN LINE)
 2080 FORMAT (25H ***ERROR: INVALID KIND =,I4)
 2085 FORMAT(26H ***ERROR: ELEMENT GROUP =,I5,10H ELEMENT =,I5,
     1  15H RESULT POINT =,I5,26H  IS NOT SAVED IN ADINA,     ,
     2  /11X,42HCHECK IPS PARAMETER IN ADINA ELEMENT INPUT     )
 2086 FORMAT(18H ***ERROR: ELEMENT,I5,27H IS NOT ACTIVE AT THIS TIME)
 2130 FORMAT(42H ***ERROR: RESULTANT ELEMENT TYPE IETYPE =,I2,
     1 38H IS NOT SAME AS ELEMENT TYPE NPAR(1) =,I2)
 2140 FORMAT(42H ***ERROR: EPOINTS ELEMENT NR IS INVALID =,I5)
 2150 FORMAT(4X,50HSTRESS POINT COORDINATES ARE NOT CALCULATED - ALL ,
     1  48HPOINTS ARE PLOTTED WITH AN EQUAL DISTANCE OF 1.0)
      END
C*NEW FILE
C***END:IBM***
      SUBROUTINE TEST
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /FIELDC/ REALI,INPREC(80),INPOS,ITYPEI,INTI,IANUMI(128),
     1               KEYI(8),NPOSRE,INECHO,MXSIGI,MXSIGR,MXSIGE,MXSTRL,
     2               ISTRIL,NFIELD,NPOSIN
      IF (ITYPE(1).EQ.INTEG)  NPOSRE = INTV(1)
      IF (ITYPE(2).EQ.INTEG)  NBSU = INTV(2)
C          LSTA IS TAKEN CARE OF IN SUBROUTINE COMND
      IF (ITYPE(4).EQ.INTEG)  LSTC = INTV(4)
      IF (ITYPE(5).EQ.INTEG)  LSTF = INTV(5)
      IF (ITYPE(6).EQ.INTEG)  LSTDB = INTV(6)
      IF (ITYPE(7).EQ.INTEG)  ISURL = INTV(7)
      IF (ITYPE(8).EQ.INTEG)  ITWO  = INTV(8)
 8000 RETURN
      END
C***ADD:CDC***
CDECK FILE
C***END:CDC***
      SUBROUTINE FILE
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      IF (ITYPE(1).EQ.INTEG)  NFREAD = INTV(1)
      IF (ITYPE(2).EQ.INTEG)  NFECHO = INTV(2)
      IF (ITYPE(3).EQ.INTEG)  NFLOG  = INTV(3)
      IF (ITYPE(4).EQ.INTEG)  NFLIST = INTV(4)
      IF (ITYPE(5).EQ.INTEG)  NFPLOT = INTV(5)
      IF (ITYPE(6).EQ.INTEG)  LUNODE = INTV(6)
      IF (ITYPE(7).EQ.INTEG)  LUELEM = INTV(7)
C
 8000 RETURN
      END
C***ADD:CDC***
CDECK CONTRL
C***END:CDC***
      SUBROUTINE CONTRL
C
C          CONTROL COMMAND
C
      DIMENSION IA(1)
C
      COMMON /ERROR/ IERROR
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /FIELDC/ REALI,INPREC(80),INPOS,ITYPEI,INTI,IANUMI(128),
     1               KEYI(8),NPOSRE,INECHO,MXSIGI,MXSIGR,MXSIGE,MXSTRL,
     2               ISTRIL,NFIELD,NPOSIN
      COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
     1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
     3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
     2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
      COMMON /MEMORY/ MTOT,LPROG,MEMPRT,MEMMAX
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      IF (ITYPE(1).EQ.INTEG)  IBATCH = INTV(1)
      IF (ITYPE(2).EQ.INTEG)  INECHO = INTV(2)
      IF (ITYPE(3).EQ.IREAL)  HEIGHT = REALV(3)
      AXEDGE = HEIGHT * 6.0
C
      IF (ITYPE(4).EQ.INTEG)  NDEVPL = INTV(4)
      IF (ITYPE(5).EQ.INTEG)  NSYSPL = INTV(5)
      IF (ITYPE(6).EQ.INTEG)  MEMPRT = INTV(6)
      IF (INTV(7).GT.15)  LINPAG = INTV(7)
      IF (ITYPE(8).EQ.INTEG)  LSKEW = INTV(8)
      IF (ITYPE(11).EQ.INTEG)  MIDSPL = INTV(11)
C
      IF (ITYPE(12).NE.INTEG) GOTO 20
        IF (INTV(12).EQ.MORIGO) GOTO 20
        MORIGO = INTV(12)
        X     = XPMAX
        XPMAX = YPMAX
        YPMAX = X
  20    CONTINUE
      IF (ITYPE(13).EQ.IREAL) PMARG = ABS( REALV(13) )
C
C          PARAM:  NSUB,  NREUSE
C
      IF (ITYPE(9).NE.INTEG .AND. ITYPE(10).NE.INTEG) GOTO 900
      NSUB = INTV(9)
      NRUSE = INTV(10)
      IF (ITYPE( 9).EQ.IOMIT) NSUB  = INSTRI - 1
      IF (ITYPE(10).EQ.IOMIT) NRUSE = 1
      IF (IOPEN.EQ.1) GOTO 110
        WRITE (NFLOG,2000)
        GOTO 800
  110 IF (NSUB.LT.0 .OR. NRUSE.LT.0) GOTO 850
      IF (NSUB.GT.NSUBST) GOTO 850
C          IA(I06) = START OF NRUSES ARRAY
      MAXNTU = IA(I06+NSUB)
      IF (NRUSE.GT.MAXNTU) GOTO 850
      INSTRI = NSUB + 1
      INRUSE = NRUSE
      INSTRU = NRUSE - MAXNTU
      DO 120 ISTRI=1,INSTRI
  120   INSTRU = INSTRU + IA(I06+ISTRI-1)
      GOTO 900
C
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT(54H ***ERROR: DATABASE MUST BE OPEN BEFORE NSUBSTRUCTURE ,
     1        25HAND NREUSE CAN BE DEFINED)
      END
C***ADD:CDC***
CDECK VIEW1
C***END:CDC***
      SUBROUTINE VIEW1
C
      DIMENSION IA(1),VIEWMX(3,3),TRANMX(3,3),ROTAMX(3,3)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          PARAM 1: NVIEW
C
      NVIEW = INTV(1)
      IF (NVIEW.GE.1 .AND. NVIEW.LE.MVIEW) GOTO 100
        WRITE (NFLOG,2000) MVIEW
        GOTO 800
C
C          PARAM 2, 3, 4, 5: XVIEW, YVIEW, ZWIEW, ROTATI
C
  100 XVIEW = REALV(2)
      YVIEW = REALV(3)
      ZVIEW = REALV(4)
      ROTAT = REALV(5)
      DO 110 I=1,3
        DO 110 J=1,3
          TRANMX(I,J) = 0.0
  110     ROTAMX(I,J) = 0.0
C
C          NORMALIZE THE VIEW DIRECTION VECTOR
C
      VLENGT = SQRT (XVIEW*XVIEW + YVIEW*YVIEW + ZVIEW*ZVIEW)
C
      IF (VLENGT.GT.EPS) GOTO 120
        WRITE (NFLOG,2010)
        GOTO 800
  120 XVIEW = XVIEW / VLENGT
      YVIEW = YVIEW / VLENGT
      ZVIEW = ZVIEW / VLENGT
C
C          COMPUTE TRANSFORMATION MATRIX TO VIEW COORDINATE SYSTEM
C
      IF (ABS(XVIEW).LT.EPS .AND. ABS(YVIEW).LT.EPS) GOTO 150
      XYLENG = SQRT(XVIEW*XVIEW + YVIEW*YVIEW)
      TRANMX(1,1) = -YVIEW / XYLENG
      TRANMX(1,2) =  XVIEW / XYLENG
      TRANMX(2,1) = - ZVIEW * XVIEW / XYLENG
      TRANMX(2,2) = - ZVIEW * YVIEW / XYLENG
      TRANMX(2,3) = XYLENG
      TRANMX(3,1) =  XVIEW
      TRANMX(3,2) =  YVIEW
      TRANMX(3,3) =  ZVIEW
      GOTO 200
C
C          VIEW DIRECTION IS PARALLELL TO GLOBAL Z-AXIS
C
  150 DO 160 I=1,3
  160   TRANMX(I,I) = 1.0
      IF (ZVIEW.GT.0.0) GOTO 200
        TRANMX(1,1) = -1.0
        TRANMX(3,3) = -1.0
C
C          COMPUTE ROTATION MATRIX
C
  200 ROTRAD = ROTAT * 0.0174533
      ROTCOS = COS(ROTRAD)
      ROTSIN = SIN(ROTRAD)
      ROTAMX(1,1) =  ROTCOS
      ROTAMX(1,2) = -ROTSIN
      ROTAMX(2,1) =  ROTSIN
      ROTAMX(2,2) =  ROTCOS
      ROTAMX(3,3) = 1.0
C
C          CONCATENATE ROTATION AND TRANSFORMATION MATRICES
C          TO THE VIEW MATRIX
C
      DO 250 I=1,3
        DO 250 J=1,3
  250 VIEWMX(I,J) = ROTAMX(I,1) * TRANMX(1,J) +
     1              ROTAMX(I,2) * TRANMX(2,J) +
     2              ROTAMX(I,3) * TRANMX(3,J)
C
C          UPDATE VIEW RECORD IN DATABASE
C
      N2 = N1 + MVIEW * 9
      I2 = N2 / ISURL
      CALL SIZE(I2)
        IF (IERROR.NE.0) GOTO 900
      N1END = N2 - 1
      DO 400 I=N1,N1END
  400   A(I) = 0.
      IF (IXGP(KVIEW).NE.0) CALL DBREAD (A(N1),KVIEW,1,0)
        IF (IERROR.NE.0) GOTO 900
      IXA = N1 + (NVIEW-1) * 9
      DO 500 I=1,3
        DO 500 J=1,3
          A(IXA) = VIEWMX(J,I)
  500     IXA = IXA + 1
      CALL DBWRIT (A(N1),MVIEW*9,0,KVIEW,1,0)
      GOTO 900
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (35H ***ERROR: IDVIEW OUT OF LIMIT 1 - ,I2)
 2010 FORMAT (40H ***ERROR: ALL VIEW COORDINATES ARE ZERO)
      END
C***ADD:CDC***
CDECK APAXIS
C***END:CDC***
      SUBROUTINE APAXIS
C
      DIMENSION AXREC(250),XPA(1),YPA(1),XL(1),VMIN(1),VMAX(1)
      DIMENSION NAMEAX(20,1),IA(1),ISTRIV(1)
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      EQUIVALENCE (ISTRIV(1),IANUMV(1,7))
C
      EQUIVALENCE (AXREC(1),XPA(1)),
     1           (AXREC(11),YPA(1)),
     1           (AXREC(21),XL(1)),
     1           (AXREC(31),VMIN(1)),
     1           (AXREC(41),VMAX(1)),
     1           (AXREC(51),NAMEAX(1,1))
C
      MAXIS = 10
C
C
      NAXIS = INTV(1)
      IF (NAXIS.GE.1.AND.NAXIS.LE.MAXIS) GOTO 100
        WRITE (NFLOG,2000) MAXIS
        GOTO 800
C
  100 IF (REALV(4).LE.0.0) GOTO 850
      IF (REALV(5).EQ.REALV(6)) GOTO 850
C
C          READ AXIS RECORD FROM DATABASE
C
      DO 150 I=1,MAXIS
  150    XL(I) = 0.0
      IF (IXGP(KAXIS).NE.0)
     1  CALL DBREAD (AXREC,KAXIS,1,0)
        IF (IERROR.NE.0) GOTO 900
C
      XPA(NAXIS)   = REALV(2)
      YPA(NAXIS)   = REALV(3)
      XL(NAXIS)   = REALV(4)
      VMIN(NAXIS) = REALV(5)
      VMAX(NAXIS) = REALV(6)
      DO 200 I=1,20
  200   NAMEAX(I,NAXIS) = ISTRIV(I)
C
C          WRITE AXIS RECORD TO DATABASE
C
      LREAL = MAXIS * 5
      LINT = MAXIS * 20
      CALL DBWRIT (AXREC,LREAL,LINT,KAXIS,1,0)
      GOTO 900
C
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT (35H ***ERROR: IDAXIS OUT OF LIMIT 1 - ,I2)
      END
C***ADD:CDC***
CDECK ZONE1
C***END:CDC***
      SUBROUTINE ZONE1
C
      DIMENSION IA(1)
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
     1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
     2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
     3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
     4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      DATA KBZONE/14/
C
C          CHECK PARAMETERS
C
      IF (ITYPE(1).NE.IOMIT) GOTO 10
      WRITE (NFLOG,2000)
      GOTO 800
  10  IF (IANUMV(1,2).EQ.IBLANK) IANUMV(1,2) = IAAA
      IF (IANUMV(1,2).EQ.IAAA .OR. IANUMV(1,2).EQ.IDDD) GOTO 20
      WRITE (NFLOG,2010)
      GOTO 800
C
C          ZONE COMMANDS LAYOUT OF BLANK COMMON
C
C                                                NAMEZ
  20  I2 = I1 + 8 * NBSU
      CALL ALIGN (I2)
C                                                NPAR
      I3 = I2 + (NELPAR + 3) * MXEG
C                                                NZONE
      I4 = I3 + MXNP
      I7 = I4
      IF (NCMD.NE.KBZONE) GOTO 50
C                                                XYZ
      I7 = I4 + MXNP * ISURL * 3
C                                                IEZONE
  50  I8 = I7 + MXEL
C                                                NOD
      I9 = I8 + MXELNP
      CALL SIZE (I9)
      IF (IERROR.NE.0) GOTO 900
C
      CALL ZONE2 (IA(I06),IA(I07),IA(I08),IA(I1),NELPAR,IA(I2),
     1           IA(I3),IA(I4),IA(I7),IA(I8))
      GOTO 900
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (25H ***ERROR: WHAT ZONENAME?)
 2010 FORMAT (37H ***ERROR: ZONE OPERATION ADD OR DEL?)
      END
C***ADD:CDC***
CDECK ZONE2
C***END:CDC***
      SUBROUTINE ZONE2 (NRUSES,NEGS,NUMNPS,NAMEZ,NPARD,NPAR,NZONE,
     1                   XYZ,IEZONE,NOD)
      DIMENSION IA(1),NRUSES(1),NEGS(1),NUMNPS(1),NAMEZ(8,1),
     1          NPAR(NPARD,1),NZONE(1),XYZ(1),IEZONE(1),NOD(1)
     2         ,MXNODA(15)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
     1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
     2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
     3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
     4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
      COMMON /ERROR/ IERROR
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      DATA KBZONE,KEZONE,KEGZON,KZZONE/14,15,16,17/
      DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
C
      DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
      DATA I2DIMF,I3DIMF/11,12/
C
      ISUBST = INSTRI - 1
      IF (NSUBST.GT.0 .AND. (NCMD.EQ.KEZONE.OR.NCMD.EQ.KEGZON))
     1  WRITE (NFLOG,2345) ISUBST, INRUSE
C
C          INITIATE (NFIRST = 1) OR READ NAMEZ
C
      IF (IXGP(KNAMEZ).NE.0) GOTO 20
      NFIRST = 1
      DO 10 I=I1,I2
  10    IA(I) = IBLANK
      GOTO 25
  20  NFIRST = 0
      CALL DBREAD (NAMEZ,KNAMEZ,1,0)
      IF (IERROR.NE.0) GOTO 900
C
C          FIND OR ADD (NEWZ=1) ZONENAME, SET IBITZ = BIT NR
C
   25 IEMPTY = 0
      DO 40 IBITZ=1,NBSU
        IF (NAMEZ(1,IBITZ).EQ.IBLANK) IEMPTY = IBITZ
        DO 30 J=1,8
          IF (NAMEZ(J,IBITZ).NE.IANUMV(J,1)) GOTO 40
  30      CONTINUE
        NEWZ = 0
        GOTO 80
  40  CONTINUE
C          NOT FOUND: ADD
      IF (IEMPTY.NE.0) GOTO 50
        WRITE (NFLOG,2000)
        GOTO 800
  50  IF (IANUMV(1,2).EQ.IAAA) GOTO 70
        WRITE (NFLOG,2010)
        GOTO 800
   70 IBITZ = IEMPTY
      NEWZ = 1
      DO 75 I=1,8
  75    NAMEZ(I,IBITZ) = IANUMV(I,1)
  80  CONTINUE
C
C          'XZONE ZONENAME DEL' DELETES ZONENAME
C
      IF (IANUMV(1,2).NE.IDDD.OR.NLASTP.NE.2) GOTO 100
  90    WRITE (NFLOG,2060)
        NAMEZ(1,IBITZ)  = IBLANK
        NEWZ = 1
        GOTO 760
  100 NULLZ = 1
C
C          IF BZONE GET XYZ - BOUNDARIES
C
      IF (NCMD.NE.KBZONE) GOTO 110
      XMIN = -1.0E10
      YMIN = -1.0E10
      ZMIN = -1.0E10
      XMAX =  1.0E10
      YMAX =  1.0E10
      ZMAX =  1.0E10
      IF (ITYPE(3).EQ.IREAL) XMIN = REALV(3)
      IF (ITYPE(4).EQ.IREAL) XMAX = REALV(4)
      IF (ITYPE(5).EQ.IREAL) YMIN = REALV(5)
      IF (ITYPE(6).EQ.IREAL) YMAX = REALV(6)
      IF (ITYPE(7).EQ.IREAL) ZMIN = REALV(7)
      IF (ITYPE(8).EQ.IREAL) ZMAX = REALV(8)
      IF (XMIN.LE.XMAX.AND.YMIN.LE.YMAX.AND.ZMIN.LE.ZMAX) GOTO 105
        WRITE (NFLOG,2050)
        GOTO 800
  105 XMIN = XMIN - ABS(EPS*XMIN)
      YMIN = YMIN - ABS(EPS*YMIN)
      ZMIN = ZMIN - ABS(EPS*ZMIN)
      XMAX = XMAX + ABS(EPS*XMAX)
      YMAX = YMAX + ABS(EPS*YMAX)
      ZMAX = ZMAX + ABS(EPS*ZMAX)
  110 CONTINUE
C
C          DO FOR ALL INDEPENDENT STRUCTURES
C
      ISTRUC = 0
      IEGAT = 0
      IEGIT = 0
      ISNOD = 0
      ISEZON = 0
      DO 750 ISTRI=1,NSTRI
C
      NRUSE = NRUSES(ISTRI)
      NUMNP = NUMNPS(ISTRI)
      NEG = NEGS(ISTRI)
      CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL TIMES A STRUCTURE IS REUSED
C
      DO 740 IRUSE=1,NRUSE
C
      ISTRUC = ISTRUC + 1
C
C          INIT (NFIRST=1) OR READ NZONE, CLEAR BITS(IBITZ) TO ZERO
C
      IF (NFIRST.EQ.0) CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
      DO 210 NP=1,NUMNP
        IF (NFIRST.EQ.1) NZONE(NP) = 0
        IF (IANUMV(1,2).EQ.IDDD) CALL BITSET (NZONE(NP),IBITZ,0)
  210   CONTINUE
C
C          IF COMMAND BZONE, READ XYZ
C
      IF (NCMD.EQ.KBZONE) CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
      IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL ELEMENT GROUPS IN REUSED STRUCTURE
C
      DO 730 IEG=1,NEG
C
      IEGAT = IEGAT + 1
      IEGIT = IEGIT + 1
      ISELEC = 0
      IELTYP = NPAR(1,IEG)
      MXNODS = MXNODA(IELTYP)
      MXNODB = MXNODS
      IF (IELTYP.EQ.IBEAM .OR. IELTYP.EQ.ISOBEA) MXNODB = MXNODB - 1
      NEL = NPAR(2,IEG)
C
C          DO FOR ALL ELEMENTS IN ELEMENT GROUP
C
      DO 720 IEL=1,NEL
C
      IF (NCMD.NE.KEGZON) ISELEC = 0
      IF (NCMD.EQ.KBZONE) GOTO 300
      IF (NLASTP.LT.3) GOTO 700
      IF (NCMD.EQ.KZZONE) GOTO 600
      IF (INSTRI.NE.ISTRI.OR.INRUSE.NE.IRUSE) GOTO 700
      IF (NCMD.EQ.KEZONE) GOTO 400
      GOTO 500
C
C          BZONE SELECTION - ALL ELEMENT NODES MUST BE ON OR WITHIN
C          XYZ BOUNDARIES
C
  300 IF (ISNOD.EQ.IEGIT) GOTO 305
      ISNOD = IEGIT
      CALL DBREAD (NOD,KNOD,IEGIT,0)
      IF (IERROR.NE.0) GOTO 900
  305 DO 310 NODEL=1,MXNODB
      INODEL = MXNODS * (IEL - 1) + NODEL
      NP = NOD(INODEL)
      IF (NP.EQ.0) GOTO 310
      XC = XYZ(NP)
      I = NUMNP + NP
      YC = XYZ(I)
      ZC = XYZ(I+NUMNP)
      IF (XC.LT.XMIN .OR. XC.GT.XMAX) GOTO 700
      IF (YC.LT.YMIN .OR. YC.GT.YMAX) GOTO 700
      IF (ZC.LT.ZMIN .OR. ZC.GT.ZMAX) GOTO 700
  310 CONTINUE
      ISELEC = 1
      GOTO 700
C
C          EZONE SELECTION
C
  400 NEGX = INTV(3)
      IF (NEGX.LT.1 .OR. NEGX.GT.NEG) GOTO 480
      IF (NEGX.NE.IEG) GOTO 700
      NELN = 4
  410 IF (NELN.GT.NLASTP) GOTO 700
      NELX = INTV(NELN)
      NELN = NELN + 1
C
C          GENERATE ELEMENT NUMBERS FROM NELX TO -(NTO) STEP -(NSTEP)
C          NELX MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
C
      NTO = 0
      IF (NELN.GT.NLASTP) GOTO 430
      IF (INTV(NELN).LT.0) NTO = -INTV(NELN)
      IF (NTO.LE.0) GOTO 430
      NELN = NELN + 1
      NSTEP = 1
      IF (NELN.GT.NLASTP .OR. INTV(NELN).GE.0) GOTO 420
      NSTEP = -INTV(NELN)
      NELN = NELN + 1
  420 IF (NELX.GT.NTO) NSTEP = -NSTEP
C
  430 IF (NELX.LT.1 .OR. NELX.GT.NEL) GOTO 490
      IF (NELX.EQ.IEL) ISELEC = 1
C
C          INCREMENT BY STEP VALUE
C
      IF (NTO.LE.0) GOTO 410
      NELX = NELX + NSTEP
      IF (NELX.GT.NTO .AND. NSTEP.GT.0) GOTO 410
      IF (NELX.LT.NTO .AND. NSTEP.LT.0) GOTO 410
      GOTO 430
C
  480 WRITE (NFLOG,2030) NEGX
      GOTO 800
  490 WRITE (NFLOG,2040) NELX
      GOTO 800
C
C          EGZONE SELECTION
C
  500 IF (IEL.GT.1) GOTO 700
      NEGN = 3
  510 IF (NEGN.GT.NLASTP) GOTO 700
      NEGX = INTV(NEGN)
      NEGN = NEGN + 1
C
C          GENERATE EG NUMBERS FROM NEGX TO -(NTO) STEP -(NSTEP)
C          NEGX MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
C
      NTO = 0
      IF (NEGN.GT.NLASTP) GOTO 530
      IF (INTV(NEGN).LT.0) NTO = -INTV(NEGN)
      IF (NTO.LE.0) GOTO 530
      NEGN = NEGN + 1
      NSTEP = 1
      IF (NEGN.GT.NLASTP .OR. INTV(NEGN).GE.0) GOTO 520
      NSTEP = -INTV(NEGN)
      NEGN = NEGN + 1
  520 IF (NEGX.GT.NTO) NSTEP = -NSTEP
C
  530 IF (NEGX.LT.1 .OR. NEGX.GT.NEG) GOTO 480
      IF (NEGX.EQ.IEG) ISELEC = 1
C
C          INCREMENT BY STEP VALUE
C
      IF (NTO.LE.0) GOTO 510
      NEGX = NEGX + NSTEP
      IF (NEGX.GT.NTO .AND. NSTEP.GT.0) GOTO 510
      IF (NEGX.LT.NTO .AND. NSTEP.LT.0) GOTO 510
      GOTO 530
C
C          ZZONE SELECTION
C
  600 DO 640 IZONN=3,NLASTP
        DO 620 IBITX=1,NBSU
          DO 610 I=1,8
            IF(NAMEZ(I,IBITX).NE.IANUMV(I,IZONN)) GOTO 620
  610       CONTINUE
          GOTO 630
  620     CONTINUE
C
C          ZONN NOT FOUND
C
        DO 625 I=1,8
          NAMEZ (I,1) = IANUMV(I,IZONN)
          CALL APCHAR(NAMEZ(I,1))
  625     CONTINUE
        WRITE (NFLOG,2010) (NAMEZ(I,1),I=1,8)
        GOTO 800
C
C          ZONN FOUND
C
  630 IF (ISEZON.EQ.IEGAT) GOTO 635
      ISEZON = IEGAT
      CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
  635 CALL BITGET (IEZONE(IEL),IBITX,IBIT)
        IF (IBIT.EQ.1) ISELEC = 1
  640   CONTINUE
C
C
C          INITIALIZE OR READ IEZONE IF NEEDED
C
  700 IF (IANUMV(1,2).EQ.IAAA .AND. NFIRST.EQ.0
     1    .AND. ISELEC.EQ.0) GOTO 720
      IF (ISEZON.EQ.IEGAT) GOTO 705
      ISEZON = IEGAT
      DO 703 I=1,NEL
  703   IEZONE(I) = 0
      IF (NFIRST.EQ.0) CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
C
C          UPDATE BIT IEZONE(IEL)
C
  705 NEWBIT = 1
      IF (IANUMV(1,2) .EQ.IDDD) NEWBIT = 0
      IF (ISELEC.EQ.1) CALL BITSET (IEZONE(IEL),IBITZ,NEWBIT)
      CALL BITGET (IEZONE(IEL),IBITZ,IBIT)
      IF (IBIT.EQ.0) GOTO 720
      NULLZ = 0
C
C          UPDATE BITS(IBITZ) IN NZONE
C
      IF (ISNOD.EQ.IEGIT) GOTO 707
      ISNOD = IEGIT
      CALL DBREAD (NOD,KNOD,IEGIT,0)
      IF (IERROR.NE.0) GOTO 900
  707 DO 710 NODEL=1,MXNODS
        INODEL = MXNODS * (IEL - 1) + NODEL
        NP = NOD(INODEL)
        IF (NP.EQ.0) GOTO 710
        CALL BITSET (NZONE(NP),IBITZ,1)
  710   CONTINUE
C
  720 CONTINUE
      IF (ISEZON.EQ.IEGAT)
     1  CALL DBWRIT (IEZONE,0,NEL,KIEZON,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
C
  730 CONTINUE
      IEGIT = IEGIT - NEG
      CALL DBWRIT (NZONE,0,NUMNP,KNZONE,ISTRUC,0)
      IF (IERROR.NE.0) GOTO 900
C
  740 CONTINUE
      IEGIT = IEGIT + NEG
  750 CONTINUE
      IF (NULLZ.EQ.0) GOTO 760
        WRITE (NFLOG,2070)
        GOTO 90
  760 IF (NEWZ.EQ.1)
     1  CALL DBWRIT (NAMEZ,0,NBSU*8,KNAMEZ,1,0)
      GOTO 900
C
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (29H ***ERROR: TOO MANY ZONENAMES)
 2010 FORMAT (29H ***ERROR: ZONENAME NOT FOUND,2X,8A1)
 2030 FORMAT (42H ***ERROR: INVALID ELEMENT GROUP NUMBER - ,I6)
 2040 FORMAT (36H ***ERROR: INVALID ELEMENT NUMBER - ,I6)
 2060 FORMAT (20H ***ZONENAME DELETED)
 2070 FORMAT (37H ***WARNING: ZONE CONTAINS NO ELEMENT)
 2050 FORMAT (45H ***ERROR: MAX VALUE MUST BE GREATER THAN MIN)
 2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
      END
C***ADD:CDC***
CDECK BITSET
C***END:CDC***
      SUBROUTINE BITSET (IWORD,IBITZ,INEW)
C
C          UPDATE IWORD BIT NR IBITZ FROM RIGHT TO VALUE INEW
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      IEXP = 2 ** (NBSU - IBITZ)
      IF (MOD(IWORD/IEXP,2).EQ.1) GOTO 10
      IF (INEW.EQ.1) IWORD = IWORD + IEXP
      GOTO 90
  10  IF (INEW.EQ.0) IWORD = IWORD - IEXP
  90  CONTINUE
      RETURN
      END
C***ADD:CDC***
CDECK NPOIN1
C***END:CDC***
      SUBROUTINE NPOIN1
C
      DIMENSION IA(1)
C
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          BLANK COMMON LAYOUT
C
C                                                LINEID
      I2 = I1 + MLINEN * 3
C                                                NODEP
      I3 = I2 + MLINEN * 99
C                                                NAMEP
      I4 = I3 + MLINEN * 8
      CALL SIZE (I4)
        IF (IERROR.NE.0) GOTO 900
      DO 50 I=I1,I4
  50    IA(I) = 0
      CALL NPOIN2 (IA(I1),IA(I2),IA(I3),IA(I08))
  900 RETURN
      END
C***ADD:CDC***
CDECK NPOIN2
C***END:CDC***
      SUBROUTINE NPOIN2 (LINEID,NODEP,NAMEP,NUMNPS)
C
      DIMENSION LINEID(3,1),NODEP(99,1),NAMEP(8,1),NUMNPS(1)
C
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
C
C
      ISUBST = INSTRI - 1
      IF (NSUBST.GT.0) WRITE (NFLOG,2345) ISUBST, INRUSE
C
C          PARAM 1: PNAME
C
      IF (ITYPE(1).NE.IOMIT) GOTO 10
        WRITE (NFLOG,2000)
        GOTO 800
C
C          READ NPOINT RECORD FROM DATABASE
C
  10  IF (IXGP(KNPOIN).NE.0) CALL DBREAD (LINEID,KNPOIN,1,0)
        IF (IERROR.NE.0) GOTO 900
C
C          TRY TO FIND PNAME IN NAME ARRAY
C
  100 IEMPTY = 0
      DO 120 ILINEN=1,MLINEN
        IF (NAMEP(1,ILINEN).EQ.0) IEMPTY = ILINEN
        DO 110 I=1,8
          IF (NAMEP(I,ILINEN).NE.IANUMV(I,1)) GOTO 120
  110     CONTINUE
        GOTO 150
  120   CONTINUE
C
C          NOT FOUND: ADD
C
      IF (IEMPTY.NE.0) GOTO 130
        WRITE (NFLOG,2010) MLINEN
        GOTO 800
  130 ILINEN = IEMPTY
      DO 140 I=1,8
  140   NAMEP(I,ILINEN) = IANUMV(I,1)
      GOTO 100
C
C          IF NO NODES, NPOINT LINE IS DELETED
C
  150 IF (ITYPE(2).NE.IOMIT) GOTO 170
        NAMEP(1,ILINEN) = 0
        GOTO 300
C
C          UPDATE LINEID AND NODEP
C
  170 LINEID(1,ILINEN) = INSTRI
      LINEID(2,ILINEN) = INSTRU
      LINEID(3,ILINEN) = INRUSE
C
C          MOVE NODEPOINT NUMBERS TO DATABASE RECORD
C          GENERATE NODE NUMBERS FROM NP TO -(NTO) STEP -(NSTEP)
C          NP MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
C
      IXOUT = 1
      IXIN = 2
 210  IF (IXIN.GT.100) GOTO 300
      NP = INTV(IXIN)
      IF (NP.EQ.0) GOTO 300
      IXIN = IXIN + 1
      NTO = 0
      IF (IXIN.GT.100) GOTO 250
      IF (INTV(IXIN).LT.0) NTO = -INTV(IXIN)
      IF (NTO.LE.0) GOTO 250
      IXIN = IXIN + 1
      NSTEP = 1
      IF (IXIN.GT.100 .OR. INTV(IXIN).GE.0) GOTO 240
      NSTEP = -INTV(IXIN)
      IXIN = IXIN + 1
  240 IF (NP.GT.NTO) NSTEP = -NSTEP
C
  250 IF (NP.GE.1 .AND. NP.LE.NUMNPS(INSTRI)) GOTO 260
        WRITE (NFLOG,2020) NP
        GOTO 800
  260 IF (IXOUT.LE.99) GOTO 270
        WRITE (NFLOG,2030) NP
        GOTO 800
  270 NODEP(IXOUT,ILINEN) = NP
      IXOUT = IXOUT + 1
      IF (NTO.LE.0) GOTO 210
      NP = NP + NSTEP
      IF (NP.GT.NTO .AND. NSTEP.GT.0) GOTO 210
      IF (NP.LT.NTO .AND. NSTEP.LT.0) GOTO 210
      GOTO 250
C
  300 CALL DBWRIT (LINEID,0,MLINEN*110,KNPOIN,1,0)
      GOTO 900
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (22H ***ERROR: WHAT  NAME?)
 2010 FORMAT (31H ***ERROR: TOO MANY  NAMES, MAX,I3)
 2020 FORMAT (32H ***ERROR: INVALID NODE NUMBER =,I5)
 2030 FORMAT(34H ***ERROR: TOO MANY NODES AT POINT,I4,8H, MAX 99)
 2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
      END
C***ADD:CDC***
CDECK EPOIN1
C***END:CDC***
      SUBROUTINE EPOIN1
C
      DIMENSION IA(1)
C
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          BLANK COMMON LAYOUT
C
C                                                LINEID
      I2 = I1 + MLINEE * 4
C                                                NELP
      I3 = I2 + MLINEE * 98
C                                                NAMEP
      I4 = I3 + MLINEE * 8
      CALL SIZE (I4)
        IF (IERROR.NE.0) GOTO 900
      DO 50 I=I1,I4
  50    IA(I) = 0
      CALL EPOIN2 (IA(I1),IA(I2),IA(I3),IA(I07))
  900 RETURN
      END
C***ADD:CDC***
CDECK EPOIN2
C***END:CDC***
      SUBROUTINE EPOIN2 (LINEID,NELP,NAMEP,NEGS)
C
      DIMENSION LINEID(4,1),NELP(98,1),NAMEP(8,1),NEGS(1)
C
C
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
C
C
      ISUBST = INSTRI - 1
      IF (NSUBST.GT.0) WRITE (NFLOG,2345) ISUBST, INRUSE
C
C          PARAM 1: PNAME
C
      IF (ITYPE(1).NE.IOMIT) GOTO 10
        WRITE (NFLOG,2000)
        GOTO 800
C
C          READ EPOINT RECORD FROM DATABASE
C
  10  IF (IXGP(KEPOIN).NE.0) CALL DBREAD (LINEID,KEPOIN,1,0)
        IF (IERROR.NE.0) GOTO 900
C
C          TRY TO FIND PNAME IN NAME ARRAY
C
  100 IEMPTY = 0
      DO 120 ILINEE=1,MLINEE
        IF (NAMEP(1,ILINEE).EQ.0) IEMPTY = ILINEE
        DO 110 I=1,8
          IF (NAMEP(I,ILINEE).NE.IANUMV(I,1)) GOTO 120
  110     CONTINUE
        GOTO 150
  120   CONTINUE
C
C          NOT FOUND: ADD
C
      IF (IEMPTY.NE.0) GOTO 130
        WRITE (NFLOG,2010) MLINEE
        GOTO 800
  130 ILINEE = IEMPTY
      DO 140 I=1,8
  140   NAMEP(I,ILINEE) = IANUMV(I,1)
      GOTO 100
C
C          IF NO NEG, EPOINT LINE IS DELETED
C
  150 IF (ITYPE(2).NE.IOMIT) GOTO 170
        NAMEP(1,ILINEE) = 0
        GOTO 300
C
C          UPDATE LINEID AND NELP
C
  170 LINEID(1,ILINEE) = INSTRI
      LINEID(2,ILINEE) = INSTRU
      LINEID(3,ILINEE) = INRUSE
      NEG = INTV(2)
      IF (NEG.LT.1 .OR. NEG.GT.NEGS(INSTRI)) GOTO 700
      LINEID(4,ILINEE) = NEG
      DO 200 I=1,98
  200   NELP(I,ILINEE) = INTV(I+2)
C
  300 CALL DBWRIT (LINEID,0,MLINEE*110,KEPOIN,1,0)
      GOTO 900
  700 WRITE (NFLOG,2020) NEG
  800 IERROR = 1
  900 RETURN
 2000 FORMAT (22H ***ERROR: WHAT  NAME?)
 2010 FORMAT (31H ***ERROR: TOO MANY  NAMES, MAX,I3)
 2020 FORMAT (41H ***ERROR: INVALID ELEMENT GROUP NUMBER =,I5)
 2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
      END
C*NEW FILE
C***END:IBM***
      SUBROUTINE MLIST1
C
      DIMENSION IA(1),NDIRV(6)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
C
      CALL ZGETNB
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 2: NDIRS
C
      NDIRS = INTV(2)
      IF (ITYPE(2).EQ.IOMIT) NDIRS = 123
      NVAR = 0
      DO 240 NDIGIT=1,6
        NDIR = MOD(NDIRS / 10**(6-NDIGIT), 10)
        IF (NDIR.EQ.0) GOTO 240
        IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
        NVAR = NVAR + 1
        NDIRV(NVAR) = NDIR
  240   CONTINUE
      IF (NVAR.EQ.0) GOTO 850
C
C          PARAM 3, 4: MSTART, MEND
C
      MSTART = INTV(3)
      IF (ITYPE(3).EQ.IOMIT) MSTART = 1
      MEND = INTV(4)
      IF (ITYPE(4).EQ.IOMIT) MEND = MSTART
C
C          BLANK COMMON LAYOUT
C
C                                                NZONE
      N2 = (I1 + MXNP) / ISURL
C                                                FRQ
      N3 = N2 + NFREQ
C                                                PHI
      N4 = N3 + MXNP * NDOF
C                                                RSDCOS
      I5 = (N4 + NSKEWS * 9) * ISURL
C                                                IDRN
      I6 = I5 + (NDOF + 2) * MXNP
C                                                KINDHD
      I7 = I6 + NVAR * 3
      CALL SIZE (I7)
        IF (IERROR.NE.0) GOTO 900
C
      CALL MLIST2 (NVAR,NDIRV,MSTART,MEND,
     1            IA(I1),A(N2),NDOF,A(N3),IA(I6),IA(I08),A(N4),IA(I5))
      GOTO 900
  850 IERROR = 2
  900 RETURN
      END
C***ADD:CDC***
CDECK MLIST2
C***END:CDC***
      SUBROUTINE MLIST2 (NVAR,NDIRV,MSTART,MEND,NZONE,
     1                   FRQ,NDOFD,PHI,KINDHD,NUMNPS,RSDCOS,IDRN)
C
      DIMENSION NDIRV(1),NZONE(1),FRQ(1),PHI(NDOFD,1),KINDHD(1)
     1          ,VALUEV(6),NUMNPS(1),RSDCOS(9,1),IDRN(1)
     2          ,VDIR(6)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /ERROR/ IERROR
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
C
      ILIST = 0
C
C          READ FRQ
C
      IF (IXGP(KFRQ).NE.0) GOTO 100
        WRITE (NFLOG,2000)
        GOTO 800
  100 CALL DBREAD (FRQ,KFRQ,1,0)
        IF (IERROR.NE.0) GOTO 900
      NUMNP = NUMNPS(1)
C
C          READ RSDCOS AND IDRN IF SKEW SYSTEMS DEFINED
C
      IF (NSKEWS.EQ.0) GOTO 110
        CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        CALL DBREAD (IDRN,KIDRN,1,0)
        IF (IERROR.NE.0) GOTO 900
        IXNRST = NDOF * NUMNP
C
C          READ NZONE
C
  110 IF (IBITZ.EQ.IWHOLE) GOTO 120
        CALL DBREAD (NZONE,KNZONE,1,0)
        IF (IERROR.NE.0) GOTO 900
C
C          DO FOR ALL SAVED MODAL STEPS
C
  120 DO 650 IFREQ=1,NFREQ
C
      IF (IFREQ.LT.MSTART .OR. IFREQ.GT.MEND) GOTO 650
C
      LINE = 9999
      CALL DBREAD (PHI,KPHI,IFREQ,0)
        IF (IERROR.NE.0) GOTO 900
      DO 620 NP=1,NUMNP
C
C          CHECK IF IN SELECTED ZONE
C
      IF (IBITZ.EQ.IWHOLE) GOTO 130
        CALL BITGET (NZONE(NP),IBITZ,ISELEC)
        IF (ISELEC.EQ.0) GOTO 620
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  130 DO 150 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0)  VDIR(I) = PHI(INDOF,NP)
  150   CONTINUE
C
C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
C
      IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 200
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.GT.0)
     1  CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
C          GET VALUES FOR SELECTED VARIABLES
C
  200 DO 250 IVAR=1,NVAR
        NDIR = NDIRV(IVAR)
        VALUEV(IVAR) = VDIR(NDIR)
  250   CONTINUE
C
C          LIST
C
  500 IF (LINE.LE.LINPAG) GOTO 530
      ILIST = 1
      HERTZ = FRQ(IFREQ) / 6.283185
      IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2030) IFREQ, HERTZ
      IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2031) NAMZON,IFREQ,HERTZ
      LINE = 2
      IF (NSKEWS.EQ.0) GOTO 505
        IF (LSKEW.NE.1) WRITE (NFLIST,2550)
        IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
        LINE = LINE + 2
  505 DO 525 IVAR=1,NVAR
        J = IVAR * 3 - 2
        CALL KINDN (NDIRV(IVAR),1,KINDHD(J))
  525   CONTINUE
      IEND = NVAR * 3
      WRITE (NFLIST,2040) (KINDHD(I),I=1,IEND)
      WRITE (NFLIST,2045)
      LINE = LINE + 3
  530 WRITE (NFLIST,2050) NP,(VALUEV(IVAR),IVAR=1,NVAR)
      LINE = LINE + 1
C
  620 CONTINUE
  650 CONTINUE
      IF (ILIST.EQ.0) WRITE (NFLOG,2700)
C
      GOTO 900
C
  800 IERROR = 1
  900 RETURN
 2000 FORMAT(32H ***ERROR: NO MODAL SHAPES FOUND)
 2030 FORMAT(48H1MODE SHAPE RESULTS FOR WHOLE MODEL    MODE NO =,
     1  I3,33H  FREQUENCY (CYCLES/UNIT TIME) = ,G10.4)
 2031 FORMAT(31H1MODE SHAPE RESULTS FOR ZONE = ,8A1,4X,9HMODE NO =,
     1  I3,33H  FREQUENCY (CYCLES/UNIT TIME) = ,G10.4)
 2040 FORMAT(/6H  NODE,6(5X,3A4))
 2045 FORMAT (1H )
 2050 FORMAT(1X,I5,6(5X,E12.6))
 2550 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
     1  17HCOORDINATE SYSTEM)
 2551 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
     1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
 2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
      END
C***ADD:CDC***
CDECK GLIST1
C***END:CDC***
      SUBROUTINE GLIST1
C
      DIMENSION IA(1)
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
C
      CALL ZGETNB
        IF (IERROR.NE.0) GOTO 900
C
C          GLIST BLANK COMMON LAYOUT
C                                                TIMEN
      I2 = I1 + NSTEN * ISURL
C                                                NSTEPN
      I3 = I2 + NSTEN
      CALL ALIGN (I3)
C                                                NZONE
      I4 = I3 + MXNP
C                                                X
      I5 = I4 + MXNP * 3 * ISURL
C                                                RSDCOS
      I6 = I5 + NSKEWS * 9 * ISURL
C                                                IDRN
      I7 = I6
      IF (NSKEWS.GT.0)
     1  I7 = I6 + (NDOF + 2) * MXNP
C                                                DISP
      I8 = I7 + NDOF * MXNP * ISURL
      CALL SIZE (I8)
        IF (IERROR.NE.0) GOTO 900
      CALL GLIST2 (IA(I06),IA(I08),IA(I1),IA(I2),IA(I3),
     1             IA(I4),IA(I5),IA(I6),NDOF,IA(I7))
  900 RETURN
      END
C***ADD:CDC***
CDECK GLIST2
C***END:CDC***
      SUBROUTINE GLIST2 (NRUSES,NUMNPS,TIMEN,NSTEPN,NZONE,X,
     1                   RSDCOS,IDRN,NDOFD,DISP)
C
      DIMENSION XYZ(3),NRUSES(1),NUMNPS(1),TIMEN(1),NSTEPN(1),
     1          NZONE(1),X(1),RSDCOS(9,1),IDRN(1),VDIR(6),DISP(NDOFD,1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
C
C          READ TIMEN, NSTEPN
C
      IF (NSTEN.GT.0) GOTO 10
        WRITE (NFLOG,2050)
        IERROR = 1
        GOTO 900
  10  CALL DBREAD (TIMEN,KTIMEN,1,0)
      IF (IERROR.NE.0) GOTO 900
C
C          GET REST OF PARAMETERS
C
      TSTA = REALV(2)
      TEND = REALV(3)
      IF (ITYPE(2).EQ.IOMIT) TSTA = TIMEN(NSTEN)
      IF (ITYPE(3).EQ.IOMIT) TEND = TSTA
      EPSVAL = DT * EPS
      TSTA = TSTA - EPSVAL
      TEND = TEND + EPSVAL
      NTSKIP = INTV(4)
      IF (NTSKIP.LT.0) GOTO 850
      ISNZON = 0
      ISXYZD = 0
      ITSKIP = 0
      ISRSDC = 0
      ISIDRN = 0
C
C          DO FOR ALL TIMESTEPS OF NODAL RESULTS
C
      DO 650 ITIME=1,NSTEN
C
      LINE = 9999
      ISTRUC = 0
      ISDISP = 0
      TIME = TIMEN(ITIME)
      IF (TIME.LT.TSTA) GOTO 650
      IF (TIME.GT.TEND) GOTO 650
C
C          NTSKIP TIMESTEPS BETWEEN OUTPUT
C
      IF (ITIME.EQ.NSTEN) GOTO 50
      IF (TIMEN(ITIME+1).GT.TEND) GOTO 50
      ITSKIP = ITSKIP - 1
      IF (ITSKIP.GE.0) GOTO 650
  50  ITSKIP = NTSKIP
C
C          DO FOR EVERY STRUCTURE, REUSE AND NODAL POINT
C
      DO 640 ISTRI=1,NSTRI
C
      NRUSE = NRUSES(ISTRI)
      NUMNP = NUMNPS(ISTRI)
      DO 630 IRUSE=1,NRUSE
C
      ISTRUC = ISTRUC + 1
      LSTSUB = 1
      IF (IBITZ.EQ.IWHOLE) GOTO 100
      IF (ISNZON.EQ.ISTRUC) GOTO 100
        CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
        IF (IERROR.NE.0) GOTO 900
        ISNZON = ISTRUC
  100 DO 620 NP=1,NUMNP
C
C          CHECK IF IN SELECTED ZONE
C
      IF (IBITZ.EQ.IWHOLE) GOTO 200
        CALL BITGET (NZONE(NP),IBITZ,ISELEC)
        IF (ISELEC.EQ.0) GOTO 620
C
C          READ XYZ IF NOT ALREADY IN BLANK COMMON
C
  200 IF (ISXYZD.EQ.ISTRUC) GOTO 210
        CALL DBREAD (X,KXYZ,ISTRUC,0)
          IF (IERROR.NE.0) GOTO 900
        ISXYZD = ISTRUC
  210 XYZ(1) = X(NP)
      I = NUMNP + NP
      XYZ(2) = X(I)
      XYZ(3) = X(I+NUMNP)
C
C          READ DISP
C
      IF (ISDISP.EQ.ISTRUC) GOTO 220
        CALL DBREAD (DISP,KDISP,ISTRUC,ITIME)
          IF (IERROR.NE.0) GOTO 900
        ISDISP = ISTRUC
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  220 DO 225 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0) VDIR(I) = DISP(INDOF,NP)
  225   CONTINUE
C
C          IF SKEW COORDINATE SYSTEM:  TRANSFORM TO GLOBAL
C
      IF (NSKEWS.EQ.0) GOTO 227
      IF (ISIDRN.NE.ISTRI)
     1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
        ISIDRN = ISTRI
      IXNRST = NDOF * NUMNP
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.LE.0) GOTO 227
      IF (ISRSDC.EQ.0)
     1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        ISRSDC = 1
      CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
C          COMPUTE DEFORMED OR INITIAL COORDINATES
C
  227 DO 230 I=1,3
          XYZ(I) = XYZ(I) + VDIR(I)
  230   CONTINUE
C
C          WRITE HEADLINES
C
  300 IF (LINE.LE.LINPAG) GOTO 310
      IF (IBITZ.EQ.IWHOLE)
     1  WRITE (NFLIST,2000) TIME,NSTEPN(ITIME)
      IF (IBITZ.NE.IWHOLE)
     1  WRITE (NFLIST,2001) NAMZON,TIME,NSTEPN(ITIME)
        LINE = 2
        LSTSUB = 1
        LSTDET = 1
  310 IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 320
        LINE = LINE + 5
        IF (LINE.GT.LINPAG) GOTO 300
      LINE = LINE - 3
        ISUBST = ISTRI - 1
        WRITE (NFLIST,2345) ISUBST, IRUSE
        LSTSUB = 0
        LSTDET = 1
  320 IF (LSTDET.EQ.0) GOTO 330
        LINE = LINE + 3
        IF (LINE.GT.LINPAG) GOTO 300
        WRITE (NFLIST,2030)
        LSTDET = 0
  330 WRITE (NFLIST,2040) NP,(XYZ(I),I=1,3)
      LINE = LINE + 1
  620 CONTINUE
  630 CONTINUE
  640 CONTINUE
  650 CONTINUE
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT(41H1DEFORMED NODAL LOCATIONS FOR WHOLE MODEL,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2001 FORMAT(37H1DEFORMED NODAL LOCATIONS FOR ZONE = ,8A1,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2030 FORMAT (/15H   NODE        ,
     1 44HX-LOCATION      Y-LOCATION      Z-LOCATION  /)
 2040 FORMAT (1X,I6,2X,3F16.5)
 2050 FORMAT (45H ***WARNING: NO TIMESTEP FOR NODAL DATA FOUND)
      END
C***ADD:CDC***
CDECK NLIST1
C***END:CDC***
      SUBROUTINE NLIST1
C
      DIMENSION IA(1),NDIRV(8),KINDV(8),VALUEV(8)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      DATA MXNVAR,KINDT/6,4/
C
C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
C
      CALL ZGETNB
        IF (IERROR.NE.0) GOTO 900
C
C          PARAM 2, 3: NDIRS,KINDS
C
      NDIRS = INTV(2)
      IF (ITYPE(2).EQ.IOMIT) NDIRS = 123
      KINDS = INTV(3)
      IF (ITYPE(3).EQ.IOMIT) KINDS = 1
C
C          ANALYZE NDIRS AND KINDS
C
  200 NVAR = 0
      DO 250 KDIGIT=1,4
        KIND = MOD(KINDS/10**(4-KDIGIT), 10)
        IF (KIND.EQ.0) GOTO 250
        IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
        IF (KIND.NE.KINDT) GOTO 210
          NVAR = NVAR + 1
          KINDV(NVAR) = KIND
          GOTO 250
  210   DO 240 NDIGIT=1,6
          NDIR = MOD (NDIRS / 10**(6-NDIGIT), 10)
          IF (NDIR.EQ.0) GOTO 240
          IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
          NVAR = NVAR + 1
          IF (NVAR.LE.MXNVAR) GOTO 220
            WRITE (NFLOG,2000) MXNVAR
          GOTO 800
  220     KINDV(NVAR) = KIND
          NDIRV(NVAR) = NDIR
  240     CONTINUE
  250   CONTINUE
      IF (NVAR.EQ.0) GOTO 850
C
C          BLANK COMMON LAYOUT
C
      N11 = N1
C                                                TIMEN
      I12 = I1 + NSTEN * ISURL
C                                                NSTEPN
      I13 = I12 + NSTEN
      CALL ALIGN (I13)
C                                                NZONE
      I14 = I13 + MXNP
C                                                RSDCOS
      I15 = I14 + NSKEWS * 9 * ISURL
C                                                IDRN
      I16 = I15
      IF (NSKEWS.GT.0 .AND. LSKEW.EQ.0)
     1  I16 = I15 + (NDOF + 2) * MXNP
      CALL SIZE (I16)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 4
      CALL NLIST2 (NVAR,
     1     VALUEV,NDIRV,KINDV,A(N11),IA(I12),IA(I13),IA(I13),
     2     IA(I06),IA(I08),IA(I14),IA(I15))
      GOTO 900
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT (43H ***ERROR: TOO MANY VARIABLES SELECTED, MAX,I3)
      END
C***ADD:CDC***
CDECK NLIST2
C***END:CDC***
      SUBROUTINE NLIST2 (NVAR,
     1           VALUEV,NDIRV,KINDV,TIMEN,NSTEPN,
     2           NZONE,IRPOL,NRUSES,NUMNPS,RSDCOS,IDRN)
C
      DIMENSION IA(1),VALUEV(1),NDIRV(1),KINDV(1),TIMEN(1),
     1 NSTEPN(1),NZONE(1),IRPOL(1),IXA(5),IREAD(5),NRUSES(1),NUMNPS(1)
      DIMENSION RSDCOS(9,1),IDRN(1),VDIR(6),IHDMAX(4,3),IHDMX2(12)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      EQUIVALENCE (IHDMAX(1,1),IHDMX2(1))
      DATA IHDMX2/
     1 4HABSO,4HLUTE,4H MAX,4HIMUM,
     2 4HMAXI,4HMUM ,4H    ,4H    ,
     3 4HMINI,4HMUM ,4H    ,4H    /
      DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
      DATA KNLIST,KNMAX,KRLIST,KRMAX/28,32,42,43/
C
      ILIST = 0
C
C          READ TIMEN, NSTEPN
C
      IF (NSTEN.GT.0) GOTO 2
        WRITE (NFLOG,2000)
        GOTO 800
  2   CALL DBREAD (TIMEN,KTIMEN,1,0)
      IF (IERROR.NE.0) GOTO 900
C
C          PARAM : TSTART, TEND
C
      TSTA = REALV(IXPAR)
      TEND = REALV(IXPAR+1)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEN(NSTEN)
      IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTA
      EPSVAL = DT * EPS
C
C          PARAM : NTSKIP
C                      MAXTYPE, NUMMAX
C                      MAXTYPE, VALUE
C
      NTSKIP = 0
      MAXTYP = 0
      NUMMAX = 0
      IF (NCMD.NE.KNLIST .AND. NCMD.NE.KRLIST) GOTO 5
        NTSKIP = INTV(IXPAR+2)
        IF (NTSKIP.LT.0) GOTO 850
        GOTO 10
  5   MAXTYP = INTV(IXPAR+2)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEN(1)
      IF (ITYPE(IXPAR+2).EQ.IOMIT) MAXTYP = 1
      IF (MAXTYP.LT.1 .OR. MAXTYP.GT.3) GOTO 850
      IF (NCMD.NE.KNMAX .AND. NCMD.NE.KRMAX) GOTO 7
        NUMMAX = INTV(IXPAR+3)
        IF (ITYPE(IXPAR+3).EQ.IOMIT) NUMMAX = 1
        IF (NUMMAX.LT.1) GOTO 850
        GOTO 10
  7   VALMAX = REALV(IXPAR+3)
C
C          CHECK WHAT KINDS ARE NEEDED
C
  10  DO 20 KIND=1,5
  20    IXA(KIND) = 0
      IVAEND = NVAR
      IF (ICALL.EQ.ICALLR) IVAEND = MVAR
      DO 30 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.NE.0) IXA(KIND) = 1
        IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  30    CONTINUE
C
C          BLANK COMMON FOR DBREAD OF NEEDED KINDS AND NUMMAX
C
C                                                DISP
C                                                VEL
C                                                ACC
C                                                TEMP
      NIX = I16 / ISURL
      DO 60 KIND=1,5
        IF (IXA(KIND).EQ.0) GOTO 60
        IXA(KIND) = NIX
        IF (KIND.NE.KINXYZ) GOTO 40
        NIX = NIX + 3 * MXNP
        GOTO 60
  40    IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
          WRITE (NFLOG,2010)
          GOTO 800
  50    NIX = NIX + MXNP * NDOF
  60    CONTINUE
      N18 = NIX
      I18 = N18 * ISURL
C
  70  I20 = I18
      IF (NUMMAX.EQ.0) GOTO 80
      IXPLUS = (NUMMAX + 1) * NVAR
C                                                MAXVALUES
      I19 = I18 + IXPLUS * ISURL
C                                                MAX ID
      I20 = I19 + IXPLUS * 4
C                                                KINDHD
  80  I21 = I20 + NVAR * 3
      CALL SIZE (I21)
      IF (IERROR.NE.0) GOTO 900
C
C          INIT OF MAX ID
C
      IF (NUMMAX.EQ.0) GOTO 100
      DO 85 I=I19,I20
  85    IA(I) = 0
  100 CONTINUE
      ISNZON = 0
      ITSKIP = 0
      ISRSDC = 0
      ISIDRN = 0
      IREAD(KINXYZ) = 0
C
C          DO FOR ALL TIMESTEPS OF NODAL DATA
C
      DO 650 ITIME=1,NSTEN
C
      TIME = TIMEN(ITIME)
      IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
      IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
C
C          NTSKIP TIMESTEPS BETWEEN OUTPUT
C
      IF (ITIME.EQ.NSTEN) GOTO 120
      IF (TIMEN(ITIME+1).GT.TEND+EPSVAL) GOTO 120
      ITSKIP = ITSKIP - 1
      IF (ITSKIP.GE.0) GOTO 650
  120 ITSKIP = NTSKIP
      DO 125 KIND=1,4
  125   IREAD(KIND) = 0
C
C          DO FOR EVERY STRUCTURE, REUSE AND NODAL POINT
C
      IEJECT = 0
      ISTRUC = 0
      DO 640 ISTRI=1,NSTRI
      ISUBST = ISTRI - 1
      NRUSE = NRUSES(ISTRI)
      NUMNP = NUMNPS(ISTRI)
      DO 630 IRUSE=1,NRUSE
C
      ISTRUC = ISTRUC + 1
      LSTSUB = 1
      IF (IBITZ.EQ.IWHOLE) GOTO 130
      IF (ISNZON.EQ.ISTRUC) GOTO 130
        CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
        IF (IERROR.NE.0) GOTO 700
        ISNZON = ISTRUC
C
  130 DO 620 NP=1,NUMNP
C
C          CHECK IF IN SELECTED ZONE
C
      IF (IBITZ.EQ.IWHOLE) GOTO 200
        CALL BITGET (NZONE(NP),IBITZ,ISELEC)
        IF (ISELEC.EQ.0) GOTO 620
C
C          READ VARIABLE VALUES FROM DATABASE
C
  200 IVPLUS = (NP - 1) * NDOF - 1
      DO 290 IVAR=1,IVAEND
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 290
        IXAKIN = IXA(KIND)
        NDIR = NDIRV(IVAR)
        IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
        IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
            WRITE (NFLOG,2210)
            GOTO 800
  210     IF (KIND.NE.KINXYZ)
     1    CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
          IF (KIND.EQ.KINXYZ)
     1    CALL DBREAD (A(IXAKIN),KXYZ,ISTRUC,0)
          IF (IERROR.NE.0) GOTO 700
        IREAD(KIND) = ISTRUC
C
C          TEMPERATURE
C
  220 IF (KIND.NE.KINDT) GOTO 225
        VALUEV(IVAR) = A(IXAKIN+NP-1)
        GOTO 290
C
C          XYZ
C
  225 IF (KIND.NE.KINXYZ) GOTO 230
        IXW = IXAKIN + (NDIR - 1) * NUMNP  +  NP - 1
        VALUEV(IVAR) = A(IXW)
        GOTO 290
C
C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
C
  230 IXW = IXAKIN + IVPLUS
      DO 250 I=1,6
        VDIR(I) = 0.0
        INDOF = NDOFSA(I)
        IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  250   CONTINUE
C
C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
C
      IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 285
      IF (ISIDRN.NE.ISTRI)
     1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
        ISIDRN = ISTRI
      IXNRST = NDOF * NUMNP
      ISKEW = IDRN(IXNRST+NP)
      IF (ISKEW.LE.0) GOTO 285
      IF (ISRSDC.EQ.0)
     1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
        IF (IERROR.NE.0) GOTO 900
        ISRSDC = 1
      CALL SKEW (VDIR,RSDCOS(1,ISKEW))
C
  285 VALUEV(IVAR) = VDIR(NDIR)
  290   CONTINUE
C
C          EXECUTE RESULTANT COMPUTATION
C
      IF (ICALL.NE.ICALLR) GOTO 300
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 700
C
C          EXCEED
C
  300 IF (MAXTYP.EQ.0) GOTO 500
      IF (NUMMAX.GT.0) GOTO 400
C
      DO 390 IVAR=1,NVAR
        GOTO (340,350,360), MAXTYP
  340   IF (ABS(VALUEV(IVAR)).GE.VALMAX) GOTO 500
        GOTO 390
  350   IF (VALUEV(IVAR).GE.VALMAX) GOTO 500
        GOTO 390
  360   IF (VALUEV(IVAR).LE.VALMAX) GOTO 500
  390   CONTINUE
      GOTO 620
C
C          MAXVALUES ARE STORED FOR EACH SELECTED VARIABLE:
C          VALUE, ITIME, ISTRI, IRUSE, NP
C
  400 DO 490 IVAR=1,NVAR
C
      IIPLUS = (NUMMAX + 1) * IVAR - 2
      NIX = N18 + IIPLUS
      IIX = I19 + IIPLUS
C
C          LOOP NUMMAX TIMES
C
      DO 465 IMAX=1,NUMMAX
      IF (IA(IIX).EQ.0) GOTO 450
      VALUE  = VALUEV(IVAR)
      VALUEA = A(NIX)
      GOTO (410,440,430), MAXTYP
  410 VALUE  = ABS(VALUE)
      VALUEA = ABS(VALUEA)
      GOTO 440
  430 VALUE  = - VALUE
      VALUEA = - VALUEA
C
  440 IF (VALUEA.GE.VALUE) GOTO 470
C
C          MAKE PLACE FOR NEW VALUE
C
  450 A(NIX+1) = A(NIX)
      J = IIX
      DO 460 I=1,4
        IA(J+1) = IA(J)
  460   J = J + IXPLUS
C
      NIX = NIX - 1
      IIX = IIX - 1
  465 CONTINUE
C
C          MOVE NEW VALUE TO ARRAY
C
  470 A(NIX+1) = VALUEV(IVAR)
      IIX = IIX + 1
      IA(IIX) = ITIME
      J = IIX + IXPLUS
      IA(J) = ISUBST
      J = J + IXPLUS
      IA(J) = IRUSE
      J = J + IXPLUS
      IA(J) = NP
C
  490 CONTINUE
      GOTO 620
C
C          LIST
C
  500 IF (LINE.LE.LINPAG) GOTO 505
      LINE = -1
      IEJECT = 1
  505 IF (IEJECT.LT.0) GOTO 510
      LINE = LINE + 10
      IF (LINE.GT.LINPAG) GOTO 500
      LINE = LINE - 7
      WRITE (NFLIST,2045)
      IF (IBITZ.EQ.IWHOLE)
     1  WRITE (NFLIST,2020) IEJECT,TIME,NSTEPN(ITIME)
      IF (IBITZ.NE.IWHOLE)
     1  WRITE (NFLIST,2021) IEJECT,NAMZON,TIME,NSTEPN(ITIME)
      LSTSUB = 1
      LSTDET = 1
      IF (IEJECT.LT.1) GOTO 510
      IF (NSKEWS.EQ.0) GOTO 507
        IF (LSKEW.NE.1) WRITE (NFLIST,2550)
        IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
        LINE = LINE + 2
  507 IF (MAXTYP.EQ.0) GOTO 510
        WRITE (NFLIST,2570) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4),VALMAX
        LINE = LINE + 2
C
  510 IEJECT = -1
      IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 520
      LINE = LINE + 5
      IF (LINE.GT.LINPAG) GOTO 500
      LINE = LINE - 3
      WRITE (NFLIST,2345) ISUBST, IRUSE
      LSTSUB = 0
      LSTDET = 1
C
  520 IF (LSTDET.EQ.0) GOTO 530
      LINE = LINE + 3
      IF (LINE.GT.LINPAG) GOTO 500
      DO 525 IVAR=1,NVAR
        I = I20 + (IVAR - 1) * 3
        CALL KINDN (NDIRV(IVAR),KINDV(IVAR),IA(I))
  525   CONTINUE
      I20END = I20 + (NVAR * 3) - 1
      IF(ICALL.NE.ICALLR) WRITE (NFLIST,2040) (IA(J),J=I20,I20END)
      IF (ICALL.EQ.ICALLR)
     1  WRITE (NFLIST,2041) (IA(J),J=I20,I20END),NAMERC
      WRITE (NFLIST,2045)
      LSTDET = 0
      GOTO 500
  530 WRITE (NFLIST,2050) NP,(VALUEV(IVAR),IVAR=1,NVAR)
      LINE = LINE + 1
      ILIST = 1
C
  620 CONTINUE
  630 CONTINUE
  640 CONTINUE
  650 CONTINUE
C
C          MAX LIST
C
      IF (NUMMAX.EQ.0) GOTO 700
C
      DO 690 IVAR=1,NVAR
      IIPLUS = (IVAR - 1) * (NUMMAX + 1) - 1
      NIX = N18 + IIPLUS
      IIX = I19 + IIPLUS
      LSTDET = 1
        DO 680 IMAX=1,NUMMAX
          ITIME = IA(IIX+IMAX)
          IF (ITIME.EQ.0) GOTO 690
          VALUE = A(NIX+IMAX)
          J = IIX + IMAX + IXPLUS
          ISUBST = IA(J)
          J = J + IXPLUS
          IRUSE = IA(J)
          J = J + IXPLUS
          NP = IA(J)
C
  652    IF (LINE.LE.LINPAG) GOTO 655
          LSTDET = 1
            IF (IBITZ.EQ.IWHOLE)  WRITE (NFLIST,2060)
            IF (IBITZ.NE.IWHOLE)  WRITE (NFLIST,2061) NAMZON
            WRITE (NFLIST,2065) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
            LINE = 4
          IF (NSKEWS.EQ.0) GOTO 655
            IF (LSKEW.NE.1) WRITE (NFLIST,2550)
            IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
           LINE = LINE + 2
  655     IF (LSTDET.EQ.0) GOTO 660
            LSTDET = 0
            LINE = LINE + 3
            IF (LINE.GT.LINPAG) GOTO 652
           CALL KINDN (NDIRV(IVAR),KINDV(IVAR),IA(I20))
           I20END = I20 + 2
           WRITE (NFLIST,2070) (IA(I),I=I20,I20END), NAMERC
  660     WRITE (NFLIST,2080) VALUE,NP,TIMEN(ITIME),NSTEPN(ITIME),
     1                     ISUBST,IRUSE
          LINE = LINE + 1
          ILIST = 1
  680     CONTINUE
  690   CONTINUE
C
  700 IF (ILIST.EQ.0) WRITE (NFLOG,2700)
      GOTO 900
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
 2000 FORMAT (43H ***ERROR: NO TIMESTEP FOR NODAL DATA FOUND)
 2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
 2020 FORMAT (I1,30HNODAL RESULTS FOR WHOLE MODEL ,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2021 FORMAT(I1,25HNODAL RESULTS FOR ZONE = ,8A1,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2040 FORMAT (/6H  NODE,8(6X,3A4))
 2041 FORMAT (/6H  NODE,6X,3A4,8A1)
 2045 FORMAT (1H )
 2050 FORMAT (1X,I5,8(6X,E12.6))
 2060 FORMAT(38H1EXTREME NODAL RESULTS FOR WHOLE MODEL)
 2061 FORMAT(34H1EXTREME NODAL RESULTS FOR ZONE = ,8A1)
 2065 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
     1  14H  SCANNED FOR ,4A4)
 2070 FORMAT (/4X,3A4,8A1,35H   NODE         TIME      STEP     ,
     1        29H   SUBSTRUCTURE   REUSE ID NO /)
 2080 FORMAT (4X,E12.6,7X,I7,8X,E10.4,I5,11X,I5,6X,I8)
 2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
 2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
 2550 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
     1  17HCOORDINATE SYSTEM)
 2551 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
     1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
 2570 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
     1  14H  SCANNED FOR ,4A4,18H VALUES EXCEEDING ,G12.6)
      END
C***ADD:CDC***
CDECK EINFO1
C***END:CDC***
      SUBROUTINE EINFO1
C
      DIMENSION IA(1)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /ERROR/ IERROR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
      CALL ZGETNB
      IF (IERROR.NE.0) GOTO 900
C
C                                                NPAR
      I2 = I1 + MXEG * NELPAR
C                                                EDATA
      I3 = I2 + MXEL * (ISURL + 2)
C                                                SXYZ
      I4 = I3 + MXIDER * 3 * ISURL
C                                                ITABLE
      I5 = I4 + MXITAB
C                                                IEZONE
      I6 = I5 + MXEL
C                                                NERPTS
      I7 = I6 + MXEL
C                                                IDERPT
      I8 = I7 + MXIDER
C                                                NOD
      I9 = I8 + MXELNP
C
      CALL SIZE (I9)
      IF (IERROR.NE.0) GOTO 900
C
      CALL EINFO2 (IA(I06),IA(I07),NELPAR,IA(I1),IA(I2),
     1  IA(I3),IA(I4),IA(I5),IA(I6),IA(I7),IA(I8))
C
  900 RETURN
      END
C***ADD:CDC***
CDECK EINFO2
C***END:CDC***
      SUBROUTINE EINFO2 (NRUSES,NEGS,NPARD,NPAR,EDATA,
     1           SXYZ,ITABLE,IEZONE,NERPTS,IDERPT,NOD)
C
      DIMENSION NRUSES(1),NEGS(1),NPAR(NPARD,1),EDATA(1),
     1          SXYZ(3,1),ITABLE(1),IEZONE(1),NERPTS(1),
     2         IDERPT(1),NOD(1),MXNODA(15)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
C
      DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
      DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
      DATA I2DIMF,I3DIMF/11,12/
      DATA ISPACE/1H /
C
CCCCCCCCCCCC    LIST OF ELEMENT NODES
C
      IF (INTV(2).NE.1) GOTO 200
      IEGIT = 0
      IEGAT = 0
C
      DO 190 ISTRI=1,NSTRI
      CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
      NRUSE = NRUSES(ISTRI)
      NEG   = NEGS  (ISTRI)
C
      DO 180 IRUSE=1,NRUSE
C
      DO 170 IEG=1,NEG
      LSTEG = 1
      IEGIT = IEGIT + 1
      IEGAT = IEGAT + 1
      IF (IBITZ.EQ.IWHOLE .AND. IRUSE.GT.1) GOTO 170
      IF (IBITZ.NE.IWHOLE)  CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
      CALL DBREAD (NOD,KNOD,IEGIT,0)
      IF (IERROR.NE.0) GOTO 900
C
      IELTYP = NPAR(1,IEG)
      NEL    = NPAR(2,IEG)
      MXNODS = MXNODA(IELTYP)
C
      DO 160 IEL=1,NEL
      IF (IBITZ.EQ.IWHOLE) GOTO 100
      CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
      IF (ISELEC.EQ.0) GOTO 160
C
  100 IF (LINE.LE.LINPAG) GOTO 110
      IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2000)
      IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2001) NAMZON
      LINE = 2
      LSTEG = 1
C
  110 IF (LSTEG.EQ.0) GOTO 150
      LSTEG = 0
      LINE = LINE + 6
      IF (ISTRI.GT.1) LINE = LINE + 2
      IF (LINE2.GT.0) LINE = LINE + 1
      IF (LINE.GT.LINPAG) GOTO 100
      ISUBST = ISTRI - 1
      IF (ISTRI.GT.1) WRITE (NFLIST,2345) ISUBST, IRUSE
      WRITE (NFLIST,2010) IEG
      WRITE (NFLIST,2020)
C
      IF (IELTYP.EQ.IBEAM) GOTO 120
      IF (IELTYP.EQ.ISOBEA) GOTO 130
      WRITE (NFLIST,2030) (ISPACE,I,I=1,MXNODS)
      GOTO 140
  120 WRITE (NFLIST,2031)
      GOTO 140
  130 WRITE (NFLIST,2032)
  140 WRITE (NFLIST,2040)
C
  150 IF (MXNODS.GT.16) LINE = LINE + 1
      IF (LINE.GT.LINPAG) GOTO 100
      LINE = LINE + 1
      IXNOD2 = MXNODS * IEL
      IXNOD1 = IXNOD2 - MXNODS + 1
      WRITE (NFLIST,2050) IEL,(NOD(I),I=IXNOD1,IXNOD2)
C
  160 CONTINUE
  170 CONTINUE
      IEGIT = IEGIT - NEG
  180 CONTINUE
      IEGIT = IEGIT + NEG
  190 CONTINUE
C
C
CCCCCCCC    LIST COORDINATES OF ELEMENT RESULT POINTS
C
C
  200 IF (INTV(3).NE.1) GOTO 900
      LINE = 999
      IEGIT = 0
      IEGAT = 0
      ISEGIT = 0
C
      DO 390 ISTRI=1,NSTRI
      CALL DBREAD (NPAR,KNPAR,ISTRI,0)
      IF (IERROR.NE.0) GOTO 900
      NRUSE = NRUSES(ISTRI)
      NEG   = NEGS  (ISTRI)
C
      DO 380 IRUSE=1,NRUSE
C
      DO 370 IEG=1,NEG
      LSTEG = 1
      IEGIT = IEGIT + 1
      IEGAT = IEGAT + 1
      IF (IBITZ.NE.IWHOLE) CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
      IELTYP = NPAR(1,IEG)
      NEL    = NPAR(2,IEG)
      INDNL  = NPAR(3,IEG)
      NTABLE = NPAR(13,IEG)
C
      CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NEL+1),ITABLE,
     1  NTABLE,IEGIT,ISEGIT,0.,NERPTS,IDERPT,NERES,NERKI,LOCALE)
      IF (IERROR.NE.0) GOTO 900
      IF (NERES.EQ.0) GOTO 250
C
      CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
      IF (IERROR.NE.0) GOTO 900
      IXIDER = 0
C
  250 DO 360 IEL=1,NEL
      ISELEC = 1
      IF (IBITZ.NE.IWHOLE)
     1  CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
      NERPT = 1
      IF (NERES.GT.0) NERPT = NERPTS(IEL)
      IF (NERPT.EQ.0) GOTO 360
C
      DO 350 IERPT=1,NERPT
      IF (NERES.EQ.0) GOTO 300
      IXIDER = IXIDER + 1
      IDERES = IABS(IDERPT(IXIDER))
      IF (ISELEC.EQ.0) GOTO 350
      IF (IELTYP.EQ.ISOBEA .AND.
     1     SXYZ(1,IXIDER).EQ.987654E32) GOTO 350
C
  300 IF (LINE.LE.LINPAG) GOTO 310
      IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2000)
      IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2001) NAMZON
      LINE = 2
      LSTEG = 1
C
  310 IF (LSTEG.EQ.0) GOTO 345
      LSTEG = 0
      LINE = LINE + 8
      IF (ISTRI.GT.1) LINE = LINE + 2
      IF (LINE.GT.LINPAG) GOTO 300
      ISUBST = ISTRI - 1
      IF (ISTRI.GT.1) WRITE (NFLIST,2345) ISUBST, IRUSE
      WRITE (NFLIST,2010) IEG
C
      IF (NERES.GT.0) GOTO 305
      WRITE (NFLIST,2090)
      GOTO 370
C
  305 IF (NTABLE.GT.0) GOTO 320
      IF (IELTYP.EQ.IBEAM .AND.
     1    (NTABLE.LT.0 .OR. INDNL.EQ.0)) GOTO 330
      IF (IELTYP.EQ.ISOBEA .AND. NTABLE.LT.0) GOTO 330
      IF (IELTYP.EQ.ITRUSS .AND. NPAR(5,IEG).EQ.1) GOTO 330
      WRITE (NFLIST,2060)
      GOTO 340
  320 WRITE (NFLIST,2061)
      GOTO 340
  330 WRITE (NFLIST,2062)
C
  340 WRITE (NFLIST,2070)
C
  345 LINE = LINE + 1
      IF (SXYZ(1,IXIDER).EQ.987654E32) GOTO 346
      WRITE (NFLIST,2080) IEL,IDERES,(SXYZ(I,IXIDER),I=1,3)
      GOTO 350
  346 WRITE (NFLIST,2081) IEL,IDERES
C
  350 CONTINUE
  360 CONTINUE
  370 CONTINUE
      IEGIT = IEGIT - NEG
  380 CONTINUE
      IEGIT = IEGIT + NEG
  390 CONTINUE
C
  900 RETURN
C
 2000 FORMAT(36H1ELEMENT INFORMATION FOR WHOLE MODEL)
 2001 FORMAT(30H1ELEMENT INFORMATION FOR ZONE=,8A1)
 2010 FORMAT(/19H ELEMENT GROUP NO =,I3)
 2020 FORMAT(/25H ELEMENT    ELEMENT NODES)
 2030 FORMAT(10X,16(A1,1H(,I2,2H) )/10X,16(A1,1H(,I2,2H) ))
 2031 FORMAT(10X,16H ( 1)  ( 2)  AUX)
 2032 FORMAT(10X,28H ( 1)  ( 2)  ( 3)  ( 4)  AUX)
 2040 FORMAT (1H )
 2050 FORMAT(1X,I5,2X,16I6/8X,16I6)
 2060 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
     1  25HINTEGRATION POINT NUMBERS)
 2061 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
     1  27HSTRESS OUTPUT TABLE NUMBERS)
 2062 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
     1  27HELEMENT NODAL POINT NUMBERS)
 2070 FORMAT(/50H ELEMENT  POINT     GLOBAL COORDINATES OF INITIAL ,
     1  23HUNDEFORMED RESULT POINT/
     2  3X,2HNO,7X,2HNO,11X,1HX,18X,1HY,18X,1HZ/)
 2080 FORMAT(1X,I4,I9,3(6X,E12.6))
 2081 FORMAT(1X,I4,I9,6X,26HCOORDINATES NOT CALCULATED)
 2090 FORMAT(//40H *** ADINA ELEMENT SAVE PARAMETER (IPS)  ,
     1  24HIS ZERO FOR ALL ELEMENTS///)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
      END
C***ADD:CDC***
CDECK ELIST1
C***END:CDC***
      SUBROUTINE ELIST1
C
      DIMENSION IA(1),VALUEV(20)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /ERROR/ IERROR
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
C
C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
C
      CALL ZGETNB
        IF (IERROR.NE.0) GOTO 900
C
C          BLANK COMMON LAYOUT
C
C                                                TIMEE
      I12 = I1 + NSTEE * ISURL
C                                                NSTEPE
      I13 = I12 + NSTEE
      CALL ALIGN (I13)
C                                                NPAR
      I14 = I13 + NELPAR * MXEG
C                                                EDATA
      I15 = I14 + (ISURL + 2) * MXEL
C                                                ITABLE
      I16 = I15 + MXITAB
C                                                IEZONE
      I17 = I16 + MXEL
      IF (IBITZ.EQ.IWHOLE) I17 = I16
C                                                ERES
      I18 = I17 + MXERES * ISURL
C                                                IXMAXA
      I19 = I18 + NEGAT * 9
C                                                NERPTS
      I20 = I19 + MXEL
C                                                IDERPT
      IXEND = I20 + MXIDER
      CALL SIZE (IXEND)
        IF (IERROR.NE.0) GOTO 900
C
      ICALL = 1
      IXPAR = 2
C
      CALL ELIST2 (VALUEV,I,IA(I20),IA(I20),
     1  IA(I1),IA(I12),IA(I13),NELPAR,IA(I14),IA(I15),IA(I16),
     2  IA(I17),IA(I18),IA(I19),IA(I20),IXEND,IA(I06),IA(I07))
C
  900 RETURN
      END
C***ADD:CDC***
CDECK ELIST2
C***END:CDC***
      SUBROUTINE ELIST2 (VALUEV,IETYP,KINDV,IRPOL,
     1     TIMEE,NSTEPE,NPAR,NPARD,ETIME,ITABLE,IEZONE,
     2     ERES,IXMAXA,NERPTS,IDERPT,IXEND,NRUSES,NEGS)
C
      DIMENSION IA(1),VALUEV(1),KINDV(1),IRPOL(1),TIMEE(1),
     2        NSTEPE(1),NPAR(NPARD,1),ETIME(1),ITABLE(1),NERPTS(1),
     3        IEZONE(1),ERES(1),NRUSES(1),NEGS(1),IDERPT(1),NERKIS(15),
     4        IHDMAX(4,3),IHDMX2(12),IXMAXA(9,1),IHDKIN(36),IHDTYP(45)
C
      COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
      COMMON /EPS/ EPS
      COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
      COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
     1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
      COMMON /ERROR/ IERROR
      COMMON /CALLP/ NAMZON(8),NAMERC(8),
     1               IBITZ,IWHOLE,ICALL,IXPAR
      COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
     1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
     2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
      COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
     1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
     2             IXGP(50),MXSGP(50),
     3             FILL1
      COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
     1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
     2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
     3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
     4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
     5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
     6                NDOFSA(6),NOUSE(4),FILL2
      COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
     1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
     2             I16,I17,I18,I19,I20,
     3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
     4             N16,N17,N18,N19,N20
      COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
     1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
     2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
     3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
     4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
     5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
     6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
     7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
     8                KX49  ,KX50
      COMMON A(1)
      EQUIVALENCE (A(1),IA(1))
      EQUIVALENCE (IHDMAX(1,1),IHDMX2(1))
C
      DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
      DATA I2DIMF,I3DIMF/11,12/
      DATA IHDMX2/
     1 4HABSO,4HLUTE,4H MAX,4HIMUM,
     2 4HMAXI,4HMUM ,4H    ,4H    ,
     3 4HMINI,4HMUM ,4H    ,4H    /
      DATA ICALLS,ICALLR/1,2/
      DATA KELIST,KEMAX,KRLIST,KRMAX/31,34,42,43/
C
      DATA NERKIS/2,4,6,6,6,6,6,0,0,0,1,1,0,0,0/
C
      DATA IHDTYP/
     1  4HTRUS,4HS)  ,4H    ,4H2-D ,4HSOLI,4HD)  ,
     2  4H3-D ,4HSOLI,4HD)  ,4HBEAM,4H)   ,4H    ,
     3  4HISO-,4HBEAM,4H)   ,4HPLAT,4HE/SH,4HELL),
     4  4HSHEL,4HL)  ,4H    ,4H    ,4H    ,4H    ,
     5  4H    ,4H    ,4H    ,4H    ,4H    ,4H    ,
     6  4H2-D ,4HFLUI,4HD)  ,4H3-D ,4HFLUI,4HD)  ,
     7  4H    ,4H    ,4H    ,4H    ,4H    ,4H    ,
     8  4H    ,4H    ,4H    /
C
C
      ILIST = 0
C
C          READ TIMEE, NSTEPE
C
      IF (NSTEE.GT.0) GOTO 2
        WRITE (NFLOG,2000)
        GOTO 800
  2   CALL DBREAD (TIMEE,KTIMEE,1,0)
      IF (IERROR.NE.0) GOTO 900
C
C          PARAM : STRAIN
C
      ISTRAN = INTV(6)
      IF (NCMD.EQ.KELIST) ISTRAN = INTV(5)
C
C          PARAM : TSTART, TEND
C
      TSTA = REALV(IXPAR)
      TEND = REALV(IXPAR+1)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEE(NSTEE)
        IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTA
      EPSVAL = DT * EPS
C
C          PARAM : NTSKIP
C                  MAXTYPE, NUMMAX
C                  MAXTYPE, VALUE
C
      NTSKIP = 0
      MAXTYP = 0
      NUMMAX = 0
      IF (NCMD.NE.KELIST .AND. NCMD.NE.KRLIST) GOTO 5
        NTSKIP = INTV(IXPAR+2)
        IF (NTSKIP.LT.0) GOTO 850
        GOTO 10
  5   MAXTYP = INTV(IXPAR+2)
      IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEE(1)
      IF (ITYPE(IXPAR+2).EQ.IOMIT) MAXTYP = 1
      IF (MAXTYP.LT.1 .OR. MAXTYP.GT.3) GOTO 850
      IF (NCMD.NE.KEMAX .AND. NCMD.NE.KRMAX) GOTO 7
        NUMMAX = INTV(IXPAR+3)
        IF (ITYPE(IXPAR+3).EQ.IOMIT) NUMMAX = 1
        IF (NUMMAX.LT.1) GOTO 850
        GOTO 10
  7   VALMAX = REALV(IXPAR+3)
C
C          INITIATE MAX VALUES STORAGE POINTER ARRAY
C
  10  DO 110 IEGAT=1,NEGAT
  110     IXMAXA(1,IEGAT) = 0
      ISEZON = 0
      ISNPAR = 0
      ISEDAT = 0
      ITSKIP = 0
C
C          DO FOR ALL TIMESTEPS OF ELEMENT RESULT
C
      DO 650 ITIME=1,NSTEE
C
      TIME = TIMEE(ITIME)
      IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
      IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
C
C          NTSKIP TIMESTEPS BETWEEN OUTPUT
C
      IF (ITIME.EQ.NSTEE) GOTO 120
      IF (TIMEE(ITIME+1).GT.TEND+EPSVAL) GOTO 120
      ITSKIP = ITSKIP - 1
      IF (ITSKIP.GE.0) GOTO 650
  120 ITSKIP = NTSKIP
C
C          DO FOR EVERY STRUCTURE, REUSE
C
      IEJECT = 0
      ISTRUC = 0
      IEGIT = 0
      IEGAT = 0
      ISERES = 0
      DO 640 ISTRI=1,NSTRI
      ISUBST = ISTRI - 1
      NRUSE = NRUSES(ISTRI)
      NEG   = NEGS  (ISTRI)
C
C          READ NPAR
C
      IF (ISNPAR.EQ.ISTRI) GOTO 125
        ISNPAR = ISTRI
        CALL DBREAD (NPAR,KNPAR,ISTRI,0)
        IF (IERROR.NE.0) GOTO 900
C
  125 DO 630 IRUSE=1,NRUSE
C
      ISTRUC = ISTRUC + 1
      LSTSUB = 1
C
C          DO FOR ALL ELEMENT GROUPS
C
      DO 620 IEG=1,NEG
C
      IEGIT = IEGIT + 1
      IEGAT = IEGAT + 1
      LSTIEG = 1
      IELTYP = NPAR(1,IEG)
      NUME   = NPAR(2,IEG)
      INDNL  = NPAR(3,IEG)
      NTABLE = NPAR(13,IEG)
      IF (ICALL.EQ.ICALLR .AND. IELTYP.NE.IETYP) GOTO 620
C
C          UPDATE NERPTS,IDERPT ARRAYS AND NERES, NERKI
C
      CALL ELRES (1,NPAR(1,IEG),ETIME,ETIME(NUME+1),
     1  ITABLE,NTABLE,IEGIT,ISEDAT,TIME,NERPTS,IDERPT,
     2  NERES,NERKI,LOCALE)
      IF (IERROR.NE.0) GOTO 900
      IF (NERES.EQ.0) GOTO 620
C
C          CHECK IF STRAINS ARE REQUESTED
C
      NVAR = NERKI
      IF (ISTRAN.EQ.1) GOTO 130
      NVAR = NERKIS(IELTYP)
      IF (IELTYP.EQ.IBEAM .AND. INDNL.GT.0) NVAR = 3
      IF (IELTYP.EQ.ISOBEA .AND. NTABLE.GE.0) NVAR = 3
  130 IF (ICALL.EQ.ICALLR) NVAR = 1
C
C          DO FOR ALL ELEMENTS IN GROUP
C
      IXIDER = 0
      IXERES = -NERKI
C
      DO 610 IEL=1,NUME
C
      NERPT = NERPTS(IEL)
      IF (NERPT.EQ.0) GOTO 610
C
C          DO FOR ALL ELEMENT RESULT POINTS
C
      DO 600 IERPT=1,NERPT
C
      IXIDER = IXIDER + 1
      IXERES = IXERES + NERKI
      IDERES = IDERPT(IXIDER)
C
C          CHECK THAT ELEMENT BELONGS TO ZONE
C
      IF (IBITZ.EQ.IWHOLE) GOTO 150
      IF (ISEZON.EQ.IEGAT) GOTO 140
        ISEZON = IEGAT
        CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
        IF (IERROR.NE.0) GOTO 900
  140 IF (IERPT.EQ.1) CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
      IF (ISELEC.EQ.0) GOTO 600
C
C          TEST FOR UNBORN OR DEAD ELEMENT
C
  150 IF (IDERES.GE.0) GOTO 155
      IF (MAXTYP.NE.0 .OR. IERPT.GT.1) GOTO 600
      GOTO 500
C
C          READ ERES
C
  155 IF (ISERES.EQ.IEGAT) GOTO 160
      ISERES = IEGAT
      CALL DBREAD (ERES,KERES,IEGAT,ITIME)
      IF (IERROR.NE.0) GOTO 900
C
C          GET ELEMENT RESULT VALUES
C
  160 IF (ERES(IXERES+1).EQ.987654E32) GOTO 600
      IF (ICALL.EQ.ICALLR) GOTO 180
      DO 170 IERKI=1,NERKI
  170   VALUEV(IERKI) = ERES(IXERES+IERKI)
      GOTO 300
C
C          EXECUTE RESULTANT COMPUTATION
C
  180 DO 190 IVAR=1,MVAR
        KIND = KINDV(IVAR)
        IF (KIND.EQ.0) GOTO 190
        IF (KIND.GT.NERKI) GOTO 620
  185   VALUEV(IVAR) = ERES(IXERES+KIND)
  190   CONTINUE
      CALL FORMEX (VALUEV,IRPOL)
      IF (IERROR.NE.0) GOTO 700
C
C          EXCEED
C
  300 IF (MAXTYP.EQ.0) GOTO 500
      IF (NUMMAX.GT.0) GOTO 400
C
      DO 390 IVAR=1,NVAR
        GOTO (340,350,360), MAXTYP
  340   IF (ABS(VALUEV(IVAR)).GE.VALMAX) GOTO 500
        GOTO 390
  350   IF (VALUEV(IVAR).GE.VALMAX) GOTO 500
        GOTO 390
  360   IF (VALUEV(IVAR).LE.VALMAX) GOTO 500
  390   CONTINUE
      GOTO 600
C
C
C          MAXVALUES ARE STORED FOR EACH ELEMENT GROUP AND KIND:
C          IXMAXA(1-8,IEG): IXMAX,ISTRI,IRUSE,IEG,IELTYP,INDNL,NTABLE
C                           NVAR,LOCALE
C          IA(IXMAX):       VALUE, ITIME, IEL, IDERES
C
C
  400 IXMAX = IXMAXA(1,IEGAT)
      IXPLUS = (NUMMAX + 1) * NVAR
      IF (IXMAX.GT.0) GOTO 403
C
C          GET BLANK COMMON AREA FOR MAXVALUES FOR EL GROUP
C
      IXMAX = IXEND
      IXMAXA(1,IEGAT) = IXMAX
      IXMAXA(2,IEGAT) = ISUBST
      IXMAXA(3,IEGAT) = IRUSE
      IXMAXA(4,IEGAT) = IEG
      IXMAXA(5,IEGAT) = IELTYP
      IXMAXA(6,IEGAT) = INDNL
      IXMAXA(7,IEGAT) = NTABLE
      IXMAXA(8,IEGAT) = NVAR
      IXMAXA(9,IEGAT) = LOCALE
      IXEND = IXEND + IXPLUS * (ISURL + 3)
      CALL SIZE (IXEND)
      IF (IERROR.NE.0) GOTO 900
      DO 402 I=IXMAX,IXEND
  402   IA(I) = 0
C
  403 NIXSTA = IXMAX / ISURL
      IIXSTA = IXMAX + IXPLUS * ISURL
C
C          SAVE MAXVALUES FOR EACH KIND OF VARIABLE
C
      DO 490 IVAR=1,NVAR
C
      IIPLUS = (NUMMAX + 1) * IVAR - 2
      NIX = NIXSTA + IIPLUS
      IIX = IIXSTA + IIPLUS
C
C          LOOP NUMMAX TIMES
C
      DO 465 IMAX=1,NUMMAX
      IF (IA(IIX).EQ.0) GOTO 450
      VALUE  = VALUEV(IVAR)
      VALUEA = A(NIX)
      GOTO (410,440,430), MAXTYP
  410 VALUE  = ABS(VALUE)
      VALUEA = ABS(VALUEA)
      GOTO 440
  430 VALUE  = - VALUE
      VALUEA = - VALUEA
C
  440 IF (VALUEA.GE.VALUE) GOTO 470
C
C          MAKE PLACE FOR NEW VALUE
C
  450 A(NIX+1) = A(NIX)
      J = IIX
      DO 460 I=1,3
        IA(J+1) = IA(J)
  460   J = J + IXPLUS
C
      NIX = NIX - 1
      IIX = IIX - 1
  465 CONTINUE
C
C          MOVE NEW VALUE TO ARRAY
C
  470 A(NIX+1) = VALUEV(IVAR)
      IIX = IIX + 1
      IA(IIX) = ITIME
      J = IIX + IXPLUS
      IA(J) = IEL
      J = J + IXPLUS
      IA(J) = IDERES
C
  490 CONTINUE
      GOTO 600
C
C
C          LIST
C
C
  500 IF (LINE.LE.LINPAG) GOTO 505
      LINE = -1
      IEJECT = 1
  505 IF (IEJECT.LT.0) GOTO 510
      LINE = LINE + 10
      IF (LINE.GT.LINPAG) GOTO 500
      LINE = LINE - 7
      WRITE (NFLIST,2045)
      IF (IBITZ.EQ.IWHOLE)
     1  WRITE (NFLIST,2020) IEJECT,TIME,NSTEPE(ITIME)
      IF (IBITZ.NE.IWHOLE)
     1  WRITE (NFLIST,2021) IEJECT,NAMZON,TIME,NSTEPE(ITIME)
      LSTSUB = 1
      LSTIEG = 1
      IF (IEJECT.LT.1) GOTO 510
      IF (MAXTYP.EQ.0) GOTO 510
        WRITE (NFLIST,2570) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
     1        ,VALMAX
        LINE = LINE + 2
C
  510 IEJECT = -1
      IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 515
      LINE = LINE + 7
      IF (LINE.GT.LINPAG) GOTO 500
      LINE = LINE - 5
      WRITE (NFLIST,2345) ISUBST, IRUSE
      LSTSUB = 0
      LSTIEG = 1
C
  515 IF (LSTIEG.EQ.0) GOTO 530
      LINE = LINE + 5
      IF (NVAR.GT.7) LINE = LINE + 1
      IF (LINE.GT.LINPAG) GOTO 500
      LSTIEG = 0
      LSTDET = 1
      J = 1 + (IELTYP - 1) * 3
      K = J + 2
      IF (LOCALE.EQ.0)
     1  WRITE (NFLIST,2035) IEG,(IHDTYP(I),I=J,K)
      IF (LOCALE.EQ.1)
     1  WRITE (NFLIST,2036) IEG,(IHDTYP(I),I=J,K)
C
      IF (ICALL.EQ.ICALLR) GOTO 528
      DO 525 IVAR=1,NVAR
        I = 1 + (IVAR - 1) * 3
        CALL KINDE (IELTYP,INDNL,NTABLE,IVAR,IHDKIN(I))
  525   CONTINUE
      J = NVAR
      IF (NVAR.GT.7) J = (NVAR + 1) / 2
      J = J * 3
      WRITE (NFLIST,2040) (IHDKIN(I),I=1,J)
      IF (NVAR.LE.7) GOTO 529
      J = J + 1
      K = NVAR * 3
      WRITE (NFLIST,2042) (IHDKIN(I),I=J,K)
      GOTO 529
C
  528 WRITE (NFLIST,2041) NAMERC
C
  529 WRITE (NFLIST,2045)
C
  530 IF (IDERES.LT.0) GOTO 545
      IF (NVAR.GT.7) GOTO 540
      WRITE (NFLIST,2050) IEL,IDERES,(VALUEV(I),I=1,NVAR)
      GOTO 550
C
  540 LINE = LINE + 2
      IF (LINE.GT.LINPAG) GOTO 500
      J = (NVAR + 1) / 2
      WRITE (NFLIST,2050) IEL,IDERES,(VALUEV(I),I=1,J)
      J = J + 1
      WRITE (NFLIST,2051) (VALUEV(I),I=J,NVAR)
      WRITE (NFLIST,2045)
      GOTO 550
C
  545 WRITE (NFLIST,2055) IEL, IDERES
  550 LINE = LINE + 1
      ILIST = 1
C
C
  600 CONTINUE
  610 CONTINUE
  620 CONTINUE
      IEGIT = IEGIT - NEG
  630 CONTINUE
      IEGIT = IEGIT + NEG
  640 CONTINUE
  650 CONTINUE
C
C          MAX LIST
C
      IF (NUMMAX.EQ.0) GOTO 700
C
      DO 695 IEGAT=1,NEGAT
C
      IXMAX = IXMAXA(1,IEGAT)
      IF (IXMAX.EQ.0) GOTO 695
      LINE = 9999
      ISUBST = IXMAXA(2,IEGAT)
      IRUSE = IXMAXA(3,IEGAT)
      IEG   = IXMAXA(4,IEGAT)
      IELTYP = IXMAXA(5,IEGAT)
      INDNL  = IXMAXA(6,IEGAT)
      NTABLE = IXMAXA(7,IEGAT)
      NVAR   = IXMAXA(8,IEGAT)
      LOCALE = IXMAXA(9,IEGAT)
      IXPLUS = (NUMMAX + 1) * NVAR
      NIXSTA = IXMAX / ISURL
      IIXSTA = IXMAX + IXPLUS * ISURL
C
C
      DO 690 IVAR=1,NVAR
      LSTDET = 1
      IIPLUS = (IVAR - 1) * (NUMMAX + 1) - 1
      NIX = NIXSTA + IIPLUS
      IIX = IIXSTA + IIPLUS
        DO 680 IMAX=1,NUMMAX
          ITIME = IA(IIX+IMAX)
          IF (ITIME.EQ.0) GOTO 690
          VALUE = A(NIX+IMAX)
          J = IIX + IMAX + IXPLUS
          IEL = IA(J)
          J = J + IXPLUS
          IDERES = IA(J)
C
  653    IF (LINE.LE.LINPAG) GOTO 654
           IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2060)
           IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2061) NAMZON
           WRITE (NFLIST,2065) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
           LINE = 4
           LSTIEG = 1
  654    IF (LSTIEG.EQ.0) GOTO 657
           LSTIEG = 0
           LSTDET = 1
        IF (ISUBST.EQ.0) GOTO 655
           LINE = LINE + 7
           IF (LINE.GT.LINPAG) GOTO 653
           LINE = LINE - 5
           WRITE (NFLIST,2345) ISUBST,IRUSE
C
  655      LINE = LINE + 5
           IF (LINE.GT.LINPAG) GOTO 653
           LINE = LINE - 3
          J = 1 + (IELTYP - 1) * 3
          K = J + 2
           IF (LOCALE.EQ.0) WRITE (NFLIST,2035) IEG,(IHDTYP(I),I=J,K)
           IF (LOCALE.EQ.1) WRITE (NFLIST,2036) IEG,(IHDTYP(I),I=J,K)
  657    IF (LSTDET.EQ.0) GOTO 660
           LSTDET = 0
           LINE = LINE + 3
           IF (LINE.GT.LINPAG) GOTO 653
           KIND = IVAR
           IF (ICALL.EQ.ICALLR) KIND = 0
           CALL KINDE (IELTYP,INDNL,NTABLE,KIND,IHDKIN)
           WRITE (NFLIST,2070) (IHDKIN(I),I=1,3),NAMERC
C
  660     WRITE (NFLIST,2080) VALUE,IEL,IDERES,
     1                   TIMEE(ITIME),NSTEPE(ITIME)
          LINE = LINE + 1
          ILIST = 1
  680     CONTINUE
  690   CONTINUE
  695 CONTINUE
C
  700 IF (ILIST.EQ.0) WRITE (NFLOG,2700)
      GOTO 900
C
  800 IERROR = 1
      GOTO 900
  850 IERROR = 2
  900 RETURN
C
 2000 FORMAT (40H ***ERROR: NO ELEMENT RESULT IN DATABASE)
 2020 FORMAT(I1,31HELEMENT RESULTS FOR WHOLE MODEL ,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2021 FORMAT(I1,27HELEMENT RESULTS FOR ZONE = ,8A1,
     1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
 2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
 2035 FORMAT(/19H ELEMENT GROUP NO =,I4,3H  (,3A4,7X,
     1  55HLISTED RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM)
 2036 FORMAT(/19H ELEMENT GROUP NO =,I4,3H  (,3A4,7X,
     1  56HLISTED RESULTS ARE MEASURED IN ELEMENT COORDINATE SYSTEM)
 2041 FORMAT (/14H ELEMENT POINT,3X,10HRESULTANT ,8A1)
 2040 FORMAT(/14H ELEMENT POINT,7(4X,3A4))
 2042 FORMAT(14X,7(4X,3A4))
 2045 FORMAT (1H )
 2050 FORMAT (1X,I4,I7,2X,7(4X,E12.6))
 2051 FORMAT(14X,7(4X,E12.6))
 2055 FORMAT(1X,I4,I7,4X,18HELEMENT NOT ACTIVE)
 2060 FORMAT(46H1EXTREME ELEMENT RESULTS PER ELEMENT GROUP FOR,
     1  12H WHOLE MODEL)
 2061 FORMAT(46H1EXTREME ELEMENT RESULTS PER ELEMENT GROUP FOR,
     1  8H ZONE = ,8A1)
 2065 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
     1  14H  SCANNED FOR ,4A4)
 2070 FORMAT(/4X,3A4,8A1,38H   ELEMENT  POINT       TIME      STEP/)
 2080 FORMAT(4X,E12.6,11X,I4,I8,4X,E11.5,I7)
 2570 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
     1  14H  SCANNED FOR ,4A4,18H VALUES EXCEEDING ,G12.6)
 2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
      END
