home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e001 / 1.ddi / TMP / ADPLOT2.FOR < prev    next >
Encoding:
Text File  |  1990-04-06  |  210.0 KB  |  6,560 lines
  1. C***ADD:CDC***
  2. CDECK TEXT
  3. C***END:CDC***
  4.       SUBROUTINE TEXT
  5. C
  6.       DIMENSION ISTRIV(1)
  7. C
  8.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  9.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  10.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  11.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  12.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  13.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  14.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  15.       COMMON /ERROR/ IERROR
  16. C
  17.       EQUIVALENCE (ISTRIV(1),IANUMV(1,5))
  18.       DATA IPLOFF,IPLON/4,5/
  19. C
  20. C          PARAM 1: NSUBF
  21. C
  22.       CALL SUBF (1)
  23.       IF (IERROR.NE.0) GOTO 900
  24. C
  25. C          PARAM 2,3,4,5:  XPT, YPT, ANGLE, TEXTSTRING
  26. C
  27.       XPT = REALV(2)
  28.       YPT = REALV(3)
  29.       IF (XPT.LT.0 .OR. XPT.GT.XPMAX) GOTO 100
  30.       IF (YPT.LT.0 .OR. YPT.GT.YPMAX) GOTO 100
  31.       GOTO 200
  32.   100   WRITE (NFLOG,2000)
  33.         GOTO 800
  34. C
  35.   200 ANGLE = REALV(4)
  36.       IF (LGHSTR.EQ.0) GOTO 850
  37.       CALL CGRAPH (IPLON)
  38.       DO 300 I=1,LGHSTR
  39.         ICHAR = ISTRIV(I)
  40.         CALL APCHAR(ICHAR)
  41.         CALL AGRAPH (XPT,YPT,HEIGHT,ICHAR,0.0,ANGLE,1,1)
  42.         XPT = 999.0
  43.         YPT = 999.0
  44.   300   CONTINUE
  45.       CALL CGRAPH (IPLOFF)
  46.       GOTO 900
  47.   800 IERROR = 1
  48.       GOTO 900
  49.   850 IERROR = 2
  50.   900 RETURN
  51.  2000 FORMAT (48H ***ERROR: XPT OR YPT NOT WITHIN SUBFRAME LIMITS)
  52.       END
  53. C***ADD:CDC***
  54. CDECK MESH1
  55. C***END:CDC***
  56.       SUBROUTINE MESH1
  57. C
  58.       DIMENSION IA(1)
  59. C
  60.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  61.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  62.       COMMON /ERROR/ IERROR
  63.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  64.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  65.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  66.      1               IBITZ,IWHOLE,ICALL,IXPAR
  67.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  68.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  69.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  70.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  71.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  72.      2             IXGP(50),MXSGP(50),
  73.      3             FILL1
  74.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  75.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  76.      2             I16,I17,I18,I19,I20,
  77.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  78.      4             N16,N17,N18,N19,N20
  79.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  80.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  81.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  82.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  83.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  84.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  85.      6                NDOFSA(6),NOUSE(4),FILL2
  86.       COMMON A(1)
  87.       EQUIVALENCE (A(1),IA(1))
  88.       DATA KMODE/19/
  89. C
  90. C          PARAM 1:ZONENAME
  91. C          GET ZONE BIT NUMBER(IBITZ), 0 = WHOLE MODEL
  92. C
  93.       CALL ZGETNB
  94.       IF (IERROR.NE.0) GOTO 900
  95. C
  96. C          PARAM 14: NSUBF
  97. C
  98.       CALL SUBF(15)
  99.       IF (IERROR.NE.0) GOTO 900
  100. C
  101. C          BLANK COMMON LAYOUT FOR NODE PLOT ARRAYS
  102. C          LENGTH = SUM OF NODE POINTS IN ALL REUSED STRUCTURES
  103. C
  104.       NODSUM = 0
  105. C
  106.       DO 100 ISTRI=1,NSTRI
  107.         NRUSE = IA(I06+ISTRI-1)
  108.         NUMNP = IA(I08+ISTRI-1)
  109.   100   NODSUM = NODSUM + NRUSE * NUMNP
  110. C
  111. C                                                XPLOT
  112.       N2 = N1 + NODSUM
  113. C                                                YPLOT
  114.       N3 = N2 + NODSUM
  115. C                                                XPLOTD
  116.       N4 = N3 + NODSUM
  117. C                                                YPLOTD
  118.       N5 = N4 + NODSUM
  119.       N6 = N5
  120.       N7 = N6
  121.       IF (NCMD.NE.KMODE) GOTO 200
  122. C                                                XPLOTR
  123.       N6 = N5 + NODSUM
  124. C                                                YPLOTR
  125.       N7 = N6 + NODSUM
  126. C
  127. C          BLANK COMMON AREAS FOR DATABASE NODE RECORDS
  128. C
  129. C                                                XYZ, DISP, PHI
  130.   200 N8 = N7 + MXNP * MAX0(3,NDOF)
  131. C                                                RSDCOS
  132.       I10 = (N8 + NSKEWS * 9) * ISURL
  133. C                                                NZONE
  134.       I11 = I10
  135.       IF (IBITZ.NE.IWHOLE) I11 = I10 + MXNP
  136. C                                                IDRN
  137.       I12 = I11
  138.       IF (NSKEWS.GT.0)  I12 = I11 + (NDOF + 2) * MXNP
  139. C
  140. C          BLANK COMMON AREAS FOR DATABASE ELEMENT RECORDS
  141. C
  142.       I13 = N7 * ISURL
  143. C                                                IEZONE
  144.       I14 = I13
  145.       IF (IBITZ.NE.IWHOLE) I14 = I13 + MXEL
  146. C                                                NPAR
  147.       I15 = I14 + NELPAR * MXEG
  148. C                                                NOD
  149.       I16 = I15 + MXELNP
  150. C
  151. C          TEMPORARY STORAGE FOR  TIMEN AND VIEW RECORDS
  152. C
  153. C                                                TIMEN
  154.       I19 = I1 + (ISURL + 1) * NSTEN
  155. C                                                VIEW
  156.       I20 = I1 + MVIEW * 9
  157. C
  158. C          MORE MEMORY MAY BE REQUESTED IN MESH2 AND PLOTL
  159.       I20 = MAX0(I12,I16,I19,I20)
  160.       CALL SIZE (I20)
  161.         IF (IERROR.NE.0) GOTO 900
  162. C
  163.       CALL MESH2 (A(N1),A(N2),A(N3),A(N4),A(N5),A(N6),
  164.      1            A(N7),A(N7),NDOF,A(N8),IA(I10),IA(I11),
  165.      2            IA(I13),IA(I14),NELPAR,IA(I15),
  166.      3            IA(I1),IA(I1),IA(I06),IA(I07),IA(I08),IA(I010))
  167. C
  168.   900 RETURN
  169.       END
  170. C***ADD:CDC***
  171. CDECK MESH2
  172. C***END:CDC***
  173.       SUBROUTINE MESH2 (XPLOT,YPLOT,XPLOTD,YPLOTD,XPLOTR,YPLOTR,
  174.      1                 XYZ,DISP,NDOFD,RSDCOS,NZONE,IDRN,
  175.      2                  IEZONE,NPAR,NPARD,NOD,
  176.      3                  VIEWDB,TIMEN,NRUSES,NEGS,NUMNPS,MAXMSS)
  177. C
  178.       DIMENSION IA(1),XPLOT(1),YPLOT(1),XPLOTD(1),YPLOTD(1),
  179.      -          XPLOTR(1),YPLOTR(1),
  180.      1          XYZ(1),DISP(NDOFD,1),RSDCOS(9,1),NZONE(1),IDRN(1),
  181.      2          IEZONE(1),NPAR(NPARD,1),NOD(1),MAXMSS(1),
  182.      3          TIMEN(1),VIEWDB(9,1),VIEWA(1),VIEWD(36),
  183.      4          NRUSES(1),NEGS(1),NUMNPS(1),VDIR(6)
  184.       DIMENSION IHDEFO(4),IHDTIM(7),IHDMOD(4),IHDORI(4),IHDEFM(5),
  185.      1          IHDGS(4),IHDDS(4),IHDMAX(4),IAXES(3),IHDREF(5)
  186.       DIMENSION LTRUSS(5),L2DIM(10),L3DIM(32),LBEAM(3),
  187.      1          LPLATE(5),MIDEL(15),MXNODA(15)
  188. C
  189.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  190.       COMMON /EPS/ EPS
  191.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  192.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  193.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  194.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  195.      1               IBITZ,IWHOLE,ICALL,IXPAR
  196.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  197.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  198.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  199.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  200.       COMMON /ERROR/ IERROR
  201.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  202.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  203.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  204.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  205.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  206.      2             IXGP(50),MXSGP(50),
  207.      3             FILL1
  208.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  209.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  210.      2             I16,I17,I18,I19,I20,
  211.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  212.      4             N16,N17,N18,N19,N20
  213.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  214.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  215.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  216.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  217.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  218.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  219.      6                NDOFSA(6),NOUSE(4),FILL2
  220.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  221.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  222.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  223.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  224.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  225.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  226.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  227.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  228.      8                KX49  ,KX50
  229.       COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
  230.       COMMON A(1)
  231.       EQUIVALENCE (A(1),IA(1))
  232.       EQUIVALENCE (VIEW(1,1),VIEWA(1))
  233. C
  234. C          DEFAULT VIEW MATRICES FOR NVIEW=0  (OMITTED), -1, -2, -3
  235. C
  236. C          MATRIX ELEMENT ORDER IN DEFAULT ARRAY:
  237. C
  238. C          (1,1) (2,1) (3,1)  (1,2) (2,2) (3,2)  (1,3) (2,3) (3,3)
  239. C
  240.       DATA VIEWD/-.707107,-.408248, .577350,
  241.      -            .707107,-.408248, .577350,
  242.      -            .0     , .816701, .577350,
  243.      1           0.,0.,1.,1.,0.,0.,0.,1.,0.,
  244.      2          -1.,0.,0.,0.,0.,1.,0.,1.,0.,
  245.      3           1.,0.,0.,0.,1.,0.,0.,0.,1./
  246. C
  247.       DATA KMESH,KMODE,IHYPH,BIG,SMALL/18,19,1H-,9.E20,.001/
  248.       DATA ZERON,IPLOFF,IPLON/1.E-30,4,5/
  249. C
  250.       DATA IHDEFO/4,4,4HDEFO,4HRMED/
  251.       DATA IHDEFM/5,3,3HMOD,3HESH,3HAPE/
  252.       DATA IHDTIM/7,1,1HT,1HI,1HM,1HE,1H /
  253.       DATA IHDMOD/4,4,4HMODE,4HNO  /
  254.       DATA IHDORI/4,4,4HORIG,4HINAL/
  255.       DATA IHDREF/5,3,3HREF,3HERE,3HNCE/
  256.       DATA IHDGS/4,4,4H GSC,4HALE /
  257.       DATA IHDDS/4,4,4H DSC,4HALE /
  258.       DATA IHDMAX/4,4,4H   D,4HMAX /
  259. C
  260.       DATA IAXES/1HX,1HY,1HZ/
  261.       DATA IUP,IDOWN/3,2/
  262.       DATA ITRUSS,ISOBEA,I2DIM,I2DIMF,I3DIM,I3DIMF/1,5,2,11,3,12/
  263.       DATA IBEAM,IPLATE,ISHELL/4,6,7/
  264. C
  265.       DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
  266.       DATA MIDEL /2,4,8,2,2,3,4,0,0,0,4,8,0,0,0/
  267. C
  268.       DATA LTRUSS/1,-3,-4,-2,999/
  269.       DATA L2DIM/1,-5,2,-6,3,-7,4,-8,1,999/
  270.       DATA L3DIM/1,-9,2,-10,3,-11,4,-12,1,-17,5,-13,6,-14,7,-15,
  271.      1           8,-16,5,0,2,-18,6,0,3,-19,7,0,4,-20,8,999/
  272.       DATA LBEAM/1,2,999/
  273.       DATA LPLATE/1,2,3,1,999/
  274. C
  275. C          PARAM 2: NVIEW
  276.       IF (ITYPE(2).EQ.IOMIT .AND. REALV(6).LT.0.0) GOTO 150
  277.       NVIEW = INTV(2)
  278.       IF (NVIEW.GE.-3 .AND. NVIEW.LE.MVIEW) GOTO 110
  279.         WRITE (NFLOG,2100) MVIEW
  280.         GOTO 800
  281.   110 IF (NVIEW.GT.0) GOTO 125
  282. C
  283. C          COPY DEFAULT OR NEGATIVE VIEW FROM ARRAY VIEWD
  284. C
  285.       IF (ITYPE(2).NE.IOMIT) GOTO 115
  286.       IF (IDOF(3).EQ.1) NVIEW = -3
  287.       IF (IDOF(2).EQ.1) NVIEW = -2
  288.       IF (IDOF(1).EQ.1) NVIEW = -1
  289.   115 NVIEW = - NVIEW * 9
  290.       DO 120 I=1,9
  291.   120   VIEWA(I) = VIEWD(NVIEW+I)
  292.       GOTO 150
  293. C
  294. C          READ VIEW FROM DATABASE
  295. C
  296.   125 IF (IXGP(KVIEW).EQ.0) GOTO 140
  297.       CALL DBREAD (VIEWDB,KVIEW,1,0)
  298.         IF (IERROR.NE.0) GOTO 900
  299.       IVAL = 0
  300.       DO 130 I=1,9
  301.         V = VIEWDB(I,NVIEW)
  302.         IF (V.NE.0.0) IVAL = 1
  303.   130   VIEWA(I) = V
  304.       IF (IVAL.EQ.1) GOTO 150
  305.   140   WRITE (NFLOG,2110)
  306.         GOTO 800
  307. C
  308. C          PARAM 3: TIME OR MODENO
  309. C
  310.   150 TIME = 9E15
  311.       ISTEN = 1
  312.       MODENO = 1
  313. C
  314.       MORIG = 1
  315.       MDEFOR = 0
  316.       IF (ITYPE(3).EQ.IOMIT) GOTO 152
  317.       MORIG = 0
  318.       MDEFOR = 1
  319.       TIME = REALV(3)
  320.   152 CONTINUE
  321. C
  322.       IF (NCMD.EQ.KMODE) GOTO 180
  323. C
  324.       IF (NSTEN.GT.0) GOTO 160
  325.   155   WRITE (NFLOG,2120)
  326.         GOTO 800
  327.   160 IF (TIME.EQ.TSTART) GOTO 190
  328.       CALL DBREAD (TIMEN,KTIMEN,1,0)
  329.         IF (IERROR.NE.0) GOTO 900
  330.       IF (ITYPE(3).EQ.IOMIT) TIME = TIMEN(NSTEN)
  331.       TDIFFO = BIG
  332.       DO 170 I=1,NSTEN
  333.         TDIFF = ABS(TIME-TIMEN(I))
  334.         IF (TDIFF.GE.TDIFFO) GOTO 170
  335.           TDIFFO = TDIFF
  336.           ISTEN = I
  337.   170   CONTINUE
  338.       TIME = TIMEN(ISTEN)
  339.       GOTO 190
  340. C
  341.   180 MODENO = INTV(3)
  342.       IF (MODENO.LT.1) MODENO = 1
  343.       IF (MODENO.GT.NFREQ) MODENO = NFREQ
  344. C
  345. C          PARAM 6: GSCALE
  346. C
  347.   190 GSCAIN = REALV(6)
  348. C
  349. C          PARAM 7: DMAX
  350. C
  351.   200 DMAX = REALV(7)
  352.       IF (DMAX.GE.0.0) GOTO 210
  353.         WRITE (NFLOG,2140)
  354.         GOTO 800
  355. C
  356. C          PARAM 4,5,8,9,10,11: MORIG,MDEFOR,NUMNPL,NUMEPL,
  357. C                                  LTEXT,INDAX
  358. C
  359.   210 IF (ITYPE(4).EQ.INTEG) MORIG = INTV(4)
  360.       IF (ITYPE(5).EQ.INTEG) MDEFOR = INTV(5)
  361.       NUMNPL = INTV(8)
  362.       NUMEPL = INTV(9)
  363.       LTEXT = 1
  364.       INDAX = 1
  365.       IF (GSCAIN.GE.0) GOTO 212
  366.       LTEXT = 0
  367.       INDAX = 0
  368.   212 IF (ITYPE(10).EQ.INTEG) LTEXT = INTV(10)
  369.       IF (ITYPE(11).EQ.INTEG) INDAX = INTV(11)
  370. C
  371. C          PARAM 12,13: XPV, YPV (SEE COMPUTATION OF SCALE)
  372. C
  373.       LINES = INTV(14)
  374. C
  375.       IF (MORIG .LT.0 .OR. MORIG .GT.2) GOTO 850
  376.       IF (MDEFOR.LT.0 .OR. MDEFOR.GT.2) GOTO 850
  377. C
  378. C          CHECK THAT DISPLACEMENTS ARE SAVED IN DATABASE
  379. C
  380.       IF (MDEFOR.EQ.0) GOTO 217
  381.       IF (NCMD.EQ.KMODE) GOTO 215
  382.         IF (NSTEN.EQ.0) GOTO 155
  383.         GOTO 217
  384.   215 IF (IXGP(KPHI).NE.0) GOTO 217
  385.         WRITE (NFLOG,2150)
  386.         GOTO 800
  387.   217 CONTINUE
  388.       LINORI = MORIG * 2
  389.       LINDEF = MDEFOR * 2
  390. C
  391. C
  392. C**************   READ NODE RECORDS AND COMPUTE NODE PLOT ARRAYS
  393. C
  394. C
  395.       ISTART = 0
  396.       IXARAY = 0
  397.       ISTRUC = 0
  398.       ISRSDC = 0
  399.       ISIDRN = 0
  400.       DISMAX = 0.0
  401.       XDMIN = 0.0
  402.       YDMIN = 0.0
  403.       XDMAX = 0.0
  404.       YDMAX = 0.0
  405.       DO 220 I=N1,N7
  406.   220   A(I) = BIG
  407. C
  408. C          DO FOR ALL INDEPENDENT STRUCTURES
  409. C
  410.       DO 440 ISTRI=1,NSTRI
  411. C
  412.       NRUSE  = NRUSES(ISTRI)
  413.       NUMNP  = NUMNPS(ISTRI)
  414. C
  415. C          DO FOR ALL TIMES A STRUCTURE IS REUSED
  416. C
  417.       DO 430 IRUSE=1,NRUSE
  418.       ISTRUC = ISTRUC + 1
  419. C
  420. C          READ NZONE IF ZONE IS REQUIRED
  421. C
  422.       IF (IBITZ.NE.IWHOLE)
  423.      1  CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
  424.         IF (IERROR.NE.0) GOTO 900
  425. C
  426. C          GET PLOT COORDINATES XPLOT AND YPLOT FOR ALL NODES IN ZONE
  427. C
  428.       ISXYZ = 0
  429.       DO 270 NP=1,NUMNP
  430.       IF (IBITZ.EQ.IWHOLE) GOTO 250
  431.       CALL BITGET (NZONE(NP),IBITZ,ISELEC)
  432.       IF (ISELEC.EQ.0) GOTO 270
  433. C
  434. C          READ XYZ
  435. C
  436.   250 IF (ISTRUC.NE.ISXYZ)
  437.      1  CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
  438.         IF (IERROR.NE.0) GOTO 900
  439.         ISXYZ = ISTRUC
  440. C
  441.       X = XYZ(NP)
  442.       I = NUMNP + NP
  443.       Y = XYZ(I)
  444.       Z = XYZ(I+NUMNP)
  445. C
  446. C          TRANSFORMATION TO PLOT COORDINATES
  447. C
  448.       XC = VIEW(1,1) * X + VIEW(1,2) * Y + VIEW(1,3) * Z
  449.       YC = VIEW(2,1) * X + VIEW(2,2) * Y + VIEW(2,3) * Z
  450. C
  451.       IF (ISTART.EQ.1) GOTO 260
  452.       ISTART = 1
  453.       XMIN = XC
  454.       YMIN = YC
  455.       XMAX = XC
  456.       YMAX = YC
  457.   260 IF (XC.LT.XMIN) XMIN = XC
  458.       IF (YC.LT.YMIN) YMIN = YC
  459.       IF (XC.GT.XMAX) XMAX = XC
  460.       IF (YC.GT.YMAX) YMAX = YC
  461. C
  462.       IX = IXARAY + NP
  463.       XPLOT(IX) = XC
  464.       YPLOT(IX) = YC
  465.   270 CONTINUE
  466. C
  467. C          GET PLOT DISPLACEMENTS XPLOTD AND Y D
  468. C
  469.       IF (MDEFOR.EQ.0 .AND. NCMD.NE.KMODE) GOTO 425
  470.       IREAD = KMESH
  471. C
  472.   275 ISDISP = 0
  473.       DO 420 NP=1,NUMNP
  474. C
  475.       IF (IBITZ.EQ.IWHOLE) GOTO 280
  476.         CALL BITGET (NZONE(NP),IBITZ,ISELEC)
  477.         IF (ISELEC.EQ.0) GOTO 420
  478. C
  479. C          READ DISP OR PHI
  480. C
  481.   280 IF (ISTRUC.EQ.ISDISP) GOTO 290
  482.       IF (IREAD.EQ.KMESH) CALL DBREAD (DISP,KDISP,ISTRUC,ISTEN)
  483.       IF (IREAD.EQ.KMODE) CALL DBREAD (DISP,KPHI,MODENO,0)
  484.       IF (IERROR.NE.0) GOTO 900
  485.       ISDISP = ISTRUC
  486. C
  487. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  488. C
  489.   290 DO 300 I=1,6
  490.         VDIR(I) = 0.0
  491.         INDOF = NDOFSA(I)
  492.         IF (INDOF.GT.0) VDIR(I) = DISP(INDOF,NP)
  493.   300   CONTINUE
  494. C
  495. C          IF SKEW COORDINATE SYSTEM:  TRANSFORM TO GLOBAL
  496. C
  497.       IF (NSKEWS.EQ.0) GOTO 310
  498.       IF (ISIDRN.NE.ISTRI)
  499.      1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  500.         IF (IERROR.NE.0) GOTO 900
  501.         ISIDRN = ISTRI
  502.       IXNRST = NDOF * NUMNP
  503.       ISKEW = IDRN(IXNRST+NP)
  504.       IF (ISKEW.LE.0) GOTO 310
  505.       IF (ISRSDC.EQ.0)
  506.      1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
  507.         IF (IERROR.NE.0) GOTO 900
  508.         ISRSDC = 1
  509.       CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  510. C
  511.   310 X = VDIR(1)
  512.       Y = VDIR(2)
  513.       Z = VDIR(3)
  514.       XD = VIEW(1,1) * X + VIEW(1,2) * Y + VIEW(1,3) * Z
  515.       YD = VIEW(2,1) * X + VIEW(2,2) * Y + VIEW(2,3) * Z
  516. C
  517.       IX = IXARAY + NP
  518. C
  519.       IF (NCMD.EQ.KMODE .AND. IREAD.EQ.KMESH) GOTO 320
  520. C
  521.       IF (ABS(XD).GT.DISMAX) DISMAX = ABS(XD)
  522.       IF (ABS(YD).GT.DISMAX) DISMAX = ABS(YD)
  523.       IF (XD.LT.XDMIN) XDMIN = XD
  524.       IF (YD.LT.YDMIN) YDMIN = YD
  525.       IF (XD.GT.XDMAX) XDMAX = XD
  526.       IF (YD.GT.YDMAX) YDMAX = YD
  527. C
  528.       XPLOTD(IX) = XD
  529.       YPLOTD(IX) = YD
  530.       GOTO 420
  531. C
  532. C          MODEPLOT: SAVE GEOMETRY AT TSTART IN XPLOTR,YPLOTR
  533. C
  534.   320 XD = XD + XPLOT(IX)
  535.       YD = YD + YPLOT(IX)
  536.       IF (XD.LT.XMIN) XMIN = XD
  537.       IF (YD.LT.YMIN) YMIN = YD
  538.       IF (XD.GT.XMAX) XMAX = XD
  539.       IF (YD.GT.YMAX) YMAX = YD
  540. C
  541.       XPLOTR(IX) = XD
  542.       YPLOTR(IX) = YD
  543. C
  544. C
  545.   420 CONTINUE
  546. C
  547. C          GET MODAL DISPLACEMENT
  548. C
  549.       IF (NCMD.EQ.KMESH .OR. IREAD.EQ.KMODE) GOTO 425
  550.       IREAD = KMODE
  551.       IF (MDEFOR.NE.0) GOTO 275
  552. C
  553.   425 IXARAY = IXARAY + NUMNP
  554.   430 CONTINUE
  555.   440 CONTINUE
  556. C
  557. C
  558. C***************    COMPUTE AVAILIBLE X AND Y PLOT LENGTHS
  559. C
  560. C
  561. C
  562.       XMARG = PMARG
  563.       YMARG = PMARG
  564.       IF (DISMAX.LT.ZERON) GOTO 500
  565.         XMARG = PMARG - XDMIN / DISMAX * DMAX
  566.         YMARG = PMARG - YDMIN / DISMAX * DMAX
  567.   500 XPLEN = XPMAX - XMARG - PMARG
  568.       YPLEN = YPMAX - YMARG - PMARG
  569.       IF (DISMAX.LT.ZERON) GOTO 505
  570.         XPLEN = XPLEN - XDMAX / DISMAX * DMAX
  571.         YPLEN = YPLEN - YDMAX / DISMAX * DMAX
  572.   505 IF (LTEXT.EQ.1) YPLEN = YPLEN - HEIGHT * 5.0
  573.       IF (LTEXT.EQ.1 .AND. MDEFOR.NE.0) YPLEN = YPLEN - 4.0 * HEIGHT
  574.       IF (XPLEN.GT.1.0 .AND. YPLEN.GT.1.0) GOTO 510
  575.         WRITE (NFLOG,2160)
  576.         GOTO 800
  577. C
  578. C          COMPUTE SCALE FACTORS
  579. C
  580.   510 IF (DMAX.GT.SMALL) GOTO 520
  581.         XMIN = XMIN + XDMIN
  582.         YMIN = YMIN + YDMIN
  583.         XMAX = XMAX + XDMAX
  584.         YMAX = YMAX + YDMAX
  585. C
  586. C          GSCALE.LT.0.0, USE SAME GSCALE,DSCALE,XPV,YPV
  587. C          AS IN PREVIOUS PLOT
  588. C
  589.   520 IF (GSCAIN.LT.0.0) GOTO 525
  590.       GSCALE = GSCAIN
  591.       IF (GSCALE.GT.0.0) GOTO 522
  592.       GSCALE = BIG
  593.       XSPAN = ABS(XMAX - XMIN)
  594.       YSPAN = ABS(YMAX - YMIN)
  595.       IF (XSPAN*GSCALE .GT. XPLEN) GSCALE = XPLEN / XSPAN
  596.       IF (YSPAN*GSCALE .GT. YPLEN) GSCALE = YPLEN / YSPAN
  597.   522 XPV = XMARG - XMIN * GSCALE
  598.       YPV = YMARG - YMIN * GSCALE
  599.       DSCALE = GSCALE
  600.   525 CONTINUE
  601.       IF (ITYPE(12).EQ.IREAL) XPV = REALV(12)
  602.       IF (ITYPE(13).EQ.IREAL) YPV = REALV(13)
  603.       IF (DMAX.GT.SMALL .AND. DISMAX.GE.ZERON) DSCALE = DMAX / DISMAX
  604.       WRITE (NFLOG,2190) GSCALE,XPV,YPV
  605.       DMAX = DISMAX * DSCALE
  606.       IF (MDEFOR.EQ.0) GOTO 528
  607.       IF (NCMD.NE.KMODE) WRITE (NFLOG,2200) DSCALE,DMAX,TIME
  608.       IF (NCMD.EQ.KMODE) WRITE (NFLOG,2210) DSCALE,DMAX,MODENO
  609.   528 CONTINUE
  610. C
  611. C          PLOT HEADER TEXT AND SCALE
  612. C
  613.       CALL CGRAPH (IPLON)
  614.       IF (LTEXT.EQ.0) GOTO 550
  615.       XP = PMARG
  616.       YP = YPMAX - PMARG - HEIGHT
  617.       IF (MORIG.EQ.0) GOTO 530
  618.       IF (NCMD.EQ.KMESH) CALL PLOTXT (XP,YP,IHDORI)
  619.       IF (NCMD.EQ.KMODE) CALL PLOTXT (XP,YP,IHDREF)
  620.       X = XP + 9.0 * HEIGHT
  621.       CALL LCLIP (X,YP,IUP)
  622.       X = XP + 13.0 * HEIGHT
  623.       CALL LCLIP (X,YP,LINORI)
  624.       YP = YP - HEIGHT - HEIGHT
  625.   530 IF (MDEFOR.EQ.0) GOTO 540
  626.       IF (NCMD.EQ.KMESH) CALL PLOTXT (XP,YP,IHDEFO)
  627.       IF (NCMD.EQ.KMODE) CALL PLOTXT (XP,YP,IHDEFM)
  628.       X = XP + 9.0 * HEIGHT
  629.       CALL LCLIP (X,YP,IUP)
  630.       X = XP + 13.0 * HEIGHT
  631.       CALL LCLIP (X,YP,LINDEF)
  632.       YP = YP - HEIGHT - HEIGHT
  633.       IF (NCMD.EQ.KMODE) GOTO 535
  634.       CALL PLOTXT (XP,YP,IHDTIM)
  635.       I = 0
  636.       IF (TIME.NE.0.0) I = MAX0 ( 0, 3 - INT( ALOG10(ABS(TIME))) )
  637.       CALL AGRAPH (999.,999.,HEIGHT,0,TIME,0.,I,3)
  638.       GOTO 540
  639.   535 CALL PLOTXT (XP,YP,IHDMOD)
  640.       FPN = MODENO
  641.       CALL AGRAPH (999.,999.,HEIGHT,0,FPN,0.,-1,3)
  642. C
  643. C          '  GSCALE N.NNN  DSCALE N.NNN  DMAX N.NNN'
  644. C
  645.   540 XP = PMARG + 13.0 * HEIGHT
  646.       YP = YPMAX - PMARG - HEIGHT
  647.       CALL PLOTXT (XP,YP,IHDGS)
  648.       I = MAX0 ( 0, 3 - INT( ALOG10 (GSCALE) ) )
  649.       CALL AGRAPH (999.,999.,HEIGHT,0,GSCALE,0.,I,3)
  650.       IF (MDEFOR.EQ.0) GOTO 550
  651.       YP = YP - HEIGHT - HEIGHT
  652.       CALL PLOTXT (XP,YP,IHDDS)
  653.       I = MAX0 ( 0, 3 - INT( ALOG10 (DSCALE) ) )
  654.       CALL AGRAPH (999.,999.,HEIGHT,0,DSCALE,0.,I,3)
  655.       YP = YP - HEIGHT - HEIGHT
  656.       CALL PLOTXT (XP,YP,IHDMAX)
  657.       I = MAX0 ( 0, 3 - INT( ALOG10 (DMAX+SMALL) ) )
  658.       CALL AGRAPH (999.,999.,HEIGHT,0,DMAX,0.,I,3)
  659. C
  660. C          PLOT X, Y AND Z AXES DIRECTIONS
  661. C
  662.   550 IF (INDAX.EQ.0) GOTO 600
  663.       DO 570 I=1,3
  664.       XP = PMARG + HEIGHT * 4.4
  665.       XC = XPMAX - XP
  666.       YC = YPMAX - XP
  667.       IF (XC.GT.(FLOAT(LTEXT)*(PMARG+HEIGHT*30.0)))
  668.      1  GOTO 560
  669.       YC = YC - HEIGHT * 4.0
  670.       IF (MDEFOR.GT.0) YC = YC - HEIGHT * 2.0
  671.   560 CALL LCLIP (XC,YC,IUP)
  672.       XP = XC + VIEW(1,I) * HEIGHT * 3.0
  673.       YP = YC + VIEW(2,I) * HEIGHT * 3.0
  674.       CALL LCLIP (XP,YP,IDOWN)
  675. C
  676. C          PLOT X, Y AND Z CHARACHTER AT AXES
  677. C
  678.       XDIFF = XP - XC
  679.       YDIFF = YP - YC
  680.       ALGH = SQRT (XDIFF*XDIFF + YDIFF*YDIFF)
  681.       IF (ALGH.LT.SMALL) GOTO 570
  682.       AFACT = (ALGH + HEIGHT) / ALGH
  683.       XP = XC + AFACT * XDIFF - HEIGHT * 0.3
  684.       YP = YC + AFACT * YDIFF - HEIGHT * 0.5
  685.       NBCD = IAXES(I)
  686.       CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
  687.   570 CONTINUE
  688. C
  689. C
  690. C**********    READ ELEMENT RECORDS AND DO PLOTTING
  691. C
  692. C
  693.   600 ISTRUC = 0
  694.       IEGIT = 0
  695.       IEGAT = 0
  696.       IXARAY = 0
  697.       ISNOD  = 0
  698.       ISEZON = 0
  699. C
  700. C          DO FOR ALL INDEPENDENT STRUCTURES
  701. C
  702.       DO 750 ISTRI=1,NSTRI
  703. C
  704.       NRUSE = NRUSES(ISTRI)
  705.       NEG   = NEGS  (ISTRI)
  706.       NUMNP = NUMNPS(ISTRI)
  707.       NMID  = MAXMSS(ISTRI)
  708. C
  709. C          READ NPAR
  710. C
  711.       CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  712.         IF (IERROR.NE.0) GOTO 900
  713. C
  714. C          DO FOR ALL TIMES A STRUCTURE IS REUSED
  715. C
  716.       DO 740 IRUSE=1,NRUSE
  717.       ISTRUC = ISTRUC + 1
  718. C
  719. C
  720. C          DO FOR ALL SELECTED NODES IN REUSED STRUCTURE
  721. C
  722. C
  723.       DO 630 NP=1,NUMNP
  724.       IX = IXARAY + NP
  725.       IF (XPLOT(IX).EQ.BIG) GOTO 630
  726. C
  727. C          TEST LIST OF VIEW COORDINATES BEFORE SCALING
  728. C
  729.       IF (NUMNPL.NE.-1) GOTO 610
  730.       CALL CGRAPH (IPLOFF)
  731.       ISUBST = ISTRI - 1
  732.       IF (NP.EQ.1) WRITE (NFLOG,2170) ISUBST, IRUSE
  733.       WRITE (NFLOG,2180) NP,XPLOT(IX),YPLOT(IX),XPLOTD(IX),YPLOTD(IX)
  734.       IF (NCMD.EQ.KMODE) WRITE (NFLOG,2180) NP,XPLOTR(IX),YPLOTR(IX)
  735.       CALL CGRAPH (IPLON)
  736. C
  737. C          COMPUTE SCALED PLOT COORDINATES
  738. C
  739.   610 XPLOT(IX) = XPLOT(IX) * GSCALE + XPV
  740.       YPLOT(IX) = YPLOT(IX) * GSCALE + YPV
  741.       XPLOTD(IX) = XPLOTD(IX) * DSCALE
  742.       YPLOTD(IX) = YPLOTD(IX) * DSCALE
  743.       IF (NCMD.NE.KMODE) GOTO 615
  744.         XPLOTR(IX) = XPLOTR(IX) * GSCALE + XPV
  745.         YPLOTR(IX) = YPLOTR(IX) * GSCALE + YPV
  746. C
  747. C          PLOT NODE NUMBERS AND SYMBOLS IF REQUESTED
  748. C
  749.   615 IF (NUMNPL.LE.0) GOTO 630
  750.       XP = XPLOT(IX)
  751.       YP = YPLOT(IX)
  752.       IF (NCMD.NE.KMODE) GOTO 617
  753.       XP = XPLOTR(IX)
  754.       YP = YPLOTR(IX)
  755.   617 IF (MDEFOR.EQ.0) GOTO 620
  756.       XP = XPLOTD(IX) + XP
  757.       YP = YPLOTD(IX) + YP
  758.   620 IF (NUMNPL.LT.10) GOTO 625
  759.       ISYMBL = 5
  760.       IF (ISTRUC.GT.1) ISYMBL = 2
  761.       H = HEIGHT * 0.6
  762.       CALL AGRAPH (XP,YP,H,ISYMBL,0.0,0.0,-1,2)
  763.   625 IF (NUMNPL.EQ.10) GOTO 630
  764.       H = HEIGHT * 0.8
  765.       XP = XP + HEIGHT
  766.       YP = YP + H
  767.       IF (ISTRUC.GT.1) YP = YP - H * 3.0
  768.       FPN = NP
  769.       CALL AGRAPH (XP,YP,H,0,FPN,0.0,-1,3)
  770.   630 CONTINUE
  771. C
  772. C          FIRST DRAW ORIGINAL OR REFERENCE SHAPE
  773. C
  774.       IDEFOR = 0
  775.       LINTYP = LINORI
  776.   640 IXYSTA = I16 / ISURL
  777.       IXYUSE = IXYSTA - 3
  778.       IXYEND = IXYSTA
  779. C
  780. C
  781. C          DO FOR ALL ELEMENT GROUPS IN REUSED STRUCTURE
  782. C
  783. C
  784.       DO 730 IEG=1,NEG
  785.       IEGAT = IEGAT + 1
  786.       IEGIT = IEGIT + 1
  787.       IF (IDEFOR.EQ.0 .AND. MORIG.EQ.0 .AND.
  788.      1    (NUMEPL.EQ.0 .OR. MDEFOR.EQ.0)) GOTO 730
  789.       ISEG = 0
  790. C
  791.       IELTYP = NPAR(1,IEG)
  792.       MXNODS = MXNODA(IELTYP)
  793.       NEL = NPAR(2,IEG)
  794. C
  795.       NTHICK = NPAR(14,IEG)
  796.       MXMNOD = NPAR(8,IEG)
  797. C
  798. C          LAGRAN = 1 IF FREQUENCY MODE REFERENCES TSTART DISPL
  799. C          LAGRAN = 0 IF FREQ. DISPL REFERENCES TO ORIGINAL MESH
  800. C
  801.       LAGRAN = 0
  802.       NPAR3 = NPAR(3,IEG)
  803.       IF (NPAR3.GT.1) LAGRAN = 1
  804.       IF (IELTYP.EQ.I2DIMF .AND. NPAR3.EQ.1) LAGRAN = 1
  805.       IF (IELTYP.EQ.I3DIMF .AND. NPAR3.EQ.1) LAGRAN = 1
  806. C
  807. C
  808. C          READ IEZONE IF REQUIRED
  809. C
  810.       IF (IBITZ.NE.IWHOLE .AND. IEGAT.NE.ISEZON)
  811.      1  CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  812.         IF (IERROR.NE.0) GOTO 900
  813.         ISEZON = IEGAT
  814. C
  815. C          DO FOR ALL ELEMENTS IN GROUP AND ZONE
  816. C
  817.       DO 720 IEL=1,NEL
  818.       IF (IBITZ.EQ.IWHOLE) GOTO 650
  819.       CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  820.       IF (ISELEC.EQ.0) GOTO 720
  821. C
  822. C          READ NOD
  823. C
  824.   650 IF (ISNOD.EQ.IEGIT) GOTO 660
  825.       ISNOD = IEGIT
  826.       CALL DBREAD (NOD,KNOD,IEGIT,0)
  827.         IF (IERROR.NE.0) GOTO 900
  828. C
  829.   660 I = IXARAY + 1
  830.       IXNOD = MXNODS * (IEL - 1) + 1
  831.       J = IXNOD
  832. C
  833.       NX = N1 + IXARAY
  834.       NY = N2 + IXARAY
  835.       IF (NCMD.NE.KMODE .OR. LAGRAN.NE.1) GOTO 665
  836.       NX = N5 + IXARAY
  837.       NY = N6 + IXARAY
  838. C
  839.   665 IF (MORIG.EQ.0 .AND. IDEFOR.EQ.0) GOTO 700
  840. C
  841.   670 IF (IELTYP.EQ.ITRUSS .OR. IELTYP.EQ.ISOBEA)
  842.      1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LTRUSS)
  843.       IF (IELTYP.EQ.I2DIM .OR. IELTYP.EQ.I2DIMF)
  844.      1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),L2DIM)
  845.       IF (IELTYP.EQ.I3DIM .OR. IELTYP.EQ.I3DIMF)
  846.      1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),L3DIM)
  847.       IF (IELTYP.EQ.IBEAM)
  848.      1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LBEAM)
  849.       IF (IELTYP.EQ.IPLATE)
  850.      1CALL PLOTL(A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),LPLATE)
  851. C
  852. C          SHELL ELEMENT PLOTTING
  853. C
  854.       IF (IELTYP.NE.ISHELL) GOTO 700
  855.       IF (ISEG.EQ.IEGIT) GOTO 685
  856.       I17 = I16
  857.       I18 = I16
  858.       I19 = I16
  859.       I20 = I16
  860.       IF (MIDSPL.EQ.1 .OR. IDEFOR.EQ.1) GOTO 685
  861. C                                                EDATA
  862.       I17 = I16 + (ISURL + 1) * NEL
  863. C                                                ITHICK
  864.       I18 = I17 + NEL
  865.       CALL ALIGN(I18)
  866. C                                                THICK
  867.       I19 = I18 + MXMNOD * NTHICK * ISURL
  868. C                                                TMIDSS
  869.       I20 = I19 + NMID * 3 * ISURL
  870. C                                                IDRN
  871.       I21 = I20 + (NDOF + 1) * NUMNP
  872. C                                                MIDS
  873.       I22 = I21 + NUMNP
  874. C
  875. C          MOVE LINES ARRAY UP ABOVE SHELL AREAS IF REQUIRED
  876. C
  877.       CALL ALIGN (I22)
  878.       IXOLAP = I22 / ISURL - IXYSTA
  879.       IF (IXOLAP.LE.0) GOTO 685
  880.       I22 = I22 + (IXYUSE - IXYSTA + 3) * ISURL
  881.       CALL SIZE (I22)
  882.       IF (IERROR.NE.0) GOTO 900
  883.       IXYSTA = IXYSTA + IXOLAP
  884.       IXYUSE = IXYUSE + IXOLAP
  885.       IXYEND = IXYUSE + 3
  886.       L = IXYEND
  887.   680 L = L - 1
  888.       IF (L.LT.IXYSTA) GOTO 685
  889.       A(L) = A(L-IXOLAP)
  890.       GOTO 680
  891. C
  892.   685 CALL SHELL (A(NX),A(NY),XPLOTD(I),YPLOTD(I),NOD(J),
  893.      1     IA(I16),IA(I17),IA(I18),IA(I19),IA(I20),IA(I21),
  894.      2     IEGIT,NTHICK,ISTRI,IEL,MXMNOD,ISEG)
  895.       IF (IERROR.NE.0) GOTO 900
  896. C
  897. C
  898. C          PLOT ELEMENT NUMBER OR GROUP,ELEMENT IF REQUESTED
  899. C
  900.   700 IF (NUMEPL.EQ.0) GOTO 720
  901.       IF (IDEFOR.EQ.0 .AND. MDEFOR.NE.0) GOTO 720
  902. C
  903.       H = HEIGHT
  904. C
  905. C          FIND MIDDLE POINT OF ELEMENTS FIRST NODES
  906. C
  907.       XP = 0.0
  908.       YP = 0.0
  909.       NMIDEL = MIDEL(IELTYP)
  910. C
  911. C          AXISYMMETRIC TRUSS (RING) HAS 1 NODE ONLY
  912.       IF (IELTYP.EQ.ITRUSS .AND. NPAR(5,IEG).EQ.1) NMIDEL = 1
  913.       DO 711 IMIDEL=1,NMIDEL
  914.         IXNODN = NOD(IXNOD+IMIDEL-1) + IXARAY
  915.         X = XPLOT(IXNODN)
  916.         Y = YPLOT(IXNODN)
  917.         IF (NCMD.NE.KMODE .OR. LAGRAN.EQ.0) GOTO 705
  918.           X = XPLOTR(IXNODN)
  919.           Y = YPLOTR(IXNODN)
  920.   705 IF (MDEFOR.EQ.0) GOTO 707
  921.       X = X + XPLOTD(IXNODN)
  922.       Y = Y + YPLOTD(IXNODN)
  923.   707 XP = XP + X
  924.       YP = YP + Y
  925.       IF (IMIDEL.NE.1) GOTO 709
  926.       XP1 = X
  927.       YP1 = Y
  928.   709 IF (IMIDEL.NE.2) GOTO 711
  929.       XP2 = X
  930.       YP2 = Y
  931.   711   CONTINUE
  932. C
  933.       XP = XP / FLOAT(NMIDEL) - H * 0.4
  934.       YP = YP / FLOAT(NMIDEL) - H * 0.5
  935. C
  936. C          MOVE AWAY FROM MIDDLE OF LINE IF 2 NODES ONLY
  937. C
  938.       IF (NMIDEL.NE.2) GOTO 712
  939.       XDIFF = XP2 - XP1
  940.       YDIFF = YP2 - YP1
  941.       ALGH = SQRT (XDIFF*XDIFF + YDIFF*YDIFF)
  942.       IF (ALGH.LT.SMALL) GOTO 712
  943.       XP = XP + HEIGHT * ABS(YDIFF) / ALGH
  944.       YP = YP - HEIGHT * XDIFF * SIGN(1.0,YDIFF) / ALGH
  945. C
  946.   712 CONTINUE
  947.       IF (NUMEPL.LE.1) GOTO 715
  948.       FPN = IEG
  949.       CALL AGRAPH (XP,YP,H,0,FPN,0.,-1,3)
  950.       CALL AGRAPH (999.,999.,H,IHYPH,0.,0.,1,1)
  951.       XP = 999.
  952.       YP = 999.
  953.   715 FPN = IEL
  954.       CALL AGRAPH (XP,YP,H,0,FPN,0.,-1,3)
  955. C
  956.   720 CONTINUE
  957.   730 CONTINUE
  958.       IEGIT = IEGIT - NEG
  959. C
  960. C
  961. C          END OF STRUCTURE, PLOT ELEMENT LINES HERE IF SAVED
  962. C
  963.       IF (LINES.EQ.0) GOTO 737
  964.       I = IXYSTA - 3
  965.   734 IFROM = 0
  966.   735 I = I + 3
  967.       IF (I.GT.IXYUSE) GOTO 737
  968.       IF (NUMNPL.EQ.-2) WRITE (NFLOG,1234) A(I),A(I+1),A(I+2)
  969.  1234 FORMAT(3(10X,G12.6))
  970.       J = INT(A(I+2) + 0.2)
  971.       IF (J.EQ.0) GOTO 734
  972.       IF (J.GT.IABS(LINES)) GOTO 734
  973.       IF (J.NE.LINES .AND. LINES.GT.0) GOTO 734
  974.       IF (IFROM.EQ.0) CALL LCLIP (A(I-3),A(I-2),IUP)
  975.       IFROM = 1
  976.       CALL LCLIP (A(I),A(I+1),LINTYP)
  977.       GOTO 735
  978. C
  979. C          GO BACK TO DRAW LINES OF DEFORMED SHAPE
  980. C
  981.   737 IF (MDEFOR.EQ.0) GOTO 739
  982.       IF (IDEFOR.EQ.1) GOTO 739
  983.       IDEFOR = 1
  984.       LINTYP = LINDEF
  985.       IEGAT = IEGAT - NEG
  986.       GOTO 640
  987. C
  988.   739 IXARAY = IXARAY + NUMNP
  989.   740 CONTINUE
  990.       IEGIT = IEGIT + NEG
  991.   750 CONTINUE
  992.       GOTO 900
  993. C
  994.   800 IERROR = 1
  995.       GOTO 900
  996.   850 IERROR = 2
  997.   900 CALL CGRAPH (IPLOFF)
  998.       RETURN
  999. C
  1000.  2100 FORMAT(41H ***ERROR:  VIEW PARAMETER INVALID, -3 - ,I2)
  1001.  2110 FORMAT(28H ***ERROR:  VIEW NOT DEFINED)
  1002.  2120 FORMAT(43H ***ERROR: NO TIMESTEP SAVED FOR NODAL DATA)
  1003.  2140 FORMAT(29H ***ERROR: INVALID DMAX VALUE)
  1004.  2150 FORMAT(35H ***ERROR: NO MODAL TIMESTEPS SAVED)
  1005.  2160 FORMAT(44H ***ERROR: PLOT AREA (SUBFRAME) IS TOO SMALL)
  1006.  2170 FORMAT (/52H  NODE   XPLOT       YPLOT       XPLOTD       YPLOTD,
  1007.      1  12X,6HNSUB =,I5,10H  NREUSE =,I5/)
  1008.  2180 FORMAT(1X,I5,4(2X,E10.4))
  1009.  2190 FORMAT(13H    GSCALE = ,G10.4,9H   XPV = ,G10.4,
  1010.      1  9H   YPV = ,G10.4)
  1011.  2200 FORMAT(13H    DCSALE = ,G10.4,9H  DMAX = ,G10.4,
  1012.      1  9H  TIME = ,G10.5)
  1013.  2210 FORMAT(13H    DSCALE = ,G10.4,9H  DMAX = ,G10.4,
  1014.      1  11H  MODENO = ,I4)
  1015.       END
  1016. C***ADD:CDC***
  1017. CDECK PLOTXT
  1018. C***END:CDC***
  1019.       SUBROUTINE PLOTXT (XP,YP,IARRAY)
  1020. C
  1021. C          HORISONTAL PLOT OF TEXT FROM AN ARRAY WITH:
  1022. C          IARRAY(1) = TOTAL LENGTH OF ARRAY
  1023. C          IARRAY(2) = NUMBER OF CHARACTERS IN EACH ARRAY ENTRY TO PLOT
  1024. C          IARRAY(3-N) = TEXT TO BE PLOTTED
  1025. C
  1026.       DIMENSION IARRAY(1)
  1027. C
  1028.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  1029.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  1030.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  1031.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  1032. C
  1033.       LENGTH = IARRAY(1)
  1034.       NCHAR  = IARRAY(2)
  1035.       X = XP
  1036.       Y = YP
  1037.       DO 100 I=3,LENGTH
  1038.         NBCD = IARRAY(I)
  1039.         CALL AGRAPH (X,Y,HEIGHT,NBCD,0.,0.,NCHAR,1)
  1040.         X = 999.0
  1041.         Y = 999.0
  1042.   100   CONTINUE
  1043.       RETURN
  1044.       END
  1045. C***ADD:CDC***
  1046. CDECK PLOTL
  1047. C***END:CDC***
  1048.       SUBROUTINE PLOTL (XPLOT,YPLOT,XPLOTD,YPLOTD,NOD,NLINE)
  1049. C
  1050.       DIMENSION NLINE(1),XPLOT(1),YPLOT(1),NOD(1),XPLOTD(1),YPLOTD(1)
  1051. C
  1052.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  1053.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1054.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1055.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1056.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1057.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1058.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1059.      6                NDOFSA(6),NOUSE(4),FILL2
  1060.       COMMON /ERROR/ IERROR
  1061.       COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
  1062.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1063.       COMMON /EPS/ EPS
  1064.       COMMON A(1)
  1065. C
  1066.       DATA IUP,IPLOFF,IPLON/3,4,5/
  1067. C
  1068.       NPLINE = 0
  1069. C
  1070. C          DRAW A LINE BETWEEN NODES IN NLINE ARRAY
  1071. C
  1072.   50  IND = IUP
  1073.   100 NPLINE = NPLINE + 1
  1074.       NPEL = NLINE(NPLINE)
  1075. C
  1076. C          0 MEANS PEN UP FOR MOVE TO NEXT NODE
  1077. C          999 MEANS END OF LINE
  1078. C
  1079.       IF (NPEL.EQ.0) GOTO 50
  1080.       IF (NPEL.EQ.999) GOTO 800
  1081.       I = IABS(NPEL)
  1082.       NP = NOD(I)
  1083. C
  1084. C          NODE IS OPTIONAL (ZERO) IF NPEL IS NEGATIVE
  1085. C
  1086.       IF (NP.EQ.0 .AND. NPEL.LT.0) GOTO 100
  1087.       IF (NP.LT.1 .OR.NP.GT.NUMNP) GOTO 700
  1088. C
  1089.       XP = XPLOT(NP)
  1090.       YP = YPLOT(NP)
  1091.       IF (IDEFOR.NE.1) GOTO 200
  1092.       XP = XP + XPLOTD(NP)
  1093.       YP = YP + YPLOTD(NP)
  1094. C
  1095. C          IMMEDIATE PLOTTING OF ELEMENT LINES
  1096. C
  1097.   200 IF (LINES.NE.0) GOTO 300
  1098.       CALL LCLIP (XP,YP,IND)
  1099. C
  1100.   250 IND = LINTYP
  1101.       GOTO 100
  1102. C
  1103. C          ELEMENT LINES ARE SAVED IN AN ARRAY TO BE PLOTTED
  1104. C          AT END OF STRUCTURE DEPENDING ON LINES PARAMETER
  1105. C
  1106.   300 IF (IND.NE.IUP) GOTO 320
  1107. C
  1108.   310 XFROM = XP
  1109.       YFROM = YP
  1110.       GOTO 250
  1111. C
  1112. C          SKIP LINE OF ZERO LENGTH
  1113. C
  1114.   320 IF (ABS (XP - XFROM) .GT. EPS) GOTO 330
  1115.       IF (ABS (YP - YFROM) .LE. EPS) GOTO 310
  1116. C
  1117. C          EXPAND SIZE OR LINES ARRAY IN BLANK COMMON
  1118. C
  1119.   330 IF (IXYUSE+9 .LE. IXYEND) GOTO 400
  1120.       IXYEND = IXYEND + 300
  1121.       I = IXYEND * ISURL
  1122.       CALL SIZE(I)
  1123.       IF (IERROR.NE.0) GOTO 900
  1124. C
  1125. C          SCAN ARRAY FOR LINE START POINT XFROM,YFROM
  1126. C          FOR BETTER PREFORMACE SCAN IS BACKWARDS
  1127. C
  1128.   400 IXSCAN = IXYUSE + 3
  1129.       IXHIT = 0
  1130. C
  1131.   410 IXSCAN = IXSCAN - 3
  1132.       IF (IXSCAN.LT.IXYSTA) GOTO 500
  1133.       IF (ABS(XFROM - A(IXSCAN)) .GT. EPS) GOTO 410
  1134.       IF (ABS(YFROM - A(IXSCAN+1)) .GT. EPS) GOTO 410
  1135. C
  1136. C          XFROM,YFROM FOUND - LOOK IF PREVIOUS ENTRY IS XP,YP
  1137. C
  1138.   420 IF (IXSCAN.EQ.IXYSTA) GOTO 440
  1139.       IF (ABS(XP - A(IXSCAN-3)) .GT. EPS) GOTO 440
  1140.       IF (ABS(YP - A(IXSCAN-2)) .GT. EPS) GOTO 440
  1141.       IXHIT = IXSCAN + 2
  1142.       IF (A(IXHIT).EQ.0.0) GOTO 440
  1143.   430 IF (A(IXHIT).GE.0.0) A(IXHIT) = - A(IXHIT) - 1.
  1144.       GOTO 310
  1145. C
  1146. C          AND NOW LOOK FOR XP,YP IN NEXT ARRAY ENTRY
  1147. C
  1148.  440  IF (IXSCAN.GE.IXYUSE) GOTO 510
  1149.       IF (ABS(XP - A(IXSCAN+3)) .GT. EPS) GOTO 410
  1150.       IF (ABS(YP - A(IXSCAN+4)) .GT. EPS) GOTO 410
  1151.       IXHIT = IXSCAN + 5
  1152.       IF (A(IXHIT).EQ.0.0) GOTO 410
  1153.       GOTO 430
  1154. C
  1155. C          LINE NOT FOUND IN ARRAY - INSERT START POINT AT ARRAY END
  1156. C
  1157.   500 IF (IXHIT.GT.0) GOTO 430
  1158.       IF (IXHIT.EQ.-1) GOTO 520
  1159.       IXYUSE = IXYUSE + 3
  1160.       A(IXYUSE) = XFROM
  1161.       A(IXYUSE+1) = YFROM
  1162.       A(IXYUSE+2) = 0.
  1163.       IXSCAN = IXYUSE
  1164.       IXHIT = 1
  1165.       GOTO 420
  1166. C
  1167. C          LINE NOT FOUND IN ARRAY - INSERT LINE END AT ARRAY END
  1168. C
  1169.   510 IF (IXHIT.NE.0) GOTO 520
  1170.       IXHIT = -1
  1171.       GOTO 410
  1172.   520 IXYUSE = IXYUSE + 3
  1173.       A(IXYUSE) = XP
  1174.       A(IXYUSE+1) = YP
  1175.       A(IXYUSE+2) = -1.
  1176.       GOTO 310
  1177. C
  1178.   700 WRITE (NFLOG,2000) NPEL, NP
  1179.       IERROR = 1
  1180.       GOTO 900
  1181.   800 IF (LINES.EQ.0) GOTO 900
  1182.       DO 850 I=IXYSTA,IXYUSE,3
  1183.       J = I + 2
  1184.   850   A(J) = ABS(A(J))
  1185.   900 CONTINUE
  1186.       RETURN
  1187.  2000 FORMAT(26H ***ERROR: ELEMENT NODE NR,I3
  1188.      1  ,13H IS INVALID =,I5)
  1189.       END
  1190. C***ADD:CDC***
  1191. CDECK SHELL
  1192. C***END:CDC***
  1193.       SUBROUTINE SHELL (XPLOT,YPLOT,XPLOTD,YPLOTD,NOD,
  1194.      1                 EDATA,ITHICK,THICK,TMIDSS,IDRN,MIDS,
  1195.      2                 IEGIT,NTHICK,ISTRI,IEL,MXMNOD,ISEG)
  1196. C
  1197.       DIMENSION IA(1),XPLOT(1),YPLOT(1),XPLOTD(1),YPLOTD(1),NOD(1),
  1198.      1          EDATA(1),ITHICK(1),THICK(MXMNOD,1),TMIDSS(3,1),
  1199.      2          IDRN(1),MIDS(1)
  1200.       DIMENSION XSHELL(32),YSHELL(32),XSD(32),YSD(32),NODSH(32)
  1201.       DIMENSION LMID1(14),LMID2(72)
  1202. C
  1203.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1204.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  1205.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  1206.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  1207.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  1208.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  1209.       COMMON /ERROR/ IERROR
  1210.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  1211.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  1212.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  1213.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1214.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1215.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1216.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1217.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1218.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1219.      6                NDOFSA(6),NOUSE(4),FILL2
  1220.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  1221.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  1222.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  1223.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  1224.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  1225.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  1226.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  1227.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  1228.      8                KX49  ,KX50
  1229.       COMMON /PLOTLC/ LINTYP,IDEFOR,IXYSTA,IXYEND,IXYUSE,LINES
  1230.       COMMON A(1)
  1231.       EQUIVALENCE (A(1),IA(1))
  1232. C
  1233.       DATA LMID1/1,-5,-9,2,-6,-10,3,-7,-11,4,-8,-12,1,999/
  1234.       DATA LMID2/1,-5,-9,2,-6,-10,3,-7,-11,4,-8,-12,
  1235.      -  1,17,-21,-25,18,-22,-26,19,-23,-27,20,-24,-28,17,
  1236.      1  0,-5,-21,0,-9,-25,0,2,18,0,-6,-22,0,-10,-26,0,3,19,
  1237.      2  0,-7,-23,0,-11,-27,0,4,20,0,-8,-24,0,-12,-28,0,-13,-29,
  1238.      3  0,-14,-30,0,-15,-31,0,-16,-32,999/
  1239. C
  1240.       NPSAVE = NUMNP
  1241.       NUMNP = 32
  1242. C
  1243.       DO 100 I=1,32
  1244.   100   NODSH(I) = 0
  1245. C
  1246. C
  1247. C          IF ORIGINAL SHAPE  AND
  1248. C          MIDSPL.EQ.0, TOP AND BOTTOM SURFACES ARE PLOTTED
  1249. C
  1250. C
  1251.       IF (MIDSPL.EQ.1) GOTO 500
  1252.       IF (IDEFOR.EQ.1) GOTO 500
  1253. C
  1254. C          READ THICKNESS AND MIDSURFACE NORMAL INFORMATION
  1255. C
  1256.       IDBMID = 0
  1257.       IF (NTHICK.EQ.0 .OR. NMID.EQ.0) GOTO 200
  1258.       IDBMID = 1
  1259.       IF (ISEG.EQ.IEGIT) GOTO 200
  1260.       ISEG = IEGIT
  1261.       CALL DBREAD(EDATA,KEDATA,IEGIT,0)
  1262.         IF (IERROR.NE.0) GOTO 900
  1263. C
  1264.       CALL DBREAD (THICK,KTHICK,IEGIT,0)
  1265.         IF (IERROR.NE.0) GOTO 900
  1266. C
  1267.       CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  1268.         IF (IERROR.NE.0) GOTO 900
  1269. C
  1270.       CALL DBREAD (TMIDSS,KTMIDS,ISTRI,0)
  1271.         IF (IERROR.NE.0) GOTO 900
  1272. C
  1273. C
  1274. C          GET ALL TOP AND BOTTOM NODES
  1275. C
  1276.   200 NTH = ITHICK(IEL)
  1277.       IF (NTH.EQ.0) GOTO 750
  1278.       ITHNOD = 0
  1279.       DO 400 NPEL=1,16
  1280. C
  1281.       NPTOP = NOD(NPEL)
  1282.       IF (NPTOP.EQ.0) GOTO 400
  1283.       NODSH(NPEL) = NPEL
  1284.       XSHELL(NPEL) = XPLOT(NPTOP)
  1285.       YSHELL(NPEL) = YPLOT(NPTOP)
  1286.       XSD   (NPEL) = XPLOTD(NPTOP)
  1287.       YSD   (NPEL) = YPLOTD(NPTOP)
  1288. C
  1289.       NPEL16 = NPEL + 16
  1290.       NPBOT = NOD(NPEL16)
  1291.       NODSH(NPEL16) = NPEL16
  1292.       IF (NPBOT.EQ.0) GOTO 300
  1293. C
  1294. C          BOTTOM NODE IS GIVEN, FIRST NOD WAS TOP
  1295. C
  1296.       XSHELL(NPEL16) = XPLOT(NPBOT)
  1297.       YSHELL(NPEL16) = YPLOT(NPBOT)
  1298.       XSD   (NPEL16) = XPLOTD(NPBOT)
  1299.       YSD   (NPEL16) = YPLOTD(NPBOT)
  1300.       GOTO 400
  1301. C
  1302. C          MIDSURFACE NODE IS GIVEN
  1303. C
  1304.   300 IF (IDBMID.EQ.0) GOTO 750
  1305. C
  1306. C          COMPUTE HALF THICKNESS AT THIS NODE
  1307. C
  1308.       ITHNOD = ITHNOD + 1
  1309.       THNESS = THICK(ITHNOD,NTH) * 0.5
  1310. C
  1311. C          GET MIDSURFACE NORMAL VECTOR IN THIS NODE
  1312. C          AND COMPUTE A VECTOR WITH HALF THICKNESS LENGTH
  1313. C
  1314.       IMID = MIDS(NPTOP)
  1315.       IF (IMID.EQ.0) GOTO 750
  1316.       X = TMIDSS(1,IMID) * THNESS
  1317.       Y = TMIDSS(2,IMID) * THNESS
  1318.       Z = TMIDSS(3,IMID) * THNESS
  1319. C
  1320. C          COMPUTE PLOT VIEW PROJECTION
  1321. C
  1322.       XD = (VIEW(1,1)*X + VIEW(1,2)*Y + VIEW(1,3)*Z)*GSCALE
  1323.       YD = (VIEW(2,1)*X + VIEW(2,2)*Y + VIEW(2,3)*Z)*GSCALE
  1324. C
  1325. C          COMPUTE TOP AND BOTTOM NODE PLOT COORDINATES
  1326. C
  1327.       XSHELL(NPEL) = XPLOT(NPTOP) + XD
  1328.       YSHELL(NPEL) = YPLOT(NPTOP) + YD
  1329.       XSHELL(NPEL16) = XPLOT(NPTOP) - XD
  1330.       YSHELL(NPEL16) = YPLOT(NPTOP) - YD
  1331.       XSD(NPEL16) = XPLOTD(NPTOP)
  1332.       YSD(NPEL16) = YPLOTD(NPTOP)
  1333.   400 CONTINUE
  1334.       CALL PLOTL (XSHELL,YSHELL,XSD,YSD,NODSH,LMID2)
  1335.       GOTO 900
  1336. C
  1337. C
  1338. C          IF DEFORMATION PLOT  OR
  1339. C          MIDSPL.EQ.1,  MIDSURFACE IS PLOTTED
  1340. C
  1341. C
  1342.   500 DO 600 NPEL=1,16
  1343. C
  1344.       NPTOP = NOD(NPEL)
  1345.       IF (NPTOP.EQ.0) GOTO 600
  1346.       NODSH(NPEL) = NPEL
  1347.       XSHELL(NPEL) = XPLOT(NPTOP)
  1348.       YSHELL(NPEL) = YPLOT(NPTOP)
  1349.       XSD   (NPEL) = XPLOTD(NPTOP)
  1350.       YSD   (NPEL) = YPLOTD(NPTOP)
  1351.       NPBOT = NOD(NPEL+16)
  1352.       IF (NPBOT.EQ.0) GOTO 600
  1353. C
  1354. C          COMPUTE MIDDLE FROM TOP AND BOTTOM NODE
  1355. C
  1356.       XSHELL(NPEL) = (XPLOT(NPTOP) + XPLOT(NPBOT)) * 0.5
  1357.       YSHELL(NPEL) = (YPLOT(NPTOP) + YPLOT(NPBOT)) * 0.5
  1358.       XSD(NPEL) = (XPLOTD(NPTOP) + XPLOTD(NPBOT)) * 0.5
  1359.       YSD(NPEL) = (YPLOTD(NPTOP) + YPLOTD(NPBOT)) * 0.5
  1360.   600 CONTINUE
  1361. C
  1362.   700 CALL PLOTL (XSHELL,YSHELL,XSD,YSD,NODSH,LMID1)
  1363.       GOTO 900
  1364. C
  1365.   750 WRITE (NFLOG,2000) NPTOP,NPBOT,NTH,IMID
  1366.   800 IERROR = 1
  1367.   900 NUMNP = NPSAVE
  1368.       RETURN
  1369.  2000 FORMAT(40H ***ERROR: IN SHELL ELEMENT DATA, NPTOP=,I4,
  1370.      1  7H,NPBOT=,I4,5H,NTH=,I4,6H,IMID=,I4)
  1371.       END
  1372. C***ADD:CDC***
  1373. CDECK EVECT1
  1374. C***END:CDC***
  1375.       SUBROUTINE EVECT1
  1376. C
  1377.       DIMENSION IA(1)
  1378.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1379.       COMMON /ERROR/ IERROR
  1380.       COMMON /CALLP/NAMZON(8),NAMERC(8),
  1381.      1               IBITZ,IWHOLE,ICALL,IXPAR
  1382.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  1383.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  1384.      2             I16,I17,I18,I19,I20,
  1385.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  1386.      4             N16,N17,N18,N19,N20
  1387.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1388.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1389.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1390.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1391.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1392.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1393.      6                NDOFSA(6),NOUSE(4),FILL2
  1394.       COMMON A(1)
  1395.       EQUIVALENCE (A(1),IA(1))
  1396. C
  1397.       CALL ZGETNB
  1398.       IF (IERROR.NE.0) GOTO 900
  1399. C
  1400. C          BLANK COMMON LAYOUT
  1401. C
  1402. C                                                IEZONE
  1403.       I3 = I1 + MXEL
  1404.       IF (IBITZ.EQ.IWHOLE) I3 = I1
  1405. C                                                XYZ
  1406.       I4 = I3 + MXNP * 3 * ISURL
  1407. C                                                NOD
  1408.       I5 = I4 + MXELNP
  1409. C                                                NPAR
  1410.       I6 = I5 + NELPAR * MXEG
  1411. C                                                EDATA
  1412.       I7 = I6 + MXEL * (ISURL + 2)
  1413. C                                                ITABLE
  1414.       I8 = I7 + MXITAB
  1415. C                                                SXYZ
  1416.       I9 = I8 + MXIDER * 3 * ISURL
  1417. C                                                NERPTS
  1418.       I10 = I9 + MXEL
  1419. C                                                IDERPT
  1420.       I11 = I10 + MXIDER
  1421. C                                                ERES
  1422.       I12 = I11 + MXERES * ISURL
  1423. C                                                TIMEE,NSTEPE (TEMPORARY
  1424.       I13 = I12 + NSTEE * (ISURL + 1)
  1425. C
  1426. C          MORE MEMORY IS REQUESTED DYNAMICALLY IN EVECT2
  1427. C
  1428.       CALL SIZE (I13)
  1429.       IF (IERROR.NE.0) GOTO 900
  1430.       CALL EVECT2 (IA(I1),IA(I3),IA(I4),NELPAR,IA(I5),IA(I6)
  1431.      1  ,IA(I7),IA(I8),IA(I9),IA(I10),IA(I11),IA(I12))
  1432. C
  1433.   900 RETURN
  1434.       END
  1435. C***ADD:CDC***
  1436. CDECK EVECT2
  1437. C***END:CDC***
  1438.       SUBROUTINE EVECT2 (IEZONE,XYZ,NOD,NPARD,NPAR,EDATA,
  1439.      1   ITABLE,SXYZ,NERPTS,IDERPT,ERES,TIMEE)
  1440. C
  1441.       DIMENSION IEZONE(1),XYZ(1),NOD(1),NPAR(NPARD,1),EDATA(1),
  1442.      1          ITABLE(1),SXYZ(3,1),NERPTS(1),IDERPT(1),ERES(1),
  1443.      2          TIMEE(1),IPSELE(3),SIGP(3),DIRCOS(3,3),IA(1)
  1444.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1445.       COMMON /EPS/ EPS
  1446.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  1447.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  1448.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  1449.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  1450.      1               IBITZ,IWHOLE,ICALL,IXPAR
  1451.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  1452.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  1453.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  1454.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  1455.       COMMON /ERROR/ IERROR
  1456.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  1457.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  1458.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  1459.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  1460.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  1461.      2             IXGP(50),MXSGP(50),
  1462.      3             FILL1
  1463.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  1464.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  1465.      2             I16,I17,I18,I19,I20,
  1466.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  1467.      4             N16,N17,N18,N19,N20
  1468.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1469.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1470.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1471.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1472.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1473.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1474.      6                NDOFSA(6),NOUSE(4),FILL2
  1475.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  1476.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  1477.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  1478.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  1479.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  1480.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  1481.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  1482.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  1483.      8                KX49  ,KX50
  1484.       COMMON A(1)
  1485.       EQUIVALENCE (A(1),IA(1))
  1486. C
  1487.       DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,PLATE,SHELL/1,2,3,4,5,6,7/
  1488.       DATA I2DIMF,I3DIMF/11,12/
  1489.       DATA IPLON,IPLOFF,IUP,ISOLID,ISPLIT/5,4,3,2,4/
  1490. C
  1491. C          PARAMETER: KIND
  1492. C
  1493.       KIND = INTV(2)
  1494. C
  1495. C          PARAMETER: TIME
  1496. C
  1497.       TIME = REALV(3)
  1498.       IF (ITYPE(3).EQ.IOMIT) TIME = 9E20
  1499.       IF (NSTEE.GT.0) GOTO 110
  1500.         WRITE (NFLOG,2000)
  1501.         GOTO 800
  1502.   110 CALL DBREAD (TIMEE,KTIMEE,1,0)
  1503.       IF (IERROR.NE.0) GOTO 900
  1504.       TDIFFO = 9E30
  1505.       DO 120 I=1,NSTEE
  1506.         TDIFF = ABS (TIME - TIMEE(I))
  1507.         IF (TDIFFO.LE.TDIFF) GOTO 120
  1508.         TDIFFO = TDIFF
  1509.         ITIME = I
  1510.   120   CONTINUE
  1511.       TIME = TIMEE(ITIME)
  1512. C
  1513. C          PARAMETER:  VLENGH
  1514. C
  1515.       VLENGH = REALV(4)
  1516. C
  1517. C          PARAMETER:  LIST
  1518. C
  1519.       LIST = INTV(5)
  1520. C
  1521. C          INITIALIZE
  1522. C
  1523.       ISEGIT = 0
  1524.       ISERES = 0
  1525.       IXVSTA = I12 / ISURL
  1526.       IXVNEX = IXVSTA
  1527.       IXVEND = I13 / ISURL
  1528.       ISTRUC = 0
  1529.       IEGIT = 0
  1530.       IEGAT = 0
  1531.       VMAX = 0.0
  1532.       IPSELE(1) = 1
  1533.       IPSELE(2) = 1
  1534.       IPSELE(3) = 1
  1535.       NUMP = 3
  1536. C
  1537. C          DO FOR EVERY STRUCTURE, REUSE AND EL GROUP
  1538. C
  1539.       DO 650 ISTRI=1,NSTRI
  1540. C
  1541.       CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  1542.       IF (IERROR.NE.0) GOTO 900
  1543.       I = ISTRI - 1
  1544.       NRUSE = IA(I06+I)
  1545.       NEG   = IA(I07+I)
  1546.       NUMNP = IA(I08+I)
  1547. C
  1548.       DO 640 IRUSE=1,NRUSE
  1549. C
  1550.       ISTRUC = ISTRUC + 1
  1551. C
  1552.       DO 630 IEG=1,NEG
  1553. C
  1554.       LSTEG = 1
  1555.       IEGIT = IEGIT + 1
  1556.       IEGAT = IEGAT + 1
  1557.       IELTYP = NPAR(1,IEG)
  1558.       NEL    = NPAR(2,IEG)
  1559.       INDNL  = NPAR(3,IEG)
  1560.       NTABLE = NPAR(13,IEG)
  1561. C
  1562. C          SKIP ELEMENT TYEPS NOT SUPPORTED
  1563. C
  1564.       IF (IELTYP.NE.I2DIM .OR. NPAR(5,IEG).EQ.3) GOTO 630
  1565. C
  1566. C          CHECK IF ANY ELEMENT IN GROUP BELONGS TO ZONE
  1567. C
  1568.       IF (IBITZ.EQ.IWHOLE) GOTO 160
  1569.       CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  1570.       DO 150 IEL=1,NEL
  1571.         CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  1572.         IF (ISELEC.EQ.1) GOTO 160
  1573.   150   CONTINUE
  1574.       GOTO 630
  1575. C
  1576. C          READ AND COMPUTE ELEMENT RESULT INFORMATION
  1577. C
  1578.   160 CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NEL+1),ITABLE,
  1579.      1  NTABLE,IEGIT,ISEGIT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
  1580.       IF (IERROR.NE.0) GOTO 900
  1581.       IF (NERES.EQ.0) GOTO 630
  1582. C
  1583.       CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
  1584.       IF (IERROR.NE.0) GOTO 900
  1585. C
  1586. C          DO FOR ALL ELEMENTS IN GROUP
  1587. C
  1588.       IXIDER = 0
  1589.       IXERES = - NERKI
  1590. C
  1591.       DO 620 IEL=1,NEL
  1592. C
  1593.       NERPT = NERPTS(IEL)
  1594.       IF (NERPT.EQ.0) GOTO 620
  1595.       ISELEC = 1
  1596.       IF (IBITZ.NE.IWHOLE)
  1597.      1  CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  1598. C
  1599. C          DO FOR ELEMENT STRESS POINTS
  1600. C
  1601.       DO 610 IERPT=1,NERPT
  1602. C
  1603.       IXIDER = IXIDER + 1
  1604.       IXERES = IXERES + NERKI
  1605. C
  1606.       IF (ISELEC.EQ.0) GOTO 610
  1607. C
  1608. C          SKIP UNBORN OR DEAD ELEMENT
  1609. C
  1610.       IDERES = IDERPT(IXIDER)
  1611.       IF (IDERES.LT.0) GOTO 610
  1612. C
  1613. C          READ ERES AND SXYZ
  1614. C
  1615.       IF (ISERES.EQ.IEGAT) GOTO 180
  1616.       ISERES = IEGAT
  1617.       CALL DBREAD (ERES,KERES,IEGAT,ITIME)
  1618.       IF (IERROR.NE.0) GOTO 900
  1619.       CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
  1620.       IF (IERROR.NE.0) GOTO 900
  1621. C
  1622.   180 IF (ERES(IXERES+1).EQ.987654E32) GOTO 610
  1623.       DO 190 I=1,3
  1624.         SIGP(I) = 0.
  1625.         DO 190 J=1,3
  1626.   190     DIRCOS(I,J) = 0.
  1627. C
  1628. C
  1629. C          2-DIMENSIONAL SOLID WITH NPAR(5).NE.3
  1630. C          ELEMENT RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM
  1631. C
  1632.   200 YY = ERES(IXERES+1)
  1633.       ZZ = ERES(IXERES+2)
  1634.       YZ = ERES(IXERES+3)
  1635.       XX = ERES(IXERES+4)
  1636. C
  1637. C          FIND PRINCIPAL STRESSES
  1638. C
  1639.       AA = (YY + ZZ) * 0.5
  1640.       BB = (YY - ZZ) * 0.5
  1641.       CC = SQRT(BB*BB + YZ*YZ)
  1642.       SIGP(1) = AA + CC
  1643.       SIGP(2) = AA - CC
  1644.       SIGP(3) = XX
  1645. C
  1646. C          FIND DIRECTIONS OF THE PRINCIPAL STRESSES
  1647. C
  1648.       ANG = 45.0
  1649.       IF (YZ.EQ.0.) ANG = 0.00001
  1650.       IF (ABS(BB).LT.0.0000001) GOTO 210
  1651.       ANG = 28.6479 * ATAN ( ABS ( YZ / BB ) )
  1652.       IF ( (BB * YZ ) .LE. 0. ) ANG = 90.0 - ANG
  1653.       IF ( YZ.LE.0. )           ANG = 90.0 + ANG
  1654. C
  1655.   210 ANGRAD = ANG * 0.0174533
  1656.       PSIN = SIN(ANGRAD)
  1657.       PCOS = COS(ANGRAD)
  1658.       DIRCOS(2,1) = PCOS
  1659.       DIRCOS(3,1) = PSIN
  1660.       DIRCOS(2,2) = -PSIN
  1661.       DIRCOS(3,2) = PCOS
  1662.       DIRCOS(1,3) = 1.
  1663. C
  1664. C
  1665.   500 IF (LIST.EQ.0) GOTO 550
  1666.       WRITE (NFLOG,2010) ISTRI,IRUSE,IEG,IEL,IDERES,SIGP(1),SIGP(2),ANG
  1667. C
  1668. C          SAVE PRINCIPAL STRESSES FOR PLOTTING
  1669. C
  1670.   550 IF (VLENGH.LT.EPS) GOTO 610
  1671. C
  1672. C          IXY = 0 FOR STRESS POINT COORDINATES SXYZ
  1673. C          IXY = 1,2,3  FOR PRINCIPAL STRESSES DISPLACEMENTS (XYZ)
  1674. C
  1675.       IXY = 0
  1676.       X = SXYZ(1,IXIDER)
  1677.       Y = SXYZ(2,IXIDER)
  1678.       Z = SXYZ(3,IXIDER)
  1679. C
  1680. C          TRANSFORM X,Y,Z TO PLOT COORDINATES XP,YP
  1681. C
  1682.   560 XP = VIEW(1,1)*X + VIEW(1,2)*Y + VIEW(1,3)*Z
  1683.       YP = VIEW(2,1)*X + VIEW(2,2)*Y + VIEW(2,3)*Z
  1684. C
  1685. C          SAVE MAX LENGTH
  1686. C
  1687.       IF (IXY.EQ.0) GOTO 570
  1688.       XL = SQRT(XP*XP + YP*YP)
  1689.       IF (VMAX.LT.XL) VMAX = XL
  1690. C
  1691. C          IF TENSION, MAKE XP OR IF XP=0 YP POSITIVE
  1692. C
  1693.       IF (XP.GT.0.) GOTO 565
  1694.       IF (XP.LT.0.) GOTO 564
  1695.       IF (YP.GT.0.) GOTO 565
  1696.   564 XP = -XP
  1697.       YP = -YP
  1698.   565 IF (SIG.GE.0.) GOTO 570
  1699.       XP = -XP
  1700.       YP = -YP
  1701. C
  1702. C          SAVE XP,YP IN ARRAY
  1703. C
  1704.   570 IF (IXVNEX.LT.IXVEND) GOTO 580
  1705.       IXVEND = IXVEND + 200
  1706.       I = IXVEND * ISURL
  1707.       CALL SIZE(I)
  1708.       IF (IERROR.NE.0) GOTO 900
  1709. C
  1710.   580 A(IXVNEX) = XP
  1711.       A(IXVNEX+1) = YP
  1712.       IXVNEX = IXVNEX + 2
  1713. C
  1714. C          LOOP FOR SELECTED PRINCIPLE STRESSES
  1715. C
  1716.   590 IXY = IXY + 1
  1717.       IF (IXY.GT.3) GOTO 610
  1718.       IF (IPSELE(IXY).EQ.0) GOTO 590
  1719. C
  1720. C          COMPUTE X,Y,Z DISPLACEMENT FOR STRESS VECTOR
  1721. C
  1722.       SIG = SIGP(IXY)
  1723.       X = SIG * DIRCOS(1,IXY)
  1724.       Y = SIG * DIRCOS(2,IXY)
  1725.       Z = SIG * DIRCOS(3,IXY)
  1726.       GOTO 560
  1727. C
  1728.   610 CONTINUE
  1729.   620 CONTINUE
  1730.   630 CONTINUE
  1731.       IEGIT = IEGIT - NEG
  1732.   640 CONTINUE
  1733.       IEGIT = IEGIT + NEG
  1734.   650 CONTINUE
  1735. C
  1736. C
  1737. C          DO THE PLOTTING
  1738. C
  1739.       IF (VLENGH.LT.EPS) GOTO 900
  1740.       IF (VMAX.LT.EPS) GOTO 900
  1741.       VSCALE = VLENGH / VMAX * 0.5
  1742.       WRITE (NFLOG,2020) TIME,VSCALE
  1743.       CALL CGRAPH (IPLON)
  1744.       IX = IXVSTA
  1745. C
  1746. C          DO FOR ALL STRESS VECTORS SAVED IN ARRAY
  1747. C
  1748.   710 IF (IX.GE.IXVNEX) GOTO 790
  1749.       IXY = 0
  1750.       XPP = A(IX)   * GSCALE + XPV
  1751.       YPP = A(IX+1) * GSCALE + YPV
  1752.       IX = IX + 2
  1753. C
  1754. C          PLOT SELECTED PRINCIPAL STRESSES
  1755. C
  1756.   720 IXY = IXY + 1
  1757.       IF (IXY.GT.3) GOTO 710
  1758.       IF (IPSELE(IXY).EQ.0) GOTO 720
  1759.       XD = A(IX)   * VSCALE
  1760.       YD = A(IX+1) * VSCALE
  1761.       IX = IX + 2
  1762. C
  1763. C          SPLIT LINE FOR TENSION
  1764. C          SOLID LINE FOR COMPRESSION
  1765. C
  1766.       LINTYP = ISOLID
  1767.       IF (XD.GT.0. .OR. (XD.EQ.0. .AND.YD.GT.0.)) LINTYP = ISPLIT
  1768. C
  1769. C          DRAW A VECTOR
  1770. C
  1771.       XP = XPP + XD
  1772.       YP = YPP + YD
  1773.       CALL LCLIP (XP,YP,IUP)
  1774.       XP = XPP - XD
  1775.       YP = YPP - YD
  1776.       CALL LCLIP (XP,YP,LINTYP)
  1777.       GOTO 720
  1778. C
  1779.   790 CALL CGRAPH (IPLOFF)
  1780.       GOTO 900
  1781.   800 IERROR = 1
  1782.   900 RETURN
  1783.  2000 FORMAT(46H ***ERROR: NO TIMESTEP OF ELEMENT RESULT SAVED)
  1784.  2010 FORMAT(5I10,10(3X,G12.6))
  1785.  2020 FORMAT(4X,13HVECTOR  TIME=G12.4,9H  VSCALE=,G12.3)
  1786.       END
  1787. C***ADD:CDC***
  1788. CDECK NHIST1
  1789. C***END:CDC***
  1790.       SUBROUTINE NHIST1 (NUMNPS)
  1791. C
  1792.       DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),NUMNPS(1)
  1793. C
  1794.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1795.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  1796.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  1797.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  1798.      1               IBITZ,IWHOLE,ICALL,IXPAR
  1799.       COMMON /ERROR/ IERROR
  1800.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  1801.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  1802.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  1803.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  1804.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  1805.      2             I16,I17,I18,I19,I20,
  1806.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  1807.      4             N16,N17,N18,N19,N20
  1808.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1809.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1810.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1811.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1812.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1813.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1814.      6                NDOFSA(6),NOUSE(4),FILL2
  1815.       COMMON A(1)
  1816.       EQUIVALENCE (A(1),IA(1))
  1817. C
  1818. C          PARAM 12: SUBF
  1819. C
  1820.       CALL SUBF (12)
  1821.         IF (IERROR.NE.0) GOTO 900
  1822. C
  1823. C          PARAM 1: NODE
  1824. C
  1825.       NODE = INTV(1)
  1826.       IF (NODE.LT.1 .OR. NODE.GT.NUMNPS(INSTRI)) GOTO 850
  1827. C
  1828. C          PARAM 2, 3: NDIR, KIND
  1829. C
  1830.       NDIR = INTV(2)
  1831.       IF (ITYPE(2).EQ.IOMIT) NDIR = 1
  1832.       IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
  1833.       NDIRV(1) = NDIR
  1834. C
  1835.       KIND = INTV(3)
  1836.       IF (ITYPE(3).EQ.IOMIT) KIND = 1
  1837.       IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
  1838.       KINDV(1) = KIND
  1839. C
  1840. C          BLANK COMMON LAYOUT
  1841. C
  1842. C                                                TIMEN
  1843.       N12 = N1 + NSTEN
  1844. C                                                TIMEPL (FOR PLOT)
  1845.       N13 = N12 + NSTEN + 2
  1846. C                                                VARPL (FOR PLOT)
  1847.       N14 = N13 + NSTEN + 2
  1848. C                                                RSDCOS
  1849.       I15 = (N14 + NSKEWS * 9) * ISURL
  1850. C                                                IDRN
  1851.       I16 = I15
  1852.       IF (NSKEWS.GT.0)
  1853.      1  I16 = I15 + (NDOF + 2) * MXNP
  1854.       CALL SIZE (I16)
  1855.         IF (IERROR.NE.0) GOTO 900
  1856. C
  1857.       ICALL = 1
  1858.       IXPAR = 4
  1859.       CALL NHIST2 (NODE,NDIRV,KINDV,VALUEV,A(N1),A(N12)
  1860.      1       ,A(N13),IA(I16),A(N14),IA(I15),IA(I16),IA(I16),IA(I16))
  1861.       GOTO 900
  1862.   850 IERROR = 2
  1863.   900 RETURN
  1864.       END
  1865. C***ADD:CDC***
  1866. CDECK NHIST2
  1867. C***END:CDC***
  1868.       SUBROUTINE NHIST2 (NP,NDIRV,KINDV,VALUEV,TIMEN
  1869.      1        ,TIMEPL,VARPL,IRPOL,RSDCOS,IDRN,LINEID,NODEP,NAMEP)
  1870. C
  1871.       DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),TIMEN(1),TIMEPL(1)
  1872.      1          ,VARPL(1),IXA(5),IREAD(5),KINDHD(3)
  1873.      2          ,IRPOL(1),RSDCOS(9,1),IDRN(1),VDIR(6),
  1874.      3           LINEID(3,1),NODEP(99,1),NAMEP(8,1)
  1875. C
  1876.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  1877.       COMMON /EPS/ EPS
  1878.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  1879.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  1880.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  1881.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  1882.      1               IBITZ,IWHOLE,ICALL,IXPAR
  1883.       COMMON /ERROR/ IERROR
  1884.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  1885.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  1886.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  1887.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  1888.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  1889.      2             IXGP(50),MXSGP(50),
  1890.      3             FILL1
  1891.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  1892.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  1893.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  1894.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  1895.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  1896.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  1897.      6                NDOFSA(6),NOUSE(4),FILL2
  1898.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  1899.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  1900.      2             I16,I17,I18,I19,I20,
  1901.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  1902.      4             N16,N17,N18,N19,N20
  1903.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  1904.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  1905.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  1906.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  1907.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  1908.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  1909.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  1910.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  1911.      8                KX49  ,KX50
  1912.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  1913.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  1914.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  1915.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  1916.       COMMON A(1)
  1917.       EQUIVALENCE (A(1),IA(1))
  1918.       DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
  1919.       DATA IHDTIM/4HTIME/
  1920.       DATA IHDNOD/4HNODE/
  1921.       DATA IPLOFF/4/
  1922. C
  1923. C          PARAM TSTART, TEND, NTSKIP
  1924. C
  1925.       TSTA = REALV(IXPAR)
  1926.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TSTART
  1927.       TEND = REALV(IXPAR+1)
  1928.       IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTART + DT * NSTE
  1929.       EPSVAL = DT * EPS
  1930.       NTSKIP = INTV(IXPAR+2)
  1931.       IF (NTSKIP.LT.0) GOTO 850
  1932. C
  1933. C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP
  1934. C
  1935.       NXAXIS = INTV(IXPAR+3)
  1936.       NYAXIS = INTV(IXPAR+4)
  1937.       ISYMBL = INTV(IXPAR+5)
  1938.       ISSKIP = INTV(IXPAR+6)
  1939.       LIST   = INTV(IXPAR+7)
  1940. C
  1941.       IF (NSTEN.GE.2) GOTO 2
  1942.         WRITE (NFLOG,2000)
  1943.         GOTO 800
  1944. C
  1945. C          READ NPOINT IF RHIST COMMAND
  1946. C
  1947.   2   ISTRUC = INSTRU
  1948.       ISTRI = INSTRI
  1949. C     IRUSE = INRUSE
  1950.       IF (ICALL.NE.ICALLR) GOTO 10
  1951.         IF (IXGP(KNPOIN).EQ.0) GOTO 5
  1952.         CALL DBREAD (LINEID,KNPOIN,1,0)
  1953.           IF (IERROR.NE.0) GOTO 900
  1954.         DO 5 ILINEN=1,MLINEN
  1955.           DO 3  J=1,8
  1956.             IF (NAMEP(J,ILINEN).NE.IANUMV(J,1)) GOTO 5
  1957.   3         CONTINUE
  1958.           NP = NODEP(1,ILINEN)
  1959.           ISTRI  = LINEID(1,ILINEN)
  1960.           ISTRUC = LINEID(2,ILINEN)
  1961.           IRUSE  = LINEID(3,ILINEN)
  1962.           GOTO 10
  1963.   5     CONTINUE
  1964.         WRITE (NFLOG,2120)
  1965.         GOTO 800
  1966.   10  NUMNP = IA(I08+ISTRI-1)
  1967. C
  1968. C          CHECK WHAT KINDS ARE NEEDED
  1969. C
  1970.       DO 20 KIND=1,5
  1971.   20    IXA(KIND) = 0
  1972.       IVAEND = 1
  1973.       IF (ICALL.EQ.ICALLR) IVAEND = MVAR
  1974.       DO 30 IVAR=1,IVAEND
  1975.         KIND = KINDV(IVAR)
  1976.         IF (KIND.NE.0) IXA(KIND) = 1
  1977.         IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  1978.   30    CONTINUE
  1979. C
  1980. C          BLANK COMMON FOR DBREAD OF NEEDED KINDS
  1981. C
  1982. C                                                DISP
  1983. C                                                VEL
  1984. C                                                ACC
  1985. C                                                TEMP
  1986. C
  1987.       NIX = I16 / ISURL
  1988.       DO 60 KIND=1,5
  1989.         IF (IXA(KIND).EQ.0) GOTO 60
  1990.         IXA(KIND) = NIX
  1991.         IF (KIND.NE.KINXYZ) GOTO 40
  1992.         NIX = NIX + 3 * MXNP
  1993.           GOTO 60
  1994.   40    IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
  1995.           WRITE (NFLOG,2010)
  1996.           GOTO 800
  1997.   50    NIX = NIX + MXNP * NDOF
  1998.   60    CONTINUE
  1999.       CALL SIZE (NIX)
  2000.       IF (IERROR.NE.0) GOTO 900
  2001. C
  2002. C          READ TIMEN, NSTEPN
  2003. C
  2004.       CALL DBREAD (TIMEN,KTIMEN,1,0)
  2005.         IF (IERROR.NE.0) GOTO 900
  2006.       NPTS = 0
  2007.       ITSKIP = 0
  2008.       ISRSDC = 0
  2009.       ISIDRN = 0
  2010.       IREAD(KINXYZ) = 0
  2011. C
  2012. C          DO FOR ALL TIMESTEPS OF NODAL DATA
  2013. C
  2014.       DO 650 ITIME=1,NSTEN
  2015. C
  2016.       TIME = TIMEN(ITIME)
  2017.       IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
  2018.       IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
  2019. C
  2020. C          NTSKIP TIMESTEPS BETWEEN OUTPUT
  2021. C
  2022.       IF (ITIME.EQ.NSTEN) GOTO 120
  2023.       IF (TIMEN(ITIME+1).GT.TEND+EPSVAL) GOTO 120
  2024.       ITSKIP = ITSKIP - 1
  2025.       IF (ITSKIP.GE.0) GOTO 650
  2026.   120 ITSKIP = NTSKIP
  2027.       DO 125 KIND=1,4
  2028.   125   IREAD(KIND) = 0
  2029. C
  2030. C          READ VARIABLE VALUES FROM DATABASE
  2031. C
  2032.   200 IVPLUS = (NP - 1) * NDOF - 1
  2033.       DO 290 IVAR=1,IVAEND
  2034.         KIND = KINDV(IVAR)
  2035.         IF (KIND.EQ.0) GOTO 290
  2036.         IXAKIN = IXA(KIND)
  2037.         NDIR = NDIRV(IVAR)
  2038.         IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
  2039.         IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
  2040.             WRITE (NFLOG,2210)
  2041.             GOTO 800
  2042.   210     IF (KIND.NE.KINXYZ)
  2043.      1    CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
  2044.           IF (KIND.EQ.KINXYZ)
  2045.      1    CALL DBREAD (A(IXAKIN),KXYZ,ISTRUC,0)
  2046.           IF (IERROR.NE.0) GOTO 700
  2047.         IREAD(KIND) = ISTRUC
  2048. C
  2049. C          TEMPERATURE
  2050. C
  2051.   220 IF (KIND.NE.KINDT) GOTO 225
  2052.         VALUEV(IVAR) = A(IXAKIN+NP-1)
  2053.         GOTO 290
  2054. C
  2055. C          XYZ
  2056. C
  2057.   225 IF (KIND.NE.KINXYZ) GOTO 230
  2058.         IXW = IXAKIN + (NDIR - 1) * NUMNP  +  NP - 1
  2059.         VALUEV(IVAR) = A(IXW)
  2060.         GOTO 290
  2061. C
  2062. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  2063. C
  2064.   230 IXW = IXAKIN + IVPLUS
  2065.       DO 250 I=1,6
  2066.         VDIR(I) = 0.0
  2067.         INDOF = NDOFSA(I)
  2068.         IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  2069.   250   CONTINUE
  2070. C
  2071. C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
  2072. C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
  2073. C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
  2074. C
  2075.       IF (NSKEWS.EQ.0) GOTO 285
  2076.       IF (ISIDRN.NE.ISTRI)
  2077.      1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  2078.         IF (IERROR.NE.0) GOTO 900
  2079.         ISIDRN = ISTRI
  2080.       IXNRST = NDOF * NUMNP
  2081.       ISKEW = IDRN(IXNRST+NP)
  2082.       IF (ISKEW.LE.0 .OR. LSKEW.EQ.1) GOTO 285
  2083.       IF (ISRSDC.EQ.0)
  2084.      1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
  2085.         IF (IERROR.NE.0) GOTO 900
  2086.         ISRSDC = 1
  2087.       CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  2088. C
  2089.   285 VALUEV(IVAR) = VDIR(NDIR)
  2090.   290   CONTINUE
  2091. C
  2092. C          EXECUTE RESULTANT COMPUTATION
  2093. C
  2094.       IF (ICALL.NE.ICALLR) GOTO 300
  2095.       CALL FORMEX (VALUEV,IRPOL)
  2096.       IF (IERROR.NE.0) GOTO 700
  2097. C
  2098. C          SAVE TIME AND VALUE FOR PLOT
  2099. C
  2100.   300 NPTS = NPTS + 1
  2101.       TIMEPL(NPTS) = TIME
  2102.       VARPL (NPTS) = VALUEV(1)
  2103. C
  2104.   650 CONTINUE
  2105.       IF (NPTS.GE.2) GOTO 700
  2106.         WRITE (NFLOG,2030)
  2107.         GOTO 800
  2108. C
  2109. C          LIST
  2110. C
  2111.   700   NDIR = NDIRV(1)
  2112.         KIND = KINDV(1)
  2113.         CALL KINDN (NDIR,KIND,KINDHD)
  2114.       LPOS1 = 1
  2115.       IF (LIST.NE.1) LPOS1 = 0
  2116.       DO 730 I=1,NPTS
  2117.         IF (LINE.LE.LINPAG) GOTO 710
  2118.           WRITE (NFLIST,2040) LPOS1,NP,KINDHD,NAMERC
  2119.           LINE = 5
  2120.           IF (ISTRI.EQ.1) GOTO 702
  2121.       ISUBST = ISTRI - 1
  2122.           WRITE (NFLIST,2345) ISUBST, IRUSE
  2123.           LINE = LINE + 2
  2124.   702     IF (NSKEWS.EQ.0 .OR. KIND.EQ.KINDT) GOTO 705
  2125.           IF (ISKEW.LE.0) WRITE (NFLIST,2550)
  2126.           IF (ISKEW.GT.0) WRITE (NFLIST,2551)
  2127.           LINE = LINE + 2
  2128.   705     IF (LIST.NE.1) GOTO 740
  2129.           WRITE (NFLIST,2050) KINDHD, NAMERC
  2130.   710   WRITE (NFLIST,2060) TIMEPL(I),VARPL(I)
  2131.         LINE = LINE + 1
  2132.   730   CONTINUE
  2133. C
  2134.   740 CALL XYPLOT (TIMEPL,VARPL,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
  2135.         IF (IERROR.NE.0) GOTO 900
  2136. C
  2137. C          PLOT TEXT 'TIME' BELOW X-AXIS IF AUTOM. SCALED
  2138. C
  2139.       IF (NXAXIS.NE.0) GOTO 750
  2140.       XP = PMARG + AXEDGE
  2141.       YP = PMARG
  2142.         CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
  2143. C
  2144. C          PLOT NODAL VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
  2145. C
  2146.   750 IF (NYAXIS.NE.0) GOTO 770
  2147.       XP = PMARG + HEIGHT
  2148.       YP = PMARG + AXEDGE
  2149.       IF (ICALL.EQ.ICALLR) GOTO 765
  2150.         DO 760 I=1,3
  2151.           NBCD = KINDHD(I)
  2152.           CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
  2153.           XP = 999.0
  2154.           YP = 999.0
  2155.   760   CONTINUE
  2156.         GOTO 770
  2157.   765 DO 767 I=1,8
  2158.         NBCD = NAMERC(I)
  2159.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.0,1,1)
  2160.         XP = 999.0
  2161.   767   YP = 999.0
  2162. C
  2163. C          PLOT 'NODE XXX' IN UPPER RIGHT CORNER
  2164. C
  2165.   770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
  2166.       XP = XPMAX - PMARG - HEIGHT * 8.0
  2167.       YP = YPMAX - PMARG - HEIGHT
  2168.       CALL AGRAPH (XP,YP,HEIGHT,IHDNOD,0.,0.,4,1)
  2169.       XP = XP + HEIGHT * 5.0
  2170.       FPN = NP
  2171.       CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
  2172. C
  2173.   780 CALL CGRAPH (IPLOFF)
  2174.       IF (LIST.NE.1) LINE = 32766
  2175.       GOTO 900
  2176.   800 IERROR = 1
  2177.       GOTO 900
  2178.   850 IERROR = 2
  2179.   900 RETURN
  2180.  2000 FORMAT(32H ***ERROR: NO NODAL RESULT SAVED)
  2181.  2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
  2182.  2030 FORMAT(41H ***ERROR: LESS THAN 2 TIMESTEPS SELECTED)
  2183.  2040 FORMAT(I1,26H   TIME HISTORY FOR NODE =,I5,3X,3A4,8A1)
  2184.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  2185.  2050 FORMAT(/20H     TIME           ,3A4,8A1/)
  2186.  2060 FORMAT(5X,E10.4,5X,E12.6)
  2187.  2120 FORMAT (28H ***ERROR: PNAME NOT DEFINED)
  2188.  2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
  2189.  2550 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
  2190.      1  17HCOORDINATE SYSTEM)
  2191.  2551 FORMAT(40H    OUTPUT RESULTS ARE MEASURED IN SKEW ,
  2192.      1  17HCOORDINATE SYSTEM)
  2193.       END
  2194. C***ADD:CDC***
  2195. CDECK EHIST1
  2196. C***END:CDC***
  2197.       SUBROUTINE EHIST1
  2198. C
  2199.       DIMENSION IA(1),KINDV(1),VALUEV(1)
  2200. C
  2201.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  2202.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  2203.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  2204.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  2205.      1               IBITZ,IWHOLE,ICALL,IXPAR
  2206.       COMMON /ERROR/ IERROR
  2207.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  2208.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  2209.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  2210.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  2211.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  2212.      2             I16,I17,I18,I19,I20,
  2213.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  2214.      4             N16,N17,N18,N19,N20
  2215.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  2216.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  2217.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  2218.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  2219.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  2220.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  2221.      6                NDOFSA(6),NOUSE(4),FILL2
  2222.       COMMON A(1)
  2223.       EQUIVALENCE (A(1),IA(1))
  2224. C
  2225. C          PARAM 13: SUBF
  2226. C
  2227.       CALL SUBF (13)
  2228.         IF (IERROR.NE.0) GOTO 900
  2229. C
  2230. C          PARAM 4: KIND
  2231. C
  2232.       KINDV(1) = INTV(4)
  2233. C
  2234. C          BLANK COMMON LAYOUT FOR EHIST2
  2235. C
  2236. C                                                TIMEE
  2237.       N12 = N1 + NSTEE
  2238. C                                                TIMEPL (FOR PLOT)
  2239.       N13 = N12 + NSTEE + 2
  2240. C                                                VARPL (FOR PLOT)
  2241.       N14 = N13 + NSTEE + 2
  2242. C                                                ERES
  2243.       I15 = (N14 + MXERES) * ISURL
  2244. C                                                EDATA
  2245.       I16 = I15 + (ISURL + 2) * MXEL
  2246. C                                                ITABLE
  2247.       I17 = I16 + MXITAB
  2248. C                                                NPAR
  2249.       I18 = I17 + NELPAR * MXEG
  2250. C                                                NERPTS
  2251.       I19 = I18 + MXEL
  2252. C                                                IDERPT
  2253.       I20 = I19 + MXIDER
  2254. C
  2255.       CALL SIZE (I20)
  2256.         IF (IERROR.NE.0) GOTO 900
  2257. C
  2258.       ICALL = 1
  2259.       IXPAR = 5
  2260.       CALL EHIST2 (KINDV,VALUEV,A(N1),A(N12),A(N13),
  2261.      1     A(N14),IA(I15),IA(I16),NELPAR,IA(I17),IA(I18),IA(I19),
  2262.      2     IA(I20),IA(I20),IA(I20),IA(I06),IA(I07),
  2263.      3     IA(I20),IETYP)
  2264.   900 RETURN
  2265.       END
  2266. C***ADD:CDC***
  2267. CDECK EHIST2
  2268. C***END:CDC***
  2269.       SUBROUTINE EHIST2 (KINDV,VALUEV,TIMEE,TIMEPL,
  2270.      1  VARPL,ERES,EDATA,ITABLE,NPARD,NPAR,NERPTS,IDERPT,
  2271.      2  LINEID,NELP,NAMEP,NRUSES,NEGS,IRPOL,IETYP)
  2272. C
  2273.       DIMENSION IA(1),KINDV(1),VALUEV(1),TIMEE(1),TIMEPL(1),
  2274.      1     VARPL(1),ERES(1),EDATA(1),ITABLE(1),NPAR(NPARD,1),NERPTS(1),
  2275.      2         IDERPT(1),LINEID(4,1),NELP(98,1),NAMEP(8,1),
  2276.      3          NRUSES(1),NEGS(1),IRPOL(1),KINDHD(3)
  2277. C
  2278.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  2279.       COMMON /EPS/ EPS
  2280.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  2281.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  2282.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  2283.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  2284.      1               IBITZ,IWHOLE,ICALL,IXPAR
  2285.       COMMON /ERROR/ IERROR
  2286.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  2287.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  2288.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  2289.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  2290.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  2291.      2             IXGP(50),MXSGP(50),
  2292.      3             FILL1
  2293.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  2294.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  2295.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  2296.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  2297.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  2298.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  2299.      6                NDOFSA(6),NOUSE(4),FILL2
  2300.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  2301.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  2302.      2             I16,I17,I18,I19,I20,
  2303.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  2304.      4             N16,N17,N18,N19,N20
  2305.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  2306.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  2307.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  2308.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  2309.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  2310.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  2311.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  2312.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  2313.      8                KX49  ,KX50
  2314.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  2315.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  2316.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  2317.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  2318.       COMMON A(1)
  2319.       EQUIVALENCE (A(1),IA(1))
  2320.       DATA ICALLS,ICALLR/1,2/
  2321.       DATA IHDTIM/4HTIME/
  2322.       DATA IHDEG,IHDE,IHDP/3HEG ,4H  E ,4H  P /
  2323.       DATA IPLOFF/4/
  2324. C
  2325. C          PARAM TSTART, TEND, NTSKIP
  2326. C
  2327.       TSTA = REALV(IXPAR)
  2328.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TSTART
  2329.       TEND = REALV(IXPAR+1)
  2330.       IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTART + DT * NSTE
  2331.       EPSVAL = DT * EPS
  2332.       NTSKIP = INTV(IXPAR+2)
  2333.       IF (NTSKIP.LT.0) GOTO 850
  2334. C
  2335. C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP
  2336. C
  2337.       NXAXIS = INTV(IXPAR+3)
  2338.       NYAXIS = INTV(IXPAR+4)
  2339.       ISYMBL = INTV(IXPAR+5)
  2340.       ISSKIP = INTV(IXPAR+6)
  2341.       LIST   = INTV(IXPAR+7)
  2342. C
  2343.       IF (NSTEE.GE.1) GOTO 10
  2344.         WRITE (NFLOG,2000)
  2345.         GOTO 800
  2346. C
  2347. C          EHIST PARAM 1,2,3:  IEG, IEL, IDERES
  2348. C
  2349.   10  IF (ICALL.EQ.ICALLR) GOTO 20
  2350.       ISTRI = INSTRI
  2351.       IRUSE = INRUSE
  2352.       IEG   = INTV(1)
  2353.       IEL   = INTV(2)
  2354.       IDERES = INTV(3)
  2355.       IVAEND = 1
  2356.       GOTO 40
  2357. C
  2358. C          READ NPOINT IF RHIST COMMAND
  2359. C
  2360.   20  IVAEND = MVAR
  2361.       IF (IXGP(KEPOIN).EQ.0) GOTO 35
  2362.       CALL DBREAD (LINEID,KEPOIN,1,0)
  2363.         IF (IERROR.NE.0) GOTO 900
  2364.       DO 35 ILINEE=1,MLINEE
  2365.         DO 30 J=1,8
  2366.           IF (NAMEP(J,ILINEE).NE.IANUMV(J,1)) GOTO 35
  2367.   30      CONTINUE
  2368.         ISTRI  = LINEID(1,ILINEE)
  2369.         IRUSE  = LINEID(3,ILINEE)
  2370.         IEG    = LINEID(4,ILINEE)
  2371.         IEL    = NELP(1,ILINEE)
  2372.         IDERES = NELP(2,ILINEE)
  2373.         GOTO 40
  2374.   35  CONTINUE
  2375.       WRITE (NFLOG,2120)
  2376.       GOTO 800
  2377. C
  2378. C          CHECK ELEMENT GROUP NUMBER
  2379. C
  2380.   40  NEG = NEGS(ISTRI)
  2381.       IF (IEG.GE.1 .AND. IEG.LE.NEG) GOTO 60
  2382.   50    WRITE (NFLOG,2070) IEG, IEL
  2383.         GOTO 800
  2384. C
  2385. C          READ NPAR
  2386. C
  2387.   60  CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  2388.       IF (IERROR.NE.0) GOTO 900
  2389.       IELTYP = NPAR(1,IEG)
  2390.       NUME   = NPAR(2,IEG)
  2391.       INDNL  = NPAR(3,IEG)
  2392.       IDEATH = NPAR(4,IEG)
  2393.       NTABLE = NPAR(13,IEG)
  2394.       IF (IEL.LT.1 .OR. IEL.GT.NUME) GOTO 50
  2395. C
  2396. C          CHECK RESULTANT FORMULA IETYP
  2397. C
  2398.       IF (ICALL.NE.ICALLR .OR. IETYP.EQ.IELTYP) GOTO 65
  2399.         WRITE (NFLOG,2130) IETYP, IELTYP
  2400.         GOTO 800
  2401. C
  2402. C          COMPUTE IEGIT AND IEGAT
  2403. C
  2404.   65  IEGIT = IEG - NEG
  2405.       IEGAT = IEG - NEG * (NRUSES(ISTRI) - IRUSE + 1)
  2406.       DO 70 I=1,ISTRI
  2407.         IEGIT = IEGIT + NEGS(I)
  2408.   70    IEGAT = IEGAT + NEGS(I) * NRUSES(I)
  2409.       ISEDAT = 0
  2410. C
  2411. C          READ TIMEE, NSTEPE
  2412. C
  2413.       CALL DBREAD (TIMEE,KTIMEE,1,0)
  2414.         IF (IERROR.NE.0) GOTO 900
  2415.       NPTS = 0
  2416.       ITSKIP = 0
  2417. C
  2418. C          DO FOR ALL TIMESTEPS OF ELEMENT DATA
  2419. C
  2420.       DO 650 ITIME=1,NSTEE
  2421. C
  2422.       TIME = TIMEE(ITIME)
  2423.       IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
  2424.       IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
  2425. C
  2426. C          NTSKIP TIMESTEPS BETWEEN OUTPUT
  2427. C
  2428.       IF (ITIME.EQ.NSTEE) GOTO 120
  2429.       IF (TIMEE(ITIME+1).GT.TEND+EPSVAL) GOTO 120
  2430.       ITSKIP = ITSKIP - 1
  2431.       IF (ITSKIP.GE.0) GOTO 650
  2432.   120 ITSKIP = NTSKIP
  2433. C
  2434. C          UPDATE NERPTS,IDERPT ARRAYS AND NERES,NERKI
  2435. C
  2436.       IF (IDEATH.EQ.0 .AND. IEGIT.EQ.ISEDAT) GOTO 240
  2437.       CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NUME+1),ITABLE,NTABLE,
  2438.      1     IEGIT,ISEDAT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
  2439.       IF (IERROR.NE.0) GOTO 900
  2440. C
  2441. C          CHECK KINDV VALUES
  2442. C
  2443.       DO 200 IVAR=1,IVAEND
  2444.         KIND = KINDV(IVAR)
  2445.         IF (KIND.EQ.0 .AND. ICALL.EQ.ICALLR) GOTO 200
  2446.         IF (KIND.GE.1 .AND. KIND.LE.NERKI) GOTO 200
  2447.           WRITE (NFLOG,2080) KIND
  2448.           GOTO 800
  2449.   200   CONTINUE
  2450. C
  2451. C          FIND IDERES = ELEMENT RESULT POINT ID
  2452. C
  2453.   210 IXIDER = 1
  2454.       IXERES = 0
  2455.       DO 220 IELWK=1,IEL
  2456.         NERPT = NERPTS(IELWK)
  2457.         IXIDER = IXIDER + NERPT
  2458.   220   IXERES = IXERES + NERPT * NERKI
  2459.       IXIDER = IXIDER - NERPT
  2460.       IXERES = IXERES - NERPT * NERKI
  2461.       IF (NERPT.EQ.0) GOTO 235
  2462. C
  2463.       DO 230 IERPT=1,NERPT
  2464.         IDERPW = IDERPT(IXIDER)
  2465. C          SKIP UNBORN OR DEAD ELEMENT
  2466.         IF (IDERPW.LT.0) GOTO 650
  2467.         IF (IDERES.EQ.IDERPW) GOTO 240
  2468.         IXIDER = IXIDER + 1
  2469.   230   IXERES = IXERES + NERKI
  2470. C
  2471. C          IDERES POINT IS NOT FOUND
  2472. C
  2473.   235 WRITE (NFLOG,2085) IDERES
  2474.       GOTO 800
  2475. C
  2476. C          READ ERES
  2477. C
  2478.   240 CALL DBREAD (ERES,KERES,IEGAT,ITIME)
  2479.       IF (IERROR.NE.0) GOTO 900
  2480. C
  2481.       DO 250 IVAR=1,IVAEND
  2482.         KIND = KINDV(IVAR)
  2483.         IF (KIND.EQ.0) GOTO 250
  2484.         VALUEV(IVAR) = ERES(IXERES+KIND)
  2485.         IF (VALUEV(IVAR) .EQ. 987654E32) GOTO 235
  2486.   250   CONTINUE
  2487. C
  2488. C          EXECUTE RESULTANT COMPUTATION
  2489. C
  2490.       IF (ICALL.NE.ICALLR) GOTO 300
  2491.       CALL FORMEX (VALUEV,IRPOL)
  2492.       IF (IERROR.NE.0) GOTO 700
  2493. C
  2494. C          SAVE TIME AND VALUE FOR PLOT
  2495. C
  2496.   300 NPTS = NPTS + 1
  2497.       TIMEPL(NPTS) = TIME
  2498.       VARPL (NPTS) = VALUEV(1)
  2499. C
  2500.   650 CONTINUE
  2501.       IF (NPTS.GE.2) GOTO 700
  2502.         WRITE (NFLOG,2030)
  2503.         GOTO 800
  2504. C
  2505. C          LIST
  2506. C
  2507.   700 KIND = KINDV(1)
  2508.       CALL KINDE (IELTYP,INDNL,NTABLE,KIND,KINDHD)
  2509.       LPOS1 = 1
  2510.       IF (LIST.NE.1) LPOS1 = 0
  2511.       DO 730 I=1,NPTS
  2512.         IF (LINE.LE.LINPAG) GOTO 710
  2513.           WRITE (NFLIST,2040) LPOS1,IEG,IEL,IDERES,KINDHD,NAMERC
  2514.           IF (LOCALE.EQ.0) WRITE (NFLIST,2035)
  2515.           IF (LOCALE.EQ.1) WRITE (NFLIST,2036)
  2516.           LINE = 4
  2517.           IF (ISTRI.EQ.1) GOTO 705
  2518.             ISUBST = ISTRI - 1
  2519.             WRITE (NFLIST,2345) ISUBST, IRUSE
  2520.             LINE = LINE + 2
  2521.   705     IF (LIST.EQ.0) GOTO 740
  2522.           WRITE (NFLIST,2050) KINDHD, NAMERC
  2523.           LINE = LINE + 2
  2524.   710   WRITE (NFLIST,2060) TIMEPL(I),VARPL(I)
  2525.         LINE = LINE + 1
  2526.   730   CONTINUE
  2527. C
  2528.   740 CALL XYPLOT (TIMEPL,VARPL,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
  2529.         IF (IERROR.NE.0) GOTO 900
  2530. C
  2531. C          PLOT TEXT 'TIME' BELOW X-AXIS IF AUTOM. SCALED
  2532. C
  2533.       IF (NXAXIS.NE.0) GOTO 750
  2534.       XP = PMARG + AXEDGE
  2535.       YP = PMARG
  2536.         CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
  2537. C
  2538. C          PLOT ELEMENT VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
  2539. C
  2540.   750 IF (NYAXIS.NE.0) GOTO 770
  2541.       XP = PMARG + HEIGHT
  2542.       YP = PMARG + AXEDGE
  2543.       IF (ICALL.EQ.ICALLR) GOTO 765
  2544.         DO 760 I=1,3
  2545.           NBCD = KINDHD(I)
  2546.           CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
  2547.           XP = 999.0
  2548.           YP = 999.0
  2549.   760   CONTINUE
  2550.         GOTO 770
  2551.   765 DO 767 I=1,8
  2552.         NBCD = NAMERC(I)
  2553.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.0,1,1)
  2554.         XP = 999.0
  2555.   767   YP = 999.0
  2556. C
  2557. C          PLOT 'EG X  E XX  P XX' AT UPPER RIGHT CORNER
  2558. C
  2559.   770 IF (NPAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
  2560.       XP = XPMAX - PMARG - HEIGHT * 16.
  2561.       YP = YPMAX - PMARG - HEIGHT
  2562.       CALL AGRAPH (XP,YP,HEIGHT,IHDEG,0.,0.,3,1)
  2563.       XP = 999.0
  2564.       YP = 999.0
  2565.       FPN = IEG
  2566.       CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
  2567.       CALL AGRAPH (XP,YP,HEIGHT,IHDE,0.,0.,4,1)
  2568.       FPN = IEL
  2569.       CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
  2570.       CALL AGRAPH (XP,YP,HEIGHT,IHDP,0.,0.,4,1)
  2571.       FPN = IDERES
  2572.       CALL AGRAPH (XP,YP,HEIGHT,0,FPN,0.,-1,3)
  2573. C
  2574.   780 CALL CGRAPH (IPLOFF)
  2575.       IF (LIST.NE.1) LINE = 32766
  2576.       GOTO 900
  2577.   800 IERROR = 1
  2578.       GOTO 900
  2579.   850 IERROR = 2
  2580.   900 RETURN
  2581.  2000 FORMAT(34H ***ERROR: NO ELEMENT RESULT SAVED)
  2582.  2030 FORMAT(41H ***ERROR: LESS THAN 2 TIMESTEPS SELECTED)
  2583.  2035 FORMAT(/35H    RESULTS ARE MEASURED IN GLOBAL ,
  2584.      1  17HCOORDINATE SYSTEM)
  2585.  2036 FORMAT(/36H    RESULTS ARE MEASURED IN ELEMENT ,
  2586.      1  17HCOORDINATE SYSTEM)
  2587.  2040 FORMAT(I1,3X,32HTIME HISTORY FOR ELEMENT GROUP =,I3,
  2588.      1  11H  ELEMENT =,I4,9H  POINT =,I4,3X,3A4,8A1)
  2589.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  2590.  2050 FORMAT(/20H     TIME           ,3A4,8A1/)
  2591.  2060 FORMAT(5X,E11.5,5X,E12.6)
  2592.  2070 FORMAT(34H ***ERROR: INVALID ELEMENT GROUP =,I5,
  2593.      1  25H  OR INVALID ELEMENT NO =,I5)
  2594.  2080 FORMAT (25H ***ERROR: INVALID KIND =,I4)
  2595.  2085 FORMAT(44H ***ERROR: ELEMENT RESULT POINT NOT SAVED ON
  2596.      1   24H ADINA PORTHOLE, POINT =,I5)
  2597.  2120 FORMAT (28H ***ERROR: PNAME NOT DEFINED)
  2598.  2130 FORMAT(35H ***ERROR: RESULTANT ELEMENT TYPE =,I2,
  2599.      1 38H IS NOT SAME AS ELEMENT TYPE NPAR(1) =,I2)
  2600.       END
  2601. C***ADD:CDC***
  2602. CDECK NLINE1
  2603. C***END:CDC***
  2604.       SUBROUTINE NLINE1
  2605. C
  2606.       DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1)
  2607. C
  2608.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  2609.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  2610.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  2611.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  2612.      1               IBITZ,IWHOLE,ICALL,IXPAR
  2613.       COMMON /ERROR/ IERROR
  2614.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  2615.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  2616.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  2617.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  2618.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  2619.      2             I16,I17,I18,I19,I20,
  2620.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  2621.      4             N16,N17,N18,N19,N20
  2622.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  2623.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  2624.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  2625.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  2626.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  2627.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  2628.      6                NDOFSA(6),NOUSE(4),FILL2
  2629.       COMMON A(1)
  2630.       EQUIVALENCE (A(1),IA(1))
  2631. C
  2632. C          PARAM 10: NSUBF
  2633. C
  2634.       CALL SUBF (10)
  2635.         IF (IERROR.NE.0) GOTO 900
  2636. C
  2637. C          PARAM 2, 3: NDIR, KIND
  2638. C
  2639.       NDIR = INTV(2)
  2640.       IF (ITYPE(2).EQ.IOMIT) NDIR = 1
  2641.       IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
  2642.       NDIRV(1) = NDIR
  2643. C
  2644.       KIND = INTV(3)
  2645.       IF (ITYPE(3).EQ.IOMIT) KIND = 1
  2646.       IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
  2647.       KINDV(1) = KIND
  2648. C
  2649. C          BLANK COMMON LAYOUT FOR NLINE2
  2650. C
  2651. C                                                TIMEN, NSTEPN
  2652.       N12 = N1 + NSTEN + NSTEN / ISURL + 1
  2653. C                                                XPLOT
  2654.       N13 = N12 + 101
  2655. C                                                YPLOT
  2656.       N14 = N13 + 101
  2657. C                                                XYZ
  2658.       N15 = N14 + MXNP * 3
  2659. C                                                RSDCOS
  2660.       I16 = (N15 + NSKEWS * 9) * ISURL
  2661. C                                                IDRN
  2662.       I17 = I16
  2663.       IF (NSKEWS.GT.0 .AND. LSKEW.EQ.0)
  2664.      1  I17 = I16 + (NDOF + 2) * MXNP
  2665. C                                                LINEID
  2666.       I18 = I17 + MLINEN * 3
  2667. C                                                NODEP
  2668.       I19 = I18 + MLINEN * 99
  2669. C                                                NAMEP
  2670.       I20 = I19 + MLINEN * 8
  2671.       CALL SIZE (I20)
  2672.         IF (IERROR.NE.0) GOTO 900
  2673. C
  2674.       ICALL = 1
  2675.       IXPAR = 4
  2676.       CALL NLINE2 (NDIRV,KINDV,VALUEV,IA(I20),
  2677.      1     A(N1),A(N12),A(N13),A(N14),A(N15),IA(I16),IA(I17),
  2678.      2     IA(I18),IA(I19))
  2679.       GOTO 900
  2680.   850 IERROR = 2
  2681.   900 RETURN
  2682.       END
  2683. C***ADD:CDC***
  2684. CDECK NLINE2
  2685. C***END:CDC***
  2686.       SUBROUTINE NLINE2 (NDIRV,KINDV,VALUEV,IRPOL,TIMEN,
  2687.      1           XPLOT,YPLOT,XYZ,RSDCOS,IDRN,LINEID,NODEP,NAMEP)
  2688. C
  2689.       DIMENSION IA(1),NDIRV(1),KINDV(1),VALUEV(1),IRPOL(1),TIMEN(1),
  2690.      1          XPLOT(1),YPLOT(1),XYZ(1),LINEID(3,1),NODEP(99,1),
  2691.      2          NAMEP(8,1),IXA(5),IREAD(5),KINDHD(3)
  2692.      3         ,RSDCOS(9,1),IDRN(1),VDIR(6),NAMEL(8)
  2693. C
  2694.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  2695.       COMMON /EPS/ EPS
  2696.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  2697.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  2698.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  2699.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  2700.      1               IBITZ,IWHOLE,ICALL,IXPAR
  2701.       COMMON /ERROR/ IERROR
  2702.       COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
  2703.      1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
  2704.      2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
  2705.      3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
  2706.      4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
  2707.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  2708.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  2709.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  2710.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  2711.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  2712.      2             IXGP(50),MXSGP(50),
  2713.      3             FILL1
  2714.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  2715.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  2716.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  2717.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  2718.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  2719.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  2720.      6                NDOFSA(6),NOUSE(4),FILL2
  2721.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  2722.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  2723.      2             I16,I17,I18,I19,I20,
  2724.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  2725.      4             N16,N17,N18,N19,N20
  2726.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  2727.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  2728.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  2729.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  2730.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  2731.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  2732.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  2733.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  2734.      8                KX49  ,KX50
  2735.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  2736.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  2737.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  2738.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  2739.       COMMON A(1)
  2740.       EQUIVALENCE (A(1),IA(1))
  2741.       DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
  2742.       DATA IHDNOD,IHDHYP/4HNODE,3H - /
  2743.       DATA IHDTIM/4HTIME/
  2744.       DATA IPLOFF,ISPACE/4,1H /
  2745. C
  2746. C          CHECK WHAT KINDS ARE NEEDED
  2747. C
  2748.   10  DO 20 KIND=1,5
  2749.         IREAD(KIND) = 0
  2750.   20    IXA(KIND) = 0
  2751.       IVAEND = 1
  2752.       IF (ICALL.EQ.ICALLR) IVAEND = MVAR
  2753.       DO 30 IVAR=1,IVAEND
  2754.         KIND = KINDV(IVAR)
  2755.         IF (KIND.NE.0) IXA(KIND) = 1
  2756.         IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  2757.   30    CONTINUE
  2758. C
  2759. C          BLANK COMMON FOR DBREAD OF NEEDED KINDS
  2760. C
  2761. C                                                DISP
  2762. C                                                VEL
  2763. C                                                ACC
  2764. C                                                TEMP
  2765. C
  2766.       NIX = I20 / ISURL
  2767.       DO 60 KIND=1,5
  2768.         IF (IXA(KIND).EQ.0) GOTO 60
  2769.         IF (KIND.EQ.KINXYZ) GOTO 60
  2770.         IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
  2771.           WRITE (NFLOG,2010)
  2772.           GOTO 800
  2773.    50   IXA(KIND) = NIX
  2774.         NIX = NIX + MXNP * NDOF
  2775.   60    CONTINUE
  2776.       CALL SIZE (NIX)
  2777.       IF (IERROR.NE.0) GOTO 900
  2778. C
  2779. C          PARAM: TIME
  2780. C
  2781.       TIME = REALV(IXPAR)
  2782.       IF (NSTEN.GT.0) GOTO 120
  2783.         WRITE (NFLOG,2000)
  2784.         GOTO 800
  2785.   120 CALL DBREAD (TIMEN,KTIMEN,1,0)
  2786.         IF (IERROR.NE.0) GOTO 900
  2787.       IF (ITYPE(IXPAR).EQ.IOMIT) TIME = TIMEN(NSTEN)
  2788.       TDIFFO = 9E30
  2789.       DO 130 I=1,NSTEN
  2790.         TDIFF = ABS(TIME - TIMEN(I))
  2791.         IF (TDIFFO.LE.TDIFF) GOTO 130
  2792.         TDIFFO = TDIFF
  2793.         ITIME = I
  2794.   130   CONTINUE
  2795.       TIME = TIMEN(ITIME)
  2796. C
  2797. C          PARAM 1: PNAME
  2798. C
  2799.   135 IF (IXGP(KNPOIN).EQ.0) GOTO 160
  2800.       CALL DBREAD (LINEID,KNPOIN,1,0)
  2801.         IF (IERROR.NE.0) GOTO 900
  2802.       DO 150 ILINEN=1,MLINEN
  2803.         DO 140 I=1,8
  2804.           ICODE = NAMEP(I,ILINEN)
  2805.           IF (IANUMV(I,1).NE.ICODE) GOTO 150
  2806.           CALL APCHAR(ICODE)
  2807.           NAMEL(I) = ICODE
  2808.   140     CONTINUE
  2809.         ISTRI  = LINEID(1,ILINEN)
  2810.         NUMNP = IA(I08+ISTRI-1)
  2811.         ISTRUC = LINEID(2,ILINEN)
  2812.         IRUSE  = LINEID(3,ILINEN)
  2813.         GOTO 170
  2814.   150   CONTINUE
  2815.   160 WRITE (NFLOG,2020)
  2816.       GOTO 800
  2817. C
  2818. C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP, LIST
  2819. C
  2820.   170 NXAXIS = INTV(IXPAR+1)
  2821.       NYAXIS = INTV(IXPAR+2)
  2822.       ISYMBL = INTV(IXPAR+3)
  2823.       ISSKIP = INTV(IXPAR+4)
  2824.       LIST   = INTV(IXPAR+5)
  2825. C
  2826. C          READ XYZ
  2827. C
  2828.       CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
  2829.         IF (IERROR.NE.0) GOTO 900
  2830. C
  2831. C          DO FOR ALL NODE POINTS IN LINE
  2832. C
  2833.       ISRSDC = 0
  2834.       ISIDRN = 0
  2835.       NPTS = 0
  2836.       XPOINT = 0.0
  2837.       DO 400 IPNODE=1,99
  2838.         NP = NODEP(IPNODE,ILINEN)
  2839.         IF (NP.EQ.0) GOTO 401
  2840.         NPTS = NPTS + 1
  2841. C
  2842. C          COMPUTE GEOMETRICAL DISTANCE (DEFORMATION NOT INCLUDED)
  2843. C
  2844.       XNOW = XYZ(NP)
  2845.       I = NUMNP + NP
  2846.       YNOW = XYZ(I)
  2847.       ZNOW = XYZ(I+NUMNP)
  2848.       IF (NPTS.EQ.1) GOTO 190
  2849.         XDIST = XNOW - XOLD
  2850.         YDIST = YNOW - YOLD
  2851.         ZDIST = ZNOW - ZOLD
  2852.         XPOINT = XPOINT + SQRT(XDIST*XDIST + YDIST*YDIST + ZDIST*ZDIST)
  2853.   190 XOLD = XNOW
  2854.       YOLD = YNOW
  2855.       ZOLD = ZNOW
  2856.       XPLOT(NPTS) = XPOINT
  2857. C
  2858. C          READ VARIABLE VALUES FROM DATABASE
  2859. C
  2860.   200 IVPLUS = (NP - 1) * NDOF - 1
  2861.       DO 290 IVAR=1,IVAEND
  2862.         KIND = KINDV(IVAR)
  2863.         IF (KIND.EQ.0) GOTO 290
  2864.         NDIR = NDIRV(IVAR)
  2865.         IXAKIN = IXA(KIND)
  2866. C
  2867. C          XYZ
  2868. C
  2869.         IF (KIND.NE.KINXYZ) GOTO 205
  2870.         IXW = (NDIR - 1) * NUMNP + NP
  2871.         VALUEV(IVAR) = XYZ(IXW)
  2872.         GOTO 290
  2873.   205   IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
  2874.         IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
  2875.             WRITE (NFLOG,2210)
  2876.             GOTO 800
  2877.   210     CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
  2878.           IF (IERROR.NE.0) GOTO 900
  2879.         IREAD(KIND) = ISTRUC
  2880. C
  2881. C          TEMPERATURE
  2882. C
  2883.   220 IF (KIND.NE.KINDT) GOTO 230
  2884.         VALUEV(IVAR) = A(IXAKIN+NP-1)
  2885.         GOTO 290
  2886. C
  2887. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  2888. C
  2889.   230 IXW = IXAKIN + IVPLUS
  2890.       DO 250 I=1,6
  2891.         VDIR(I) = 0.0
  2892.         INDOF = NDOFSA(I)
  2893.         IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  2894.   250   CONTINUE
  2895. C
  2896. C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
  2897. C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
  2898. C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
  2899. C
  2900.       IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 285
  2901.       IF (ISIDRN.NE.ISTRI)
  2902.      1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  2903.         IF (IERROR.NE.0) GOTO 900
  2904.         ISIDRN = ISTRI
  2905.       IXNRST = NDOF * NUMNP
  2906.       ISKEW = IDRN(IXNRST+NP)
  2907.       IF (ISKEW.LE.0) GOTO 285
  2908.       IF (ISRSDC.EQ.0)
  2909.      1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
  2910.         IF (IERROR.NE.0) GOTO 900
  2911.         ISRSDC = 1
  2912.       CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  2913. C
  2914.   285 VALUEV(IVAR) = VDIR(NDIR)
  2915.   290   CONTINUE
  2916. C
  2917. C          EXECUTE RESULTANT COMPUTATION
  2918. C
  2919.       IF (ICALL.NE.ICALLR) GOTO 300
  2920.       CALL FORMEX (VALUEV,IRPOL)
  2921.       IF (IERROR.NE.0) GOTO 800
  2922. C
  2923.   300 YPLOT(NPTS) = VALUEV(1)
  2924.   400 CONTINUE
  2925.   401 CONTINUE
  2926. C
  2927. C          LIST
  2928. C
  2929.       NDIR = NDIRV(1)
  2930.       KIND = KINDV(1)
  2931.       CALL KINDN (NDIR,KIND,KINDHD)
  2932. C
  2933.       LPOS1 = 1
  2934.       IF (LIST.NE.1) LPOS1 = 0
  2935.       DO 730 I=1,NPTS
  2936.       IF (LINE.LE.LINPAG) GOTO 710
  2937.         WRITE (NFLIST,2030) LPOS1,NAMEL,TIME,KINDHD,NAMERC
  2938.         LINE = 2
  2939.         IF (NSKEWS.EQ.0 .OR. KIND.EQ.KINDT) GOTO 600
  2940.           IF (LSKEW.NE.1) WRITE (NFLIST,2550)
  2941.           IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
  2942.           LINE = LINE + 2
  2943.   600   IF (ISTRI.EQ.1) GOTO 705
  2944.         ISUBST = ISTRI - 1
  2945.           WRITE (NFLIST,2345) ISUBST, IRUSE
  2946.           LINE = LINE + 2
  2947.   705   IF (LIST.NE.1) GOTO 740
  2948.         WRITE (NFLIST,2040) (KINDHD(J),J=1,3), NAMERC
  2949.         LINE = LINE + 2
  2950.   710   WRITE (NFLIST,2050) NODEP(I,ILINEN),XPLOT(I),YPLOT(I)
  2951.         LINE = LINE + 1
  2952. C
  2953.   730 CONTINUE
  2954.   740 IF (NPTS.GE.2) GOTO 745
  2955.         WRITE (NFLOG,2070)
  2956.         GOTO 800
  2957. C
  2958.   745 CALL XYPLOT (XPLOT,YPLOT,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
  2959.         IF (IERROR.NE.0) GOTO 900
  2960. C
  2961. C          PLOT TEXT 'NAMEP  NODE NNNN - MMMM'
  2962. C          BELOW X-AXIS IF AUTOMATICALLY SCALED
  2963. C
  2964.       IF (NXAXIS.NE.0) GOTO 750
  2965.       XP = PMARG + AXEDGE
  2966.       YP = PMARG
  2967.       DO 747 I=1,8
  2968.         NBCD = NAMEL(I)
  2969.         IF (NBCD.EQ.ISPACE) GOTO 747
  2970.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
  2971.         XP = XP + HEIGHT
  2972.   747   CONTINUE
  2973.       XP = XP + HEIGHT + HEIGHT
  2974.         CALL AGRAPH (XP,YP,HEIGHT,IHDNOD,0.,0.,4,1)
  2975.       CALL AGRAPH (999.0,999.0,HEIGHT,IHDHYP,0.0,0.0,1,1)
  2976.         FPN = NODEP(1,ILINEN)
  2977.         CALL AGRAPH (999.0,999.0,HEIGHT,0,FPN,0.0,-1,3)
  2978.         CALL AGRAPH (999.0,999.0,HEIGHT,IHDHYP,0.0,0.0,3,1)
  2979.         FPN = NODEP(NPTS,ILINEN)
  2980.         CALL AGRAPH (999.0,999.0,HEIGHT,0,FPN,0.,-1,3)
  2981. C
  2982. C          PLOT NODAL VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
  2983. C
  2984.   750 IF (NYAXIS.NE.0) GOTO 770
  2985.       XP = PMARG + HEIGHT
  2986.       YP = PMARG + AXEDGE
  2987.       IF (ICALL.EQ.ICALLR) GOTO 765
  2988.         DO 760 I=1,3
  2989.           NBCD = KINDHD(I)
  2990.           CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
  2991.           XP = 999.0
  2992.           YP = 999.0
  2993.   760   CONTINUE
  2994.         GOTO 770
  2995.   765 DO 767 I=1,8
  2996.         NBCD = NAMERC(I)
  2997.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,1,1)
  2998.         XP = 999.0
  2999.   767   YP = 999.0
  3000. C
  3001. C          PLOT 'TIME X.XXX' IN UPPER RIGHT CORNER
  3002. C
  3003.   770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
  3004.       I = 0
  3005.       IF (TIME.NE.0.0) I = MAX0(0, 3 - INT(ALOG10(ABS(TIME))))
  3006.       XP = XPMAX - PMARG - HEIGHT * 10.0
  3007.       YP = YPMAX - PMARG - HEIGHT
  3008.       CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
  3009.       XP = XP + HEIGHT * 5.0
  3010.       CALL AGRAPH (XP,YP,HEIGHT,0,TIME,0.,I,3)
  3011. C
  3012.   780 CALL CGRAPH (IPLOFF)
  3013.       IF (LIST.NE.1) LINE = 32766
  3014.       GOTO 900
  3015. C
  3016.   800 IERROR = 1
  3017.   900 RETURN
  3018.  2000 FORMAT (43H ***ERROR: NO TIMESTEP FOR NODAL DATA FOUND)
  3019.  2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
  3020.  2020 FORMAT(29H ***ERROR: LINENAME NOT FOUND)
  3021.  2030 FORMAT(I1,3X,28HNODAL RESULTS ALONG NLINE = ,8A1,
  3022.      1  11H  AT TIME =,G11.5,5X,3A4,8A1)
  3023.  2040 FORMAT(/20H  NODE   LINE COORD.,5X,3A4,8A1/)
  3024.  2050 FORMAT(1X,I5,3X,E12.6,3X,E12.6)
  3025.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  3026.  2070 FORMAT (38H ***ERROR: ONLY ONE NODE POINT IN LINE)
  3027.  2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
  3028.  2550 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
  3029.      1  17HCOORDINATE SYSTEM)
  3030.  2551 FORMAT(/42H    OUTPUT RESULTS ARE MEASURED IN GLOBAL ,
  3031.      1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
  3032.       END
  3033. C***ADD:CDC***
  3034. CDECK ELINE1
  3035. C***END:CDC***
  3036.       SUBROUTINE ELINE1
  3037. C
  3038.       DIMENSION IA(1),KINDV(1),VALUEV(1)
  3039. C
  3040.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3041.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3042.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3043.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  3044.      1               IBITZ,IWHOLE,ICALL,IXPAR
  3045.       COMMON /ERROR/ IERROR
  3046.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3047.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3048.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3049.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3050.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3051.      2             I16,I17,I18,I19,I20,
  3052.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3053.      4             N16,N17,N18,N19,N20
  3054.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  3055.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  3056.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  3057.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  3058.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  3059.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  3060.      6                NDOFSA(6),NOUSE(4),FILL2
  3061.       COMMON A(1)
  3062.       EQUIVALENCE (A(1),IA(1))
  3063. C
  3064. C          PARAM 9 : NSUBF
  3065. C
  3066.       CALL SUBF (9)
  3067.         IF (IERROR.NE.0) GOTO 900
  3068. C
  3069. C          PARAM 2 : KIND
  3070. C
  3071.       KINDV(1) = INTV(2)
  3072. C
  3073. C          BLANK COMMON LAYOUT FOR ELINE2
  3074. C
  3075. C                                                TIMEE, NSTEPE
  3076.       N12 = N1 + NSTEE + NSTEE / ISURL + 1
  3077. C                                                XPLOT
  3078.       N13 = N12 + 51
  3079. C                                                YPLOT
  3080.       N14 = N13 + 51
  3081. C                                                ERES
  3082.       I15 = (N14 + MXERES) * ISURL
  3083. C                                                EDATA
  3084.       I16 = I15 + (ISURL + 2) * MXEL
  3085. C                                                ITABLE
  3086.       I17 = I16 + MXITAB
  3087. C                                                NPAR
  3088.       I18 = I17 + NELPAR * MXEG
  3089. C                                                NERPTS
  3090.       I19 = I18 + MXEL
  3091. C                                                IDERPT
  3092.       I20 = I19 + MXIDER
  3093. C                                                SXYZ
  3094.       I21 = I20 + MXIDER * 3 * ISURL
  3095. C                                                LINEID
  3096.       I22 = I21 + MLINEE * 4
  3097. C                                                NELP
  3098.       I23 = I22 + MLINEE * 98
  3099. C                                                NAMEP
  3100.       I24 = I23 + MLINEE * 8
  3101.       CALL SIZE (I24)
  3102.         IF (IERROR.NE.0) GOTO 900
  3103. C
  3104.       ICALL = 1
  3105.       IXPAR = 3
  3106.       CALL ELINE2 (IA(I06),IA(I07),IETYP,KINDV,VALUEV,
  3107.      -     IA(I24),
  3108.      1     A(N1),A(N12),A(N13),A(N14),IA(I15),IA(I16),NELPAR,IA(I17),
  3109.      2     IA(I18),IA(I19),IA(I20),IA(I21),IA(I22),IA(I23))
  3110.       GOTO 900
  3111.   900 RETURN
  3112.       END
  3113. C***ADD:CDC***
  3114. CDECK ELINE2
  3115. C***END:CDC***
  3116.       SUBROUTINE ELINE2 (NRUSES,NEGS,IETYP,KINDV,VALUEV,
  3117.      1           IRPOL,TIMEE,XPLOT,YPLOT,ERES,EDATA,ITABLE,NPARD,
  3118.      2           NPAR,NERPTS,IDERPT,SXYZ,LINEID,NELP,NAMEP)
  3119. C
  3120.       DIMENSION IA(1),KINDV(1),VALUEV(1),IRPOL(1),TIMEE(1),
  3121.      1     XPLOT(1),YPLOT(1),XYZ(1),LINEID(4,1),NELP(98,1),
  3122.      2    NAMEP(8,1),KINDHD(3),ERES(1),EDATA(1),ITABLE(1),NPAR(NPARD,1),
  3123.      3    NERPTS(1),IDERPT(1),SXYZ(3,1),NRUSES(1),NEGS(1),NAMEL(8)
  3124. C
  3125.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3126.       COMMON /EPS/ EPS
  3127.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3128.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3129.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3130.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  3131.      1               IBITZ,IWHOLE,ICALL,IXPAR
  3132.       COMMON /ERROR/ IERROR
  3133.       COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
  3134.      1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
  3135.      2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
  3136.      3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
  3137.      4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
  3138.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3139.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3140.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3141.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3142.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3143.      2             IXGP(50),MXSGP(50),
  3144.      3             FILL1
  3145.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  3146.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  3147.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  3148.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  3149.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  3150.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  3151.      6                NDOFSA(6),NOUSE(4),FILL2
  3152.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3153.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3154.      2             I16,I17,I18,I19,I20,
  3155.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3156.      4             N16,N17,N18,N19,N20
  3157.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  3158.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  3159.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  3160.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  3161.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  3162.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  3163.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  3164.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  3165.      8                KX49  ,KX50
  3166.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  3167.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  3168.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  3169.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  3170.       COMMON A(1)
  3171.       EQUIVALENCE (A(1),IA(1))
  3172.       DATA ICALLS,ICALLR/1,2/
  3173.       DATA IPLOFF,ISPACE/4,1H /
  3174.       DATA IHDTIM/4HTIME/
  3175. C
  3176. C
  3177. C          PARAM: TIME
  3178. C
  3179.       TIME = REALV(IXPAR)
  3180.       IF (NSTEE.GT.0) GOTO 120
  3181.         WRITE (NFLOG,2000)
  3182.         GOTO 800
  3183.   120 CALL DBREAD (TIMEE,KTIMEE,1,0)
  3184.         IF (IERROR.NE.0) GOTO 900
  3185.       IF (ITYPE(IXPAR).EQ.IOMIT) TIME = TIMEE(NSTEE)
  3186.       TDIFFO = 9E30
  3187.       DO 130 I=1,NSTEE
  3188.         TDIFF = ABS (TIME - TIMEE(I))
  3189.         IF (TDIFFO.LE.TDIFF) GOTO 130
  3190.         TDIFFO = TDIFF
  3191.         ITIME = I
  3192.   130   CONTINUE
  3193.       TIME = TIMEE(ITIME)
  3194. C
  3195. C          PARAM 1: PNAME
  3196. C
  3197.   135 IF (IXGP(KEPOIN).EQ.0) GOTO 160
  3198.       CALL DBREAD (LINEID,KEPOIN,1,0)
  3199.         IF (IERROR.NE.0) GOTO 900
  3200.       DO 150 ILINEE=1,MLINEE
  3201.         DO 140 I=1,8
  3202.           ICODE = NAMEP(I,ILINEE)
  3203.           IF (IANUMV(I,1).NE.ICODE) GOTO 150
  3204.           CALL APCHAR(ICODE)
  3205.           NAMEL(I) = ICODE
  3206.   140     CONTINUE
  3207.         ISTRI  = LINEID(1,ILINEE)
  3208.         ISTRUC = LINEID(2,ILINEE)
  3209.         IRUSE  = LINEID(3,ILINEE)
  3210.         IEG    = LINEID(4,ILINEE)
  3211.         GOTO 170
  3212.   150   CONTINUE
  3213.   160 WRITE (NFLOG,2020)
  3214.       GOTO 800
  3215. C
  3216. C          PARAM NXAXIS, NYAXIS, ISYMBL, ISSKIP, LIST
  3217. C
  3218.   170 NXAXIS = INTV(IXPAR+1)
  3219.       NYAXIS = INTV(IXPAR+2)
  3220.       ISYMBL = INTV(IXPAR+3)
  3221.       ISSKIP = INTV(IXPAR+4)
  3222.       LIST   = INTV(IXPAR+5)
  3223. C
  3224. C          READ NPAR
  3225. C
  3226.   175 CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  3227.       IF (IERROR.NE.0) GOTO 900
  3228.       IELTYP = NPAR(1,IEG)
  3229.       NUME   = NPAR(2,IEG)
  3230.       INDNL  = NPAR(3,IEG)
  3231.       NTABLE = NPAR(13,IEG)
  3232. C
  3233. C          CHECK RESULTANT FORMULA IETYP
  3234. C
  3235.       IF (ICALL.NE.ICALLR .OR. IETYP.EQ.IELTYP) GOTO 180
  3236.         WRITE (NFLOG,2130) IETYP, IELTYP
  3237.         GOTO 800
  3238. C
  3239. C          COMPUTE IEGIT AND IEGAT
  3240. C
  3241.   180 NEG = NEGS(ISTRI)
  3242.       IEGIT = IEG - NEG
  3243.       IEGAT = IEG - NEG * (NRUSES(ISTRI) - IRUSE + 1)
  3244.       DO 190 I=1,ISTRI
  3245.         IEGIT = IEGIT + NEGS(I)
  3246.   190   IEGAT = IEGAT + NEGS(I) * NRUSES(I)
  3247.       ISEDAT = 0
  3248. C
  3249. C          UPDATE NERPTS,IDERPT ARRAYS AND NERES,NERKI
  3250. C
  3251.       CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NUME+1),ITABLE,NTABLE,
  3252.      1     IEGIT,ISEDAT,TIME,NERPTS,IDERPT,NERES,NERKI,LOCALE)
  3253.       IF (IERROR.NE.0) GOTO 900
  3254.       IF (NERES.EQ.0) GOTO 235
  3255. C
  3256. C          CHECK KINDV VALUES
  3257. C
  3258.       IVAEND = 1
  3259.       IF (ICALL.EQ.ICALLR) IVAEND = MVAR
  3260.       DO 200 IVAR=1,IVAEND
  3261.         KIND = KINDV(IVAR)
  3262.         IF (KIND.EQ.0 .AND. ICALL.EQ.ICALLR) GOTO 200
  3263.         IF (KIND.GE.1 .AND. KIND.LE.NERKI) GOTO 200
  3264.           WRITE (NFLOG,2080) KIND
  3265.           GOTO 800
  3266.   200   CONTINUE
  3267. C
  3268. C          READ ERES
  3269. C
  3270.       CALL DBREAD (ERES,KERES,IEGAT,ITIME)
  3271.       IF (IERROR.NE.0) GOTO 900
  3272. C
  3273. C          READ SXYZ
  3274. C
  3275.       CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
  3276.       IF (IERROR.NE.0) GOTO 900
  3277.       IF (SXYZ(1,1).EQ.987654E32)  WRITE (NFLOG,2150)
  3278. C
  3279. C          DO FOR ALL ELEMENT POINTS IN LINE
  3280. C
  3281.       NPTS = 0
  3282.       XPOINT = 0.0
  3283.       DO 400 IELP=1,98,2
  3284.         IEL    = NELP(IELP  ,ILINEE)
  3285.         IDERES = NELP(IELP+1,ILINEE)
  3286.         IF (IEL.EQ.0) GOTO 401
  3287.         NPTS = NPTS + 1
  3288. C
  3289. C          CHECK ELEMENT NUMBER
  3290. C
  3291.       IF (IEL.GE.1 .AND. IEL.LE.NUME) GOTO 210
  3292.         WRITE (NFLOG,2140) IEL
  3293.         GOTO 800
  3294. C
  3295. C          FIND IDERES = ELEMENT RESULT POINT ID
  3296. C
  3297.   210 IXIDER = 1
  3298.       IXERES = 0
  3299.       DO 220 IELWK=1,IEL
  3300.         NERPT = NERPTS(IELWK)
  3301.         IXIDER = IXIDER + NERPT
  3302.   220   IXERES = IXERES + NERPT * NERKI
  3303.       IXIDER = IXIDER - NERPT
  3304.       IXERES = IXERES - NERPT * NERKI
  3305.       IF (NERPT.EQ.0) GOTO 235
  3306. C
  3307.       DO 230 IERPT=1,NERPT
  3308.         IDERPW = IDERPT(IXIDER)
  3309.         IF (IDERPW.GT.0) GOTO 225
  3310.           WRITE (NFLOG,2086) IEL
  3311.           GOTO 900
  3312.   225   IF (IDERES.EQ.IDERPW) GOTO 240
  3313.         IXIDER = IXIDER + 1
  3314.   230   IXERES = IXERES + NERKI
  3315. C
  3316. C          IDERES POINT IS NOT FOUND
  3317. C
  3318.   235 WRITE (NFLOG,2085) IEG, IEL, IDERES
  3319.       GOTO 800
  3320. C
  3321.   240 DO 250 IVAR=1,IVAEND
  3322.         KIND = KINDV(IVAR)
  3323.         IF (KIND.EQ.0) GOTO 250
  3324.         VALUEV(IVAR) = ERES(IXERES+KIND)
  3325.         IF (VALUEV(IVAR) .EQ. 987654E32) GOTO 235
  3326.   250   CONTINUE
  3327. C
  3328. C          COMPUTE GEOMETRICAL DISTANCE (DEFORMATION NOT INCLUDED)
  3329. C
  3330.       XPLOT(NPTS) = FLOAT(NPTS)
  3331.       IF (SXYZ(1,1).EQ.987654E32) GOTO 295
  3332.       XNOW = SXYZ(1,IXIDER)
  3333.       YNOW = SXYZ(2,IXIDER)
  3334.       ZNOW = SXYZ(3,IXIDER)
  3335.       IF (NPTS.EQ.1) GOTO 290
  3336.         XDIST = XNOW - XOLD
  3337.         YDIST = YNOW - YOLD
  3338.         ZDIST = ZNOW - ZOLD
  3339.         XPOINT = XPOINT + SQRT(XDIST*XDIST + YDIST*YDIST + ZDIST*ZDIST)
  3340.   290 XOLD = XNOW
  3341.       YOLD = YNOW
  3342.       ZOLD = ZNOW
  3343.       XPLOT(NPTS) = XPOINT
  3344. C
  3345. C
  3346. C          EXECUTE RESULTANT COMPUTATION
  3347. C
  3348.   295 IF (ICALL.NE.ICALLR) GOTO 300
  3349.       CALL FORMEX (VALUEV,IRPOL)
  3350.       IF (IERROR.NE.0) GOTO 800
  3351. C
  3352.   300 YPLOT(NPTS) = VALUEV(1)
  3353.   400 CONTINUE
  3354.   401 CONTINUE
  3355. C
  3356. C          LIST
  3357. C
  3358.       KIND = KINDV(1)
  3359.       CALL KINDE (IELTYP,INDNL,NTABLE,KIND,KINDHD)
  3360. C
  3361.       LPOS1 = 1
  3362.       IF (LIST.NE.1) LPOS1 = 0
  3363.       DO 730 I=1,NPTS
  3364.       IF (LINE.LE.LINPAG) GOTO 710
  3365.         WRITE (NFLIST,2030) LPOS1,NAMEL,TIME,KINDHD,NAMERC
  3366.         LINE = 4
  3367.         IF (NSUBST.EQ.0) GOTO 705
  3368.           ISUBST = ISTRI - 1
  3369.           WRITE (NFLIST,2345) ISUBST, IRUSE
  3370.           LINE = LINE + 2
  3371.   705   IF (LOCALE.EQ.0) WRITE (NFLIST,2035) IEG
  3372.           IF (LOCALE.EQ.1) WRITE (NFLIST,2036) IEG
  3373.           IF (LIST.NE.1) GOTO 740
  3374.         WRITE (NFLIST,2040) KINDHD, NAMERC
  3375.         LINE = LINE + 3
  3376.   710   WRITE (NFLIST,2050) NELP(I*2-1,ILINEE),NELP(I*2,ILINEE),
  3377.      1              XPLOT(I),YPLOT(I)
  3378.         LINE = LINE + 1
  3379. C
  3380.   730 CONTINUE
  3381.   740 IF (NPTS.GE.2) GOTO 745
  3382.         WRITE (NFLOG,2070)
  3383.         GOTO 800
  3384. C
  3385.   745 CALL XYPLOT (XPLOT,YPLOT,NPTS,NXAXIS,NYAXIS,ISYMBL,ISSKIP)
  3386.         IF (IERROR.NE.0) GOTO 900
  3387. C
  3388. C          PLOT TEXT 'NAMEP  '
  3389. C          BELOW X-AXIS IF AUTOMATICALLY SCALED
  3390. C
  3391.       IF (NXAXIS.NE.0) GOTO 750
  3392.       XP = PMARG + AXEDGE
  3393.       YP = PMARG
  3394.       DO 747 I=1,8
  3395.         NBCD = NAMEL(I)
  3396.         IF (NBCD.EQ.ISPACE) GOTO 747
  3397.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,0.,1,1)
  3398.         XP = XP + HEIGHT
  3399.   747   CONTINUE
  3400. C
  3401. C          PLOT ELEMENT VARIABLE HEADER IF Y-AXIS AUTOM. SCALED
  3402. C
  3403.   750 IF (NYAXIS.NE.0) GOTO 770
  3404.       XP = PMARG + HEIGHT
  3405.       YP = PMARG + AXEDGE
  3406.       IF (ICALL.EQ.ICALLR) GOTO 765
  3407.         DO 760 I=1,3
  3408.           NBCD = KINDHD(I)
  3409.           CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,4,1)
  3410.           XP = 999.0
  3411.           YP = 999.0
  3412.   760   CONTINUE
  3413.         GOTO 770
  3414.   765 DO 767 I=1,8
  3415.         NBCD = NAMERC(I)
  3416.         CALL AGRAPH (XP,YP,HEIGHT,NBCD,0.,90.,1,1)
  3417.         XP = 999.0
  3418.   767   YP = 999.0
  3419. C
  3420. C          PLOT 'TIME X.XXX' IN UPPER RIGHT CORNER
  3421. C
  3422.   770 IF (NXAXIS.LT.0 .OR. NYAXIS.LT.0) GOTO 780
  3423.       I = 0
  3424.       IF (TIME.NE.0.0) I = MAX0(0, 3 - INT(ALOG10(ABS(TIME))))
  3425.       XP = XPMAX - PMARG - HEIGHT * 10.0
  3426.       YP = YPMAX - PMARG - HEIGHT
  3427.       CALL AGRAPH (XP,YP,HEIGHT,IHDTIM,0.,0.,4,1)
  3428.       XP = XP + HEIGHT * 5.0
  3429.       CALL AGRAPH (XP,YP,HEIGHT,0,TIME,0.,I,3)
  3430. C
  3431.   780 CALL CGRAPH (IPLOFF)
  3432.       IF (LIST.NE.1) LINE = 32766
  3433.       GOTO 900
  3434. C
  3435.   800 IERROR = 1
  3436.   900 RETURN
  3437.  2000 FORMAT (45H ***ERROR: NO TIMESTEP FOR ELEMENT DATA FOUND)
  3438.  2020 FORMAT(29H ***ERROR: LINENAME NOT FOUND)
  3439.  2030 FORMAT(I1,3X,30HELEMENT RESULTS ALONG ELINE = ,8A1,
  3440.      1  10H  AT TIME=,G11.5,5X,3A4,8A1)
  3441.  2035 FORMAT(/19H    ELEMENT GROUP =,I4,
  3442.      1  52H    RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM)
  3443.  2036 FORMAT(/19H    ELEMENT GROUP =,I4,
  3444.      1  53H    RESULTS ARE MEASURED IN ELEMENT COORDINATE SYSTEM)
  3445.  2040 FORMAT(/35H ELEMENT   POINT       LINE COORD. ,5X,3A4,8A1/)
  3446.  2050 FORMAT(1X,I5,I10,6X,E12.6,3X,E12.6)
  3447.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  3448.  2070 FORMAT (41H ***ERROR: ONLY ONE ELEMENT POINT IN LINE)
  3449.  2080 FORMAT (25H ***ERROR: INVALID KIND =,I4)
  3450.  2085 FORMAT(26H ***ERROR: ELEMENT GROUP =,I5,10H ELEMENT =,I5,
  3451.      1  15H RESULT POINT =,I5,26H  IS NOT SAVED IN ADINA,     ,
  3452.      2  /11X,42HCHECK IPS PARAMETER IN ADINA ELEMENT INPUT     )
  3453.  2086 FORMAT(18H ***ERROR: ELEMENT,I5,27H IS NOT ACTIVE AT THIS TIME)
  3454.  2130 FORMAT(42H ***ERROR: RESULTANT ELEMENT TYPE IETYPE =,I2,
  3455.      1 38H IS NOT SAME AS ELEMENT TYPE NPAR(1) =,I2)
  3456.  2140 FORMAT(42H ***ERROR: EPOINTS ELEMENT NR IS INVALID =,I5)
  3457.  2150 FORMAT(4X,50HSTRESS POINT COORDINATES ARE NOT CALCULATED - ALL ,
  3458.      1  48HPOINTS ARE PLOTTED WITH AN EQUAL DISTANCE OF 1.0)
  3459.       END
  3460. C*NEW FILE
  3461. C***END:IBM***
  3462.       SUBROUTINE TEST
  3463. C
  3464.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3465.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3466.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3467.      1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3468.       COMMON /FIELDC/ REALI,INPREC(80),INPOS,ITYPEI,INTI,IANUMI(128),
  3469.      1               KEYI(8),NPOSRE,INECHO,MXSIGI,MXSIGR,MXSIGE,MXSTRL,
  3470.      2               ISTRIL,NFIELD,NPOSIN
  3471.       IF (ITYPE(1).EQ.INTEG)  NPOSRE = INTV(1)
  3472.       IF (ITYPE(2).EQ.INTEG)  NBSU = INTV(2)
  3473. C          LSTA IS TAKEN CARE OF IN SUBROUTINE COMND
  3474.       IF (ITYPE(4).EQ.INTEG)  LSTC = INTV(4)
  3475.       IF (ITYPE(5).EQ.INTEG)  LSTF = INTV(5)
  3476.       IF (ITYPE(6).EQ.INTEG)  LSTDB = INTV(6)
  3477.       IF (ITYPE(7).EQ.INTEG)  ISURL = INTV(7)
  3478.       IF (ITYPE(8).EQ.INTEG)  ITWO  = INTV(8)
  3479.  8000 RETURN
  3480.       END
  3481. C***ADD:CDC***
  3482. CDECK FILE
  3483. C***END:CDC***
  3484.       SUBROUTINE FILE
  3485. C
  3486.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3487.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3488.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3489.      1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3490.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  3491.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  3492.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  3493.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  3494.       IF (ITYPE(1).EQ.INTEG)  NFREAD = INTV(1)
  3495.       IF (ITYPE(2).EQ.INTEG)  NFECHO = INTV(2)
  3496.       IF (ITYPE(3).EQ.INTEG)  NFLOG  = INTV(3)
  3497.       IF (ITYPE(4).EQ.INTEG)  NFLIST = INTV(4)
  3498.       IF (ITYPE(5).EQ.INTEG)  NFPLOT = INTV(5)
  3499.       IF (ITYPE(6).EQ.INTEG)  LUNODE = INTV(6)
  3500.       IF (ITYPE(7).EQ.INTEG)  LUELEM = INTV(7)
  3501. C
  3502.  8000 RETURN
  3503.       END
  3504. C***ADD:CDC***
  3505. CDECK CONTRL
  3506. C***END:CDC***
  3507.       SUBROUTINE CONTRL
  3508. C
  3509. C          CONTROL COMMAND
  3510. C
  3511.       DIMENSION IA(1)
  3512. C
  3513.       COMMON /ERROR/ IERROR
  3514.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3515.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3516.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3517.      1               IANUMV(160),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3518.       COMMON /FIELDC/ REALI,INPREC(80),INPOS,ITYPEI,INTI,IANUMI(128),
  3519.      1               KEYI(8),NPOSRE,INECHO,MXSIGI,MXSIGR,MXSIGE,MXSTRL,
  3520.      2               ISTRIL,NFIELD,NPOSIN
  3521.       COMMON /PLOTCO/ GSCALE,DSCALE,XPV,YPV,PUNIT,HEIGHT,PMARG,AXEDGE,
  3522.      1              XSF,YSF,XFMAX,YFMAX,XF1,YF1,XPMAX,YPMAX,
  3523.      3              XSMIN,XSMAX,YSMIN,YSMAX,XPSAVE,YPSAVE,VIEW(3,3),
  3524.      2              NFPLOT,IONPLT,NSYSPL,NDEVPL,MORIGO,NGPTS
  3525.       COMMON /MEMORY/ MTOT,LPROG,MEMPRT,MEMMAX
  3526.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3527.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3528.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3529.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3530.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3531.      2             IXGP(50),MXSGP(50),
  3532.      3             FILL1
  3533.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3534.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3535.      2             I16,I17,I18,I19,I20,
  3536.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3537.      4             N16,N17,N18,N19,N20
  3538.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  3539.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  3540.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  3541.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  3542.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  3543.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  3544.      6                NDOFSA(6),NOUSE(4),FILL2
  3545.       COMMON A(1)
  3546.       EQUIVALENCE (A(1),IA(1))
  3547.       IF (ITYPE(1).EQ.INTEG)  IBATCH = INTV(1)
  3548.       IF (ITYPE(2).EQ.INTEG)  INECHO = INTV(2)
  3549.       IF (ITYPE(3).EQ.IREAL)  HEIGHT = REALV(3)
  3550.       AXEDGE = HEIGHT * 6.0
  3551. C
  3552.       IF (ITYPE(4).EQ.INTEG)  NDEVPL = INTV(4)
  3553.       IF (ITYPE(5).EQ.INTEG)  NSYSPL = INTV(5)
  3554.       IF (ITYPE(6).EQ.INTEG)  MEMPRT = INTV(6)
  3555.       IF (INTV(7).GT.15)  LINPAG = INTV(7)
  3556.       IF (ITYPE(8).EQ.INTEG)  LSKEW = INTV(8)
  3557.       IF (ITYPE(11).EQ.INTEG)  MIDSPL = INTV(11)
  3558. C
  3559.       IF (ITYPE(12).NE.INTEG) GOTO 20
  3560.         IF (INTV(12).EQ.MORIGO) GOTO 20
  3561.         MORIGO = INTV(12)
  3562.         X     = XPMAX
  3563.         XPMAX = YPMAX
  3564.         YPMAX = X
  3565.   20    CONTINUE
  3566.       IF (ITYPE(13).EQ.IREAL) PMARG = ABS( REALV(13) )
  3567. C
  3568. C          PARAM:  NSUB,  NREUSE
  3569. C
  3570.       IF (ITYPE(9).NE.INTEG .AND. ITYPE(10).NE.INTEG) GOTO 900
  3571.       NSUB = INTV(9)
  3572.       NRUSE = INTV(10)
  3573.       IF (ITYPE( 9).EQ.IOMIT) NSUB  = INSTRI - 1
  3574.       IF (ITYPE(10).EQ.IOMIT) NRUSE = 1
  3575.       IF (IOPEN.EQ.1) GOTO 110
  3576.         WRITE (NFLOG,2000)
  3577.         GOTO 800
  3578.   110 IF (NSUB.LT.0 .OR. NRUSE.LT.0) GOTO 850
  3579.       IF (NSUB.GT.NSUBST) GOTO 850
  3580. C          IA(I06) = START OF NRUSES ARRAY
  3581.       MAXNTU = IA(I06+NSUB)
  3582.       IF (NRUSE.GT.MAXNTU) GOTO 850
  3583.       INSTRI = NSUB + 1
  3584.       INRUSE = NRUSE
  3585.       INSTRU = NRUSE - MAXNTU
  3586.       DO 120 ISTRI=1,INSTRI
  3587.   120   INSTRU = INSTRU + IA(I06+ISTRI-1)
  3588.       GOTO 900
  3589. C
  3590.   800 IERROR = 1
  3591.       GOTO 900
  3592.   850 IERROR = 2
  3593.   900 RETURN
  3594.  2000 FORMAT(54H ***ERROR: DATABASE MUST BE OPEN BEFORE NSUBSTRUCTURE ,
  3595.      1        25HAND NREUSE CAN BE DEFINED)
  3596.       END
  3597. C***ADD:CDC***
  3598. CDECK VIEW1
  3599. C***END:CDC***
  3600.       SUBROUTINE VIEW1
  3601. C
  3602.       DIMENSION IA(1),VIEWMX(3,3),TRANMX(3,3),ROTAMX(3,3)
  3603. C
  3604.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3605.       COMMON /EPS/ EPS
  3606.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3607.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3608.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3609.       COMMON /ERROR/ IERROR
  3610.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3611.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3612.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3613.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3614.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3615.      2             IXGP(50),MXSGP(50),
  3616.      3             FILL1
  3617.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3618.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3619.      2             I16,I17,I18,I19,I20,
  3620.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3621.      4             N16,N17,N18,N19,N20
  3622.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  3623.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  3624.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  3625.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  3626.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  3627.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  3628.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  3629.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  3630.      8                KX49  ,KX50
  3631.       COMMON A(1)
  3632.       EQUIVALENCE (A(1),IA(1))
  3633. C
  3634. C          PARAM 1: NVIEW
  3635. C
  3636.       NVIEW = INTV(1)
  3637.       IF (NVIEW.GE.1 .AND. NVIEW.LE.MVIEW) GOTO 100
  3638.         WRITE (NFLOG,2000) MVIEW
  3639.         GOTO 800
  3640. C
  3641. C          PARAM 2, 3, 4, 5: XVIEW, YVIEW, ZWIEW, ROTATI
  3642. C
  3643.   100 XVIEW = REALV(2)
  3644.       YVIEW = REALV(3)
  3645.       ZVIEW = REALV(4)
  3646.       ROTAT = REALV(5)
  3647.       DO 110 I=1,3
  3648.         DO 110 J=1,3
  3649.           TRANMX(I,J) = 0.0
  3650.   110     ROTAMX(I,J) = 0.0
  3651. C
  3652. C          NORMALIZE THE VIEW DIRECTION VECTOR
  3653. C
  3654.       VLENGT = SQRT (XVIEW*XVIEW + YVIEW*YVIEW + ZVIEW*ZVIEW)
  3655. C
  3656.       IF (VLENGT.GT.EPS) GOTO 120
  3657.         WRITE (NFLOG,2010)
  3658.         GOTO 800
  3659.   120 XVIEW = XVIEW / VLENGT
  3660.       YVIEW = YVIEW / VLENGT
  3661.       ZVIEW = ZVIEW / VLENGT
  3662. C
  3663. C          COMPUTE TRANSFORMATION MATRIX TO VIEW COORDINATE SYSTEM
  3664. C
  3665.       IF (ABS(XVIEW).LT.EPS .AND. ABS(YVIEW).LT.EPS) GOTO 150
  3666.       XYLENG = SQRT(XVIEW*XVIEW + YVIEW*YVIEW)
  3667.       TRANMX(1,1) = -YVIEW / XYLENG
  3668.       TRANMX(1,2) =  XVIEW / XYLENG
  3669.       TRANMX(2,1) = - ZVIEW * XVIEW / XYLENG
  3670.       TRANMX(2,2) = - ZVIEW * YVIEW / XYLENG
  3671.       TRANMX(2,3) = XYLENG
  3672.       TRANMX(3,1) =  XVIEW
  3673.       TRANMX(3,2) =  YVIEW
  3674.       TRANMX(3,3) =  ZVIEW
  3675.       GOTO 200
  3676. C
  3677. C          VIEW DIRECTION IS PARALLELL TO GLOBAL Z-AXIS
  3678. C
  3679.   150 DO 160 I=1,3
  3680.   160   TRANMX(I,I) = 1.0
  3681.       IF (ZVIEW.GT.0.0) GOTO 200
  3682.         TRANMX(1,1) = -1.0
  3683.         TRANMX(3,3) = -1.0
  3684. C
  3685. C          COMPUTE ROTATION MATRIX
  3686. C
  3687.   200 ROTRAD = ROTAT * 0.0174533
  3688.       ROTCOS = COS(ROTRAD)
  3689.       ROTSIN = SIN(ROTRAD)
  3690.       ROTAMX(1,1) =  ROTCOS
  3691.       ROTAMX(1,2) = -ROTSIN
  3692.       ROTAMX(2,1) =  ROTSIN
  3693.       ROTAMX(2,2) =  ROTCOS
  3694.       ROTAMX(3,3) = 1.0
  3695. C
  3696. C          CONCATENATE ROTATION AND TRANSFORMATION MATRICES
  3697. C          TO THE VIEW MATRIX
  3698. C
  3699.       DO 250 I=1,3
  3700.         DO 250 J=1,3
  3701.   250 VIEWMX(I,J) = ROTAMX(I,1) * TRANMX(1,J) +
  3702.      1              ROTAMX(I,2) * TRANMX(2,J) +
  3703.      2              ROTAMX(I,3) * TRANMX(3,J)
  3704. C
  3705. C          UPDATE VIEW RECORD IN DATABASE
  3706. C
  3707.       N2 = N1 + MVIEW * 9
  3708.       I2 = N2 / ISURL
  3709.       CALL SIZE(I2)
  3710.         IF (IERROR.NE.0) GOTO 900
  3711.       N1END = N2 - 1
  3712.       DO 400 I=N1,N1END
  3713.   400   A(I) = 0.
  3714.       IF (IXGP(KVIEW).NE.0) CALL DBREAD (A(N1),KVIEW,1,0)
  3715.         IF (IERROR.NE.0) GOTO 900
  3716.       IXA = N1 + (NVIEW-1) * 9
  3717.       DO 500 I=1,3
  3718.         DO 500 J=1,3
  3719.           A(IXA) = VIEWMX(J,I)
  3720.   500     IXA = IXA + 1
  3721.       CALL DBWRIT (A(N1),MVIEW*9,0,KVIEW,1,0)
  3722.       GOTO 900
  3723.   800 IERROR = 1
  3724.   900 RETURN
  3725.  2000 FORMAT (35H ***ERROR: IDVIEW OUT OF LIMIT 1 - ,I2)
  3726.  2010 FORMAT (40H ***ERROR: ALL VIEW COORDINATES ARE ZERO)
  3727.       END
  3728. C***ADD:CDC***
  3729. CDECK APAXIS
  3730. C***END:CDC***
  3731.       SUBROUTINE APAXIS
  3732. C
  3733.       DIMENSION AXREC(250),XPA(1),YPA(1),XL(1),VMIN(1),VMAX(1)
  3734.       DIMENSION NAMEAX(20,1),IA(1),ISTRIV(1)
  3735. C
  3736.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3737.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3738.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3739.       COMMON /ERROR/ IERROR
  3740.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3741.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3742.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3743.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3744.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3745.      2             IXGP(50),MXSGP(50),
  3746.      3             FILL1
  3747.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  3748.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  3749.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  3750.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  3751.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  3752.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  3753.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  3754.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  3755.      8                KX49  ,KX50
  3756.       COMMON A(1)
  3757.       EQUIVALENCE (A(1),IA(1))
  3758.       EQUIVALENCE (ISTRIV(1),IANUMV(1,7))
  3759. C
  3760.       EQUIVALENCE (AXREC(1),XPA(1)),
  3761.      1           (AXREC(11),YPA(1)),
  3762.      1           (AXREC(21),XL(1)),
  3763.      1           (AXREC(31),VMIN(1)),
  3764.      1           (AXREC(41),VMAX(1)),
  3765.      1           (AXREC(51),NAMEAX(1,1))
  3766. C
  3767.       MAXIS = 10
  3768. C
  3769. C
  3770.       NAXIS = INTV(1)
  3771.       IF (NAXIS.GE.1.AND.NAXIS.LE.MAXIS) GOTO 100
  3772.         WRITE (NFLOG,2000) MAXIS
  3773.         GOTO 800
  3774. C
  3775.   100 IF (REALV(4).LE.0.0) GOTO 850
  3776.       IF (REALV(5).EQ.REALV(6)) GOTO 850
  3777. C
  3778. C          READ AXIS RECORD FROM DATABASE
  3779. C
  3780.       DO 150 I=1,MAXIS
  3781.   150    XL(I) = 0.0
  3782.       IF (IXGP(KAXIS).NE.0)
  3783.      1  CALL DBREAD (AXREC,KAXIS,1,0)
  3784.         IF (IERROR.NE.0) GOTO 900
  3785. C
  3786.       XPA(NAXIS)   = REALV(2)
  3787.       YPA(NAXIS)   = REALV(3)
  3788.       XL(NAXIS)   = REALV(4)
  3789.       VMIN(NAXIS) = REALV(5)
  3790.       VMAX(NAXIS) = REALV(6)
  3791.       DO 200 I=1,20
  3792.   200   NAMEAX(I,NAXIS) = ISTRIV(I)
  3793. C
  3794. C          WRITE AXIS RECORD TO DATABASE
  3795. C
  3796.       LREAL = MAXIS * 5
  3797.       LINT = MAXIS * 20
  3798.       CALL DBWRIT (AXREC,LREAL,LINT,KAXIS,1,0)
  3799.       GOTO 900
  3800. C
  3801.   800 IERROR = 1
  3802.       GOTO 900
  3803.   850 IERROR = 2
  3804.   900 RETURN
  3805.  2000 FORMAT (35H ***ERROR: IDAXIS OUT OF LIMIT 1 - ,I2)
  3806.       END
  3807. C***ADD:CDC***
  3808. CDECK ZONE1
  3809. C***END:CDC***
  3810.       SUBROUTINE ZONE1
  3811. C
  3812.       DIMENSION IA(1)
  3813.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3814.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3815.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3816.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3817.       COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
  3818.      1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
  3819.      2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
  3820.      3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
  3821.      4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
  3822.       COMMON /ERROR/ IERROR
  3823.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3824.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3825.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3826.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3827.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3828.      2             IXGP(50),MXSGP(50),
  3829.      3             FILL1
  3830.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3831.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3832.      2             I16,I17,I18,I19,I20,
  3833.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3834.      4             N16,N17,N18,N19,N20
  3835.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  3836.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  3837.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  3838.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  3839.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  3840.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  3841.      6                NDOFSA(6),NOUSE(4),FILL2
  3842.       COMMON A(1)
  3843.       EQUIVALENCE (A(1),IA(1))
  3844. C
  3845.       DATA KBZONE/14/
  3846. C
  3847. C          CHECK PARAMETERS
  3848. C
  3849.       IF (ITYPE(1).NE.IOMIT) GOTO 10
  3850.       WRITE (NFLOG,2000)
  3851.       GOTO 800
  3852.   10  IF (IANUMV(1,2).EQ.IBLANK) IANUMV(1,2) = IAAA
  3853.       IF (IANUMV(1,2).EQ.IAAA .OR. IANUMV(1,2).EQ.IDDD) GOTO 20
  3854.       WRITE (NFLOG,2010)
  3855.       GOTO 800
  3856. C
  3857. C          ZONE COMMANDS LAYOUT OF BLANK COMMON
  3858. C
  3859. C                                                NAMEZ
  3860.   20  I2 = I1 + 8 * NBSU
  3861.       CALL ALIGN (I2)
  3862. C                                                NPAR
  3863.       I3 = I2 + (NELPAR + 3) * MXEG
  3864. C                                                NZONE
  3865.       I4 = I3 + MXNP
  3866.       I7 = I4
  3867.       IF (NCMD.NE.KBZONE) GOTO 50
  3868. C                                                XYZ
  3869.       I7 = I4 + MXNP * ISURL * 3
  3870. C                                                IEZONE
  3871.   50  I8 = I7 + MXEL
  3872. C                                                NOD
  3873.       I9 = I8 + MXELNP
  3874.       CALL SIZE (I9)
  3875.       IF (IERROR.NE.0) GOTO 900
  3876. C
  3877.       CALL ZONE2 (IA(I06),IA(I07),IA(I08),IA(I1),NELPAR,IA(I2),
  3878.      1           IA(I3),IA(I4),IA(I7),IA(I8))
  3879.       GOTO 900
  3880.   800 IERROR = 1
  3881.   900 RETURN
  3882.  2000 FORMAT (25H ***ERROR: WHAT ZONENAME?)
  3883.  2010 FORMAT (37H ***ERROR: ZONE OPERATION ADD OR DEL?)
  3884.       END
  3885. C***ADD:CDC***
  3886. CDECK ZONE2
  3887. C***END:CDC***
  3888.       SUBROUTINE ZONE2 (NRUSES,NEGS,NUMNPS,NAMEZ,NPARD,NPAR,NZONE,
  3889.      1                   XYZ,IEZONE,NOD)
  3890.       DIMENSION IA(1),NRUSES(1),NEGS(1),NUMNPS(1),NAMEZ(8,1),
  3891.      1          NPAR(NPARD,1),NZONE(1),XYZ(1),IEZONE(1),NOD(1)
  3892.      2         ,MXNODA(15)
  3893. C
  3894.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  3895.       COMMON /EPS/ EPS
  3896.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  3897.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  3898.       COMMON /SICODE/ I000,I111,I222,I333,I444,I555,I666,I777,I888,I999,
  3899.      1              IBLANK,IAAA,IBBB,ICCC,IDDD,IEEE,IFFF,IGGG,IHHH,IIII,
  3900.      2                IJJJ,IKKK,ILLL,IMMM,INNN,IOOO,IPPP,IQQQ,IRRR,ISSS,
  3901.      3                ITTT,IUUU,IVVV,IWWW,IXXX,IYYY,IZZZ,IPOINT,ICOMMA,
  3902.      4              IPLUS,IMINUS,IEQUAL,ILPAR,IRPAR,ISLASH,IASTER,IAPOST
  3903.       COMMON /ERROR/ IERROR
  3904.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  3905.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  3906.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  3907.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  3908.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  3909.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  3910.      2             IXGP(50),MXSGP(50),
  3911.      3             FILL1
  3912.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  3913.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  3914.      2             I16,I17,I18,I19,I20,
  3915.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  3916.      4             N16,N17,N18,N19,N20
  3917.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  3918.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  3919.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  3920.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  3921.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  3922.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  3923.      6                NDOFSA(6),NOUSE(4),FILL2
  3924.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  3925.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  3926.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  3927.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  3928.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  3929.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  3930.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  3931.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  3932.      8                KX49  ,KX50
  3933.       COMMON A(1)
  3934.       EQUIVALENCE (A(1),IA(1))
  3935. C
  3936.       DATA KBZONE,KEZONE,KEGZON,KZZONE/14,15,16,17/
  3937.       DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
  3938. C
  3939.       DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
  3940.       DATA I2DIMF,I3DIMF/11,12/
  3941. C
  3942.       ISUBST = INSTRI - 1
  3943.       IF (NSUBST.GT.0 .AND. (NCMD.EQ.KEZONE.OR.NCMD.EQ.KEGZON))
  3944.      1  WRITE (NFLOG,2345) ISUBST, INRUSE
  3945. C
  3946. C          INITIATE (NFIRST = 1) OR READ NAMEZ
  3947. C
  3948.       IF (IXGP(KNAMEZ).NE.0) GOTO 20
  3949.       NFIRST = 1
  3950.       DO 10 I=I1,I2
  3951.   10    IA(I) = IBLANK
  3952.       GOTO 25
  3953.   20  NFIRST = 0
  3954.       CALL DBREAD (NAMEZ,KNAMEZ,1,0)
  3955.       IF (IERROR.NE.0) GOTO 900
  3956. C
  3957. C          FIND OR ADD (NEWZ=1) ZONENAME, SET IBITZ = BIT NR
  3958. C
  3959.    25 IEMPTY = 0
  3960.       DO 40 IBITZ=1,NBSU
  3961.         IF (NAMEZ(1,IBITZ).EQ.IBLANK) IEMPTY = IBITZ
  3962.         DO 30 J=1,8
  3963.           IF (NAMEZ(J,IBITZ).NE.IANUMV(J,1)) GOTO 40
  3964.   30      CONTINUE
  3965.         NEWZ = 0
  3966.         GOTO 80
  3967.   40  CONTINUE
  3968. C          NOT FOUND: ADD
  3969.       IF (IEMPTY.NE.0) GOTO 50
  3970.         WRITE (NFLOG,2000)
  3971.         GOTO 800
  3972.   50  IF (IANUMV(1,2).EQ.IAAA) GOTO 70
  3973.         WRITE (NFLOG,2010)
  3974.         GOTO 800
  3975.    70 IBITZ = IEMPTY
  3976.       NEWZ = 1
  3977.       DO 75 I=1,8
  3978.   75    NAMEZ(I,IBITZ) = IANUMV(I,1)
  3979.   80  CONTINUE
  3980. C
  3981. C          'XZONE ZONENAME DEL' DELETES ZONENAME
  3982. C
  3983.       IF (IANUMV(1,2).NE.IDDD.OR.NLASTP.NE.2) GOTO 100
  3984.   90    WRITE (NFLOG,2060)
  3985.         NAMEZ(1,IBITZ)  = IBLANK
  3986.         NEWZ = 1
  3987.         GOTO 760
  3988.   100 NULLZ = 1
  3989. C
  3990. C          IF BZONE GET XYZ - BOUNDARIES
  3991. C
  3992.       IF (NCMD.NE.KBZONE) GOTO 110
  3993.       XMIN = -1.0E10
  3994.       YMIN = -1.0E10
  3995.       ZMIN = -1.0E10
  3996.       XMAX =  1.0E10
  3997.       YMAX =  1.0E10
  3998.       ZMAX =  1.0E10
  3999.       IF (ITYPE(3).EQ.IREAL) XMIN = REALV(3)
  4000.       IF (ITYPE(4).EQ.IREAL) XMAX = REALV(4)
  4001.       IF (ITYPE(5).EQ.IREAL) YMIN = REALV(5)
  4002.       IF (ITYPE(6).EQ.IREAL) YMAX = REALV(6)
  4003.       IF (ITYPE(7).EQ.IREAL) ZMIN = REALV(7)
  4004.       IF (ITYPE(8).EQ.IREAL) ZMAX = REALV(8)
  4005.       IF (XMIN.LE.XMAX.AND.YMIN.LE.YMAX.AND.ZMIN.LE.ZMAX) GOTO 105
  4006.         WRITE (NFLOG,2050)
  4007.         GOTO 800
  4008.   105 XMIN = XMIN - ABS(EPS*XMIN)
  4009.       YMIN = YMIN - ABS(EPS*YMIN)
  4010.       ZMIN = ZMIN - ABS(EPS*ZMIN)
  4011.       XMAX = XMAX + ABS(EPS*XMAX)
  4012.       YMAX = YMAX + ABS(EPS*YMAX)
  4013.       ZMAX = ZMAX + ABS(EPS*ZMAX)
  4014.   110 CONTINUE
  4015. C
  4016. C          DO FOR ALL INDEPENDENT STRUCTURES
  4017. C
  4018.       ISTRUC = 0
  4019.       IEGAT = 0
  4020.       IEGIT = 0
  4021.       ISNOD = 0
  4022.       ISEZON = 0
  4023.       DO 750 ISTRI=1,NSTRI
  4024. C
  4025.       NRUSE = NRUSES(ISTRI)
  4026.       NUMNP = NUMNPS(ISTRI)
  4027.       NEG = NEGS(ISTRI)
  4028.       CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  4029.       IF (IERROR.NE.0) GOTO 900
  4030. C
  4031. C          DO FOR ALL TIMES A STRUCTURE IS REUSED
  4032. C
  4033.       DO 740 IRUSE=1,NRUSE
  4034. C
  4035.       ISTRUC = ISTRUC + 1
  4036. C
  4037. C          INIT (NFIRST=1) OR READ NZONE, CLEAR BITS(IBITZ) TO ZERO
  4038. C
  4039.       IF (NFIRST.EQ.0) CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
  4040.       DO 210 NP=1,NUMNP
  4041.         IF (NFIRST.EQ.1) NZONE(NP) = 0
  4042.         IF (IANUMV(1,2).EQ.IDDD) CALL BITSET (NZONE(NP),IBITZ,0)
  4043.   210   CONTINUE
  4044. C
  4045. C          IF COMMAND BZONE, READ XYZ
  4046. C
  4047.       IF (NCMD.EQ.KBZONE) CALL DBREAD (XYZ,KXYZ,ISTRUC,0)
  4048.       IF (IERROR.NE.0) GOTO 900
  4049. C
  4050. C          DO FOR ALL ELEMENT GROUPS IN REUSED STRUCTURE
  4051. C
  4052.       DO 730 IEG=1,NEG
  4053. C
  4054.       IEGAT = IEGAT + 1
  4055.       IEGIT = IEGIT + 1
  4056.       ISELEC = 0
  4057.       IELTYP = NPAR(1,IEG)
  4058.       MXNODS = MXNODA(IELTYP)
  4059.       MXNODB = MXNODS
  4060.       IF (IELTYP.EQ.IBEAM .OR. IELTYP.EQ.ISOBEA) MXNODB = MXNODB - 1
  4061.       NEL = NPAR(2,IEG)
  4062. C
  4063. C          DO FOR ALL ELEMENTS IN ELEMENT GROUP
  4064. C
  4065.       DO 720 IEL=1,NEL
  4066. C
  4067.       IF (NCMD.NE.KEGZON) ISELEC = 0
  4068.       IF (NCMD.EQ.KBZONE) GOTO 300
  4069.       IF (NLASTP.LT.3) GOTO 700
  4070.       IF (NCMD.EQ.KZZONE) GOTO 600
  4071.       IF (INSTRI.NE.ISTRI.OR.INRUSE.NE.IRUSE) GOTO 700
  4072.       IF (NCMD.EQ.KEZONE) GOTO 400
  4073.       GOTO 500
  4074. C
  4075. C          BZONE SELECTION - ALL ELEMENT NODES MUST BE ON OR WITHIN
  4076. C          XYZ BOUNDARIES
  4077. C
  4078.   300 IF (ISNOD.EQ.IEGIT) GOTO 305
  4079.       ISNOD = IEGIT
  4080.       CALL DBREAD (NOD,KNOD,IEGIT,0)
  4081.       IF (IERROR.NE.0) GOTO 900
  4082.   305 DO 310 NODEL=1,MXNODB
  4083.       INODEL = MXNODS * (IEL - 1) + NODEL
  4084.       NP = NOD(INODEL)
  4085.       IF (NP.EQ.0) GOTO 310
  4086.       XC = XYZ(NP)
  4087.       I = NUMNP + NP
  4088.       YC = XYZ(I)
  4089.       ZC = XYZ(I+NUMNP)
  4090.       IF (XC.LT.XMIN .OR. XC.GT.XMAX) GOTO 700
  4091.       IF (YC.LT.YMIN .OR. YC.GT.YMAX) GOTO 700
  4092.       IF (ZC.LT.ZMIN .OR. ZC.GT.ZMAX) GOTO 700
  4093.   310 CONTINUE
  4094.       ISELEC = 1
  4095.       GOTO 700
  4096. C
  4097. C          EZONE SELECTION
  4098. C
  4099.   400 NEGX = INTV(3)
  4100.       IF (NEGX.LT.1 .OR. NEGX.GT.NEG) GOTO 480
  4101.       IF (NEGX.NE.IEG) GOTO 700
  4102.       NELN = 4
  4103.   410 IF (NELN.GT.NLASTP) GOTO 700
  4104.       NELX = INTV(NELN)
  4105.       NELN = NELN + 1
  4106. C
  4107. C          GENERATE ELEMENT NUMBERS FROM NELX TO -(NTO) STEP -(NSTEP)
  4108. C          NELX MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
  4109. C
  4110.       NTO = 0
  4111.       IF (NELN.GT.NLASTP) GOTO 430
  4112.       IF (INTV(NELN).LT.0) NTO = -INTV(NELN)
  4113.       IF (NTO.LE.0) GOTO 430
  4114.       NELN = NELN + 1
  4115.       NSTEP = 1
  4116.       IF (NELN.GT.NLASTP .OR. INTV(NELN).GE.0) GOTO 420
  4117.       NSTEP = -INTV(NELN)
  4118.       NELN = NELN + 1
  4119.   420 IF (NELX.GT.NTO) NSTEP = -NSTEP
  4120. C
  4121.   430 IF (NELX.LT.1 .OR. NELX.GT.NEL) GOTO 490
  4122.       IF (NELX.EQ.IEL) ISELEC = 1
  4123. C
  4124. C          INCREMENT BY STEP VALUE
  4125. C
  4126.       IF (NTO.LE.0) GOTO 410
  4127.       NELX = NELX + NSTEP
  4128.       IF (NELX.GT.NTO .AND. NSTEP.GT.0) GOTO 410
  4129.       IF (NELX.LT.NTO .AND. NSTEP.LT.0) GOTO 410
  4130.       GOTO 430
  4131. C
  4132.   480 WRITE (NFLOG,2030) NEGX
  4133.       GOTO 800
  4134.   490 WRITE (NFLOG,2040) NELX
  4135.       GOTO 800
  4136. C
  4137. C          EGZONE SELECTION
  4138. C
  4139.   500 IF (IEL.GT.1) GOTO 700
  4140.       NEGN = 3
  4141.   510 IF (NEGN.GT.NLASTP) GOTO 700
  4142.       NEGX = INTV(NEGN)
  4143.       NEGN = NEGN + 1
  4144. C
  4145. C          GENERATE EG NUMBERS FROM NEGX TO -(NTO) STEP -(NSTEP)
  4146. C          NEGX MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
  4147. C
  4148.       NTO = 0
  4149.       IF (NEGN.GT.NLASTP) GOTO 530
  4150.       IF (INTV(NEGN).LT.0) NTO = -INTV(NEGN)
  4151.       IF (NTO.LE.0) GOTO 530
  4152.       NEGN = NEGN + 1
  4153.       NSTEP = 1
  4154.       IF (NEGN.GT.NLASTP .OR. INTV(NEGN).GE.0) GOTO 520
  4155.       NSTEP = -INTV(NEGN)
  4156.       NEGN = NEGN + 1
  4157.   520 IF (NEGX.GT.NTO) NSTEP = -NSTEP
  4158. C
  4159.   530 IF (NEGX.LT.1 .OR. NEGX.GT.NEG) GOTO 480
  4160.       IF (NEGX.EQ.IEG) ISELEC = 1
  4161. C
  4162. C          INCREMENT BY STEP VALUE
  4163. C
  4164.       IF (NTO.LE.0) GOTO 510
  4165.       NEGX = NEGX + NSTEP
  4166.       IF (NEGX.GT.NTO .AND. NSTEP.GT.0) GOTO 510
  4167.       IF (NEGX.LT.NTO .AND. NSTEP.LT.0) GOTO 510
  4168.       GOTO 530
  4169. C
  4170. C          ZZONE SELECTION
  4171. C
  4172.   600 DO 640 IZONN=3,NLASTP
  4173.         DO 620 IBITX=1,NBSU
  4174.           DO 610 I=1,8
  4175.             IF(NAMEZ(I,IBITX).NE.IANUMV(I,IZONN)) GOTO 620
  4176.   610       CONTINUE
  4177.           GOTO 630
  4178.   620     CONTINUE
  4179. C
  4180. C          ZONN NOT FOUND
  4181. C
  4182.         DO 625 I=1,8
  4183.           NAMEZ (I,1) = IANUMV(I,IZONN)
  4184.           CALL APCHAR(NAMEZ(I,1))
  4185.   625     CONTINUE
  4186.         WRITE (NFLOG,2010) (NAMEZ(I,1),I=1,8)
  4187.         GOTO 800
  4188. C
  4189. C          ZONN FOUND
  4190. C
  4191.   630 IF (ISEZON.EQ.IEGAT) GOTO 635
  4192.       ISEZON = IEGAT
  4193.       CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  4194.       IF (IERROR.NE.0) GOTO 900
  4195.   635 CALL BITGET (IEZONE(IEL),IBITX,IBIT)
  4196.         IF (IBIT.EQ.1) ISELEC = 1
  4197.   640   CONTINUE
  4198. C
  4199. C
  4200. C          INITIALIZE OR READ IEZONE IF NEEDED
  4201. C
  4202.   700 IF (IANUMV(1,2).EQ.IAAA .AND. NFIRST.EQ.0
  4203.      1    .AND. ISELEC.EQ.0) GOTO 720
  4204.       IF (ISEZON.EQ.IEGAT) GOTO 705
  4205.       ISEZON = IEGAT
  4206.       DO 703 I=1,NEL
  4207.   703   IEZONE(I) = 0
  4208.       IF (NFIRST.EQ.0) CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  4209.       IF (IERROR.NE.0) GOTO 900
  4210. C
  4211. C          UPDATE BIT IEZONE(IEL)
  4212. C
  4213.   705 NEWBIT = 1
  4214.       IF (IANUMV(1,2) .EQ.IDDD) NEWBIT = 0
  4215.       IF (ISELEC.EQ.1) CALL BITSET (IEZONE(IEL),IBITZ,NEWBIT)
  4216.       CALL BITGET (IEZONE(IEL),IBITZ,IBIT)
  4217.       IF (IBIT.EQ.0) GOTO 720
  4218.       NULLZ = 0
  4219. C
  4220. C          UPDATE BITS(IBITZ) IN NZONE
  4221. C
  4222.       IF (ISNOD.EQ.IEGIT) GOTO 707
  4223.       ISNOD = IEGIT
  4224.       CALL DBREAD (NOD,KNOD,IEGIT,0)
  4225.       IF (IERROR.NE.0) GOTO 900
  4226.   707 DO 710 NODEL=1,MXNODS
  4227.         INODEL = MXNODS * (IEL - 1) + NODEL
  4228.         NP = NOD(INODEL)
  4229.         IF (NP.EQ.0) GOTO 710
  4230.         CALL BITSET (NZONE(NP),IBITZ,1)
  4231.   710   CONTINUE
  4232. C
  4233.   720 CONTINUE
  4234.       IF (ISEZON.EQ.IEGAT)
  4235.      1  CALL DBWRIT (IEZONE,0,NEL,KIEZON,IEGAT,0)
  4236.       IF (IERROR.NE.0) GOTO 900
  4237. C
  4238.   730 CONTINUE
  4239.       IEGIT = IEGIT - NEG
  4240.       CALL DBWRIT (NZONE,0,NUMNP,KNZONE,ISTRUC,0)
  4241.       IF (IERROR.NE.0) GOTO 900
  4242. C
  4243.   740 CONTINUE
  4244.       IEGIT = IEGIT + NEG
  4245.   750 CONTINUE
  4246.       IF (NULLZ.EQ.0) GOTO 760
  4247.         WRITE (NFLOG,2070)
  4248.         GOTO 90
  4249.   760 IF (NEWZ.EQ.1)
  4250.      1  CALL DBWRIT (NAMEZ,0,NBSU*8,KNAMEZ,1,0)
  4251.       GOTO 900
  4252. C
  4253.   800 IERROR = 1
  4254.   900 RETURN
  4255.  2000 FORMAT (29H ***ERROR: TOO MANY ZONENAMES)
  4256.  2010 FORMAT (29H ***ERROR: ZONENAME NOT FOUND,2X,8A1)
  4257.  2030 FORMAT (42H ***ERROR: INVALID ELEMENT GROUP NUMBER - ,I6)
  4258.  2040 FORMAT (36H ***ERROR: INVALID ELEMENT NUMBER - ,I6)
  4259.  2060 FORMAT (20H ***ZONENAME DELETED)
  4260.  2070 FORMAT (37H ***WARNING: ZONE CONTAINS NO ELEMENT)
  4261.  2050 FORMAT (45H ***ERROR: MAX VALUE MUST BE GREATER THAN MIN)
  4262.  2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  4263.       END
  4264. C***ADD:CDC***
  4265. CDECK BITSET
  4266. C***END:CDC***
  4267.       SUBROUTINE BITSET (IWORD,IBITZ,INEW)
  4268. C
  4269. C          UPDATE IWORD BIT NR IBITZ FROM RIGHT TO VALUE INEW
  4270. C
  4271.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  4272.       IEXP = 2 ** (NBSU - IBITZ)
  4273.       IF (MOD(IWORD/IEXP,2).EQ.1) GOTO 10
  4274.       IF (INEW.EQ.1) IWORD = IWORD + IEXP
  4275.       GOTO 90
  4276.   10  IF (INEW.EQ.0) IWORD = IWORD - IEXP
  4277.   90  CONTINUE
  4278.       RETURN
  4279.       END
  4280. C***ADD:CDC***
  4281. CDECK NPOIN1
  4282. C***END:CDC***
  4283.       SUBROUTINE NPOIN1
  4284. C
  4285.       DIMENSION IA(1)
  4286. C
  4287.       COMMON /ERROR/ IERROR
  4288.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4289.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4290.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4291.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  4292.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  4293.      2             I16,I17,I18,I19,I20,
  4294.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  4295.      4             N16,N17,N18,N19,N20
  4296.       COMMON A(1)
  4297.       EQUIVALENCE (A(1),IA(1))
  4298. C
  4299. C          BLANK COMMON LAYOUT
  4300. C
  4301. C                                                LINEID
  4302.       I2 = I1 + MLINEN * 3
  4303. C                                                NODEP
  4304.       I3 = I2 + MLINEN * 99
  4305. C                                                NAMEP
  4306.       I4 = I3 + MLINEN * 8
  4307.       CALL SIZE (I4)
  4308.         IF (IERROR.NE.0) GOTO 900
  4309.       DO 50 I=I1,I4
  4310.   50    IA(I) = 0
  4311.       CALL NPOIN2 (IA(I1),IA(I2),IA(I3),IA(I08))
  4312.   900 RETURN
  4313.       END
  4314. C***ADD:CDC***
  4315. CDECK NPOIN2
  4316. C***END:CDC***
  4317.       SUBROUTINE NPOIN2 (LINEID,NODEP,NAMEP,NUMNPS)
  4318. C
  4319.       DIMENSION LINEID(3,1),NODEP(99,1),NAMEP(8,1),NUMNPS(1)
  4320. C
  4321. C
  4322.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  4323.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  4324.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  4325.       COMMON /ERROR/ IERROR
  4326.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4327.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4328.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4329.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  4330.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  4331.      2             IXGP(50),MXSGP(50),
  4332.      3             FILL1
  4333.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  4334.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  4335.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  4336.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  4337.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  4338.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  4339.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  4340.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  4341.      8                KX49  ,KX50
  4342.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4343.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4344.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4345.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4346.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4347.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4348.      6                NDOFSA(6),NOUSE(4),FILL2
  4349. C
  4350. C
  4351.       ISUBST = INSTRI - 1
  4352.       IF (NSUBST.GT.0) WRITE (NFLOG,2345) ISUBST, INRUSE
  4353. C
  4354. C          PARAM 1: PNAME
  4355. C
  4356.       IF (ITYPE(1).NE.IOMIT) GOTO 10
  4357.         WRITE (NFLOG,2000)
  4358.         GOTO 800
  4359. C
  4360. C          READ NPOINT RECORD FROM DATABASE
  4361. C
  4362.   10  IF (IXGP(KNPOIN).NE.0) CALL DBREAD (LINEID,KNPOIN,1,0)
  4363.         IF (IERROR.NE.0) GOTO 900
  4364. C
  4365. C          TRY TO FIND PNAME IN NAME ARRAY
  4366. C
  4367.   100 IEMPTY = 0
  4368.       DO 120 ILINEN=1,MLINEN
  4369.         IF (NAMEP(1,ILINEN).EQ.0) IEMPTY = ILINEN
  4370.         DO 110 I=1,8
  4371.           IF (NAMEP(I,ILINEN).NE.IANUMV(I,1)) GOTO 120
  4372.   110     CONTINUE
  4373.         GOTO 150
  4374.   120   CONTINUE
  4375. C
  4376. C          NOT FOUND: ADD
  4377. C
  4378.       IF (IEMPTY.NE.0) GOTO 130
  4379.         WRITE (NFLOG,2010) MLINEN
  4380.         GOTO 800
  4381.   130 ILINEN = IEMPTY
  4382.       DO 140 I=1,8
  4383.   140   NAMEP(I,ILINEN) = IANUMV(I,1)
  4384.       GOTO 100
  4385. C
  4386. C          IF NO NODES, NPOINT LINE IS DELETED
  4387. C
  4388.   150 IF (ITYPE(2).NE.IOMIT) GOTO 170
  4389.         NAMEP(1,ILINEN) = 0
  4390.         GOTO 300
  4391. C
  4392. C          UPDATE LINEID AND NODEP
  4393. C
  4394.   170 LINEID(1,ILINEN) = INSTRI
  4395.       LINEID(2,ILINEN) = INSTRU
  4396.       LINEID(3,ILINEN) = INRUSE
  4397. C
  4398. C          MOVE NODEPOINT NUMBERS TO DATABASE RECORD
  4399. C          GENERATE NODE NUMBERS FROM NP TO -(NTO) STEP -(NSTEP)
  4400. C          NP MAY BE LESS THAN -(NTO), THEN STEP INCREMENT IS NEGATIVE
  4401. C
  4402.       IXOUT = 1
  4403.       IXIN = 2
  4404.  210  IF (IXIN.GT.100) GOTO 300
  4405.       NP = INTV(IXIN)
  4406.       IF (NP.EQ.0) GOTO 300
  4407.       IXIN = IXIN + 1
  4408.       NTO = 0
  4409.       IF (IXIN.GT.100) GOTO 250
  4410.       IF (INTV(IXIN).LT.0) NTO = -INTV(IXIN)
  4411.       IF (NTO.LE.0) GOTO 250
  4412.       IXIN = IXIN + 1
  4413.       NSTEP = 1
  4414.       IF (IXIN.GT.100 .OR. INTV(IXIN).GE.0) GOTO 240
  4415.       NSTEP = -INTV(IXIN)
  4416.       IXIN = IXIN + 1
  4417.   240 IF (NP.GT.NTO) NSTEP = -NSTEP
  4418. C
  4419.   250 IF (NP.GE.1 .AND. NP.LE.NUMNPS(INSTRI)) GOTO 260
  4420.         WRITE (NFLOG,2020) NP
  4421.         GOTO 800
  4422.   260 IF (IXOUT.LE.99) GOTO 270
  4423.         WRITE (NFLOG,2030) NP
  4424.         GOTO 800
  4425.   270 NODEP(IXOUT,ILINEN) = NP
  4426.       IXOUT = IXOUT + 1
  4427.       IF (NTO.LE.0) GOTO 210
  4428.       NP = NP + NSTEP
  4429.       IF (NP.GT.NTO .AND. NSTEP.GT.0) GOTO 210
  4430.       IF (NP.LT.NTO .AND. NSTEP.LT.0) GOTO 210
  4431.       GOTO 250
  4432. C
  4433.   300 CALL DBWRIT (LINEID,0,MLINEN*110,KNPOIN,1,0)
  4434.       GOTO 900
  4435.   800 IERROR = 1
  4436.   900 RETURN
  4437.  2000 FORMAT (22H ***ERROR: WHAT  NAME?)
  4438.  2010 FORMAT (31H ***ERROR: TOO MANY  NAMES, MAX,I3)
  4439.  2020 FORMAT (32H ***ERROR: INVALID NODE NUMBER =,I5)
  4440.  2030 FORMAT(34H ***ERROR: TOO MANY NODES AT POINT,I4,8H, MAX 99)
  4441.  2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  4442.       END
  4443. C***ADD:CDC***
  4444. CDECK EPOIN1
  4445. C***END:CDC***
  4446.       SUBROUTINE EPOIN1
  4447. C
  4448.       DIMENSION IA(1)
  4449. C
  4450.       COMMON /ERROR/ IERROR
  4451.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4452.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4453.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4454.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  4455.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  4456.      2             I16,I17,I18,I19,I20,
  4457.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  4458.      4             N16,N17,N18,N19,N20
  4459.       COMMON A(1)
  4460.       EQUIVALENCE (A(1),IA(1))
  4461. C
  4462. C          BLANK COMMON LAYOUT
  4463. C
  4464. C                                                LINEID
  4465.       I2 = I1 + MLINEE * 4
  4466. C                                                NELP
  4467.       I3 = I2 + MLINEE * 98
  4468. C                                                NAMEP
  4469.       I4 = I3 + MLINEE * 8
  4470.       CALL SIZE (I4)
  4471.         IF (IERROR.NE.0) GOTO 900
  4472.       DO 50 I=I1,I4
  4473.   50    IA(I) = 0
  4474.       CALL EPOIN2 (IA(I1),IA(I2),IA(I3),IA(I07))
  4475.   900 RETURN
  4476.       END
  4477. C***ADD:CDC***
  4478. CDECK EPOIN2
  4479. C***END:CDC***
  4480.       SUBROUTINE EPOIN2 (LINEID,NELP,NAMEP,NEGS)
  4481. C
  4482.       DIMENSION LINEID(4,1),NELP(98,1),NAMEP(8,1),NEGS(1)
  4483. C
  4484. C
  4485.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  4486.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  4487.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  4488.       COMMON /ERROR/ IERROR
  4489.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4490.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4491.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4492.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  4493.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  4494.      2             IXGP(50),MXSGP(50),
  4495.      3             FILL1
  4496.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  4497.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  4498.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  4499.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  4500.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  4501.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  4502.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  4503.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  4504.      8                KX49  ,KX50
  4505.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4506.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4507.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4508.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4509.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4510.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4511.      6                NDOFSA(6),NOUSE(4),FILL2
  4512. C
  4513. C
  4514.       ISUBST = INSTRI - 1
  4515.       IF (NSUBST.GT.0) WRITE (NFLOG,2345) ISUBST, INRUSE
  4516. C
  4517. C          PARAM 1: PNAME
  4518. C
  4519.       IF (ITYPE(1).NE.IOMIT) GOTO 10
  4520.         WRITE (NFLOG,2000)
  4521.         GOTO 800
  4522. C
  4523. C          READ EPOINT RECORD FROM DATABASE
  4524. C
  4525.   10  IF (IXGP(KEPOIN).NE.0) CALL DBREAD (LINEID,KEPOIN,1,0)
  4526.         IF (IERROR.NE.0) GOTO 900
  4527. C
  4528. C          TRY TO FIND PNAME IN NAME ARRAY
  4529. C
  4530.   100 IEMPTY = 0
  4531.       DO 120 ILINEE=1,MLINEE
  4532.         IF (NAMEP(1,ILINEE).EQ.0) IEMPTY = ILINEE
  4533.         DO 110 I=1,8
  4534.           IF (NAMEP(I,ILINEE).NE.IANUMV(I,1)) GOTO 120
  4535.   110     CONTINUE
  4536.         GOTO 150
  4537.   120   CONTINUE
  4538. C
  4539. C          NOT FOUND: ADD
  4540. C
  4541.       IF (IEMPTY.NE.0) GOTO 130
  4542.         WRITE (NFLOG,2010) MLINEE
  4543.         GOTO 800
  4544.   130 ILINEE = IEMPTY
  4545.       DO 140 I=1,8
  4546.   140   NAMEP(I,ILINEE) = IANUMV(I,1)
  4547.       GOTO 100
  4548. C
  4549. C          IF NO NEG, EPOINT LINE IS DELETED
  4550. C
  4551.   150 IF (ITYPE(2).NE.IOMIT) GOTO 170
  4552.         NAMEP(1,ILINEE) = 0
  4553.         GOTO 300
  4554. C
  4555. C          UPDATE LINEID AND NELP
  4556. C
  4557.   170 LINEID(1,ILINEE) = INSTRI
  4558.       LINEID(2,ILINEE) = INSTRU
  4559.       LINEID(3,ILINEE) = INRUSE
  4560.       NEG = INTV(2)
  4561.       IF (NEG.LT.1 .OR. NEG.GT.NEGS(INSTRI)) GOTO 700
  4562.       LINEID(4,ILINEE) = NEG
  4563.       DO 200 I=1,98
  4564.   200   NELP(I,ILINEE) = INTV(I+2)
  4565. C
  4566.   300 CALL DBWRIT (LINEID,0,MLINEE*110,KEPOIN,1,0)
  4567.       GOTO 900
  4568.   700 WRITE (NFLOG,2020) NEG
  4569.   800 IERROR = 1
  4570.   900 RETURN
  4571.  2000 FORMAT (22H ***ERROR: WHAT  NAME?)
  4572.  2010 FORMAT (31H ***ERROR: TOO MANY  NAMES, MAX,I3)
  4573.  2020 FORMAT (41H ***ERROR: INVALID ELEMENT GROUP NUMBER =,I5)
  4574.  2345 FORMAT(21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  4575.       END
  4576. C*NEW FILE
  4577. C***END:IBM***
  4578.       SUBROUTINE MLIST1
  4579. C
  4580.       DIMENSION IA(1),NDIRV(6)
  4581. C
  4582.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  4583.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  4584.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  4585.       COMMON /ERROR/ IERROR
  4586.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4587.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4588.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4589.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  4590.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  4591.      2             IXGP(50),MXSGP(50),
  4592.      3             FILL1
  4593.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  4594.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  4595.      2             I16,I17,I18,I19,I20,
  4596.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  4597.      4             N16,N17,N18,N19,N20
  4598.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4599.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4600.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4601.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4602.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4603.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4604.      6                NDOFSA(6),NOUSE(4),FILL2
  4605.       COMMON A(1)
  4606.       EQUIVALENCE (A(1),IA(1))
  4607. C
  4608. C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
  4609. C
  4610.       CALL ZGETNB
  4611.         IF (IERROR.NE.0) GOTO 900
  4612. C
  4613. C          PARAM 2: NDIRS
  4614. C
  4615.       NDIRS = INTV(2)
  4616.       IF (ITYPE(2).EQ.IOMIT) NDIRS = 123
  4617.       NVAR = 0
  4618.       DO 240 NDIGIT=1,6
  4619.         NDIR = MOD(NDIRS / 10**(6-NDIGIT), 10)
  4620.         IF (NDIR.EQ.0) GOTO 240
  4621.         IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
  4622.         NVAR = NVAR + 1
  4623.         NDIRV(NVAR) = NDIR
  4624.   240   CONTINUE
  4625.       IF (NVAR.EQ.0) GOTO 850
  4626. C
  4627. C          PARAM 3, 4: MSTART, MEND
  4628. C
  4629.       MSTART = INTV(3)
  4630.       IF (ITYPE(3).EQ.IOMIT) MSTART = 1
  4631.       MEND = INTV(4)
  4632.       IF (ITYPE(4).EQ.IOMIT) MEND = MSTART
  4633. C
  4634. C          BLANK COMMON LAYOUT
  4635. C
  4636. C                                                NZONE
  4637.       N2 = (I1 + MXNP) / ISURL
  4638. C                                                FRQ
  4639.       N3 = N2 + NFREQ
  4640. C                                                PHI
  4641.       N4 = N3 + MXNP * NDOF
  4642. C                                                RSDCOS
  4643.       I5 = (N4 + NSKEWS * 9) * ISURL
  4644. C                                                IDRN
  4645.       I6 = I5 + (NDOF + 2) * MXNP
  4646. C                                                KINDHD
  4647.       I7 = I6 + NVAR * 3
  4648.       CALL SIZE (I7)
  4649.         IF (IERROR.NE.0) GOTO 900
  4650. C
  4651.       CALL MLIST2 (NVAR,NDIRV,MSTART,MEND,
  4652.      1            IA(I1),A(N2),NDOF,A(N3),IA(I6),IA(I08),A(N4),IA(I5))
  4653.       GOTO 900
  4654.   850 IERROR = 2
  4655.   900 RETURN
  4656.       END
  4657. C***ADD:CDC***
  4658. CDECK MLIST2
  4659. C***END:CDC***
  4660.       SUBROUTINE MLIST2 (NVAR,NDIRV,MSTART,MEND,NZONE,
  4661.      1                   FRQ,NDOFD,PHI,KINDHD,NUMNPS,RSDCOS,IDRN)
  4662. C
  4663.       DIMENSION NDIRV(1),NZONE(1),FRQ(1),PHI(NDOFD,1),KINDHD(1)
  4664.      1          ,VALUEV(6),NUMNPS(1),RSDCOS(9,1),IDRN(1)
  4665.      2          ,VDIR(6)
  4666. C
  4667.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  4668.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  4669.       COMMON /ERROR/ IERROR
  4670.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  4671.      1               IBITZ,IWHOLE,ICALL,IXPAR
  4672.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4673.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4674.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4675.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  4676.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  4677.      2             IXGP(50),MXSGP(50),
  4678.      3             FILL1
  4679.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4680.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4681.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4682.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4683.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4684.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4685.      6                NDOFSA(6),NOUSE(4),FILL2
  4686.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  4687.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  4688.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  4689.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  4690.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  4691.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  4692.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  4693.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  4694.      8                KX49  ,KX50
  4695. C
  4696.       ILIST = 0
  4697. C
  4698. C          READ FRQ
  4699. C
  4700.       IF (IXGP(KFRQ).NE.0) GOTO 100
  4701.         WRITE (NFLOG,2000)
  4702.         GOTO 800
  4703.   100 CALL DBREAD (FRQ,KFRQ,1,0)
  4704.         IF (IERROR.NE.0) GOTO 900
  4705.       NUMNP = NUMNPS(1)
  4706. C
  4707. C          READ RSDCOS AND IDRN IF SKEW SYSTEMS DEFINED
  4708. C
  4709.       IF (NSKEWS.EQ.0) GOTO 110
  4710.         CALL DBREAD (RSDCOS,KRSDCO,1,0)
  4711.         IF (IERROR.NE.0) GOTO 900
  4712.         CALL DBREAD (IDRN,KIDRN,1,0)
  4713.         IF (IERROR.NE.0) GOTO 900
  4714.         IXNRST = NDOF * NUMNP
  4715. C
  4716. C          READ NZONE
  4717. C
  4718.   110 IF (IBITZ.EQ.IWHOLE) GOTO 120
  4719.         CALL DBREAD (NZONE,KNZONE,1,0)
  4720.         IF (IERROR.NE.0) GOTO 900
  4721. C
  4722. C          DO FOR ALL SAVED MODAL STEPS
  4723. C
  4724.   120 DO 650 IFREQ=1,NFREQ
  4725. C
  4726.       IF (IFREQ.LT.MSTART .OR. IFREQ.GT.MEND) GOTO 650
  4727. C
  4728.       LINE = 9999
  4729.       CALL DBREAD (PHI,KPHI,IFREQ,0)
  4730.         IF (IERROR.NE.0) GOTO 900
  4731.       DO 620 NP=1,NUMNP
  4732. C
  4733. C          CHECK IF IN SELECTED ZONE
  4734. C
  4735.       IF (IBITZ.EQ.IWHOLE) GOTO 130
  4736.         CALL BITGET (NZONE(NP),IBITZ,ISELEC)
  4737.         IF (ISELEC.EQ.0) GOTO 620
  4738. C
  4739. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  4740. C
  4741.   130 DO 150 I=1,6
  4742.         VDIR(I) = 0.0
  4743.         INDOF = NDOFSA(I)
  4744.         IF (INDOF.GT.0)  VDIR(I) = PHI(INDOF,NP)
  4745.   150   CONTINUE
  4746. C
  4747. C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
  4748. C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
  4749. C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
  4750. C
  4751.       IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 200
  4752.       ISKEW = IDRN(IXNRST+NP)
  4753.       IF (ISKEW.GT.0)
  4754.      1  CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  4755. C
  4756. C          GET VALUES FOR SELECTED VARIABLES
  4757. C
  4758.   200 DO 250 IVAR=1,NVAR
  4759.         NDIR = NDIRV(IVAR)
  4760.         VALUEV(IVAR) = VDIR(NDIR)
  4761.   250   CONTINUE
  4762. C
  4763. C          LIST
  4764. C
  4765.   500 IF (LINE.LE.LINPAG) GOTO 530
  4766.       ILIST = 1
  4767.       HERTZ = FRQ(IFREQ) / 6.283185
  4768.       IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2030) IFREQ, HERTZ
  4769.       IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2031) NAMZON,IFREQ,HERTZ
  4770.       LINE = 2
  4771.       IF (NSKEWS.EQ.0) GOTO 505
  4772.         IF (LSKEW.NE.1) WRITE (NFLIST,2550)
  4773.         IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
  4774.         LINE = LINE + 2
  4775.   505 DO 525 IVAR=1,NVAR
  4776.         J = IVAR * 3 - 2
  4777.         CALL KINDN (NDIRV(IVAR),1,KINDHD(J))
  4778.   525   CONTINUE
  4779.       IEND = NVAR * 3
  4780.       WRITE (NFLIST,2040) (KINDHD(I),I=1,IEND)
  4781.       WRITE (NFLIST,2045)
  4782.       LINE = LINE + 3
  4783.   530 WRITE (NFLIST,2050) NP,(VALUEV(IVAR),IVAR=1,NVAR)
  4784.       LINE = LINE + 1
  4785. C
  4786.   620 CONTINUE
  4787.   650 CONTINUE
  4788.       IF (ILIST.EQ.0) WRITE (NFLOG,2700)
  4789. C
  4790.       GOTO 900
  4791. C
  4792.   800 IERROR = 1
  4793.   900 RETURN
  4794.  2000 FORMAT(32H ***ERROR: NO MODAL SHAPES FOUND)
  4795.  2030 FORMAT(48H1MODE SHAPE RESULTS FOR WHOLE MODEL    MODE NO =,
  4796.      1  I3,33H  FREQUENCY (CYCLES/UNIT TIME) = ,G10.4)
  4797.  2031 FORMAT(31H1MODE SHAPE RESULTS FOR ZONE = ,8A1,4X,9HMODE NO =,
  4798.      1  I3,33H  FREQUENCY (CYCLES/UNIT TIME) = ,G10.4)
  4799.  2040 FORMAT(/6H  NODE,6(5X,3A4))
  4800.  2045 FORMAT (1H )
  4801.  2050 FORMAT(1X,I5,6(5X,E12.6))
  4802.  2550 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
  4803.      1  17HCOORDINATE SYSTEM)
  4804.  2551 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
  4805.      1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
  4806.  2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
  4807.       END
  4808. C***ADD:CDC***
  4809. CDECK GLIST1
  4810. C***END:CDC***
  4811.       SUBROUTINE GLIST1
  4812. C
  4813.       DIMENSION IA(1)
  4814.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  4815.       COMMON /ERROR/ IERROR
  4816.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  4817.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  4818.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  4819.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  4820.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  4821.      2             I16,I17,I18,I19,I20,
  4822.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  4823.      4             N16,N17,N18,N19,N20
  4824.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4825.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4826.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4827.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4828.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4829.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4830.      6                NDOFSA(6),NOUSE(4),FILL2
  4831.       COMMON A(1)
  4832.       EQUIVALENCE (A(1),IA(1))
  4833. C
  4834. C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
  4835. C
  4836.       CALL ZGETNB
  4837.         IF (IERROR.NE.0) GOTO 900
  4838. C
  4839. C          GLIST BLANK COMMON LAYOUT
  4840. C                                                TIMEN
  4841.       I2 = I1 + NSTEN * ISURL
  4842. C                                                NSTEPN
  4843.       I3 = I2 + NSTEN
  4844.       CALL ALIGN (I3)
  4845. C                                                NZONE
  4846.       I4 = I3 + MXNP
  4847. C                                                X
  4848.       I5 = I4 + MXNP * 3 * ISURL
  4849. C                                                RSDCOS
  4850.       I6 = I5 + NSKEWS * 9 * ISURL
  4851. C                                                IDRN
  4852.       I7 = I6
  4853.       IF (NSKEWS.GT.0)
  4854.      1  I7 = I6 + (NDOF + 2) * MXNP
  4855. C                                                DISP
  4856.       I8 = I7 + NDOF * MXNP * ISURL
  4857.       CALL SIZE (I8)
  4858.         IF (IERROR.NE.0) GOTO 900
  4859.       CALL GLIST2 (IA(I06),IA(I08),IA(I1),IA(I2),IA(I3),
  4860.      1             IA(I4),IA(I5),IA(I6),NDOF,IA(I7))
  4861.   900 RETURN
  4862.       END
  4863. C***ADD:CDC***
  4864. CDECK GLIST2
  4865. C***END:CDC***
  4866.       SUBROUTINE GLIST2 (NRUSES,NUMNPS,TIMEN,NSTEPN,NZONE,X,
  4867.      1                   RSDCOS,IDRN,NDOFD,DISP)
  4868. C
  4869.       DIMENSION XYZ(3),NRUSES(1),NUMNPS(1),TIMEN(1),NSTEPN(1),
  4870.      1          NZONE(1),X(1),RSDCOS(9,1),IDRN(1),VDIR(6),DISP(NDOFD,1)
  4871. C
  4872.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  4873.       COMMON /EPS/ EPS
  4874.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  4875.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  4876.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  4877.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  4878.      1               IBITZ,IWHOLE,ICALL,IXPAR
  4879.       COMMON /ERROR/ IERROR
  4880.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  4881.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  4882.      2             IXGP(50),MXSGP(50),
  4883.      3             FILL1
  4884.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  4885.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  4886.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  4887.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  4888.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  4889.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  4890.      6                NDOFSA(6),NOUSE(4),FILL2
  4891.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  4892.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  4893.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  4894.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  4895.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  4896.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  4897.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  4898.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  4899.      8                KX49  ,KX50
  4900. C
  4901. C          READ TIMEN, NSTEPN
  4902. C
  4903.       IF (NSTEN.GT.0) GOTO 10
  4904.         WRITE (NFLOG,2050)
  4905.         IERROR = 1
  4906.         GOTO 900
  4907.   10  CALL DBREAD (TIMEN,KTIMEN,1,0)
  4908.       IF (IERROR.NE.0) GOTO 900
  4909. C
  4910. C          GET REST OF PARAMETERS
  4911. C
  4912.       TSTA = REALV(2)
  4913.       TEND = REALV(3)
  4914.       IF (ITYPE(2).EQ.IOMIT) TSTA = TIMEN(NSTEN)
  4915.       IF (ITYPE(3).EQ.IOMIT) TEND = TSTA
  4916.       EPSVAL = DT * EPS
  4917.       TSTA = TSTA - EPSVAL
  4918.       TEND = TEND + EPSVAL
  4919.       NTSKIP = INTV(4)
  4920.       IF (NTSKIP.LT.0) GOTO 850
  4921.       ISNZON = 0
  4922.       ISXYZD = 0
  4923.       ITSKIP = 0
  4924.       ISRSDC = 0
  4925.       ISIDRN = 0
  4926. C
  4927. C          DO FOR ALL TIMESTEPS OF NODAL RESULTS
  4928. C
  4929.       DO 650 ITIME=1,NSTEN
  4930. C
  4931.       LINE = 9999
  4932.       ISTRUC = 0
  4933.       ISDISP = 0
  4934.       TIME = TIMEN(ITIME)
  4935.       IF (TIME.LT.TSTA) GOTO 650
  4936.       IF (TIME.GT.TEND) GOTO 650
  4937. C
  4938. C          NTSKIP TIMESTEPS BETWEEN OUTPUT
  4939. C
  4940.       IF (ITIME.EQ.NSTEN) GOTO 50
  4941.       IF (TIMEN(ITIME+1).GT.TEND) GOTO 50
  4942.       ITSKIP = ITSKIP - 1
  4943.       IF (ITSKIP.GE.0) GOTO 650
  4944.   50  ITSKIP = NTSKIP
  4945. C
  4946. C          DO FOR EVERY STRUCTURE, REUSE AND NODAL POINT
  4947. C
  4948.       DO 640 ISTRI=1,NSTRI
  4949. C
  4950.       NRUSE = NRUSES(ISTRI)
  4951.       NUMNP = NUMNPS(ISTRI)
  4952.       DO 630 IRUSE=1,NRUSE
  4953. C
  4954.       ISTRUC = ISTRUC + 1
  4955.       LSTSUB = 1
  4956.       IF (IBITZ.EQ.IWHOLE) GOTO 100
  4957.       IF (ISNZON.EQ.ISTRUC) GOTO 100
  4958.         CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
  4959.         IF (IERROR.NE.0) GOTO 900
  4960.         ISNZON = ISTRUC
  4961.   100 DO 620 NP=1,NUMNP
  4962. C
  4963. C          CHECK IF IN SELECTED ZONE
  4964. C
  4965.       IF (IBITZ.EQ.IWHOLE) GOTO 200
  4966.         CALL BITGET (NZONE(NP),IBITZ,ISELEC)
  4967.         IF (ISELEC.EQ.0) GOTO 620
  4968. C
  4969. C          READ XYZ IF NOT ALREADY IN BLANK COMMON
  4970. C
  4971.   200 IF (ISXYZD.EQ.ISTRUC) GOTO 210
  4972.         CALL DBREAD (X,KXYZ,ISTRUC,0)
  4973.           IF (IERROR.NE.0) GOTO 900
  4974.         ISXYZD = ISTRUC
  4975.   210 XYZ(1) = X(NP)
  4976.       I = NUMNP + NP
  4977.       XYZ(2) = X(I)
  4978.       XYZ(3) = X(I+NUMNP)
  4979. C
  4980. C          READ DISP
  4981. C
  4982.       IF (ISDISP.EQ.ISTRUC) GOTO 220
  4983.         CALL DBREAD (DISP,KDISP,ISTRUC,ITIME)
  4984.           IF (IERROR.NE.0) GOTO 900
  4985.         ISDISP = ISTRUC
  4986. C
  4987. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  4988. C
  4989.   220 DO 225 I=1,6
  4990.         VDIR(I) = 0.0
  4991.         INDOF = NDOFSA(I)
  4992.         IF (INDOF.GT.0) VDIR(I) = DISP(INDOF,NP)
  4993.   225   CONTINUE
  4994. C
  4995. C          IF SKEW COORDINATE SYSTEM:  TRANSFORM TO GLOBAL
  4996. C
  4997.       IF (NSKEWS.EQ.0) GOTO 227
  4998.       IF (ISIDRN.NE.ISTRI)
  4999.      1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  5000.         IF (IERROR.NE.0) GOTO 900
  5001.         ISIDRN = ISTRI
  5002.       IXNRST = NDOF * NUMNP
  5003.       ISKEW = IDRN(IXNRST+NP)
  5004.       IF (ISKEW.LE.0) GOTO 227
  5005.       IF (ISRSDC.EQ.0)
  5006.      1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
  5007.         IF (IERROR.NE.0) GOTO 900
  5008.         ISRSDC = 1
  5009.       CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  5010. C
  5011. C          COMPUTE DEFORMED OR INITIAL COORDINATES
  5012. C
  5013.   227 DO 230 I=1,3
  5014.           XYZ(I) = XYZ(I) + VDIR(I)
  5015.   230   CONTINUE
  5016. C
  5017. C          WRITE HEADLINES
  5018. C
  5019.   300 IF (LINE.LE.LINPAG) GOTO 310
  5020.       IF (IBITZ.EQ.IWHOLE)
  5021.      1  WRITE (NFLIST,2000) TIME,NSTEPN(ITIME)
  5022.       IF (IBITZ.NE.IWHOLE)
  5023.      1  WRITE (NFLIST,2001) NAMZON,TIME,NSTEPN(ITIME)
  5024.         LINE = 2
  5025.         LSTSUB = 1
  5026.         LSTDET = 1
  5027.   310 IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 320
  5028.         LINE = LINE + 5
  5029.         IF (LINE.GT.LINPAG) GOTO 300
  5030.       LINE = LINE - 3
  5031.         ISUBST = ISTRI - 1
  5032.         WRITE (NFLIST,2345) ISUBST, IRUSE
  5033.         LSTSUB = 0
  5034.         LSTDET = 1
  5035.   320 IF (LSTDET.EQ.0) GOTO 330
  5036.         LINE = LINE + 3
  5037.         IF (LINE.GT.LINPAG) GOTO 300
  5038.         WRITE (NFLIST,2030)
  5039.         LSTDET = 0
  5040.   330 WRITE (NFLIST,2040) NP,(XYZ(I),I=1,3)
  5041.       LINE = LINE + 1
  5042.   620 CONTINUE
  5043.   630 CONTINUE
  5044.   640 CONTINUE
  5045.   650 CONTINUE
  5046.       GOTO 900
  5047.   850 IERROR = 2
  5048.   900 RETURN
  5049.  2000 FORMAT(41H1DEFORMED NODAL LOCATIONS FOR WHOLE MODEL,
  5050.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  5051.  2001 FORMAT(37H1DEFORMED NODAL LOCATIONS FOR ZONE = ,8A1,
  5052.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  5053.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  5054.  2030 FORMAT (/15H   NODE        ,
  5055.      1 44HX-LOCATION      Y-LOCATION      Z-LOCATION  /)
  5056.  2040 FORMAT (1X,I6,2X,3F16.5)
  5057.  2050 FORMAT (45H ***WARNING: NO TIMESTEP FOR NODAL DATA FOUND)
  5058.       END
  5059. C***ADD:CDC***
  5060. CDECK NLIST1
  5061. C***END:CDC***
  5062.       SUBROUTINE NLIST1
  5063. C
  5064.       DIMENSION IA(1),NDIRV(8),KINDV(8),VALUEV(8)
  5065. C
  5066.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  5067.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  5068.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  5069.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  5070.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  5071.      1               IBITZ,IWHOLE,ICALL,IXPAR
  5072.       COMMON /ERROR/ IERROR
  5073.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  5074.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  5075.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  5076.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  5077.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  5078.      2             I16,I17,I18,I19,I20,
  5079.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  5080.      4             N16,N17,N18,N19,N20
  5081.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  5082.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  5083.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  5084.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  5085.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  5086.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  5087.      6                NDOFSA(6),NOUSE(4),FILL2
  5088.       COMMON A(1)
  5089.       EQUIVALENCE (A(1),IA(1))
  5090. C
  5091.       DATA MXNVAR,KINDT/6,4/
  5092. C
  5093. C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
  5094. C
  5095.       CALL ZGETNB
  5096.         IF (IERROR.NE.0) GOTO 900
  5097. C
  5098. C          PARAM 2, 3: NDIRS,KINDS
  5099. C
  5100.       NDIRS = INTV(2)
  5101.       IF (ITYPE(2).EQ.IOMIT) NDIRS = 123
  5102.       KINDS = INTV(3)
  5103.       IF (ITYPE(3).EQ.IOMIT) KINDS = 1
  5104. C
  5105. C          ANALYZE NDIRS AND KINDS
  5106. C
  5107.   200 NVAR = 0
  5108.       DO 250 KDIGIT=1,4
  5109.         KIND = MOD(KINDS/10**(4-KDIGIT), 10)
  5110.         IF (KIND.EQ.0) GOTO 250
  5111.         IF (KIND.LT.1 .OR. KIND.GT.4) GOTO 850
  5112.         IF (KIND.NE.KINDT) GOTO 210
  5113.           NVAR = NVAR + 1
  5114.           KINDV(NVAR) = KIND
  5115.           GOTO 250
  5116.   210   DO 240 NDIGIT=1,6
  5117.           NDIR = MOD (NDIRS / 10**(6-NDIGIT), 10)
  5118.           IF (NDIR.EQ.0) GOTO 240
  5119.           IF (NDIR.LT.1 .OR. NDIR.GT.6) GOTO 850
  5120.           NVAR = NVAR + 1
  5121.           IF (NVAR.LE.MXNVAR) GOTO 220
  5122.             WRITE (NFLOG,2000) MXNVAR
  5123.           GOTO 800
  5124.   220     KINDV(NVAR) = KIND
  5125.           NDIRV(NVAR) = NDIR
  5126.   240     CONTINUE
  5127.   250   CONTINUE
  5128.       IF (NVAR.EQ.0) GOTO 850
  5129. C
  5130. C          BLANK COMMON LAYOUT
  5131. C
  5132.       N11 = N1
  5133. C                                                TIMEN
  5134.       I12 = I1 + NSTEN * ISURL
  5135. C                                                NSTEPN
  5136.       I13 = I12 + NSTEN
  5137.       CALL ALIGN (I13)
  5138. C                                                NZONE
  5139.       I14 = I13 + MXNP
  5140. C                                                RSDCOS
  5141.       I15 = I14 + NSKEWS * 9 * ISURL
  5142. C                                                IDRN
  5143.       I16 = I15
  5144.       IF (NSKEWS.GT.0 .AND. LSKEW.EQ.0)
  5145.      1  I16 = I15 + (NDOF + 2) * MXNP
  5146.       CALL SIZE (I16)
  5147.         IF (IERROR.NE.0) GOTO 900
  5148. C
  5149.       ICALL = 1
  5150.       IXPAR = 4
  5151.       CALL NLIST2 (NVAR,
  5152.      1     VALUEV,NDIRV,KINDV,A(N11),IA(I12),IA(I13),IA(I13),
  5153.      2     IA(I06),IA(I08),IA(I14),IA(I15))
  5154.       GOTO 900
  5155.   800 IERROR = 1
  5156.       GOTO 900
  5157.   850 IERROR = 2
  5158.   900 RETURN
  5159.  2000 FORMAT (43H ***ERROR: TOO MANY VARIABLES SELECTED, MAX,I3)
  5160.       END
  5161. C***ADD:CDC***
  5162. CDECK NLIST2
  5163. C***END:CDC***
  5164.       SUBROUTINE NLIST2 (NVAR,
  5165.      1           VALUEV,NDIRV,KINDV,TIMEN,NSTEPN,
  5166.      2           NZONE,IRPOL,NRUSES,NUMNPS,RSDCOS,IDRN)
  5167. C
  5168.       DIMENSION IA(1),VALUEV(1),NDIRV(1),KINDV(1),TIMEN(1),
  5169.      1 NSTEPN(1),NZONE(1),IRPOL(1),IXA(5),IREAD(5),NRUSES(1),NUMNPS(1)
  5170.       DIMENSION RSDCOS(9,1),IDRN(1),VDIR(6),IHDMAX(4,3),IHDMX2(12)
  5171. C
  5172.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  5173.       COMMON /EPS/ EPS
  5174.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  5175.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  5176.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  5177.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  5178.      1               IBITZ,IWHOLE,ICALL,IXPAR
  5179.       COMMON /ERROR/ IERROR
  5180.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  5181.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  5182.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  5183.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  5184.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  5185.      2             IXGP(50),MXSGP(50),
  5186.      3             FILL1
  5187.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  5188.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  5189.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  5190.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  5191.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  5192.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  5193.      6                NDOFSA(6),NOUSE(4),FILL2
  5194.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  5195.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  5196.      2             I16,I17,I18,I19,I20,
  5197.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  5198.      4             N16,N17,N18,N19,N20
  5199.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  5200.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  5201.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  5202.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  5203.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  5204.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  5205.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  5206.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  5207.      8                KX49  ,KX50
  5208.       COMMON A(1)
  5209.       EQUIVALENCE (A(1),IA(1))
  5210.       EQUIVALENCE (IHDMAX(1,1),IHDMX2(1))
  5211.       DATA IHDMX2/
  5212.      1 4HABSO,4HLUTE,4H MAX,4HIMUM,
  5213.      2 4HMAXI,4HMUM ,4H    ,4H    ,
  5214.      3 4HMINI,4HMUM ,4H    ,4H    /
  5215.       DATA ICALLN,ICALLR,KINDT,KINXYZ/1,2,4,5/
  5216.       DATA KNLIST,KNMAX,KRLIST,KRMAX/28,32,42,43/
  5217. C
  5218.       ILIST = 0
  5219. C
  5220. C          READ TIMEN, NSTEPN
  5221. C
  5222.       IF (NSTEN.GT.0) GOTO 2
  5223.         WRITE (NFLOG,2000)
  5224.         GOTO 800
  5225.   2   CALL DBREAD (TIMEN,KTIMEN,1,0)
  5226.       IF (IERROR.NE.0) GOTO 900
  5227. C
  5228. C          PARAM : TSTART, TEND
  5229. C
  5230.       TSTA = REALV(IXPAR)
  5231.       TEND = REALV(IXPAR+1)
  5232.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEN(NSTEN)
  5233.       IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTA
  5234.       EPSVAL = DT * EPS
  5235. C
  5236. C          PARAM : NTSKIP
  5237. C                      MAXTYPE, NUMMAX
  5238. C                      MAXTYPE, VALUE
  5239. C
  5240.       NTSKIP = 0
  5241.       MAXTYP = 0
  5242.       NUMMAX = 0
  5243.       IF (NCMD.NE.KNLIST .AND. NCMD.NE.KRLIST) GOTO 5
  5244.         NTSKIP = INTV(IXPAR+2)
  5245.         IF (NTSKIP.LT.0) GOTO 850
  5246.         GOTO 10
  5247.   5   MAXTYP = INTV(IXPAR+2)
  5248.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEN(1)
  5249.       IF (ITYPE(IXPAR+2).EQ.IOMIT) MAXTYP = 1
  5250.       IF (MAXTYP.LT.1 .OR. MAXTYP.GT.3) GOTO 850
  5251.       IF (NCMD.NE.KNMAX .AND. NCMD.NE.KRMAX) GOTO 7
  5252.         NUMMAX = INTV(IXPAR+3)
  5253.         IF (ITYPE(IXPAR+3).EQ.IOMIT) NUMMAX = 1
  5254.         IF (NUMMAX.LT.1) GOTO 850
  5255.         GOTO 10
  5256.   7   VALMAX = REALV(IXPAR+3)
  5257. C
  5258. C          CHECK WHAT KINDS ARE NEEDED
  5259. C
  5260.   10  DO 20 KIND=1,5
  5261.   20    IXA(KIND) = 0
  5262.       IVAEND = NVAR
  5263.       IF (ICALL.EQ.ICALLR) IVAEND = MVAR
  5264.       DO 30 IVAR=1,IVAEND
  5265.         KIND = KINDV(IVAR)
  5266.         IF (KIND.NE.0) IXA(KIND) = 1
  5267.         IF (KIND.EQ.KINDT) NDIRV(IVAR) = 1
  5268.   30    CONTINUE
  5269. C
  5270. C          BLANK COMMON FOR DBREAD OF NEEDED KINDS AND NUMMAX
  5271. C
  5272. C                                                DISP
  5273. C                                                VEL
  5274. C                                                ACC
  5275. C                                                TEMP
  5276.       NIX = I16 / ISURL
  5277.       DO 60 KIND=1,5
  5278.         IF (IXA(KIND).EQ.0) GOTO 60
  5279.         IXA(KIND) = NIX
  5280.         IF (KIND.NE.KINXYZ) GOTO 40
  5281.         NIX = NIX + 3 * MXNP
  5282.         GOTO 60
  5283.   40    IF (IXGP(KDISP+KIND-1).NE.0) GOTO 50
  5284.           WRITE (NFLOG,2010)
  5285.           GOTO 800
  5286.   50    NIX = NIX + MXNP * NDOF
  5287.   60    CONTINUE
  5288.       N18 = NIX
  5289.       I18 = N18 * ISURL
  5290. C
  5291.   70  I20 = I18
  5292.       IF (NUMMAX.EQ.0) GOTO 80
  5293.       IXPLUS = (NUMMAX + 1) * NVAR
  5294. C                                                MAXVALUES
  5295.       I19 = I18 + IXPLUS * ISURL
  5296. C                                                MAX ID
  5297.       I20 = I19 + IXPLUS * 4
  5298. C                                                KINDHD
  5299.   80  I21 = I20 + NVAR * 3
  5300.       CALL SIZE (I21)
  5301.       IF (IERROR.NE.0) GOTO 900
  5302. C
  5303. C          INIT OF MAX ID
  5304. C
  5305.       IF (NUMMAX.EQ.0) GOTO 100
  5306.       DO 85 I=I19,I20
  5307.   85    IA(I) = 0
  5308.   100 CONTINUE
  5309.       ISNZON = 0
  5310.       ITSKIP = 0
  5311.       ISRSDC = 0
  5312.       ISIDRN = 0
  5313.       IREAD(KINXYZ) = 0
  5314. C
  5315. C          DO FOR ALL TIMESTEPS OF NODAL DATA
  5316. C
  5317.       DO 650 ITIME=1,NSTEN
  5318. C
  5319.       TIME = TIMEN(ITIME)
  5320.       IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
  5321.       IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
  5322. C
  5323. C          NTSKIP TIMESTEPS BETWEEN OUTPUT
  5324. C
  5325.       IF (ITIME.EQ.NSTEN) GOTO 120
  5326.       IF (TIMEN(ITIME+1).GT.TEND+EPSVAL) GOTO 120
  5327.       ITSKIP = ITSKIP - 1
  5328.       IF (ITSKIP.GE.0) GOTO 650
  5329.   120 ITSKIP = NTSKIP
  5330.       DO 125 KIND=1,4
  5331.   125   IREAD(KIND) = 0
  5332. C
  5333. C          DO FOR EVERY STRUCTURE, REUSE AND NODAL POINT
  5334. C
  5335.       IEJECT = 0
  5336.       ISTRUC = 0
  5337.       DO 640 ISTRI=1,NSTRI
  5338.       ISUBST = ISTRI - 1
  5339.       NRUSE = NRUSES(ISTRI)
  5340.       NUMNP = NUMNPS(ISTRI)
  5341.       DO 630 IRUSE=1,NRUSE
  5342. C
  5343.       ISTRUC = ISTRUC + 1
  5344.       LSTSUB = 1
  5345.       IF (IBITZ.EQ.IWHOLE) GOTO 130
  5346.       IF (ISNZON.EQ.ISTRUC) GOTO 130
  5347.         CALL DBREAD (NZONE,KNZONE,ISTRUC,0)
  5348.         IF (IERROR.NE.0) GOTO 700
  5349.         ISNZON = ISTRUC
  5350. C
  5351.   130 DO 620 NP=1,NUMNP
  5352. C
  5353. C          CHECK IF IN SELECTED ZONE
  5354. C
  5355.       IF (IBITZ.EQ.IWHOLE) GOTO 200
  5356.         CALL BITGET (NZONE(NP),IBITZ,ISELEC)
  5357.         IF (ISELEC.EQ.0) GOTO 620
  5358. C
  5359. C          READ VARIABLE VALUES FROM DATABASE
  5360. C
  5361.   200 IVPLUS = (NP - 1) * NDOF - 1
  5362.       DO 290 IVAR=1,IVAEND
  5363.         KIND = KINDV(IVAR)
  5364.         IF (KIND.EQ.0) GOTO 290
  5365.         IXAKIN = IXA(KIND)
  5366.         NDIR = NDIRV(IVAR)
  5367.         IF (IREAD(KIND).EQ.ISTRUC) GOTO 220
  5368.         IF (KIND.NE.KINDT .OR. ISTRUC.EQ.1) GOTO 210
  5369.             WRITE (NFLOG,2210)
  5370.             GOTO 800
  5371.   210     IF (KIND.NE.KINXYZ)
  5372.      1    CALL DBREAD (A(IXAKIN),KIND+KDISP-1,ISTRUC,ITIME)
  5373.           IF (KIND.EQ.KINXYZ)
  5374.      1    CALL DBREAD (A(IXAKIN),KXYZ,ISTRUC,0)
  5375.           IF (IERROR.NE.0) GOTO 700
  5376.         IREAD(KIND) = ISTRUC
  5377. C
  5378. C          TEMPERATURE
  5379. C
  5380.   220 IF (KIND.NE.KINDT) GOTO 225
  5381.         VALUEV(IVAR) = A(IXAKIN+NP-1)
  5382.         GOTO 290
  5383. C
  5384. C          XYZ
  5385. C
  5386.   225 IF (KIND.NE.KINXYZ) GOTO 230
  5387.         IXW = IXAKIN + (NDIR - 1) * NUMNP  +  NP - 1
  5388.         VALUEV(IVAR) = A(IXW)
  5389.         GOTO 290
  5390. C
  5391. C          GET ALL 6 DIRECTIONS OF DISPLACEMENT AND ROTATION
  5392. C
  5393.   230 IXW = IXAKIN + IVPLUS
  5394.       DO 250 I=1,6
  5395.         VDIR(I) = 0.0
  5396.         INDOF = NDOFSA(I)
  5397.         IF (INDOF.GT.0) VDIR(I) = A(IXW+INDOF)
  5398.   250   CONTINUE
  5399. C
  5400. C          IF LSKEW.EQ.0 THE USER WANTS TRANSFORMATION OF
  5401. C          DISPLACEMENTS AND ROTATIONS FROM SKEW SYSTEM TO
  5402. C          GLOBAL COORDINATE SYSTEM FOR NODES DEFINED WITH SKEW SYSTEM
  5403. C
  5404.       IF (NSKEWS.EQ.0 .OR. LSKEW.EQ.1) GOTO 285
  5405.       IF (ISIDRN.NE.ISTRI)
  5406.      1  CALL DBREAD (IDRN,KIDRN,ISTRI,0)
  5407.         IF (IERROR.NE.0) GOTO 900
  5408.         ISIDRN = ISTRI
  5409.       IXNRST = NDOF * NUMNP
  5410.       ISKEW = IDRN(IXNRST+NP)
  5411.       IF (ISKEW.LE.0) GOTO 285
  5412.       IF (ISRSDC.EQ.0)
  5413.      1  CALL DBREAD (RSDCOS,KRSDCO,1,0)
  5414.         IF (IERROR.NE.0) GOTO 900
  5415.         ISRSDC = 1
  5416.       CALL SKEW (VDIR,RSDCOS(1,ISKEW))
  5417. C
  5418.   285 VALUEV(IVAR) = VDIR(NDIR)
  5419.   290   CONTINUE
  5420. C
  5421. C          EXECUTE RESULTANT COMPUTATION
  5422. C
  5423.       IF (ICALL.NE.ICALLR) GOTO 300
  5424.       CALL FORMEX (VALUEV,IRPOL)
  5425.       IF (IERROR.NE.0) GOTO 700
  5426. C
  5427. C          EXCEED
  5428. C
  5429.   300 IF (MAXTYP.EQ.0) GOTO 500
  5430.       IF (NUMMAX.GT.0) GOTO 400
  5431. C
  5432.       DO 390 IVAR=1,NVAR
  5433.         GOTO (340,350,360), MAXTYP
  5434.   340   IF (ABS(VALUEV(IVAR)).GE.VALMAX) GOTO 500
  5435.         GOTO 390
  5436.   350   IF (VALUEV(IVAR).GE.VALMAX) GOTO 500
  5437.         GOTO 390
  5438.   360   IF (VALUEV(IVAR).LE.VALMAX) GOTO 500
  5439.   390   CONTINUE
  5440.       GOTO 620
  5441. C
  5442. C          MAXVALUES ARE STORED FOR EACH SELECTED VARIABLE:
  5443. C          VALUE, ITIME, ISTRI, IRUSE, NP
  5444. C
  5445.   400 DO 490 IVAR=1,NVAR
  5446. C
  5447.       IIPLUS = (NUMMAX + 1) * IVAR - 2
  5448.       NIX = N18 + IIPLUS
  5449.       IIX = I19 + IIPLUS
  5450. C
  5451. C          LOOP NUMMAX TIMES
  5452. C
  5453.       DO 465 IMAX=1,NUMMAX
  5454.       IF (IA(IIX).EQ.0) GOTO 450
  5455.       VALUE  = VALUEV(IVAR)
  5456.       VALUEA = A(NIX)
  5457.       GOTO (410,440,430), MAXTYP
  5458.   410 VALUE  = ABS(VALUE)
  5459.       VALUEA = ABS(VALUEA)
  5460.       GOTO 440
  5461.   430 VALUE  = - VALUE
  5462.       VALUEA = - VALUEA
  5463. C
  5464.   440 IF (VALUEA.GE.VALUE) GOTO 470
  5465. C
  5466. C          MAKE PLACE FOR NEW VALUE
  5467. C
  5468.   450 A(NIX+1) = A(NIX)
  5469.       J = IIX
  5470.       DO 460 I=1,4
  5471.         IA(J+1) = IA(J)
  5472.   460   J = J + IXPLUS
  5473. C
  5474.       NIX = NIX - 1
  5475.       IIX = IIX - 1
  5476.   465 CONTINUE
  5477. C
  5478. C          MOVE NEW VALUE TO ARRAY
  5479. C
  5480.   470 A(NIX+1) = VALUEV(IVAR)
  5481.       IIX = IIX + 1
  5482.       IA(IIX) = ITIME
  5483.       J = IIX + IXPLUS
  5484.       IA(J) = ISUBST
  5485.       J = J + IXPLUS
  5486.       IA(J) = IRUSE
  5487.       J = J + IXPLUS
  5488.       IA(J) = NP
  5489. C
  5490.   490 CONTINUE
  5491.       GOTO 620
  5492. C
  5493. C          LIST
  5494. C
  5495.   500 IF (LINE.LE.LINPAG) GOTO 505
  5496.       LINE = -1
  5497.       IEJECT = 1
  5498.   505 IF (IEJECT.LT.0) GOTO 510
  5499.       LINE = LINE + 10
  5500.       IF (LINE.GT.LINPAG) GOTO 500
  5501.       LINE = LINE - 7
  5502.       WRITE (NFLIST,2045)
  5503.       IF (IBITZ.EQ.IWHOLE)
  5504.      1  WRITE (NFLIST,2020) IEJECT,TIME,NSTEPN(ITIME)
  5505.       IF (IBITZ.NE.IWHOLE)
  5506.      1  WRITE (NFLIST,2021) IEJECT,NAMZON,TIME,NSTEPN(ITIME)
  5507.       LSTSUB = 1
  5508.       LSTDET = 1
  5509.       IF (IEJECT.LT.1) GOTO 510
  5510.       IF (NSKEWS.EQ.0) GOTO 507
  5511.         IF (LSKEW.NE.1) WRITE (NFLIST,2550)
  5512.         IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
  5513.         LINE = LINE + 2
  5514.   507 IF (MAXTYP.EQ.0) GOTO 510
  5515.         WRITE (NFLIST,2570) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4),VALMAX
  5516.         LINE = LINE + 2
  5517. C
  5518.   510 IEJECT = -1
  5519.       IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 520
  5520.       LINE = LINE + 5
  5521.       IF (LINE.GT.LINPAG) GOTO 500
  5522.       LINE = LINE - 3
  5523.       WRITE (NFLIST,2345) ISUBST, IRUSE
  5524.       LSTSUB = 0
  5525.       LSTDET = 1
  5526. C
  5527.   520 IF (LSTDET.EQ.0) GOTO 530
  5528.       LINE = LINE + 3
  5529.       IF (LINE.GT.LINPAG) GOTO 500
  5530.       DO 525 IVAR=1,NVAR
  5531.         I = I20 + (IVAR - 1) * 3
  5532.         CALL KINDN (NDIRV(IVAR),KINDV(IVAR),IA(I))
  5533.   525   CONTINUE
  5534.       I20END = I20 + (NVAR * 3) - 1
  5535.       IF(ICALL.NE.ICALLR) WRITE (NFLIST,2040) (IA(J),J=I20,I20END)
  5536.       IF (ICALL.EQ.ICALLR)
  5537.      1  WRITE (NFLIST,2041) (IA(J),J=I20,I20END),NAMERC
  5538.       WRITE (NFLIST,2045)
  5539.       LSTDET = 0
  5540.       GOTO 500
  5541.   530 WRITE (NFLIST,2050) NP,(VALUEV(IVAR),IVAR=1,NVAR)
  5542.       LINE = LINE + 1
  5543.       ILIST = 1
  5544. C
  5545.   620 CONTINUE
  5546.   630 CONTINUE
  5547.   640 CONTINUE
  5548.   650 CONTINUE
  5549. C
  5550. C          MAX LIST
  5551. C
  5552.       IF (NUMMAX.EQ.0) GOTO 700
  5553. C
  5554.       DO 690 IVAR=1,NVAR
  5555.       IIPLUS = (IVAR - 1) * (NUMMAX + 1) - 1
  5556.       NIX = N18 + IIPLUS
  5557.       IIX = I19 + IIPLUS
  5558.       LSTDET = 1
  5559.         DO 680 IMAX=1,NUMMAX
  5560.           ITIME = IA(IIX+IMAX)
  5561.           IF (ITIME.EQ.0) GOTO 690
  5562.           VALUE = A(NIX+IMAX)
  5563.           J = IIX + IMAX + IXPLUS
  5564.           ISUBST = IA(J)
  5565.           J = J + IXPLUS
  5566.           IRUSE = IA(J)
  5567.           J = J + IXPLUS
  5568.           NP = IA(J)
  5569. C
  5570.   652    IF (LINE.LE.LINPAG) GOTO 655
  5571.           LSTDET = 1
  5572.             IF (IBITZ.EQ.IWHOLE)  WRITE (NFLIST,2060)
  5573.             IF (IBITZ.NE.IWHOLE)  WRITE (NFLIST,2061) NAMZON
  5574.             WRITE (NFLIST,2065) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
  5575.             LINE = 4
  5576.           IF (NSKEWS.EQ.0) GOTO 655
  5577.             IF (LSKEW.NE.1) WRITE (NFLIST,2550)
  5578.             IF (LSKEW.EQ.1) WRITE (NFLIST,2551)
  5579.            LINE = LINE + 2
  5580.   655     IF (LSTDET.EQ.0) GOTO 660
  5581.             LSTDET = 0
  5582.             LINE = LINE + 3
  5583.             IF (LINE.GT.LINPAG) GOTO 652
  5584.            CALL KINDN (NDIRV(IVAR),KINDV(IVAR),IA(I20))
  5585.            I20END = I20 + 2
  5586.            WRITE (NFLIST,2070) (IA(I),I=I20,I20END), NAMERC
  5587.   660     WRITE (NFLIST,2080) VALUE,NP,TIMEN(ITIME),NSTEPN(ITIME),
  5588.      1                     ISUBST,IRUSE
  5589.           LINE = LINE + 1
  5590.           ILIST = 1
  5591.   680     CONTINUE
  5592.   690   CONTINUE
  5593. C
  5594.   700 IF (ILIST.EQ.0) WRITE (NFLOG,2700)
  5595.       GOTO 900
  5596.   800 IERROR = 1
  5597.       GOTO 900
  5598.   850 IERROR = 2
  5599.   900 RETURN
  5600.  2000 FORMAT (43H ***ERROR: NO TIMESTEP FOR NODAL DATA FOUND)
  5601.  2010 FORMAT (54H ***ERROR: NO DATA SAVED FOR SELECTED KIND OF VARIABLE)
  5602.  2020 FORMAT (I1,30HNODAL RESULTS FOR WHOLE MODEL ,
  5603.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  5604.  2021 FORMAT(I1,25HNODAL RESULTS FOR ZONE = ,8A1,
  5605.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  5606.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  5607.  2040 FORMAT (/6H  NODE,8(6X,3A4))
  5608.  2041 FORMAT (/6H  NODE,6X,3A4,8A1)
  5609.  2045 FORMAT (1H )
  5610.  2050 FORMAT (1X,I5,8(6X,E12.6))
  5611.  2060 FORMAT(38H1EXTREME NODAL RESULTS FOR WHOLE MODEL)
  5612.  2061 FORMAT(34H1EXTREME NODAL RESULTS FOR ZONE = ,8A1)
  5613.  2065 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
  5614.      1  14H  SCANNED FOR ,4A4)
  5615.  2070 FORMAT (/4X,3A4,8A1,35H   NODE         TIME      STEP     ,
  5616.      1        29H   SUBSTRUCTURE   REUSE ID NO /)
  5617.  2080 FORMAT (4X,E12.6,7X,I7,8X,E10.4,I5,11X,I5,6X,I8)
  5618.  2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
  5619.  2210 FORMAT (54H ***ERROR: TEMPERATURE CANNOT BE READ FOR SUBSTRUCTURE)
  5620.  2550 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
  5621.      1  17HCOORDINATE SYSTEM)
  5622.  2551 FORMAT(/42H    LISTED RESULTS ARE MEASURED IN GLOBAL ,
  5623.      1  47HOR SKEW COORDINATE SYSTEM AS REQUESTED IN ADINA)
  5624.  2570 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
  5625.      1  14H  SCANNED FOR ,4A4,18H VALUES EXCEEDING ,G12.6)
  5626.       END
  5627. C***ADD:CDC***
  5628. CDECK EINFO1
  5629. C***END:CDC***
  5630.       SUBROUTINE EINFO1
  5631. C
  5632.       DIMENSION IA(1)
  5633. C
  5634.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  5635.       COMMON /ERROR/ IERROR
  5636.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  5637.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  5638.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  5639.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  5640.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  5641.      2             IXGP(50),MXSGP(50),
  5642.      3             FILL1
  5643.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  5644.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  5645.      2             I16,I17,I18,I19,I20,
  5646.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  5647.      4             N16,N17,N18,N19,N20
  5648.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  5649.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  5650.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  5651.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  5652.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  5653.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  5654.      6                NDOFSA(6),NOUSE(4),FILL2
  5655.       COMMON A(1)
  5656.       EQUIVALENCE (A(1),IA(1))
  5657. C
  5658.       CALL ZGETNB
  5659.       IF (IERROR.NE.0) GOTO 900
  5660. C
  5661. C                                                NPAR
  5662.       I2 = I1 + MXEG * NELPAR
  5663. C                                                EDATA
  5664.       I3 = I2 + MXEL * (ISURL + 2)
  5665. C                                                SXYZ
  5666.       I4 = I3 + MXIDER * 3 * ISURL
  5667. C                                                ITABLE
  5668.       I5 = I4 + MXITAB
  5669. C                                                IEZONE
  5670.       I6 = I5 + MXEL
  5671. C                                                NERPTS
  5672.       I7 = I6 + MXEL
  5673. C                                                IDERPT
  5674.       I8 = I7 + MXIDER
  5675. C                                                NOD
  5676.       I9 = I8 + MXELNP
  5677. C
  5678.       CALL SIZE (I9)
  5679.       IF (IERROR.NE.0) GOTO 900
  5680. C
  5681.       CALL EINFO2 (IA(I06),IA(I07),NELPAR,IA(I1),IA(I2),
  5682.      1  IA(I3),IA(I4),IA(I5),IA(I6),IA(I7),IA(I8))
  5683. C
  5684.   900 RETURN
  5685.       END
  5686. C***ADD:CDC***
  5687. CDECK EINFO2
  5688. C***END:CDC***
  5689.       SUBROUTINE EINFO2 (NRUSES,NEGS,NPARD,NPAR,EDATA,
  5690.      1           SXYZ,ITABLE,IEZONE,NERPTS,IDERPT,NOD)
  5691. C
  5692.       DIMENSION NRUSES(1),NEGS(1),NPAR(NPARD,1),EDATA(1),
  5693.      1          SXYZ(3,1),ITABLE(1),IEZONE(1),NERPTS(1),
  5694.      2         IDERPT(1),NOD(1),MXNODA(15)
  5695. C
  5696.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  5697.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  5698.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  5699.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  5700.       COMMON /ERROR/ IERROR
  5701.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  5702.      1               IBITZ,IWHOLE,ICALL,IXPAR
  5703.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  5704.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  5705.      2             IXGP(50),MXSGP(50),
  5706.      3             FILL1
  5707.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  5708.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  5709.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  5710.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  5711.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  5712.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  5713.      6                NDOFSA(6),NOUSE(4),FILL2
  5714.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  5715.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  5716.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  5717.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  5718.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  5719.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  5720.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  5721.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  5722.      8                KX49  ,KX50
  5723. C
  5724.       DATA MXNODA/4,8,21,3,5,3,32,0,0,0,8,21,0,0,0/
  5725.       DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
  5726.       DATA I2DIMF,I3DIMF/11,12/
  5727.       DATA ISPACE/1H /
  5728. C
  5729. CCCCCCCCCCCC    LIST OF ELEMENT NODES
  5730. C
  5731.       IF (INTV(2).NE.1) GOTO 200
  5732.       IEGIT = 0
  5733.       IEGAT = 0
  5734. C
  5735.       DO 190 ISTRI=1,NSTRI
  5736.       CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  5737.       IF (IERROR.NE.0) GOTO 900
  5738.       NRUSE = NRUSES(ISTRI)
  5739.       NEG   = NEGS  (ISTRI)
  5740. C
  5741.       DO 180 IRUSE=1,NRUSE
  5742. C
  5743.       DO 170 IEG=1,NEG
  5744.       LSTEG = 1
  5745.       IEGIT = IEGIT + 1
  5746.       IEGAT = IEGAT + 1
  5747.       IF (IBITZ.EQ.IWHOLE .AND. IRUSE.GT.1) GOTO 170
  5748.       IF (IBITZ.NE.IWHOLE)  CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  5749.       IF (IERROR.NE.0) GOTO 900
  5750.       CALL DBREAD (NOD,KNOD,IEGIT,0)
  5751.       IF (IERROR.NE.0) GOTO 900
  5752. C
  5753.       IELTYP = NPAR(1,IEG)
  5754.       NEL    = NPAR(2,IEG)
  5755.       MXNODS = MXNODA(IELTYP)
  5756. C
  5757.       DO 160 IEL=1,NEL
  5758.       IF (IBITZ.EQ.IWHOLE) GOTO 100
  5759.       CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  5760.       IF (ISELEC.EQ.0) GOTO 160
  5761. C
  5762.   100 IF (LINE.LE.LINPAG) GOTO 110
  5763.       IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2000)
  5764.       IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2001) NAMZON
  5765.       LINE = 2
  5766.       LSTEG = 1
  5767. C
  5768.   110 IF (LSTEG.EQ.0) GOTO 150
  5769.       LSTEG = 0
  5770.       LINE = LINE + 6
  5771.       IF (ISTRI.GT.1) LINE = LINE + 2
  5772.       IF (LINE2.GT.0) LINE = LINE + 1
  5773.       IF (LINE.GT.LINPAG) GOTO 100
  5774.       ISUBST = ISTRI - 1
  5775.       IF (ISTRI.GT.1) WRITE (NFLIST,2345) ISUBST, IRUSE
  5776.       WRITE (NFLIST,2010) IEG
  5777.       WRITE (NFLIST,2020)
  5778. C
  5779.       IF (IELTYP.EQ.IBEAM) GOTO 120
  5780.       IF (IELTYP.EQ.ISOBEA) GOTO 130
  5781.       WRITE (NFLIST,2030) (ISPACE,I,I=1,MXNODS)
  5782.       GOTO 140
  5783.   120 WRITE (NFLIST,2031)
  5784.       GOTO 140
  5785.   130 WRITE (NFLIST,2032)
  5786.   140 WRITE (NFLIST,2040)
  5787. C
  5788.   150 IF (MXNODS.GT.16) LINE = LINE + 1
  5789.       IF (LINE.GT.LINPAG) GOTO 100
  5790.       LINE = LINE + 1
  5791.       IXNOD2 = MXNODS * IEL
  5792.       IXNOD1 = IXNOD2 - MXNODS + 1
  5793.       WRITE (NFLIST,2050) IEL,(NOD(I),I=IXNOD1,IXNOD2)
  5794. C
  5795.   160 CONTINUE
  5796.   170 CONTINUE
  5797.       IEGIT = IEGIT - NEG
  5798.   180 CONTINUE
  5799.       IEGIT = IEGIT + NEG
  5800.   190 CONTINUE
  5801. C
  5802. C
  5803. CCCCCCCC    LIST COORDINATES OF ELEMENT RESULT POINTS
  5804. C
  5805. C
  5806.   200 IF (INTV(3).NE.1) GOTO 900
  5807.       LINE = 999
  5808.       IEGIT = 0
  5809.       IEGAT = 0
  5810.       ISEGIT = 0
  5811. C
  5812.       DO 390 ISTRI=1,NSTRI
  5813.       CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  5814.       IF (IERROR.NE.0) GOTO 900
  5815.       NRUSE = NRUSES(ISTRI)
  5816.       NEG   = NEGS  (ISTRI)
  5817. C
  5818.       DO 380 IRUSE=1,NRUSE
  5819. C
  5820.       DO 370 IEG=1,NEG
  5821.       LSTEG = 1
  5822.       IEGIT = IEGIT + 1
  5823.       IEGAT = IEGAT + 1
  5824.       IF (IBITZ.NE.IWHOLE) CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  5825.       IF (IERROR.NE.0) GOTO 900
  5826.       IELTYP = NPAR(1,IEG)
  5827.       NEL    = NPAR(2,IEG)
  5828.       INDNL  = NPAR(3,IEG)
  5829.       NTABLE = NPAR(13,IEG)
  5830. C
  5831.       CALL ELRES (1,NPAR(1,IEG),EDATA,EDATA(NEL+1),ITABLE,
  5832.      1  NTABLE,IEGIT,ISEGIT,0.,NERPTS,IDERPT,NERES,NERKI,LOCALE)
  5833.       IF (IERROR.NE.0) GOTO 900
  5834.       IF (NERES.EQ.0) GOTO 250
  5835. C
  5836.       CALL DBREAD (SXYZ,KSXYZ,IEGAT,0)
  5837.       IF (IERROR.NE.0) GOTO 900
  5838.       IXIDER = 0
  5839. C
  5840.   250 DO 360 IEL=1,NEL
  5841.       ISELEC = 1
  5842.       IF (IBITZ.NE.IWHOLE)
  5843.      1  CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  5844.       NERPT = 1
  5845.       IF (NERES.GT.0) NERPT = NERPTS(IEL)
  5846.       IF (NERPT.EQ.0) GOTO 360
  5847. C
  5848.       DO 350 IERPT=1,NERPT
  5849.       IF (NERES.EQ.0) GOTO 300
  5850.       IXIDER = IXIDER + 1
  5851.       IDERES = IABS(IDERPT(IXIDER))
  5852.       IF (ISELEC.EQ.0) GOTO 350
  5853.       IF (IELTYP.EQ.ISOBEA .AND.
  5854.      1     SXYZ(1,IXIDER).EQ.987654E32) GOTO 350
  5855. C
  5856.   300 IF (LINE.LE.LINPAG) GOTO 310
  5857.       IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2000)
  5858.       IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2001) NAMZON
  5859.       LINE = 2
  5860.       LSTEG = 1
  5861. C
  5862.   310 IF (LSTEG.EQ.0) GOTO 345
  5863.       LSTEG = 0
  5864.       LINE = LINE + 8
  5865.       IF (ISTRI.GT.1) LINE = LINE + 2
  5866.       IF (LINE.GT.LINPAG) GOTO 300
  5867.       ISUBST = ISTRI - 1
  5868.       IF (ISTRI.GT.1) WRITE (NFLIST,2345) ISUBST, IRUSE
  5869.       WRITE (NFLIST,2010) IEG
  5870. C
  5871.       IF (NERES.GT.0) GOTO 305
  5872.       WRITE (NFLIST,2090)
  5873.       GOTO 370
  5874. C
  5875.   305 IF (NTABLE.GT.0) GOTO 320
  5876.       IF (IELTYP.EQ.IBEAM .AND.
  5877.      1    (NTABLE.LT.0 .OR. INDNL.EQ.0)) GOTO 330
  5878.       IF (IELTYP.EQ.ISOBEA .AND. NTABLE.LT.0) GOTO 330
  5879.       IF (IELTYP.EQ.ITRUSS .AND. NPAR(5,IEG).EQ.1) GOTO 330
  5880.       WRITE (NFLIST,2060)
  5881.       GOTO 340
  5882.   320 WRITE (NFLIST,2061)
  5883.       GOTO 340
  5884.   330 WRITE (NFLIST,2062)
  5885. C
  5886.   340 WRITE (NFLIST,2070)
  5887. C
  5888.   345 LINE = LINE + 1
  5889.       IF (SXYZ(1,IXIDER).EQ.987654E32) GOTO 346
  5890.       WRITE (NFLIST,2080) IEL,IDERES,(SXYZ(I,IXIDER),I=1,3)
  5891.       GOTO 350
  5892.   346 WRITE (NFLIST,2081) IEL,IDERES
  5893. C
  5894.   350 CONTINUE
  5895.   360 CONTINUE
  5896.   370 CONTINUE
  5897.       IEGIT = IEGIT - NEG
  5898.   380 CONTINUE
  5899.       IEGIT = IEGIT + NEG
  5900.   390 CONTINUE
  5901. C
  5902.   900 RETURN
  5903. C
  5904.  2000 FORMAT(36H1ELEMENT INFORMATION FOR WHOLE MODEL)
  5905.  2001 FORMAT(30H1ELEMENT INFORMATION FOR ZONE=,8A1)
  5906.  2010 FORMAT(/19H ELEMENT GROUP NO =,I3)
  5907.  2020 FORMAT(/25H ELEMENT    ELEMENT NODES)
  5908.  2030 FORMAT(10X,16(A1,1H(,I2,2H) )/10X,16(A1,1H(,I2,2H) ))
  5909.  2031 FORMAT(10X,16H ( 1)  ( 2)  AUX)
  5910.  2032 FORMAT(10X,28H ( 1)  ( 2)  ( 3)  ( 4)  AUX)
  5911.  2040 FORMAT (1H )
  5912.  2050 FORMAT(1X,I5,2X,16I6/8X,16I6)
  5913.  2060 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
  5914.      1  25HINTEGRATION POINT NUMBERS)
  5915.  2061 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
  5916.      1  27HSTRESS OUTPUT TABLE NUMBERS)
  5917.  2062 FORMAT(/34H ELEMENT RESULT POINT NUMBERS ARE ,
  5918.      1  27HELEMENT NODAL POINT NUMBERS)
  5919.  2070 FORMAT(/50H ELEMENT  POINT     GLOBAL COORDINATES OF INITIAL ,
  5920.      1  23HUNDEFORMED RESULT POINT/
  5921.      2  3X,2HNO,7X,2HNO,11X,1HX,18X,1HY,18X,1HZ/)
  5922.  2080 FORMAT(1X,I4,I9,3(6X,E12.6))
  5923.  2081 FORMAT(1X,I4,I9,6X,26HCOORDINATES NOT CALCULATED)
  5924.  2090 FORMAT(//40H *** ADINA ELEMENT SAVE PARAMETER (IPS)  ,
  5925.      1  24HIS ZERO FOR ALL ELEMENTS///)
  5926.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  5927.       END
  5928. C***ADD:CDC***
  5929. CDECK ELIST1
  5930. C***END:CDC***
  5931.       SUBROUTINE ELIST1
  5932. C
  5933.       DIMENSION IA(1),VALUEV(20)
  5934. C
  5935.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  5936.       COMMON /ERROR/ IERROR
  5937.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  5938.      1               IBITZ,IWHOLE,ICALL,IXPAR
  5939.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  5940.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  5941.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  5942.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  5943.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  5944.      2             IXGP(50),MXSGP(50),
  5945.      3             FILL1
  5946.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  5947.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  5948.      2             I16,I17,I18,I19,I20,
  5949.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  5950.      4             N16,N17,N18,N19,N20
  5951.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  5952.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  5953.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  5954.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  5955.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  5956.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  5957.      6                NDOFSA(6),NOUSE(4),FILL2
  5958.       COMMON A(1)
  5959.       EQUIVALENCE (A(1),IA(1))
  5960. C
  5961. C          GET ZONENAME BIT NR IBITZ, 0 = WHOLE MODEL
  5962. C
  5963.       CALL ZGETNB
  5964.         IF (IERROR.NE.0) GOTO 900
  5965. C
  5966. C          BLANK COMMON LAYOUT
  5967. C
  5968. C                                                TIMEE
  5969.       I12 = I1 + NSTEE * ISURL
  5970. C                                                NSTEPE
  5971.       I13 = I12 + NSTEE
  5972.       CALL ALIGN (I13)
  5973. C                                                NPAR
  5974.       I14 = I13 + NELPAR * MXEG
  5975. C                                                EDATA
  5976.       I15 = I14 + (ISURL + 2) * MXEL
  5977. C                                                ITABLE
  5978.       I16 = I15 + MXITAB
  5979. C                                                IEZONE
  5980.       I17 = I16 + MXEL
  5981.       IF (IBITZ.EQ.IWHOLE) I17 = I16
  5982. C                                                ERES
  5983.       I18 = I17 + MXERES * ISURL
  5984. C                                                IXMAXA
  5985.       I19 = I18 + NEGAT * 9
  5986. C                                                NERPTS
  5987.       I20 = I19 + MXEL
  5988. C                                                IDERPT
  5989.       IXEND = I20 + MXIDER
  5990.       CALL SIZE (IXEND)
  5991.         IF (IERROR.NE.0) GOTO 900
  5992. C
  5993.       ICALL = 1
  5994.       IXPAR = 2
  5995. C
  5996.       CALL ELIST2 (VALUEV,I,IA(I20),IA(I20),
  5997.      1  IA(I1),IA(I12),IA(I13),NELPAR,IA(I14),IA(I15),IA(I16),
  5998.      2  IA(I17),IA(I18),IA(I19),IA(I20),IXEND,IA(I06),IA(I07))
  5999. C
  6000.   900 RETURN
  6001.       END
  6002. C***ADD:CDC***
  6003. CDECK ELIST2
  6004. C***END:CDC***
  6005.       SUBROUTINE ELIST2 (VALUEV,IETYP,KINDV,IRPOL,
  6006.      1     TIMEE,NSTEPE,NPAR,NPARD,ETIME,ITABLE,IEZONE,
  6007.      2     ERES,IXMAXA,NERPTS,IDERPT,IXEND,NRUSES,NEGS)
  6008. C
  6009.       DIMENSION IA(1),VALUEV(1),KINDV(1),IRPOL(1),TIMEE(1),
  6010.      2        NSTEPE(1),NPAR(NPARD,1),ETIME(1),ITABLE(1),NERPTS(1),
  6011.      3        IEZONE(1),ERES(1),NRUSES(1),NEGS(1),IDERPT(1),NERKIS(15),
  6012.      4        IHDMAX(4,3),IHDMX2(12),IXMAXA(9,1),IHDKIN(36),IHDTYP(45)
  6013. C
  6014.       COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE
  6015.       COMMON /EPS/ EPS
  6016.       COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM
  6017.       COMMON /PARAM/ REALV(100),NCMD,NLASTP,ITYPE(20),INTV(100),
  6018.      1               IANUMV(8,20),LGHSTR,INTEG,IREAL,IANUM,ISTRIN,IOMIT
  6019.       COMMON /ERROR/ IERROR
  6020.       COMMON /CALLP/ NAMZON(8),NAMERC(8),
  6021.      1               IBITZ,IWHOLE,ICALL,IXPAR
  6022.       COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS,
  6023.      1            LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU,
  6024.      2            MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL
  6025.       COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX,
  6026.      1             LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ,
  6027.      2             IXGP(50),MXSGP(50),
  6028.      3             FILL1
  6029.       COMMON /DBCTRL/ DT    ,TSTART,NUMNP ,NEQT  ,NSUBST,IDOF(6),
  6030.      1                NDOF  ,NEG   ,NMID  ,MODEX ,NSTE  ,NSTEN ,
  6031.      2                NSTEE ,NSKEWS,NMIDSS,IEIG  ,NSREFB,NEQITB,
  6032.      3                NPRIB ,NODSVB,LEMSVB,JDC   ,JAC   ,JVC   ,
  6033.      4                ISTAT ,JTC   ,NDISCE,ITP96 ,MXITAB,MXIDER,MXERES,
  6034.      5                NELPAR,MXNP  ,MXEG  ,MXEL  ,MXELNP,
  6035.      6                NDOFSA(6),NOUSE(4),FILL2
  6036.       COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011,
  6037.      1             I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15,
  6038.      2             I16,I17,I18,I19,I20,
  6039.      3             N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15,
  6040.      4             N16,N17,N18,N19,N20
  6041.       COMMON /IGPNAM/ KDBC  ,KSUBGP,KDBCTR,KSTRI ,KRSDCO,KTMIDS,
  6042.      1                KXYZ  ,KIDRN ,KICONA,KNZONE,KNPAR ,KTHICK,
  6043.      2                KITABL,KNOD  ,KEDATA,KIEZON,KFRQ  ,KPHI  ,
  6044.      3                KTIMEN,KDISP ,KVEL  ,KACC  ,KTEMP ,KTIMEE,
  6045.      4                KERES ,KSUBF ,KVIEW ,KAXIS ,KNPOIN,KVARES,
  6046.      5                KNAMEZ,KEPOIN,KSXYZ ,KX34  ,KX35  ,KX36  ,
  6047.      6                KX37  ,KX38  ,KX39  ,KX40  ,KX41  ,KX42  ,
  6048.      7                KX43  ,KX44  ,KX45  ,KX46  ,KX47  ,KX48  ,
  6049.      8                KX49  ,KX50
  6050.       COMMON A(1)
  6051.       EQUIVALENCE (A(1),IA(1))
  6052.       EQUIVALENCE (IHDMAX(1,1),IHDMX2(1))
  6053. C
  6054.       DATA ITRUSS,I2DIM,I3DIM,IBEAM,ISOBEA,IPLATE,ISHELL/1,2,3,4,5,6,7/
  6055.       DATA I2DIMF,I3DIMF/11,12/
  6056.       DATA IHDMX2/
  6057.      1 4HABSO,4HLUTE,4H MAX,4HIMUM,
  6058.      2 4HMAXI,4HMUM ,4H    ,4H    ,
  6059.      3 4HMINI,4HMUM ,4H    ,4H    /
  6060.       DATA ICALLS,ICALLR/1,2/
  6061.       DATA KELIST,KEMAX,KRLIST,KRMAX/31,34,42,43/
  6062. C
  6063.       DATA NERKIS/2,4,6,6,6,6,6,0,0,0,1,1,0,0,0/
  6064. C
  6065.       DATA IHDTYP/
  6066.      1  4HTRUS,4HS)  ,4H    ,4H2-D ,4HSOLI,4HD)  ,
  6067.      2  4H3-D ,4HSOLI,4HD)  ,4HBEAM,4H)   ,4H    ,
  6068.      3  4HISO-,4HBEAM,4H)   ,4HPLAT,4HE/SH,4HELL),
  6069.      4  4HSHEL,4HL)  ,4H    ,4H    ,4H    ,4H    ,
  6070.      5  4H    ,4H    ,4H    ,4H    ,4H    ,4H    ,
  6071.      6  4H2-D ,4HFLUI,4HD)  ,4H3-D ,4HFLUI,4HD)  ,
  6072.      7  4H    ,4H    ,4H    ,4H    ,4H    ,4H    ,
  6073.      8  4H    ,4H    ,4H    /
  6074. C
  6075. C
  6076.       ILIST = 0
  6077. C
  6078. C          READ TIMEE, NSTEPE
  6079. C
  6080.       IF (NSTEE.GT.0) GOTO 2
  6081.         WRITE (NFLOG,2000)
  6082.         GOTO 800
  6083.   2   CALL DBREAD (TIMEE,KTIMEE,1,0)
  6084.       IF (IERROR.NE.0) GOTO 900
  6085. C
  6086. C          PARAM : STRAIN
  6087. C
  6088.       ISTRAN = INTV(6)
  6089.       IF (NCMD.EQ.KELIST) ISTRAN = INTV(5)
  6090. C
  6091. C          PARAM : TSTART, TEND
  6092. C
  6093.       TSTA = REALV(IXPAR)
  6094.       TEND = REALV(IXPAR+1)
  6095.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEE(NSTEE)
  6096.         IF (ITYPE(IXPAR+1).EQ.IOMIT) TEND = TSTA
  6097.       EPSVAL = DT * EPS
  6098. C
  6099. C          PARAM : NTSKIP
  6100. C                  MAXTYPE, NUMMAX
  6101. C                  MAXTYPE, VALUE
  6102. C
  6103.       NTSKIP = 0
  6104.       MAXTYP = 0
  6105.       NUMMAX = 0
  6106.       IF (NCMD.NE.KELIST .AND. NCMD.NE.KRLIST) GOTO 5
  6107.         NTSKIP = INTV(IXPAR+2)
  6108.         IF (NTSKIP.LT.0) GOTO 850
  6109.         GOTO 10
  6110.   5   MAXTYP = INTV(IXPAR+2)
  6111.       IF (ITYPE(IXPAR).EQ.IOMIT) TSTA = TIMEE(1)
  6112.       IF (ITYPE(IXPAR+2).EQ.IOMIT) MAXTYP = 1
  6113.       IF (MAXTYP.LT.1 .OR. MAXTYP.GT.3) GOTO 850
  6114.       IF (NCMD.NE.KEMAX .AND. NCMD.NE.KRMAX) GOTO 7
  6115.         NUMMAX = INTV(IXPAR+3)
  6116.         IF (ITYPE(IXPAR+3).EQ.IOMIT) NUMMAX = 1
  6117.         IF (NUMMAX.LT.1) GOTO 850
  6118.         GOTO 10
  6119.   7   VALMAX = REALV(IXPAR+3)
  6120. C
  6121. C          INITIATE MAX VALUES STORAGE POINTER ARRAY
  6122. C
  6123.   10  DO 110 IEGAT=1,NEGAT
  6124.   110     IXMAXA(1,IEGAT) = 0
  6125.       ISEZON = 0
  6126.       ISNPAR = 0
  6127.       ISEDAT = 0
  6128.       ITSKIP = 0
  6129. C
  6130. C          DO FOR ALL TIMESTEPS OF ELEMENT RESULT
  6131. C
  6132.       DO 650 ITIME=1,NSTEE
  6133. C
  6134.       TIME = TIMEE(ITIME)
  6135.       IF (TIME.LT.(TSTA - EPSVAL)) GOTO 650
  6136.       IF (TIME.GT.(TEND + EPSVAL)) GOTO 650
  6137. C
  6138. C          NTSKIP TIMESTEPS BETWEEN OUTPUT
  6139. C
  6140.       IF (ITIME.EQ.NSTEE) GOTO 120
  6141.       IF (TIMEE(ITIME+1).GT.TEND+EPSVAL) GOTO 120
  6142.       ITSKIP = ITSKIP - 1
  6143.       IF (ITSKIP.GE.0) GOTO 650
  6144.   120 ITSKIP = NTSKIP
  6145. C
  6146. C          DO FOR EVERY STRUCTURE, REUSE
  6147. C
  6148.       IEJECT = 0
  6149.       ISTRUC = 0
  6150.       IEGIT = 0
  6151.       IEGAT = 0
  6152.       ISERES = 0
  6153.       DO 640 ISTRI=1,NSTRI
  6154.       ISUBST = ISTRI - 1
  6155.       NRUSE = NRUSES(ISTRI)
  6156.       NEG   = NEGS  (ISTRI)
  6157. C
  6158. C          READ NPAR
  6159. C
  6160.       IF (ISNPAR.EQ.ISTRI) GOTO 125
  6161.         ISNPAR = ISTRI
  6162.         CALL DBREAD (NPAR,KNPAR,ISTRI,0)
  6163.         IF (IERROR.NE.0) GOTO 900
  6164. C
  6165.   125 DO 630 IRUSE=1,NRUSE
  6166. C
  6167.       ISTRUC = ISTRUC + 1
  6168.       LSTSUB = 1
  6169. C
  6170. C          DO FOR ALL ELEMENT GROUPS
  6171. C
  6172.       DO 620 IEG=1,NEG
  6173. C
  6174.       IEGIT = IEGIT + 1
  6175.       IEGAT = IEGAT + 1
  6176.       LSTIEG = 1
  6177.       IELTYP = NPAR(1,IEG)
  6178.       NUME   = NPAR(2,IEG)
  6179.       INDNL  = NPAR(3,IEG)
  6180.       NTABLE = NPAR(13,IEG)
  6181.       IF (ICALL.EQ.ICALLR .AND. IELTYP.NE.IETYP) GOTO 620
  6182. C
  6183. C          UPDATE NERPTS,IDERPT ARRAYS AND NERES, NERKI
  6184. C
  6185.       CALL ELRES (1,NPAR(1,IEG),ETIME,ETIME(NUME+1),
  6186.      1  ITABLE,NTABLE,IEGIT,ISEDAT,TIME,NERPTS,IDERPT,
  6187.      2  NERES,NERKI,LOCALE)
  6188.       IF (IERROR.NE.0) GOTO 900
  6189.       IF (NERES.EQ.0) GOTO 620
  6190. C
  6191. C          CHECK IF STRAINS ARE REQUESTED
  6192. C
  6193.       NVAR = NERKI
  6194.       IF (ISTRAN.EQ.1) GOTO 130
  6195.       NVAR = NERKIS(IELTYP)
  6196.       IF (IELTYP.EQ.IBEAM .AND. INDNL.GT.0) NVAR = 3
  6197.       IF (IELTYP.EQ.ISOBEA .AND. NTABLE.GE.0) NVAR = 3
  6198.   130 IF (ICALL.EQ.ICALLR) NVAR = 1
  6199. C
  6200. C          DO FOR ALL ELEMENTS IN GROUP
  6201. C
  6202.       IXIDER = 0
  6203.       IXERES = -NERKI
  6204. C
  6205.       DO 610 IEL=1,NUME
  6206. C
  6207.       NERPT = NERPTS(IEL)
  6208.       IF (NERPT.EQ.0) GOTO 610
  6209. C
  6210. C          DO FOR ALL ELEMENT RESULT POINTS
  6211. C
  6212.       DO 600 IERPT=1,NERPT
  6213. C
  6214.       IXIDER = IXIDER + 1
  6215.       IXERES = IXERES + NERKI
  6216.       IDERES = IDERPT(IXIDER)
  6217. C
  6218. C          CHECK THAT ELEMENT BELONGS TO ZONE
  6219. C
  6220.       IF (IBITZ.EQ.IWHOLE) GOTO 150
  6221.       IF (ISEZON.EQ.IEGAT) GOTO 140
  6222.         ISEZON = IEGAT
  6223.         CALL DBREAD (IEZONE,KIEZON,IEGAT,0)
  6224.         IF (IERROR.NE.0) GOTO 900
  6225.   140 IF (IERPT.EQ.1) CALL BITGET (IEZONE(IEL),IBITZ,ISELEC)
  6226.       IF (ISELEC.EQ.0) GOTO 600
  6227. C
  6228. C          TEST FOR UNBORN OR DEAD ELEMENT
  6229. C
  6230.   150 IF (IDERES.GE.0) GOTO 155
  6231.       IF (MAXTYP.NE.0 .OR. IERPT.GT.1) GOTO 600
  6232.       GOTO 500
  6233. C
  6234. C          READ ERES
  6235. C
  6236.   155 IF (ISERES.EQ.IEGAT) GOTO 160
  6237.       ISERES = IEGAT
  6238.       CALL DBREAD (ERES,KERES,IEGAT,ITIME)
  6239.       IF (IERROR.NE.0) GOTO 900
  6240. C
  6241. C          GET ELEMENT RESULT VALUES
  6242. C
  6243.   160 IF (ERES(IXERES+1).EQ.987654E32) GOTO 600
  6244.       IF (ICALL.EQ.ICALLR) GOTO 180
  6245.       DO 170 IERKI=1,NERKI
  6246.   170   VALUEV(IERKI) = ERES(IXERES+IERKI)
  6247.       GOTO 300
  6248. C
  6249. C          EXECUTE RESULTANT COMPUTATION
  6250. C
  6251.   180 DO 190 IVAR=1,MVAR
  6252.         KIND = KINDV(IVAR)
  6253.         IF (KIND.EQ.0) GOTO 190
  6254.         IF (KIND.GT.NERKI) GOTO 620
  6255.   185   VALUEV(IVAR) = ERES(IXERES+KIND)
  6256.   190   CONTINUE
  6257.       CALL FORMEX (VALUEV,IRPOL)
  6258.       IF (IERROR.NE.0) GOTO 700
  6259. C
  6260. C          EXCEED
  6261. C
  6262.   300 IF (MAXTYP.EQ.0) GOTO 500
  6263.       IF (NUMMAX.GT.0) GOTO 400
  6264. C
  6265.       DO 390 IVAR=1,NVAR
  6266.         GOTO (340,350,360), MAXTYP
  6267.   340   IF (ABS(VALUEV(IVAR)).GE.VALMAX) GOTO 500
  6268.         GOTO 390
  6269.   350   IF (VALUEV(IVAR).GE.VALMAX) GOTO 500
  6270.         GOTO 390
  6271.   360   IF (VALUEV(IVAR).LE.VALMAX) GOTO 500
  6272.   390   CONTINUE
  6273.       GOTO 600
  6274. C
  6275. C
  6276. C          MAXVALUES ARE STORED FOR EACH ELEMENT GROUP AND KIND:
  6277. C          IXMAXA(1-8,IEG): IXMAX,ISTRI,IRUSE,IEG,IELTYP,INDNL,NTABLE
  6278. C                           NVAR,LOCALE
  6279. C          IA(IXMAX):       VALUE, ITIME, IEL, IDERES
  6280. C
  6281. C
  6282.   400 IXMAX = IXMAXA(1,IEGAT)
  6283.       IXPLUS = (NUMMAX + 1) * NVAR
  6284.       IF (IXMAX.GT.0) GOTO 403
  6285. C
  6286. C          GET BLANK COMMON AREA FOR MAXVALUES FOR EL GROUP
  6287. C
  6288.       IXMAX = IXEND
  6289.       IXMAXA(1,IEGAT) = IXMAX
  6290.       IXMAXA(2,IEGAT) = ISUBST
  6291.       IXMAXA(3,IEGAT) = IRUSE
  6292.       IXMAXA(4,IEGAT) = IEG
  6293.       IXMAXA(5,IEGAT) = IELTYP
  6294.       IXMAXA(6,IEGAT) = INDNL
  6295.       IXMAXA(7,IEGAT) = NTABLE
  6296.       IXMAXA(8,IEGAT) = NVAR
  6297.       IXMAXA(9,IEGAT) = LOCALE
  6298.       IXEND = IXEND + IXPLUS * (ISURL + 3)
  6299.       CALL SIZE (IXEND)
  6300.       IF (IERROR.NE.0) GOTO 900
  6301.       DO 402 I=IXMAX,IXEND
  6302.   402   IA(I) = 0
  6303. C
  6304.   403 NIXSTA = IXMAX / ISURL
  6305.       IIXSTA = IXMAX + IXPLUS * ISURL
  6306. C
  6307. C          SAVE MAXVALUES FOR EACH KIND OF VARIABLE
  6308. C
  6309.       DO 490 IVAR=1,NVAR
  6310. C
  6311.       IIPLUS = (NUMMAX + 1) * IVAR - 2
  6312.       NIX = NIXSTA + IIPLUS
  6313.       IIX = IIXSTA + IIPLUS
  6314. C
  6315. C          LOOP NUMMAX TIMES
  6316. C
  6317.       DO 465 IMAX=1,NUMMAX
  6318.       IF (IA(IIX).EQ.0) GOTO 450
  6319.       VALUE  = VALUEV(IVAR)
  6320.       VALUEA = A(NIX)
  6321.       GOTO (410,440,430), MAXTYP
  6322.   410 VALUE  = ABS(VALUE)
  6323.       VALUEA = ABS(VALUEA)
  6324.       GOTO 440
  6325.   430 VALUE  = - VALUE
  6326.       VALUEA = - VALUEA
  6327. C
  6328.   440 IF (VALUEA.GE.VALUE) GOTO 470
  6329. C
  6330. C          MAKE PLACE FOR NEW VALUE
  6331. C
  6332.   450 A(NIX+1) = A(NIX)
  6333.       J = IIX
  6334.       DO 460 I=1,3
  6335.         IA(J+1) = IA(J)
  6336.   460   J = J + IXPLUS
  6337. C
  6338.       NIX = NIX - 1
  6339.       IIX = IIX - 1
  6340.   465 CONTINUE
  6341. C
  6342. C          MOVE NEW VALUE TO ARRAY
  6343. C
  6344.   470 A(NIX+1) = VALUEV(IVAR)
  6345.       IIX = IIX + 1
  6346.       IA(IIX) = ITIME
  6347.       J = IIX + IXPLUS
  6348.       IA(J) = IEL
  6349.       J = J + IXPLUS
  6350.       IA(J) = IDERES
  6351. C
  6352.   490 CONTINUE
  6353.       GOTO 600
  6354. C
  6355. C
  6356. C          LIST
  6357. C
  6358. C
  6359.   500 IF (LINE.LE.LINPAG) GOTO 505
  6360.       LINE = -1
  6361.       IEJECT = 1
  6362.   505 IF (IEJECT.LT.0) GOTO 510
  6363.       LINE = LINE + 10
  6364.       IF (LINE.GT.LINPAG) GOTO 500
  6365.       LINE = LINE - 7
  6366.       WRITE (NFLIST,2045)
  6367.       IF (IBITZ.EQ.IWHOLE)
  6368.      1  WRITE (NFLIST,2020) IEJECT,TIME,NSTEPE(ITIME)
  6369.       IF (IBITZ.NE.IWHOLE)
  6370.      1  WRITE (NFLIST,2021) IEJECT,NAMZON,TIME,NSTEPE(ITIME)
  6371.       LSTSUB = 1
  6372.       LSTIEG = 1
  6373.       IF (IEJECT.LT.1) GOTO 510
  6374.       IF (MAXTYP.EQ.0) GOTO 510
  6375.         WRITE (NFLIST,2570) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
  6376.      1        ,VALMAX
  6377.         LINE = LINE + 2
  6378. C
  6379.   510 IEJECT = -1
  6380.       IF (ISTRI.EQ.1 .OR. LSTSUB.EQ.0) GOTO 515
  6381.       LINE = LINE + 7
  6382.       IF (LINE.GT.LINPAG) GOTO 500
  6383.       LINE = LINE - 5
  6384.       WRITE (NFLIST,2345) ISUBST, IRUSE
  6385.       LSTSUB = 0
  6386.       LSTIEG = 1
  6387. C
  6388.   515 IF (LSTIEG.EQ.0) GOTO 530
  6389.       LINE = LINE + 5
  6390.       IF (NVAR.GT.7) LINE = LINE + 1
  6391.       IF (LINE.GT.LINPAG) GOTO 500
  6392.       LSTIEG = 0
  6393.       LSTDET = 1
  6394.       J = 1 + (IELTYP - 1) * 3
  6395.       K = J + 2
  6396.       IF (LOCALE.EQ.0)
  6397.      1  WRITE (NFLIST,2035) IEG,(IHDTYP(I),I=J,K)
  6398.       IF (LOCALE.EQ.1)
  6399.      1  WRITE (NFLIST,2036) IEG,(IHDTYP(I),I=J,K)
  6400. C
  6401.       IF (ICALL.EQ.ICALLR) GOTO 528
  6402.       DO 525 IVAR=1,NVAR
  6403.         I = 1 + (IVAR - 1) * 3
  6404.         CALL KINDE (IELTYP,INDNL,NTABLE,IVAR,IHDKIN(I))
  6405.   525   CONTINUE
  6406.       J = NVAR
  6407.       IF (NVAR.GT.7) J = (NVAR + 1) / 2
  6408.       J = J * 3
  6409.       WRITE (NFLIST,2040) (IHDKIN(I),I=1,J)
  6410.       IF (NVAR.LE.7) GOTO 529
  6411.       J = J + 1
  6412.       K = NVAR * 3
  6413.       WRITE (NFLIST,2042) (IHDKIN(I),I=J,K)
  6414.       GOTO 529
  6415. C
  6416.   528 WRITE (NFLIST,2041) NAMERC
  6417. C
  6418.   529 WRITE (NFLIST,2045)
  6419. C
  6420.   530 IF (IDERES.LT.0) GOTO 545
  6421.       IF (NVAR.GT.7) GOTO 540
  6422.       WRITE (NFLIST,2050) IEL,IDERES,(VALUEV(I),I=1,NVAR)
  6423.       GOTO 550
  6424. C
  6425.   540 LINE = LINE + 2
  6426.       IF (LINE.GT.LINPAG) GOTO 500
  6427.       J = (NVAR + 1) / 2
  6428.       WRITE (NFLIST,2050) IEL,IDERES,(VALUEV(I),I=1,J)
  6429.       J = J + 1
  6430.       WRITE (NFLIST,2051) (VALUEV(I),I=J,NVAR)
  6431.       WRITE (NFLIST,2045)
  6432.       GOTO 550
  6433. C
  6434.   545 WRITE (NFLIST,2055) IEL, IDERES
  6435.   550 LINE = LINE + 1
  6436.       ILIST = 1
  6437. C
  6438. C
  6439.   600 CONTINUE
  6440.   610 CONTINUE
  6441.   620 CONTINUE
  6442.       IEGIT = IEGIT - NEG
  6443.   630 CONTINUE
  6444.       IEGIT = IEGIT + NEG
  6445.   640 CONTINUE
  6446.   650 CONTINUE
  6447. C
  6448. C          MAX LIST
  6449. C
  6450.       IF (NUMMAX.EQ.0) GOTO 700
  6451. C
  6452.       DO 695 IEGAT=1,NEGAT
  6453. C
  6454.       IXMAX = IXMAXA(1,IEGAT)
  6455.       IF (IXMAX.EQ.0) GOTO 695
  6456.       LINE = 9999
  6457.       ISUBST = IXMAXA(2,IEGAT)
  6458.       IRUSE = IXMAXA(3,IEGAT)
  6459.       IEG   = IXMAXA(4,IEGAT)
  6460.       IELTYP = IXMAXA(5,IEGAT)
  6461.       INDNL  = IXMAXA(6,IEGAT)
  6462.       NTABLE = IXMAXA(7,IEGAT)
  6463.       NVAR   = IXMAXA(8,IEGAT)
  6464.       LOCALE = IXMAXA(9,IEGAT)
  6465.       IXPLUS = (NUMMAX + 1) * NVAR
  6466.       NIXSTA = IXMAX / ISURL
  6467.       IIXSTA = IXMAX + IXPLUS * ISURL
  6468. C
  6469. C
  6470.       DO 690 IVAR=1,NVAR
  6471.       LSTDET = 1
  6472.       IIPLUS = (IVAR - 1) * (NUMMAX + 1) - 1
  6473.       NIX = NIXSTA + IIPLUS
  6474.       IIX = IIXSTA + IIPLUS
  6475.         DO 680 IMAX=1,NUMMAX
  6476.           ITIME = IA(IIX+IMAX)
  6477.           IF (ITIME.EQ.0) GOTO 690
  6478.           VALUE = A(NIX+IMAX)
  6479.           J = IIX + IMAX + IXPLUS
  6480.           IEL = IA(J)
  6481.           J = J + IXPLUS
  6482.           IDERES = IA(J)
  6483. C
  6484.   653    IF (LINE.LE.LINPAG) GOTO 654
  6485.            IF (IBITZ.EQ.IWHOLE) WRITE (NFLIST,2060)
  6486.            IF (IBITZ.NE.IWHOLE) WRITE (NFLIST,2061) NAMZON
  6487.            WRITE (NFLIST,2065) TSTA,TEND,(IHDMAX(I,MAXTYP),I=1,4)
  6488.            LINE = 4
  6489.            LSTIEG = 1
  6490.   654    IF (LSTIEG.EQ.0) GOTO 657
  6491.            LSTIEG = 0
  6492.            LSTDET = 1
  6493.         IF (ISUBST.EQ.0) GOTO 655
  6494.            LINE = LINE + 7
  6495.            IF (LINE.GT.LINPAG) GOTO 653
  6496.            LINE = LINE - 5
  6497.            WRITE (NFLIST,2345) ISUBST,IRUSE
  6498. C
  6499.   655      LINE = LINE + 5
  6500.            IF (LINE.GT.LINPAG) GOTO 653
  6501.            LINE = LINE - 3
  6502.           J = 1 + (IELTYP - 1) * 3
  6503.           K = J + 2
  6504.            IF (LOCALE.EQ.0) WRITE (NFLIST,2035) IEG,(IHDTYP(I),I=J,K)
  6505.            IF (LOCALE.EQ.1) WRITE (NFLIST,2036) IEG,(IHDTYP(I),I=J,K)
  6506.   657    IF (LSTDET.EQ.0) GOTO 660
  6507.            LSTDET = 0
  6508.            LINE = LINE + 3
  6509.            IF (LINE.GT.LINPAG) GOTO 653
  6510.            KIND = IVAR
  6511.            IF (ICALL.EQ.ICALLR) KIND = 0
  6512.            CALL KINDE (IELTYP,INDNL,NTABLE,KIND,IHDKIN)
  6513.            WRITE (NFLIST,2070) (IHDKIN(I),I=1,3),NAMERC
  6514. C
  6515.   660     WRITE (NFLIST,2080) VALUE,IEL,IDERES,
  6516.      1                   TIMEE(ITIME),NSTEPE(ITIME)
  6517.           LINE = LINE + 1
  6518.           ILIST = 1
  6519.   680     CONTINUE
  6520.   690   CONTINUE
  6521.   695 CONTINUE
  6522. C
  6523.   700 IF (ILIST.EQ.0) WRITE (NFLOG,2700)
  6524.       GOTO 900
  6525. C
  6526.   800 IERROR = 1
  6527.       GOTO 900
  6528.   850 IERROR = 2
  6529.   900 RETURN
  6530. C
  6531.  2000 FORMAT (40H ***ERROR: NO ELEMENT RESULT IN DATABASE)
  6532.  2020 FORMAT(I1,31HELEMENT RESULTS FOR WHOLE MODEL ,
  6533.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  6534.  2021 FORMAT(I1,27HELEMENT RESULTS FOR ZONE = ,8A1,
  6535.      1  13H   AT TIME = ,G11.5,8H  STEP =,I4)
  6536.  2345 FORMAT(/21H    SUBSTRUCTURE NO =,I3,15H  REUSE ID NO =,I3)
  6537.  2035 FORMAT(/19H ELEMENT GROUP NO =,I4,3H  (,3A4,7X,
  6538.      1  55HLISTED RESULTS ARE MEASURED IN GLOBAL COORDINATE SYSTEM)
  6539.  2036 FORMAT(/19H ELEMENT GROUP NO =,I4,3H  (,3A4,7X,
  6540.      1  56HLISTED RESULTS ARE MEASURED IN ELEMENT COORDINATE SYSTEM)
  6541.  2041 FORMAT (/14H ELEMENT POINT,3X,10HRESULTANT ,8A1)
  6542.  2040 FORMAT(/14H ELEMENT POINT,7(4X,3A4))
  6543.  2042 FORMAT(14X,7(4X,3A4))
  6544.  2045 FORMAT (1H )
  6545.  2050 FORMAT (1X,I4,I7,2X,7(4X,E12.6))
  6546.  2051 FORMAT(14X,7(4X,E12.6))
  6547.  2055 FORMAT(1X,I4,I7,4X,18HELEMENT NOT ACTIVE)
  6548.  2060 FORMAT(46H1EXTREME ELEMENT RESULTS PER ELEMENT GROUP FOR,
  6549.      1  12H WHOLE MODEL)
  6550.  2061 FORMAT(46H1EXTREME ELEMENT RESULTS PER ELEMENT GROUP FOR,
  6551.      1  8H ZONE = ,8A1)
  6552.  2065 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
  6553.      1  14H  SCANNED FOR ,4A4)
  6554.  2070 FORMAT(/4X,3A4,8A1,38H   ELEMENT  POINT       TIME      STEP/)
  6555.  2080 FORMAT(4X,E12.6,11X,I4,I8,4X,E11.5,I7)
  6556.  2570 FORMAT(/18H INTERVAL  TSTART=,G11.5,7H  TEND=,G11.5,
  6557.      1  14H  SCANNED FOR ,4A4,18H VALUES EXCEEDING ,G12.6)
  6558.  2700 FORMAT(51H ***NULL LINES PRINTED - NO MATCH FOR SELECTED LIST)
  6559.       END
  6560.