Liren Large Software Subsidy 9/09.iso/e/e001/1.ddi/TMP/ADINA32.FOR

Text File | 1991-01-07 | 194.9 KB | 7,270 lines

C *CDC* *DECK STIFF
C *UNI* )FOR,IS N.STIFF,R.STIFF
      SUBROUTINE STIFF (AS,XLT,E,G,XI,YI,ZI,AREA)
C
C
C         SUBROUTINE TO CALCULATE LINEAR ELASTIC STIFFNESS MATRIX
C
C     AREA(2)   ,   AREA(3)  = EFFECTIVE SHEAR AREA IN  S  AND  T
C                                      DIRECTIONS RESPECTIVELY
C     AREA(2)=0.   NO SHEAR DEFORMATION IN  S  DIRECTION
C     AREA(3)=0.   NO SHEAR DEFORMATION IN  T  DIRECTION
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION AS(16,1),AREA(1)
C
      IF (AREA(2).EQ.0.D0) GO TO 510
      FIY = 12.*E*ZI/(G*AREA(2)*XLT*XLT)
      GO TO 511
  510 FIY = 0.0
  511 FIY1 = 1.+FIY
C
      IF (AREA(3).EQ.0.D0) GO TO 515
      FIZ = 12.*E*YI/(G*AREA(3)*XLT*XLT)
      GO TO 516
  515 FIZ = 0.0
  516 FIZ1 = 1.+FIZ
      DO 501 I=1,12
      DO 501 J=1,I
  501 AS(I,J)= 0.
      AS(1,1) = E*AREA(1)/XLT
      AS(2,2) = 12.*E*ZI/(FIY1*XLT**3)
      AS(3,3) = 12.*E*YI/(FIZ1*XLT**3)
      AS(4,4) = G*XI/XLT
      AS(5,3) =-6.*E*YI/(FIZ1*XLT**2)
      AS(5,5) = (4. + FIZ)*E*YI/(FIZ1*XLT)
      AS(6,2) = 6.*E*ZI/(FIY1*XLT**2)
      AS(6,6) = (4. + FIY)*E*ZI/(FIY1*XLT)
      DO 502 I=1,4
  502 AS(I+6,I)= -AS(I,I)
      DO 503 I=1,6
      IJ=I+6
  503 AS(IJ,IJ)= AS(I,I)
      AS(8,6) = -AS(6,2)
      AS(9,5) = -AS(5,3)
      AS(11,9)= -AS(5,3)
      AS(11,3) = AS(5,3)
      AS(12,2) = AS(6,2)
      AS(12,8) = AS(8,6)
      AS(11,5) = (2. - FIZ)*E*YI/(FIZ1*XLT)
      AS(12,6) = (2. - FIY)*E*ZI/(FIY1*XLT)
      DO 504 I=1,12
      DO 504 J=I,12
  504 AS(I,J)=AS(J,I)
      RETURN
      END
C *CDC* *DECK MASS
C *UNI* )FOR,IS N.MASS,R.MASS
      SUBROUTINE MASS (AS,XLT,XI,YI,ZI,AREA,DEN)
C
C     SUBROUTINE TO CALCULATE THE CONSISTANT MASS MATRIX
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION AS(16,16)
C
C
      DO 652 I= 1,12
      DO 652 J=I,12
  652 AS(I,J)= 0.
      XMM= XLT*AREA*DEN
      AA= AREA*XLT
      AB=AA*XLT
      AS(1,1)= XMM/3.
      AS(1,7) = XMM/6.
      AS(2,2)= XMM*(13./35.+6.*ZI/(5.*AB))
      AS(3,3)= XMM*(13./35.+6.*YI/(5.*AB))
      AS(4,4)= XMM *XI/(3.*AREA)
      AS(3,5)= -XMM*(11.*XLT/210.+YI/(10.*AA))
      AS(5,5)= XMM*(XLT*XLT/105.+YI/(7.5*AREA))
      AS(2,6)= XMM*(11.*XLT/210.+ZI/(10.*AA))
      AS(6,6)= XMM*(XLT*XLT/105.+ZI/(7.5*AREA))
      DO 653 I= 1,6
      IJ= I+6
  653 AS(IJ,IJ)= AS(I,I)
      AS(8,12)= -AS(2,6)
      AS(9,11)= -AS(3,5)
      AS(2,8)= XMM*(9./70.-1.2*ZI/AB)
      AS(6,8)= XMM*(13.*XLT/420.-ZI/(10.*AA))
      AS(2,12)=-AS(6,8)
      AS(3,9)= XMM*(9./70.-1.2*YI/AB)
      AS(5,9)= XMM*(-13.*XLT/420.+YI/(10.*AA))
      AS(4,10)= AS(4,4)/2.
      AS(3,11)=-AS(5,9)
      AS(5,11)=-XMM*(XLT*XLT/140.+YI/(30.*AREA))
      AS(6,12)=-XMM*(XLT*XLT/140.+ZI/(30.*AREA))
      DO 654 I= 1,12
      DO 654 J= 1,I
  654 AS(I,J)= AS(J,I)
C
      RETURN
      END
C *CDC* *DECK ENDREL
C *UNI* )FOR,IS N.ENDREL,R.ENDREL
      SUBROUTINE ENDREL (AS,IMOMNT,SREL,DISP,NDRL,IENDRL)
C
C
C     ROUTINE TO
C        1. CALCULATE CONDENSED DISPLACEMENTS
C        2. CALCULATE AND STORE THE MATRIX REQUIRED TO RETERIVE
C           THE CONDENSED DISPLACEMENTS
C        3. TO CONDENSE THE STIFNESS MATRIX
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      DIMENSION AS(16,1),IMOMNT(1),SREL(NDRL,1),DISP(1),DUMY(6,6),
     1          DISPT(12)
C
      IF (IENDRL - 2) 110,30,10
C
C     CALCULATE THE CONDENSED DISPLACEMENTS
C
   10 JJ=0
      DO 15 I=1,12
      DO 17 J=1,NDRL
      IF (IMOMNT(J).EQ.I) GO TO 15
   17 CONTINUE
      JJ=JJ + 1
      DISPT(JJ)=DISP(I)
   15 CONTINUE
      DO 20 I=1,NDRL
      II=IMOMNT(I)
      TEMP=0.
      DO 25 J=1,JJ
   25 TEMP=TEMP + SREL(I,J)*DISPT(J)
   20 DISP(II)=-TEMP
      RETURN
C
C     CALCULATE MATRIX NEEDED FOR CALCULATING CONDENSED DISPLACEMENTS
C
   30 DO 32 I=1,NDRL
      II=IMOMNT(I)
      DO 32 J=I,NDRL
      JJ=IMOMNT(J)
      DUMY(I,J)=AS(II,JJ)
   32 DUMY(J,I)=DUMY(I,J)
C
      DO 34 K=1,NDRL
      D=DUMY(K,K)
      DO 33 J=1,NDRL
   33 DUMY(K,J)=-DUMY(K,J)/D
      DO 37 I=1,NDRL
      IF (K-I) 35,37,35
   35 DO 40 J=1,NDRL
      IF (K-J) 45,40,45
   45 DUMY(I,J)=DUMY(I,J) + DUMY(I,K)*DUMY(K,J)
   40 CONTINUE
   37 DUMY(I,K)=DUMY(I,K)/D
   34 DUMY(K,K)=1.0/D
C
      JJ=0
      DO 50 J=1,12
      DO 55 K=1,NDRL
      KK=IMOMNT(K)
      IF (KK.EQ.J) GO TO 50
   55 CONTINUE
      JJ=JJ + 1
      DO 57 II=1,NDRL
      I=IMOMNT(II)
   57 SREL(II,JJ)=AS(I,J)
   50 CONTINUE
C
      DO 60 J=1,JJ
      DO 65 I=1,NDRL
      TEMP=0.
      DO 67 K=1,NDRL
   67 TEMP=TEMP + DUMY(I,K)*SREL(K,J)
   65 DISPT(I)=TEMP
      DO 68 K=1,NDRL
   68 SREL(K,J)=DISPT(K)
   60 CONTINUE
C
C     ELIMINATE THE REQUIRED ROWS AND COLUMNS BY USING
C     GAUSSIAN ELIMINATION PROCEDURE
C
  110 II=0
      PV=1.0D-10
      DO 100 I=1,6
      IM=IMOMNT(I)
      IF (IM.EQ.0) RETURN
      II=II + 1
      D=AS(IM,IM)
      IF (D.LT.PV) GO TO 145
C
      DO 120 J=1,12
      IF (J.EQ.IM) GO TO 120
C
      DD=AS(IM,J)/D
      DO 130 L=1,12
      IF (L.EQ.IM) GO TO 130
      AS(L,J)=AS(L,J) - AS(L,IM)*DD
  130 CONTINUE
  120 CONTINUE
C
  145 DO 140 J=1,12
      AS(IM,J)=0.
  140 AS(J,IM)=0.
  100 CONTINUE
C
      RETURN
      END
C *CDC* *DECK TRANSF
C *UNI* )FOR,IS N.TRANSF,R.TRANSF
      SUBROUTINE TRANSF (XYZ,AS,BS,T,PDISP,GAMA,ITONLY)
C
C
C      SUBROUTINE TO TRANSFORM  THE LOCAL MASS OR STIFFNESS MATRICES
C             TO GLOBAL SYSTEM
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
      COMMON /BTRANS/ DISP(16),DXYZ(9),XLN,EPS,EPS1
C
      DIMENSION T(3,3),XYZ(9),AS(16,16),BS(3,3),XM(3),DL(3),
     1          PDISP(1)
C
      IF (ITONLY-2) 5,11,200
C
    5 AX = XYZ(4) - XYZ(1)
      AY = XYZ(5) - XYZ(2)
      AZ = XYZ(6) - XYZ(3)
C
      DX = XYZ(7) - XYZ(1)
      DY = XYZ(8) - XYZ(2)
      DZ = XYZ(9) - XYZ(3)
C
      CX = AY*DZ - DY*AZ
      CY = DX*AZ - AX*DZ
      CZ = AX*DY - DX*AY
C
      AL=DSQRT(AX*AX+AY*AY+AZ*AZ)
      CL=DSQRT(CX*CX+CY*CY+CZ*CZ)
C
      IF (AL.LE.0.00000001D0.OR.
     1    CL.LE.0.00000001D0) GO TO 10
C
      T(1,1)= AX/AL
      T(1,2)= AY/AL
      T(1,3)= AZ/AL
      T(3,1)= CX/CL
      T(3,2)= CY/CL
      T(3,3)= CZ/CL
      T(2,1) = T(1,3)*T(3,2) - T(1,2)*T(3,3)
      T(2,2) = T(1,1)*T(3,3) - T(1,3)*T(3,1)
      T(2,3) = T(1,2)*T(3,1) - T(1,1)*T(3,2)
      IF (ITONLY.EQ.1) RETURN
      GO TO 11
C
   10 WRITE(6,20)
      STOP
C
C     EVALUATION OF TRANSFORMATION MATRIX FOR U.L. FORMULATION
C
C     CALCULATE DIFFERENTIAL DISPLACEMENT
C
  200 DO 201 I=1,3
  201 XM(I)=DISP(I+6) -DISP(I)
  205 DO 202 I=1,3
      TEMP=0.
      DO 203 J=1,3
  203 TEMP=TEMP + T(I,J)*XM(J)
  202 DL(I)=TEMP
C
C     EVALUATE THE KINEMATIC OF MOTION
C
      ADUM=(XLT + DL(1))**2 + DL(3)*DL(3)
      ADUM=DSQRT(ADUM)
      TEMP=ADUM/XLT
      IF (TEMP.GT.0.000001D0) GO TO 223
      DO 221 I=1,3
  221 XM(I)=PDISP(I+6) - PDISP(I)
      ITONLY=5
      GO TO 205
  223 AROT=(XLT + DL(1))/ADUM
      BROT=DL(3)/ADUM
C
C     CALCULATE NEW LENGTH OF THE BEAM
C
      XLN=ADUM*ADUM + DL(2)*DL(2)
      XLN=DSQRT(XLN)
C
      CROT=ADUM/XLN
      DROT=DL(2)/XLN
C
C
C     CALCULATE INTERMEDIATE TRANSFORMATION MATRIX
C
      BS(1,1)=AROT*CROT
      BS(1,2)=DROT
      BS(1,3)=BROT*CROT
      BS(2,1)=-AROT*DROT
      BS(2,2)=CROT
      BS(2,3)=-BROT*DROT
      BS(3,1)=-BROT
      BS(3,2)=0.0
      BS(3,3)=AROT
C
      DO 230 I=1,3
      DO 232 J=1,3
      TEMP=0.
      DO 234 K=1,3
  234 TEMP=TEMP + BS(I,K)*T(K,J)
  232 XM(J)=TEMP
      DO 235 L=1,3
  235 BS(I,L)=XM(L)
  230 CONTINUE
C
      RROT=0.
      DO 210 I=1,3
  210 RROT=RROT + T(1,I)*((DISP(I+3) - PDISP(I+3))
     1                   + (DISP(I+9) - PDISP(I+9)))
      RROT=0.5*RROT + GAMA
      GAMA=RROT
      ROT1=DCOS(RROT)
      ROT2=DSIN(RROT)
C
C     CALCULATE FINAL TRANSFORMATION MATRIX AT TIME  T
C
      DO 215 I=1,3
      T(1,I)=BS(1,I)
      T(2,I)=ROT1*BS(2,I) + ROT2*BS(3,I)
  215 T(3,I)=-ROT2*BS(2,I) + ROT1*BS(3,I)
      RETURN
C
C
C     TRANSFORM THE LOCAL STIFNESS MATRIX TO THE GLOBAL COORDINATE
C
   11 DO 450 I=1,10,3
      DO 450 J=I,10,3
C
      DO 501 M=1,3
      I1=I + M - 1
      DO 501 NI=1,3
      TEMP=0.
      DO 500 K=1,3
      K1=J + K - 1
  500 TEMP=TEMP + AS(I1,K1)*T(K,NI)
      BS(M,NI)=TEMP
  501 CONTINUE
C
      DO 511 M=1,3
      I1=I + M - 1
      DO 511 NI=1,3
      J1=J + NI - 1
      TEMP=0.
      DO 510 K=1,3
  510 TEMP=TEMP + T(K,M)*BS(K,NI)
      AS(I1,J1)=TEMP
  511 CONTINUE
  450 CONTINUE
      RETURN
C
   20 FORMAT (//15H *** ERROR ***       //
     1          42H AUXILIARY NODE COINCIDES WITH A BEAM NODE      //)
      END
C *CDC* *DECK LENGTH
C *UNI* )FOR,IS N.LENGTH,R.LENGTH
      SUBROUTINE LENGTH (XLT,XYZ)
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION XYZ(1)
      XX=0.
      DO 10 L=1,3
      D=XYZ(L) - XYZ(L+3)
   10 XX=XX + D*D
      XLT = DSQRT(XX)
      RETURN
      END
C *CDC* *DECK STIFNL
C *UNI* )FOR,IS N.STIFNL,R.STIFNL
      SUBROUTINE STIFNL(DISP,PROP,WA,AS,RE,ICS,ISHEAR,SR,RERIT)
C
C     THIS ROUTINE CALCULATES THE GEOMETRIC AND/OR MATERIAL NONLINEAR
C     STIFFNESS MATRIX AND UNBALANCED LOAD COLUMN
C
C     NC = NO. OF DISPLACEMENTS TO BE CONDENSED
C     IB = DIMENSION OF THE STIFFNESS MATRIX PRIOR TO CONDENSATION
C     IBB = NO. OF NONZERO ROWS OR COLUMNS IN THE STIFFNESS MATRIX
C     INPL = NO. OF ROWS IN THE B MATRIX
C     IC ARRAY CONTAINS THE COLUMN NOS. IN B MATRIX WHICH HAVE NONZERO
C     ENTRIES.
C
C                  TABLE OF VARIOUS FLAGS
C  ICS     ITYPB   ISHEAR    NC     NCOL     IB     IBB    IBC    ITS
C 1 OR 2     0       0       0       1       12      6      6      0
C 1 OR 2     0       1       1       1       14      7      6      1
C   1        1       0       2       2       16     14     12      1
C   1        1       1       4       3       16     16     12      2
C   2        1       0       0       3       12     12     12      0
C   2        1       1       2       3       14     14     12      1
C
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1      ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
      COMMON /BTRANS/ DISPT(16),DXYZ(9),XLN,EPS,EPS1
      COMMON /POS/ I1,I2,I3,ISTRES
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
      COMMON /SHP/ B(3,16),BNL1(3,16),BNL2(2,16),BNL3(2,16)
      COMMON /ICA/ IC(16,3),NCOL,IBC,NC
C
      DIMENSION AS(16,16),WA(1),PROP(1),C(5,5),DUMMY(3,16),XAREA(3)
     1           ,SR(1),DISP(1),RE(1),WI(7,7),LI3I(15)
      DIMENSION LOCATE(8,3),RERIT(1),ADUM(1)
      DIMENSION KSTART(4)
      DIMENSION ITFLAG(6,6)
C
      EQUIVALENCE (NPAR(15),MODEL),(NPAR(3),INDNL),(NPAR(5),ITYPB)
      EQUIVALENCE  (NPAR(13),NTABLE)
C
C *CDC*      DATA WI/1.00E0,13*0.0,0.666666666667E0,2*0.166666666667E0,
C *CDC*     1      11*0.0,0.133333333333E0,2*0.355555555556E0,
C *CDC*     2      2*0.777777777778E-1,2*0.0,7*0.0,0.32380952381E0,
C *CDC*     3      2*0.321428571429E-1,2*0.257142857143E0,
C *CDC*     4      2*0.48809523881E-1/
C
C    *IBM*  USE THE FOLLOWING CARDS FOR   WI
C
      DATA WI/1.0D0,13*0.0D0,0.666666666667D0,2*0.166666666667D0,
     1      11*0.0D0,0.133333333333D0,2*0.355555555556D0,
     2      2*0.777777777778D-1,2*0.0D0,7*0.0D0,0.32380952381D0,
     3      2*0.321428571429D-1,2*0.257142857143D0,
     4      2*0.48809523881D-1/
C
      DATA LI3I/3,1,2,5,3,1,2,4,7,5,3,1,2,4,6/
      DATA LOCATE / 1,0,0,0,14,0,0,0,
     1              1,14,0,0,16,15,0,0,
     1              1,16,30,43,16,15,14,13 /
C
      DATA ITFLAG / 0, 1,12, 6, 6, 0,
     1              1, 1,14, 7, 6, 1,
     2              2, 2,16,14,12, 1,
     3              4, 3,16,16,12, 2,
     4              0, 3,12,12,12, 0,
     5              2, 3,14,14,12, 1/
C
      ADUM1=0.D0
      ADUM(1)=0.D0
C
      IF (ITYPB.GT.0.OR.ICS.EQ.1) GO TO 5
      LPIPE=0
      IF (INTZ.EQ.5) LPIPE=3
      IF (INTZ.EQ.7) LPIPE=8
    5 CONTINUE
      DO 395 I=13,16
  395 RE(I)=0.0
      INPL = 2 + ITYPB
      NUMC = 2*ITYPB*ICS + ISHEAR + 1
      NC = ITFLAG(1,NUMC)
      NCOL = ITFLAG(2,NUMC)
      IB = ITFLAG(3,NUMC)
      IBB = ITFLAG(4,NUMC)
      IBC = ITFLAG(5,NUMC)
      ITS= ITFLAG(6,NUMC)
C
C     RECOVER THE SHEAR AND TORSIONAL ANGLES BY EMPLOYING
C     THE GAUSS ELIMINATION COEFFICIENT OF THE PREVIOUS STEP
C
      IF (ITS.EQ.0) GO TO 70
      DO 410 IJ=1,NC
      I=NC+1-IJ
      ISTART = LOCATE(I,NCOL)
      TEMP=0.0
      IJK=IBB-I
      DO 415 JK=1,IJK
      J = IC(JK,NCOL)
      TEMP = TEMP - SR(ISTART)*DISP(J)
  415 ISTART = ISTART + 1
      JL = LOCATE( 4+I,NCOL )
      DISP(JL) = TEMP
  410 CONTINUE
C
C     IN THE CASE OF NONLINEAR ANALYSIS, CORRECTING THE RECOVERED
C     DISPLACEMENTS.
C
      IF (INDNL .EQ. 0) GO TO 405
      DO 406 IJ=1,NC
      I=NC+1-IJ
      JL=LOCATE(4+I,NCOL)
      DISP(JL) = DISP(JL) - RERIT(4+IJ)
  406 CONTINUE
C
  405 CONTINUE
C
   70 EPS1=WA(1)
      EPS=(XLN - XLT)/XLT
C
C     ISTRES=-1    FORM NONLINEAR STIFFNESS MATRIX
C           = 0    CALCULATE STRESSES AT ALL INTEGRATION POINTS OR
C                  CALCULATE NODAL FORCES
C           = 1    CALCULATE STRESSES AT SELECTED INTEGRATION POINTS
C
      IF (ISTRES) 49,40,10
C
C     STRESS CALCULATION AT SELECTED INTEGRATION POINTS
C
   10 CALL SECT (PROP(3),PROP(4),R,ICS)
      CALL SHAPE
      IST=ISTRES
C
      IF (MODEL.EQ.2) GO TO 15
C
      IST1=IST
      IST2=IST
      IST3=IST
      IST4=IST
      CALL BELPAL (PROP,ADUM1,ADUM1,WA(IST2),ADUM,ADUM,IB)
      RETURN
C
   15 IST1=IST + 1
      IST2=IST1 + 1
      IST3=IST2 + 3
      IST4=IST3 + 3
C
      CALL BELPAL (PROP,WA(IST),WA(IST1),WA(IST2),WA(IST3),WA(IST4),IB)
      RETURN
C
   49 DO 50 I=1,IB
      DO 50 J=1,IB
   50 AS(I,J)=0.
C
C
C     L I N E A R   E L A S T I C   M A T E R I A L
C     S T I F F N E S S   M A T R I X
C
C
      IF (ICOUNT.GT.2) GO TO 40
      IF (IREF.NE.0) GO TO 40
      IF (MODEL.GT.1) GO TO 40
C
      IF (ICS.GT.1) GO TO 25
C
C     RECTANGULAR  CROSS-SECTION
C
      XAREA(1)=PROP(3)*PROP(4)
      SSI=XAREA(1)*PROP(4)*PROP(4)/12.
      TTI=XAREA(1)*PROP(3)*PROP(3)/12.
      RRI=SSI + TTI
      GO TO 30
C
C     PIPE  CROSS-SECTION
C
   25 XAREA(1)=PI*(PROP(3)**2 - PROP(4)**2)/4.
      SSI=XAREA(1)*(PROP(3)**2 + PROP(4)**2)/16.
      TTI=SSI
      RRI=SSI + TTI
C
   30 XAREA(2)=0.
      XAREA(3)=0.
      EY=PROP(1)
      XNU=PROP(2)
      GE=EY/(2.*(1. + XNU))
      CALL STIFF (AS,XLT,EY,GE,RRI,SSI,TTI,XAREA)
C
C
   40 DELV=XLT*PROP(3)*PROP(4)
      IF (ICS.LE.1) GO TO 99
      DELY=XLT*PI*(PROP(3) - PROP(4))
      ZD=4.0
      IF (INTZ.LT.8) ZD=DBLE(FLOAT(INTZ))
      IF (ITYPB.EQ.0) ZD=2.0
      DELV=XLT*DELY/ZD
C
   99 DO 91 I=1,INPL
      DO 91 J=1,IBB
   91 DUMMY(I,J)=0.
C
      IST=1 - NST
      IF (INDNL.EQ.2) IST=IST + 1
      DO 100 I1=1,INTX
      DO 105 I3=1,INTZ
      DO 110 I2=1,INTY
C
C
C     N O N L I N E A R   M A T E R I A L
C     S T I F F N E S S    M A T R I X
C
C
      CALL SECT (PROP(3),PROP(4),R,ICS)
      CALL SHAPE
      IST=IST + NST
C
      IF (MODEL.EQ.2) GO TO 95
C
      IST1=IST
      IST2=IST
      IST3=IST
      IST4=IST
      KST=IST2 - 1
      CALL BELPAL (PROP,ADUM1,ADUM1,WA(IST2),ADUM,ADUM,IB)
      GO TO 96
C
   95 IST1=IST + 1
      IST2=IST1 + 1
      IST3=IST2 + 3
      IST4=IST3 + 3
      KST=IST2 - 1
C
      CALL BELPAL (PROP,WA(IST),WA(IST1),WA(IST2),WA(IST3),WA(IST4),IB)
C
   96 CONTINUE
C
      IF (NTABLE.EQ.0 .AND. ISTRES.EQ.0) GO TO 110
C
C     EVALUATE INTEGRATION WEIGTHING FACTORS
C
      WFAC=WI(I1,INTX)*WI(I2,INTY)*DELV
      IF (ICS-1) 243,243,244
  243 WFACZ=WI(I3,INTZ)
      GO TO 245
  244 IF (ITYPB.EQ.0) GO TO 246
      WFACZ=1.00D0
      IF (INTZ.NE.8) GO TO 245
      LL=I3 - (I3/2)*2
      IF (LL.EQ.0) WFACZ=2.0000D0
      WFACZ=WFACZ/3.0
      GO TO 245
  246 LL=LPIPE + I3
      I3I=LI3I(LL)
      WFACZ=2.0*WI(I3I,INTZ)
  245 WFAC=WFAC*WFACZ
      IF (ICS.EQ.2) WFAC=WFAC*R
C
      IF (NTABLE.EQ.-1 .AND. ISTRES.EQ.0) GO TO 324
C
  189 IF (ICOUNT.GT.2) GO TO 324
      IF (IREF) 324,190,324
  190 IPEL=1
      IF (MODEL.EQ.1) GO TO 191
      IF (WA(IST).GE.0.) IPEL=2
  191 CALL CPEL (WA(IST),WA(IST2),PROP,C,IPEL,WA(IST1))
C
      IF (MODEL.GT.1) GO TO 240
      IF (ITS.EQ.0) GO TO 324
C
C     INCLUDE SHEAR AND TORSIONAL EFFECTS TO THE
C     ELASTIC STIFFNESS MATRIX.
C
      DO 420 IJ=1,NC
      I = IC( IBC+IJ , NCOL )
      DO 425 JK=IJ,NC
      J = IC( IBC+JK , NCOL )
      DO 425 K=1,INPL
  425 AS(I,J) = AS(I,J) + B(K,I)*C(K,K)*B(K,J)*WFAC
C
      DO 430 J=4,10,6
      DO 430 K=2,INPL
  430 AS(J,I) = AS(J,I) + B(K,I)*C(K,K)*B(K,J)*WFAC
C
      DO 435 JK=1,IBC
      J = IC(JK,NCOL)
  435 AS(J,I) = AS(J,I) + B(1,I)*C(1,1)*B(1,J)*WFAC
C
  420 CONTINUE
      GO TO 324
C
C     CALCULATE MATERIALLY NONLINEAR STIFNESS MATRIX
C
C     CALCULATE (DUMMY) = (C) * (B)
C
  240 DO 200 I=1,INPL
      DO 200 JJ=1,IBB
      J = IC(JJ,NCOL)
      TEMP=0.
      DO 210 K=1,INPL
  210 TEMP=TEMP + C(I,K)*B(K,J)
  200 DUMMY(I,JJ)=TEMP
C
C     CALCULATE  (AS) = (BT)*(C)*(B) = (BT)*(DUMMY)
C     FOR THIS INTEGRATION POINT
C     EVALUATE THE MATERIALLY NONLINEAR STIFFNESS MATRIX
C
      DO 250 II=1,IBB
      I = IC(II,NCOL)
      DO 250 JJ=II,IBB
      J = IC(JJ,NCOL)
      TEMP=0.
      DO 260 K=1,INPL
  260 TEMP=TEMP + B(K,I)*DUMMY(K,JJ)
  250 AS(I,J)=AS(I,J) + WFAC*TEMP
C
C
C     L O A D   V E C T O R
C
C
  324 DO 325 LL=1,IBB
      L = IC(LL,NCOL)
      TEMP=0.
      DO 330 K=1,INPL
  330 TEMP=TEMP + B(K,L)*WA(KST+K)
  325 RE(L)=RE(L) + TEMP*WFAC
      IF (NTABLE.EQ.-1 .AND. ISTRES.EQ.0) GO TO 110
      IF (ICOUNT.GT.2) GO TO 110
      IF (IREF.NE.0) GO TO 110
      IF (INDNL.LT.2) GO TO 110
C
C     G E O M E T R I C    N O N L I N E A R
C     S T I F F N E S S    M A T R I X
C
C
      TAU11=WA(IST2)
      TAU12=WA(IST2 + 1)
      TAU13=WA(IST2 + 2)
C
      DO 400 II=1,IBB
      I = IC(II,NCOL)
      DO 400 JJ=II,IBB
      J = IC(JJ,NCOL)
      TEMP=(BNL1(1,I)*BNL1(1,J) + BNL2(1,I)*BNL2(1,J))*TAU11
     +   + (BNL1(1,I)*BNL1(2,J) + BNL1(2,I)*BNL1(1,J))*TAU12
      IF (ITYPB.EQ.0) GO TO 400
      TEMP=TEMP +
     +     (BNL3(1,I)*BNL3(1,J))*TAU11 +
     +     (BNL3(1,I)*BNL3(2,J) + BNL3(2,I)*BNL3(1,J))*TAU12 +
     +     (BNL1(1,I)*BNL1(3,J) + BNL2(1,I)*BNL2(2,J))*TAU13
     +    +(BNL1(3,I)*BNL1(1,J) + BNL2(2,I)*BNL2(1,J))*TAU13
C
  400 AS(I,J)=AS(I,J) + WFAC*TEMP
  110 CONTINUE
  105 CONTINUE
  100 CONTINUE
C
C
      IF (ISTRES.GE.0) RETURN
      IF (ICOUNT.GT.2) GO TO 351
      IF (INDNL.EQ.2) WA(1)=EPS
      IF (IREF) 351,369,351
  369 IF (ITS.EQ.0) GO TO 349
C
C     STATIC CONDENSATION TO ELIMINATE THE SHEAR AND/OR TORSIONAL
C     DEGREES OF FREEDOM AT THE ELEMENT LEVEL.
C
C     (RERIT(I),I=1,NC) STORE (1.0/PIVOT) WHICH ARE ENCOUNTERED
C     DURING THE CONDENSATION PROCEDURE.
C
C
      KI=0
      DO 440 IJ=1,NC
      IBD=IBB - IJ
      I = IC( (IBD+1) , NCOL )
      DD = 1.0/AS(I,I)
C
      RERIT(NC+1-IJ)=DD
C
      DO 440 JK=1,IBD
      J = IC(JK,NCOL)
      KI=KI+1
      SR(KI) = DD*AS(J,I)
      DO 445 KL=JK,IBD
      K = IC(KL,NCOL)
  445 AS(J,K) = AS(J,K) -SR(KI)*AS(K,I)
  440 CONTINUE
C
C
  349 DO 350 I=2,12
      K=I - 1
      DO 350 J=1,K
  350 AS(I,J)=AS(J,I)
C
C
C     (RERIT(I),I=5,4+NC) STORE THE CORRECTIONS TO BE MADE TO THE
C     RECOVERED DISPLACEMENTS IN THE NEXT STEP. THESE CORRECTIONS NEED
C     TO BE MADE BECAUSE THE LOADS CORRESPONDING TO THE STATICALLY
C     CONDENSED DEGREES OF FREEDOM DONOT REMAIN ZERO DUE
C     TO NONLINEARITY OF THE STRESS-STRAIN RELATION.
C
  351 IF (INDNL .EQ. 0) RETURN
      IF (ITS .EQ. 0) RETURN
C
      IF (NC .GT. 1) GO TO 355
      RERIT(5) = RERIT(1)*RE(14)
      GO TO 450
C
  355 IF (NC .GT. 2) GO TO 360
      IF ( ICS .EQ. 2 ) GO TO 357
      RE(15) = RE(15) - SR(13)*RE(16)
      RERIT(5) = RERIT(1)*RE(15)
      RERIT(6) = RE(16)*RERIT(2) - SR(13)*RERIT(5)
      GO TO 450
  357 RE(13) = RE(13) - SR(13)*RE(14)
      RERIT(5) = RERIT(1)*RE(13)
      RERIT(6) = RE(14)*RERIT(2) - SR(13)*RERIT(5)
      GO TO 450
C
C      THIS CASE OCCURS IN CASE OF RECTANGULAR SECTION ONLY.
C
C     FOR THE CASE WHEN NC=4
C
  360 KSTART(1)=13
      KSTART(2)=28
      KSTART(3)=42
      DO 365 I=1,3
      IJ=KSTART(I)
      IK=4-I
      DO 370 J=1,IK
      JK=12+J
      RE(JK) = RE(JK) - SR(IJ)*RE(13+IK)
  370 IJ=IJ+1
  365 CONTINUE
      RERIT(5)=RERIT(1)*RE(13)
      DO 375 I=1,3
      IJ=KSTART(4-I)
      RERIT(5+I)=RERIT(1+I)*RE(13+I)
      DO 380 J=1,I
      RERIT(5+I) = RERIT(5+I) - SR(IJ)*RERIT(4+J)
  380 IJ=IJ+1
  375 CONTINUE
C
C     CORRECTING THE LOAD VECTOR TO ACCOUNT FOR THE LOADS
C     CORRESPONDING TO CONDENSED DEGREES OF FREEDOM
C
  450 KSTART(1)=1
      KSTART(2)=16
      IF (NC .EQ. 2) KSTART(2)=14
      KSTART(3)=30
      KSTART(4)=43
      DO 385 I=1,NC
      IJ=KSTART(I)
      IK=IBB-I
      IL=IC(IK+1 , NCOL)
      DO 390 JK=1,IBC
      J=IC(JK,NCOL)
      RE(J) = RE(J) - SR(IJ)*RE(IL)
  390 IJ=IJ+1
  385 CONTINUE
C
      RETURN
      END
C *CDC* *DECK BELPAL
C *UNI* )FOR,IS N.BELPAL,R.BELPAL
      SUBROUTINE BELPAL (PROP,SIGY,EPSTR,SIG,STRN,EPSP,IB)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                 .
C .   SIG     STRESSES FROM THE PREVIOUS TIME STEP                  .
C .   STRN    STRAINS FROM THE PREVIOUS TIME STEP                   .
C .   EPSP    PLASTIC STRAINS FROM THE PREVIOUS TIME STEP           .
C .   EPSTR   ACCUMULATED EFFECTIVE PLASTIC STRAIN FROM             .
C .           THE PREVIOUS TIME STEP                                .
C .                                                                 .
C .   STRESS  CURRENT STRESSES                                      .
C .   SIGY    YIELD STRESS                                          .
C .                                                                 .
C .   C       CURRENT ELASTIC-PLASTIC MODULUS MATRIX                .
C .                                                                 .
C .                                                                 .
C .   NOTES/                                                        .
C .       SIGY IS -VE FOR ELASTIC STATE                             .
C .       SIGY IS +VE FOR PLASTIC STATE                             .
C .                                                                 .
C .      INDNL.EQ.1     SMALL DISPLACEMENT ELASTIC-PLASTIC ANALYSIS .
C .      INDNL.EQ.2     LARGE DISP ANALYSIS (UPDATED LAGRANGIAN)    .
C .                                                                 .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1      ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
      COMMON /SHP/ B(3,16),BNL1(3,16),BNL2(2,16),BNL3(2,16)
      COMMON /BTRANS/ DISP(16),DXYZ(9),XLN,EPS,EPS1
      COMMON /ICA/ IC(16,3),NCOL,IBC,NC
      DIMENSION DELEPS(3),STRESS(3),SIG(3),DELSIG(3),PROP(1),C(5,5)
      DIMENSION STRN(1),EPSP(1),DEPSP(3)
C
      EQUIVALENCE (NPAR(15),MODEL),(NPAR(3),INDNL)
C
      EY=PROP(1)
      XNU=PROP(2)
C
C      1. FIND THE STRAIN INCREMENTS
C
      K=1
      IF (INDNL.EQ.2) K=2
      I=1
      TEMP=0.
      DO 105 J=1,3
  105 DELEPS(J)=0.0
      DO 108 J=K,6
  108 TEMP=TEMP + B(I,J)*DISP(J) + B(I,J+6)*DISP(J+6)
      IF (IB.EQ.12) GO TO 300
      DO 305 L=1,NC
      KL = IC( IBC+L , NCOL )
      TEMP = TEMP + B(I,KL)*DISP(KL)
      DELEPS(2) = DELEPS(2) + B(2,KL)*DISP(KL)
      DELEPS(3) = DELEPS(3) + B(3,KL)*DISP(KL)
  305 CONTINUE
C
  300 DELEPS(1) = TEMP
      IF (INDNL.EQ.2) DELEPS(1)=DELEPS(1) + EPS - EPS1
      DO 310 J=2,3
      DO 310 I=4,10,6
      DELEPS(J) = DELEPS(J) + B(J,I)*DISP(I)
  310 CONTINUE
C
C      3.  CALCULATE THE TRIAL STRESS INCREMENT ASSUMING
C          ELASTIC BEHAVIOR
C
      DELSIG(1)=EY*DELEPS(1)
      DO 120 L=2,3
  120 DELSIG(L)=PFAC*DELEPS(L)
C
C      4.  ASSUMING ELASTIC BEHAVIOR DURING THIS INCREMENT,DETRMINE THE
C          NEW STATE OF STRESS. LOCATE THE POSITION OF THE NEW STRESS
C          STATE IN THE STRESS PLANE.
C
      DO 125 L=1,3
  125 STRESS(L)=DELSIG(L) + SIG(L)
      IF (MODEL.GT.1) GO TO 130
      DO 129 L=1,3
  129 SIG(L)=STRESS(L)
      RETURN
C
  130 SIGSQ=STRESS(1)**2 + 3.*(STRESS(2)**2 + STRESS(3)**2)
      YSQ=SIGY*SIGY
C
      IF (SIGSQ - YSQ) 150,200,200
C
C     STATE OF STRESS LIES WITHIN THE LOADING SURFACE , ELASTIC BEHAVIOR
C
  150 IPEL=1
      DO 155 L=1,3
  155 SIG(L)=STRESS(L)
      IF (SIGY.GT.0.) SIGY=-SIGY
      GO TO 410
C
C     STATE OF STRESS OUTSIDE THE YIELD SURFACE, PLASTIC BEHAVIOR.
C
C     TO CHECK THE STATE OF STRESS AT PREVIOUS STEP.
  200 IPEL=2
      IF (SIGY.LT.0.) GO TO 250
C
C     THE STATE OF STRESS WAS OUTSIDE OF THE YIELD SURFACE AT TIME (T)
C     CALCULATE PLASTIC STRESS INCREMENTS.
C
      RAT=1.0
      CALL CPEL (SIGY,SIG,PROP,C,IPEL,EPSTR)
C
      DO 205 L=1,3
      TEMP=0.
      DO 210 K=1,3
  210 TEMP=TEMP + C(L,K)*DELEPS(K)
  205 DELSIG(L)=TEMP
C
      DO 215 L=1,3
  215 STRESS(L)=SIG(L) + DELSIG(L)
C
      SIGSQ=STRESS(1)**2 + 3.*(STRESS(2)**2 + STRESS(3)**2)
      SIGY=DSQRT(SIGSQ)
C
      DO 225 L=1,3
  225 SIG(L)=STRESS(L)
      GO TO 400
C
C     THE MATERIAL AT THIS POINT WAS BEHAVING ELASTICALLY AT TIME (T).
C     DETERMINE THE ELASTIC PORTION OF STRAINS.
C
  250 IPEL=2
      ALFA1=DELSIG(1)**2 + 3.*(DELSIG(2)**2 + DELSIG(3)**2)
      ALFA2=SIG(1)*DELSIG(1) + 3.*(SIG(2)*DELSIG(2) + SIG(3)*DELSIG(3))
      ALFA3=SIG(1)**2 + 3.*(SIG(2)**2 + SIG(3)**2) - SIGY*SIGY
      ADEL=ALFA2*ALFA2 - ALFA1*ALFA3
      RATIO=(DSQRT(ADEL) - ALFA2)/ALFA1
      RAT=1. - RATIO
C
      DO 255 L=1,3
  255 SIG(L)=SIG(L) + RATIO*DELSIG(L)
C
      CALL CPEL (SIGY,SIG,PROP,C,IPEL,EPSTR)
C
      DO 260 L=1,3
      TEMP=0.0
      DO 265 K=1,3
  265 TEMP=TEMP + C(L,K)*DELEPS(K)*RAT
  260 DELSIG(L)=TEMP
C
      DO 270 L=1,3
  270 SIG(L)=SIG(L) + DELSIG(L)
C
      SIGSQ=SIG(1)**2 + 3.*(SIG(2)**2 + SIG(3)**2)
      SIGY=DSQRT(SIGSQ)
C
C     UPDATE TOTAL STRAINS, PLASTIC STRAINS, AND ACCUMULATED
C     EFFECTIVE PLASTIC STRAIN  (DELSIG(I) IS THE ELASTIC-PLASTIC
C     STRESS INCREMENT)
C
  400 DEPSP(1)=RAT*DELEPS(1) - DELSIG(1)/EY
      DEPSP(2)=RAT*DELEPS(2) - DELSIG(2)/PFAC
      DEPSP(3)=RAT*DELEPS(3) - DELSIG(3)/PFAC
C
      DO 405 I=1,3
  405 EPSP(I)=EPSP(I) + DEPSP(I)
C
      DEPSTR=DSQRT(DEPSP(1)*DEPSP(1) + (DEPSP(2)*DEPSP(2) +
     1            DEPSP(3)*DEPSP(3))/3.0)
      EPSTR=EPSTR + DEPSTR
C
  410 DO 415 I=1,3
  415 STRN(I)=STRN(I) + DELEPS(I)
C
      RETURN
C
      END
C *CDC* *DECK CPEL
C *UNI* )FOR,IS N.CPEL,R.CPEL
      SUBROUTINE CPEL (SIGY,SIG,PROP,C,IPEL,EPSTR)
C
C
C     THIS SUBROUTINE CALCULATE THE ELASTIC-PLASTIC CONSTITUTIVE
C     RELATION AND THE PLASTIC STRAIN INCREMENTS
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1      ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
C
      DIMENSION C(5,5),SIG(1),S(5),PROP(1)
C
      EQUIVALENCE (NPAR(15),MODEL),(NPAR(3),INDNL)
      EQUIVALENCE (NPAR(17),NCON)
C
C     CALCULATE MATERIAL PROPERTIES
C
      EY=PROP(1)
      XNU=PROP(2)
C
      DO 50 I=1,5
      DO 50 J=1,5
   50 C(I,J)=0.
      IF (IPEL - 1) 100,100,200
C
C     ELASTIC STRESS-STRAIN RELATION
C
  100 C(1,1)=EY
      C(2,2)=PFAC
      C(3,3)=PFAC
      RETURN
C
C     PLASTIC STRESS-STRAIN RELATION
C
  200 IF (NCON.GE.8) GO TO 210
C
C        BILINEAR STRESS-STRAIN CURVE
C
      ET=PROP(6)
      GO TO 215
C
C        PIECEWISE-LINEAR STRESS-STRAIN CURVE
C
  210 CALL HARDMB (PROP,EPSTR,ET)
C
  215 SM=SIG(1)/3.0
      S(1)=SIG(1) - SM
      S(2)=SIG(2)
      S(3)=SIG(3)
      S(4)=-SM
      S(5)=-SM
      GAMA=ET/EY
      BETA=4.5*(1. - GAMA)/((3. - (1. - 2.*XNU)*GAMA)*SIGY*SIGY)
      SCALE=2.*PFAC
      DO 220 I=1,5
      DO 220 J=1,5
  220 C(I,J)=-BETA*S(I)*S(J)*SCALE
      SCALE=FAC*(1. - XNU)
      C(1,1)=C(1,1) + SCALE
      C(4,4)=C(4,4) + SCALE
      C(5,5)=C(5,5) + SCALE
      DO 222 I=2,3
  222 C(I,I)=C(I,I) + PFAC
      SCALE=XNU*FAC
      C(1,4)=C(1,4) + SCALE
      C(1,5)=C(1,5) + SCALE
      C(4,5)=C(4,5) + SCALE
C
C     GAUSS  ELIMINATION  TO  REDUCE  C(5,5)  TO  C(3,3)
C
      DO 250 K=1,2
      L=5 - K
      LL=L + 1
      DD=1./C(LL,LL)
      DO 250 I=1,L
      D=DD*C(I,LL)
      DO 255 J=I,L
  255 C(I,J)=C(I,J) - D*C(J,LL)
  250 CONTINUE
      C(2,1)=C(1,2)
      C(3,1)=C(1,3)
      C(3,2)=C(2,3)
      RETURN
      END
C *CDC* *DECK HARDMB
C *UNI* )FOR,IS N.HARDMB, R.HARDMB
C
      SUBROUTINE HARDMB (PROP,EPSTR,ET)
C
C
C
C     THIS SUBROUTINE CALCULATES THE SLOPE OF THE UNIAXIAL
C     STRESS-STRAIN CURVE CORRESPONDING TO A GIVEN VALUE
C     OF ACCUMULATED EFFECTIVE PLASTIC STRAIN
C
C
C
C        NPR  = NUMBER OF PAIRS OF STRESS-STRAIN VALUES DEFINING THE
C               PLASTIC PORTION OF THE STRESS-STRAIN CURVE
C        NSEG = NUMBER OF SEGMENTS IN THE PLASTIC PORTION OF THE CURVE
C
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      DIMENSION PROP(1)
      EQUIVALENCE (NPAR(17),NCON)
C
C
      YM=PROP(1)
      NPR=(NCON - 4)/2
      NSEG=NPR - 1
C
      KK=8
      DO 10 J=1,NSEG
      TEPSTR=PROP(KK) - (PROP(KK - 1)/YM)
      IF (EPSTR.LT.TEPSTR) GO TO 20
   10 KK=KK + 2
C
      WRITE (6,2000)
      STOP
C
C     CALCULATE THE HARDENING MODULUS
C
   20 ET=(PROP(KK - 1) - PROP(KK - 3))/(PROP(KK) - PROP(KK - 2))
C
      RETURN
C
 2000 FORMAT (126H   ERROR   ACCUMULATED EFFECTIVE PLASTIC STRAIN IS OUT
     1SIDE THE RANGE OF THE UNIAXIAL STRESS-STRAIN CURVE   (SUBROUTINE H
     2ARDMB))
C
      END
C *CDC* *DECK SHAPE
C *UNI* )FOR,IS N.SHAPE,R.SHAPE
      SUBROUTINE SHAPE
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1      ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
      COMMON /SHP/ B(3,16),BNL1(3,16),BNL2(2,16),BNL3(2,16)
C
      EQUIVALENCE (NPAR(3),INDNL)
C
C     INITIALIZE THE SHAPE FUNCTIONS.
C
      DO 100 I=1,3
      DO 100 J=1,16
  100 B(I,J)=0.
C
C     DEFINE THE STRAIN-DISPLACEMENT RELATIONS
C
      XLT3 = XLT*XLT*XLT
      YOL2 = YOL*YOL
      YOL3 = YOL2*YOL
      ZOL2 = ZOL*ZOL
      ZOL3 = ZOL2*ZOL
      B(1,1)=-1./XLT
      A=(6. -12.*XOL)/XLT
      B(1,2)=A*YOL
      B(1,3)=A*ZOL
      B(1,5)=(-4. + 6.*XOL)*ZOL
      B(1,6)=(4. - 6.*XOL)*YOL
      B(1,7)=-B(1,1)
      B(1,8)=-B(1,2)
      B(1,9)=-B(1,3)
      B(1,11)=(-2. + 6.*XOL)*ZOL
      B(1,12)=(2. - 6.*XOL)*YOL
      B(1,13)=A*ZOL*XLT
      B(1,14)=-A*YOL*XLT
      B(2,14)=-1.0
      B(2,15) = XLT*ZOL
      B(2,16) = XLT3*( 3.0*YOL2*ZOL - ZOL3 )
      B(3,13)=1.0
      B(3,15) = XLT*YOL
      B(3,16) = XLT3*( YOL3 - 3.0*YOL*ZOL2 )
      B(2,4)=ZOL
      B(2,10)=-ZOL
      B(3,4)=-YOL
      B(3,10)=YOL
C
C     NONLINEAR  STRAIN  DISPLACEMENT  RELATIONS
C
      IF (INDNL.LT.2) RETURN
      DO 200 I=1,2
      DO 200 J=1,16
      BNL1(I,J)=0.
      BNL2(I,J)=0.
  200 BNL3(I,J)=0.
      DO 201 J=1,16
  201 BNL1(3,J)=0.
C
      R1=(6. - 12.*XOL)/XLT
      R2=4. -6.*XOL
      R3=6.*XOL*(1. - XOL)/XLT
      R4=1. - 4.*XOL + 3.*XOL*XOL
      R5=XOL*(2. -3.*XOL)
C
C     DERIVATIVE  WITH  RESPECT  TO  ORIGINAL  LOCAL  X-COORDINATE
C
      BNL1(1,1)=-1./XLT
      BNL1(1,2)=R1*YOL
      BNL1(1,3)=R1*ZOL
      BNL1(1,5)=-R2*ZOL
      BNL1(1,6)=R2*YOL
      BNL1(1,7)=-BNL1(1,1)
      BNL1(1,8)=-BNL1(1,2)
      BNL1(1,9)=-BNL1(1,3)
      BNL1(1,11)=(6.*XOL - 2.)*ZOL
      BNL1(1,12)=(2. - 6.*XOL)*YOL
      BNL1(1,13)=R1*ZOL*XLT
      BNL1(1,14)=-R1*YOL*XLT
      DO 220 I=15,16
      DO 220 J=2,3
  220 BNL1(J,I) = B(J,I)
      BNL2(1,2)=-R3
      BNL2(1,4)=ZOL
      BNL2(1,6)=R4
      BNL2(1,8)=R3
      BNL2(1,10)=-ZOL
      BNL2(1,12)=-R5
      BNL2(1,14)=-1.0 + R3*XLT
      BNL3(1,3)=-R3
      BNL3(1,4)=-YOL
      BNL3(1,5)=-R4
      BNL3(1,9)=R3
      BNL3(1,10)=YOL
      BNL3(1,11)=R5
      BNL3(1,13)=1.0 - R3*XLT
C
C     DERIVATIVE  WITH  RESPECT  TO  ORIGINAL  LOCAL  Y-COORDINATE
C
      BNL1(2,2)=R3
      BNL1(2,6)=-R4
      BNL1(2,8)=-R3
      BNL1(2,12)=R5
      BNL1(2,14)=2.0 - R3*XLT
      BNL2(2,4)=1. - XOL
      BNL2(2,10)=XOL
C
C     DERIVATIVE  WITH  RESPECT  TO  ORIGINAL  LOCAL  Z-COORDINATE
C
      BNL1(3,3)=R3
      BNL1(3,5)=R4
      BNL1(3,9)=-R3
      BNL1(3,11)=-R5
      BNL1(3,13)=R3*XLT
      BNL3(2,4)=XOL - 1.0
      BNL3(2,10)=-XOL
      RETURN
      END
C *CDC* *DECK SECT
C *UNI* )FOR,IS N.SECT,R.SECT
      SUBROUTINE SECT (RO,RI,R,ICS)
C
C     THIS SUBROUTINE CALCULATE THE COORDINATES OF THE SIMPSON@S RULE
C     INTEGRATION POINTS.
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1      ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /STNL/ XLT,XOL,YOL,ZOL,FAC,PFAC,INTX,INTY,INTZ,NST
      COMMON /POS/ I1,I2,I3,ISTRES
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
C
      EQUIVALENCE (NPAR(5),ITYPB)
C
      XOL=((-1)**I1)/DBLE(FLOAT(INTX-1))
      L1=I1/2
      XOL=XOL*L1 + 0.5
C
      IF (ICS.GT.1) GO TO 200
C
C     RECTANGULAR SECTION OF SIDES RO , RI
C
      YOL=0.
      IF (INTY.LE.1)GO TO 100
      YOL=((-1)**I2)*RO/DBLE(FLOAT(INTY-1))
      L2=I2/2
      YOL=YOL*L2/XLT
C
  100 ZOL=0.
      IF (INTZ.LE.1)GO TO 110
      ZOL=((-1)**I3)*RI/DBLE(FLOAT(INTZ-1))
      L3=I3/2
      ZOL=ZOL*L3/XLT
  110 RETURN
C
C     PIPE SECTION, INNER DIAMETER=RI  OUTER DIAMETER=RO
C
  200 R=(RO + RI)/(4.0*XLT)
      IF (INTY.LE.1) GO TO 210
      DR=((-1)**I2)*(RO - RI)/DBLE(FLOAT(INTY-1))
      DR=DR/2.0
      L2=I2/2
      R=R + DR*L2/XLT
C
  210 ANGLE=0.
      IF (INTZ.LE.1) GO TO 220
      IF (ITYPB.EQ.0) GO TO 215
      DANGLE=2.0*PI/DBLE(FLOAT(INTZ))
      GO TO 219
  215 DANGLE=PI/DBLE(FLOAT(INTZ-1))
  219 L3=I3 - 1
      ANGLE=DANGLE*L3
C
  220 YOL=R*DCOS(ANGLE)
      ZOL=R*DSIN(ANGLE)
C
      RETURN
      END
C *CDC* *DECK OVL60
C *CDC*       OVERLAY (ADINA,6,0)
C *CDC* *DECK ISOBM
C *UNI* )FOR,IS N.ISOBM,R.ISOBM
C *CDC*       PROGRAM ISOBM
      SUBROUTINE ISOBM
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     PROGRAM
C        . VARIABLE NODE, ISOPARAMETRIC BEAM ELEMENT
C
C
C     S T O R A G E -
C
C        N101      XYZ       NCM*NUME
C        N102      CENTER    3*NUME
C        N103      LM        NDM*NUME
C        N104      IELT      NUME
C        N105      MATP      NUME
C        N106      PROP      NCON*NUMMAT
C        N107      DEN       NUMMAT
C        N108      ETIME     NUME
C        N109      EDISOL    NDM*NUME
C        N110      IPST      NUME
C        N111      ISTAB     NTABS*MPT
C        N112      WA        IDWT*NUME
C        N113      ISKEW     MXNODS*NUME
C        N114      SECT      NST*NUMMAT
C        N115      EULER     3*MXNODS*NUME
C        N116      ROTOLD    3*MXNODS*NUME
C        N117      IELS      NUME
C        N118      SR        INSR*NUME
C        N119      EDIS      NDM*NUME
C        N120      RITZ      2*NUME
C        N121      RERIT     5*NUME
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /DIM/ N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15
      COMMON /DIMETC/ N01,N02,N03,N04,N05,N06,N07,N08,N09
      COMMON /FREQIF/ ISTOH,N1A,N1B,N1C
      COMMON /SOL/ NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1           ,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /DPR/ ITWO
      COMMON /JUNK/ IHED(18),MTOT,LPROG
      COMMON /ELGLTH/ NFIRST,NLAST,NBCEL
      COMMON /ELSTP / TIME,IDTHF
      COMMON /PRCON/ IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
      COMMON /PORT/ INPORT,JNPORT,NPUTSV,LUNODE,LU1,LU2,LU3,JDC,JVC,JAC
      COMMON /TEMPRT/ TEMP1,TEMP2,ITEMPR,ITP96,N6A,N6B
      COMMON /SKEW  / NSKEWS
      COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
      COMMON A(1)
      REAL A
      DIMENSION IA(1)
      EQUIVALENCE (A(1),IA(1))
C
      EQUIVALENCE (NPAR(1),NPAR1),(NPAR(2),NUME),(NPAR(3),INDNL),
     1            (NPAR(4),IDEATH),(NPAR(6),NEGSKS),(NPAR(7),MXNODS),
     2            (NPAR(9),INTA),(NPAR(10),INTB),(NPAR(11),INTC),
     3            (NPAR(13),NTABS),(NPAR(14),MXPTS),(NPAR(15),MODEL),
     4            (NPAR(16),NUMMAT),(NPAR(17),NCON),(NPAR(18),IDW)
      EQUIVALENCE (NPAR(5),ISECT)
C
C
      DIMENSION DATA(20),NMCON(3),IDWAS(3),NSCON(3)
C
      DATA RECLB1 /8HTYPE-5  /
      DATA NMCON / 2, 4, 4 /
      DATA NSCON /2,2,0/ , IRECT /1/
      DATA IDWAS / 0, 8, 9 /
C
C
      IF (IND.NE.0) GO TO 100
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   I N P U T   P H A S E                                           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     CHECK ON RANGE AND SET DEFAULTS FOR NPAR VECTOR
C
      ISTOP=0
C
      LINEL=1
      MODMAX=3
      ISMAX=1
C
      IF (NUME.GT.0) GO TO 10
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=2
      IRANGE=1
      WRITE (6,2400) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
   10 IF (INDNL.GE.0 .AND. INDNL.LE.2) GO TO 15
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=3
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
C
   15 IF (IDEATH.NE.0) IDTHF=1
      IF (IDEATH.GE.0 .AND. IDEATH.LE.2) GO TO 20
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=4
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
C
   20 IF (ISECT.LE.0) ISECT=1
      IF (ISECT.LE.ISMAX) GO TO 25
      ISTOP=ISTOP+1
      IF(ISECT.NE.2) GO TO 21
      WRITE(6,2150)
      GO TO 25
   21 IF(ISTOP.EQ.1) WRITE(6,2100) NG
      ISUB=5
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
C
   25 IF(MXNODS.LE.0) MXNODS=4
      IF (MXNODS.LE.4) GO TO 30
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=7
      IRANGE=4
      WRITE (6,2300) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
   30 ISUB=9
      INTE=NPAR(9)
   31 IF (INTE.EQ.0) INTE=MXNODS
      IF (INTE.LT.0) GO TO 32
      IF (INTE.LE.4) GO TO 33
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      IRANGE=4
      WRITE (6,2300) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
      GO TO 33
   32 IF (INTE.GT.(-3)) INTE=-3
      IF (INTE.EQ.(-4)) INTE=-5
      IF (INTE.EQ.(-6)) INTE=-7
      IF (INTE.GE.(-7)) GO TO 33
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      IRANGE=-7
      WRITE (6,2400) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
   33 INTA=INTE
      IRGS=4
      IRNC=-7
      IF (INTB.GT.0 .AND. INTB.NE.4) WRITE (6,3301) IRGS
      IF (INTB.LT.0 .AND. INTB.NE.-7) WRITE (6,3302) IRNC
      IF (INTB.GE.0) INTB=4
      IF (INTB.LT.0) INTB=-7
      IF (INTC.GT.0 .AND. INTC.NE.4) WRITE (6,3301) IRGS
      IF (INTC.LT.0 .AND. INTC.NE.-7) WRITE (6,3302) IRNC
      IF (INTC.GE.0) INTC=4
      IF (INTC.LT.0) INTC=-7
      ISUB=11
C
   38 IF (MODEL.LE.0) MODEL=1
      IF (MODEL.LE.MODMAX) GO TO 40
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=15
      WRITE (6,2300) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
   40 IF (NUMMAT.LE.0) NUMMAT=1
C
      IF (MODEL.EQ.MODMAX) GO TO 45
      NCON=NMCON(MODEL)
      IDW=IDWAS(MODEL)
C
   45 IF (NTABS.LE.0) GO TO 47
      IF (MXPTS.LT.1) MXPTS=1
      GO TO 50
   47 MXPTS=0
C
C     CHECK ON COMPATIBILITY BETWEEN ELEMENTS OF NPAR
C
C
C        1. COMPATIBILITY OF INDNL AND IDEATH
C
   50 ISUB=3
      IF (INDNL.GT.0) GO TO 60
      IF (IDEATH.EQ.0) GO TO 54
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUD=4
      WRITE (6,2500) ISTOP,ISUB,NPAR(ISUB),ISUD,NPAR(ISUD)
C
C
C        3. COMPATIBILITY OF INDNL AND MODEL
C
   54 IF (MODEL.EQ.LINEL) GO TO 60
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUD=15
      WRITE (6,2500) ISTOP,ISUB,NPAR(ISUB),ISUD,NPAR(ISUD)
C
C
C        6. COMPATIBILITY OF NEGSKS AND NSKEWS
C
   60 IF (NEGSKS.EQ.0) GO TO 65
      IF (NSKEWS.GT.0) GO TO 65
      ISUB=6
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      WRITE (6,2550) ISTOP,NSKEWS,ISUB,NPAR(ISUB)
C
C
C     CHECK FOR TEMPERATURE TAPE
C
   65 ITEMPR=0
C
C
      IF (ISTOP.EQ.0) GO TO 75
      WRITE (6,2700) ISTOP
      INPUT=5
      BACKSPACE INPUT
      READ (5,1000) DATA
      WRITE (6,2800) (I,I=1,8),DATA
      IDATWR=1
C
   75 IF (IDATWR.GT.1) GO TO 90
C
C     PRINT OUT NPAR VECTOR
C
      WRITE (6,2900) NPAR1
      WRITE (6,2905) NUME,INDNL,IDEATH
      WRITE (6,2910) ISECT,NEGSKS,MXNODS
      IF (ISECT.EQ.IRECT) WRITE (6,2915) INTA,INTB,INTC
      WRITE (6,2930) NTABS,MXPTS
C
      WRITE (6,2940) MODEL,NUMMAT
      IF (INDNL.GT.1) WRITE (6,2698)
   90 IF (ISTOP.EQ.0) GO TO 95
      WRITE (6,2750)
      STOP
C
C
C***  DATA PORTHOLE  *************************** (START)
C
   95 IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) GO TO 100
      RECLAB=RECLB1
      WRITE (LU1) RECLAB,NG,(NPAR(I),I=1,20),NSUB
C
C***  DATA PORTHOLE  *************************** ( END )
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   E N D   O F   C H E C K   O N   N P A R   V E C T O R           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
  100 NCM=3*MXNODS
      NDM=6*MXNODS
      INSR = 2*NDM + 1
      MPT=0
      IF (MXPTS.GT.0) MPT=MXPTS+1
      NPT=IABS (INTA*INTB*INTC)
      IDWT=IDW*NPT
      NST=NSCON(ISECT)
C
      NFIRST=N6
      IF (IND.EQ.4) NFIRST=N10
      N101=NFIRST + 20
      N102=N101 + NCM*NUME*ITWO
      N103=N102 + 3*NUME*ITWO
      N104=N103 + NDM*NUME
      N105=N104 + NUME
      N106=N105 + NUME
      N107=N106 + NCON*NUMMAT*ITWO
      N108=N107 + NUMMAT*ITWO
      MM=0
      IF (IDEATH.GT.0) MM=1
      N109=N108 + MM*NUME*ITWO
      MM=0
      IF (IDEATH.EQ.1) MM=1
      N110=N109 + MM*NDM*NUME*ITWO
      N111=N110 + NUME
      MM=0
      IF (NTABS.GT.0) MM=1
      N112=N111 + MM*NTABS*MPT
      N113=N112 + IDWT*NUME*ITWO
      MM=0
      IF (NEGSKS.GT.0) MM=1
      N114=N113 + MM*MXNODS*NUME
      N115=N114 + NST*NUMMAT*ITWO
      MM=0
      IF (INDNL.EQ.2) MM=1
      N116=N115 + MM*NCM*NUME*ITWO
      N117=N116 + MM*NCM*NUME*ITWO
      N118=N117 + NUME
      N119=N118 + INSR*NUME*ITWO
      IF (INDNL .GE. 1) MM=1
      N120 = N119 + MM*NDM*NUME*ITWO
      N121 = N120 + 2*MM*NUME*ITWO
      N122 = N121 + 5*MM*NUME*ITWO
      NLAST = N122 - 1
C
      IF (IND.NE.0) GO TO 105
C
      J=NFIRST - 1
      DO 102 I=1,20
      J=J+1
  102 IA(J)=NPAR(I)
C
      MIDEST=(NLAST-NFIRST) + 1
      WRITE (6,2000) NG,MIDEST
      CALL SIZE (NLAST)
C
C
  105 IF (IND.GT.3) GO TO 110
      M2=N2
      M3=N3
      M4=N4
      GO TO 120
  110 M2=N2
      M3=N7
      M4=N8
      IF (ICOUNT.LT.3) GO TO 120
      M2=N6
C
  120 CALL CUTEL  (A(N06),A(N1A),A(N1),A(M2),A(M3),A(M4),A(N5),
     1            A(N101),A(N102),A(N103),A(N104),A(N105),A(N106),
     2            A(N107),A(N108),A(N109),A(N110),A(N111),A(N112),
     3            A(N113),A(N114),A(N115),A(N116),A(N117),A(N118),
     4            A(N119),A(N120),A(N121),
     5            NDOF,NCM,NDM,NCON,MPT,IDWT,MXNODS,NST,INSR)
C
      RETURN
C
 1000 FORMAT (20A4)
C
 2000 FORMAT (///38H S T O R A G E   I N F O R M A T I O N,
     1       ///49H LENGTH OF ARRAY NEEDED FOR STORING ELEMENT GROUP/
     3        12H DATA (GROUP,I3,26H). . . . . . . . . . . . .,
     4        15H( MIDEST ). . =,I5)
C
 2100 FORMAT (1H1,47HERROR IN ELEMENT GROUP CONTROL CARDS (ISO/BEAM)/
     1        16H ELEMENT GROUP =, I5/)
 2150 FORMAT(37H NPAR(5)=2 (I-SECTION) NOT AVAILABLE /)
 2200 FORMAT (I5,7H. NPAR(,I2,27H) IS OUT OF RANGE ... NPAR(,I2,
     1        3H) =,I5)
 2300 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .LE., I2,10H ... NPAR(,I2,
     1        3H) =,I5)
 2400 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .GE., I2,10H ... NPAR(,I2,
     1        3H) =,I5)
 2500 FORMAT (I5,7H. NPAR(,I2,3H) =,I2,10H AND NPAR(,I2,3H) =,I2,
     1        19H ARE NOT COMPATIBLE )
 2550 FORMAT (I5,10H. NSKEWS =,I2,10H AND NPAR(,I2,3H) =,I2,
     1        19H ARE NOT COMPATIBLE )
 2698 FORMAT (////16H *** N O T E ***//
     1  52H IN GEOMETRIC NONLINEAR ANALYSIS, I.E., INDNL.GT.1, /
     2  52H THE TOTAL ROTATIONS AT THE NODAL POINTS PRINTED IN /
     3  52H THE STEP-BY-STEP SOLUTION ARE NOT USED.            //
     4  52H THE ELEMENT KINEMATICS AND STRESSES ARE CALCULATED /
     5  52H USING INCREMENTAL ROTATIONS.                       ///)
 2700 FORMAT (//25H TOTAL NUMBER OF ERRORS =,I5//
     1        48H CARD IMAGE LISTING AND PRINT-OUT OF NPAR VECTOR/
     2        48H (WITH DEFAULTS ENFORCED) ARE GIVEN BELOW ------)
 2800 FORMAT (///34H CARD IMAGE LISTING OF NPAR VECTOR //29X,8(I1,9X)/
     1        15H COLUMN NUMBERS,5X,8(10H1234567890)/
     2        15H NPAR VECTOR   ,5X,20A4 // )
 2750 FORMAT (//// 23H STOP  (ERRORS IN NPAR)  )
C
 2900 FORMAT (36H E L E M E N T   D E F I N I T I O N ///,
     1        14H ELEMENT TYPE ,13(2H .),16H( NPAR(1) ). . =,I5/,
     2        25H     EQ.1, TRUSS ELEMENTS/,
     3        25H     EQ.2, 2-DIM ELEMENTS/,
     4        25H     EQ.3, 3-DIM ELEMENTS/,
     5        25H     EQ.4, BEAM  ELEMENTS/,
     A        28H     EQ.5, ISO/BEAM ELEMENTS/,
     B        25H     EQ.6, PLATE ELEMENTS/,
     C        25H     EQ.7, SHELL ELEMENTS/,
     D        25H     EQ.8,9,10, EMPTY    /,
     G        32H     EQ.11, 2-DIM FLUID ELEMENTS/,
     6        32H     EQ.12, 3-DIM FLUID ELEMENTS  //)
 2905 FORMAT (20H NUMBER OF ELEMENTS.,10(2H .),16H( NPAR(2) ). . =,I5//,
     7        28H TYPE OF ANALYSIS. . . . . .,6(2H .),15H( NPAR(3) ). .
     8        1H=,I5/,
     9        38H     EQ.0, LINEAR ANALYSIS            /
     A        38H     EQ.1, MATERIALLY NONLINEAR ONLY   /,
     1        39H     EQ.2, TOTAL LAGRANGIAN FORMULATION//
     2        32H ELEMENT BIRTH AND DEATH OPTIONS ,4(2H .),
     3        16H( NPAR(4) ). . =,I5/,
     4        28H     EQ.0, OPTION NOT ACTIVE/,
     5        30H     EQ.1, BIRTH OPTION ACTIVE /,
     6        30H     EQ.2, DEATH OPTION ACTIVE /)
 2910 FORMAT (22H ELEMENT SECTION CODE ,9(2H .),16H( NPAR(5) ). . =,I5/,
     1        30H     EQ.1, RECTANGULAR SECTION  //
     2        23H SKEW COORDINATE SYSTEM/
     B        40H     REFERENCE INDICATOR . . . . . . . .,
     C        16H( NPAR(6) ). . =,I5/
     D        28H     EQ.0, ALL ELEMENT NODES/
     E        37H           USE THE GLOBAL SYSTEM ONLY/
     F        35H     EQ.1, ELEMENT NODES REFER     /
     G        36H           TO SKEW COORDINATE SYSTEM//
     4        42H MAXIMUM NUMBER OF NODES USED TO DESCRIBE  /,4X,
     5        16H ANY ONE ELEMENT,10(2H .),16H( NPAR(7) ). . =,I5/)
 2915 FORMAT (29H NUMBER OF INTEGRATION POINTS/4X,
     1        20H IN THE R- DIRECTION,8(2H .),16H( NPAR(9) ). . =,I5//
     2        29H NUMBER OF INTEGRATION POINTS/4X,
     3        20H IN THE S- DIRECTION,8(2H .),16H( NPAR(10)). . =,I5//
     3        29H NUMBER OF INTEGRATION POINTS/4X,
     3        20H IN THE T- DIRECTION,8(2H .),16H( NPAR(11)). . =,I5/)
 2930 FORMAT (34H STRESS OUTPUT LOCATION INDICATOR.,3(2H .),
     1        16H( NPAR(13)). . =,I5/
     2        4X,30H LT.0, FORCE AND MOMENT OUTPUT/
     2        4X,30H       AT ALL NODAL SECTIONS  /
     2        4X,20H EQ.0, STRESS OUTPUT/
     2        4X,32H       AT ALL INTEGRATION POINTS/
     3        4X,32H GT.0, NUMBER OF STRESS OUTPUT  /
     3        4X,13H       TABLES//
     4        25H MAXIMUM NUMBER OF POINTS/
     4        40H     IN ANY STRESS OUTPUT TABLE . . . . ,
     5        16H( NPAR(14)). . =,I5///)
 2940 FORMAT (42H M A T E R I A L   D E F I N I T I O N     ///,
     1        16H MATERIAL MODEL.,12(2H .),16H( NPAR(15)). . =,I5/,
     2        40H     EQ.1,  LINEAR ELASTIC                     /,
     3        44H     EQ.2,  ELASTIC-PLASTIC (ISOTROPIC)     ,/,
     4        44H     EQ.3,  ELASTIC-PLASTIC (KINEMATIC)     ,//,
     8        37H NUMBER OF DIFFERENT SETS OF MATERIAL          /,
     9        14H     CONSTANTS,13(2H .),16H( NPAR(16)). . =,I5//)
 3301 FORMAT (//15H *** NOTE ***   /
     1          45H INTEGRATION ORDER IN THE S-DIRECTION           /
     2          20H HAS BEEN RE-SET TO  ,I4/)
 3302 FORMAT (//15H *** NOTE ***   /
     1          45H INTEGRATION ORDER IN THE T-DIRECTION           /
     2          20H HAS BEEN RE-SET TO  ,I4/)
C
      END
C *CDC* *DECK CUTEL
C *UNI* )FOR,IS N.CUTEL,R.CUTEL
      SUBROUTINE CUTEL (RSDCOS,NODSYS,ID,X,Y,Z,HT,
     1                  XYZ,CENTER,LM,IELT,MATP,PROP,DEN,ETIME,EDISOL,
     2                  IPS,ISTAB,WA,ISKEW,SECT,EULER,ROTOLD,IELS,SR,
     3                  EDIS,RITZ,RERIT,
     3                  NDOF,NCM,NDM,NCON,MPT,IDWT,MXNODS,NST,INSR)
C
C
C        SR ARRAY CONTAINS GAUSS ELIMINATION COEFFICIENTS REQUIRED FOR
C        RECOVERY OF INCREMENTS IN TORSIONAL RITZ FUNCTION DISP.
C        EDIS ARRAY CONTAINS TOTAL DISPLACEMENTS.
C        RITZ ARRAY CONTAINS TOTAL TORSIONAL RITZ FUNCTION DISPLACEMENTS
C        RERIT ARRAY KEEPS TRACK OF CORRECTIONS TO RECOVERED RITZ
C        FUNCTION DISPLACEMENTS.
C
C        ARRAYS EDIS,RITZ,RERIT ARE USED IF INDNL .GE. 1
C
C        XEI AND RIT ARRAYS CONTAIN
C                  TOTAL DISPLACEMENTS IF INDNL .EQ. 0
C                  INCREMENTAL DISPLACEMENTS IF INDNL .GE. 1
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,ISTAT
     1            ,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /DIM/ N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15
      COMMON /SOL/ NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /PRCON/ IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
      COMMON /PORT/ INPORT,JNPORT,NPUTSV,LUNODE,LU1,LU2,LU3,JDC,JVC,JAC
      COMMON /RANDI/ N0A,N1D,IELCPL
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
      COMMON /GASNEW/ TRAPS(12,3),GATES(7,7),WATES(7,7)
      COMMON /ELSTP/ TIME,IDTHF
      COMMON /SKEW  / NSKEWS
      COMMON /MDFRDM/ IDOF(6)
C
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
      COMMON /CINT/ IMLEN,INLEN,INLENT,IMTIK,INTIK,INTIKT,
     1                INPER,INPERT,WZ
      COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
      COMMON A(1)
      REAL A
C
      DIMENSION RSDCOS(9,1),NODSYS(1),ID(NDOF,1),X(1),Y(1),Z(1),HT(1),
     1          XYZ(NCM,1),CENTER(3,1),LM(NDM,1),IELT(1),MATP(1),
     2          PROP(NCON,1),DEN(1),ETIME(1),EDISOL(NDM,1),IPS(1),
     3          ISTAB(MPT,1),WA(IDWT,1),ISKEW(MXNODS,1),SECT(NST,1),
     4          EULER(NCM,1),ROTOLD(NCM,1),IELS(1),SR(INSR,1),
     5          EDIS(NDM,1),RITZ(2,1),RERIT(5,1)
C
      DIMENSION ILSK(8),NOD(4),NODE(4)
      DIMENSION AS(26,26),S(300),EDISE(24),SRE(49),RITZE(2),RERITE(5)
      DIMENSION XEI(24),RIT(2),XYZINT(3,343)
C
      EQUIVALENCE (NPAR(2),NUME),(NPAR(3),INDNL),(NPAR(4),IDEATH),
     1            (NPAR(6),NEGSKS),(NPAR(13),NTABS),(NPAR(14),MXPTS),
     2            (NPAR(9),INTA),(NPAR(10),INTB),(NPAR(11),INTC),
     3            (NPAR(15),MODEL),(NPAR(16),NUMMAT),(NPAR(5),ISECT)
      EQUIVALENCE (NPAR(18),IDW)
C
      DATA RECLB1/8HMATERAL5/, RECLB2/8HELEMENT5/,
     1     RECLB3/8HNEWSTEP5/, RECLB4/8HOUTPUT-5/
      DATA RECLB5/8HOUTABLE5/, RECLB6/8HIPOINT-5/
C
      DATA IRECT /1/
C
C
C     ** NOTE ** DURING THE TIME INTEGRATION, X=DISP, Y=VEL, Z=ACC
C
      IELCPL=0
      IF (KPRI.EQ.0) GO TO 800
      IF (IND.GT.0) GO TO 360
      IJPORT=1
      IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) IJPORT=0
C
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   R E A D   A N D   G E N E R A T E   E L E M E N T               .
C .   I N F O R M A T I O N                                           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
C     READ MATERIAL PROPERTIES
C
      CALL CINTEG (NPAR)
      NINT=INLEN*INTIK*INPER
C
      IF (IDATWR.LE.1) WRITE (6,2000)
C
C
C     INPUT -
C     E    YOUNG*S MODULUS
C     XNU  POISSON*S RATIO
C
C     STORAGE -
C        PROP(1) = E
C        PROP(2) = G
C
C     ISECT = 1  (RECT)
C        SECT(1) = DEPTH/2
C        SECT(2) = WIDTH/2
C
C
   10 DO 12 I=1,NUMMAT
      IBUG=0
      READ (5,1010) N,DENN,DIMA,DIMB
      READ (5,1012) E,XNU,YLD,ET
      IF (N.NE.I) GO TO 14
      IF (IDATWR.GT.1) GO TO 11
C
      WRITE (6,2010) N,DENN
      IF (ISECT.EQ.IRECT) WRITE (6,2015) DIMA,DIMB
C
      IF (MODEL.EQ.1) WRITE (6,2050) E,XNU
      IF (MODEL.GT.1) WRITE (6,2060) E,XNU,YLD,ET
C
   11 DEN(N)=DENN
C
      PROP(1,N)=E
      PROP(2,N)=E/(2.*(1.+XNU))
      IF (MODEL.EQ.1) GO TO 16
      PROP(3,N)=YLD
      PROP(4,N)=ET
C
      IF (YLD.GT.0.0) GO TO 17
      IBUG=1
      WRITE (6,3401) NG,N
   17 IF (ET.LT.E) GO TO 16
      IBUG=1
      WRITE (6,3402) NG,N
   16 IF (MODEX.EQ.0 .OR. IBUG.EQ.0) GO TO 18
      WRITE (6,3403)
      STOP
C
   18 SECT(1,N)=DIMA/2.
      SECT(2,N)=DIMB/2.
      GO TO 12
C
C
   12 CONTINUE
C
      GO TO 60
C
   14 WRITE (6,3010) NG
      WRITE (6,3012) I,N
      STOP
C
C
C
   60 CONTINUE
C
C
C***  DATA PORTHOLE  **************************** (START)
C
      IF (IJPORT.EQ.0) GO TO 65
      RECLAB=RECLB1
      WRITE (LU1) RECLAB,NUMMAT,NCON,(DEN(I),I=1,NUMMAT),
     1            ((PROP(I,J),I=1,NCON),J=1,NUMMAT)
C
C***  DATA PORTHOLE  **************************** ( END )
C
C     READ STRESS OUTPUT TABLES
C
   65 IF (NTABS.LE.0) GO TO 100
C
      IF (IDATWR.LE.1) WRITE (6,2100)
      ISMN=NINT+1
C
      DO 82 K=1,NTABS
      READ (5,1100) N,NPTS
      IF (N.NE.K) GO TO 84
      IF (NPTS.LE.0) NPTS=MXPTS
      IF (NPTS.GT.MXPTS) GO TO 86
      IF (IDATWR.LE.1) WRITE (6,2105) N,NPTS
      IDUM=NPTS+1
      READ (5,1100) (ISTAB(J,N),J=2,IDUM)
C
C     CHECK TO SEE IF STRESS OUTPUT POINTS ARE ACCEPTABLE
C
      DO 77 I=1,NPTS
C
      KA=ISTAB(I+1,N)
      KK=IABS(KA)
      LL=100
      IF (KK.GT.1000) LL=1000
      INL=KK/LL
      KK=KK - INL*LL
      LL=LL/10
      INT=KK/LL
      INP=KK - INT*LL
C
      ISTOP=0
      IF (INL.GT.0 .AND. INL.LE.INLEN) GO TO 72
      ISTOP=ISTOP+1
   72 IF (INT.GT.0 .AND. INT.LE.INTIK) GO TO 74
      ISTOP=ISTOP+1
   74 IF (INP.GT.0 .AND. INP.LE.INPER) GO TO 75
      ISTOP=ISTOP+1
   75 IF (IDATWR.LE.1) WRITE (6,2110) I,INL,INT,INP
      IF (ISTOP.EQ.0) GO TO 76
      WRITE (6,3020)
      WRITE (6,3024) N,I,KA,INL,INLEN,INT,INTIK,INP,INPER
      STOP
   76 J=INP + INPER*(INT-1) + INPER*INTIK*(INL-1)
      ISTAB(I+1,N)=J
   77 CONTINUE
C
C     ORDER STRESS OUTPUT POINTS (FROM MIN TO MAX)
C
      DO 79 I=2,NPTS
      ISMIN=ISMN
      DO 78 J=I,IDUM
      IF (ISTAB(J,N).GT.ISMIN) GO TO 78
      ISMIN=ISTAB(J,N)
      KJ=J
   78 CONTINUE
      ISTAB(KJ,N)=ISTAB(I,N)
      ISTAB(I,N)=ISMIN
   79 CONTINUE
C
C     CHECK FOR DUPLICATE ENTRY
C
      DO 80 I=2,NPTS
      J=I+1
      IF (ISTAB(J,N).GT.ISTAB(I,N)) GO TO 80
      WRITE (6,3020)
      WRITE (6,3026) N
      STOP
   80 CONTINUE
C
   82 ISTAB(1,N)=NPTS
      GO TO 100
C
   84 WRITE (6,3020)
      WRITE (6,3022) K,N
      STOP
   86 WRITE (6,3020)
      WRITE (6,3028) N,NPTS,MXPTS
      STOP
C
C
C***  DATA PORTHOLE (START)
C
  100 IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) GO TO 101
      RECLAB = RECLB5
      IF (NTABS.LE.0) WRITE (LU1) RECLAB,NTABS
      IF (NTABS.GT.0) WRITE (LU1) RECLAB,NTABS,((ISTAB(I,J),
     1                J=1,NTABS),I=1,MPT)
C
C***  DATA PORTHOLE (END)
C
  101 CONTINUE
C
      IF (IDATWR.LE.1) WRITE (6,2200)
C
      N=1
      IPORT=0
      DIET=1.
      IF (IDEATH.EQ.1) DIET=-1.
      READ (5,1200) M,IELE,IS,MTYP,KG,ETIM,INTLOC
      IF (M.EQ.1) GO TO 105
      WRITE (6,2330) NG,M
      STOP
C
  104 READ (5,1200) M,IELE,IS,MTYP,KG,ETIM,INTLOC
  105 READ (5,1100) ICD,NOD
C
      IF (IELE.EQ.0) IELE=MXNODS
      IF (IELE.GT.MXNODS) GO TO 110
      IF (MTYP.LE.0) MTYP=1
      IF (MTYP.GT.NUMMAT) GO TO 120
      IF (NTABS.GT.0 .AND. IABS(IS).GT.NTABS) GO TO 130
      IF (KG.EQ.0) KG=1
      IF (IDEATH.EQ.2 .AND. ETIM.EQ.0.) ETIM=100000.
      IF (ICD.LT.0 .OR. ICD.GT.NUMNP) GO TO 140
      GO TO 150
C
C
  110 WRITE (6,2300) NG,M,IELE,MXNODS
      STOP
  120 WRITE (6,2310) NG,M,MTYP,NUMMAT
      STOP
  130 WRITE (6,2320) NG,M,IS,NTABS
      STOP
  140 WRITE (6,2340) NG,M,ICD,NUMNP
      STOP
C
C
  150 IF (M.NE.N) GO TO 175
C
C     WHEN M=N, TRANSFER ELEMENT INFORMATION
C     TO WORKING VARIABLES
C
  155 IELD=IELE
      MTYPE=MTYP
      IPST=IS
      ETIMT=ETIM
      KKK=KG
      ICDT=ICD
      INTLM=INTLOC
      DO 160 I=1,IELE
  160 NODE(I)=NOD(I)
C
C
C     SAVE THE GENERATED ELEMENT INFORMATION
C     IN ELEMENT DATA STORAGE
C
  175 K=-2
      DO 180 I=1,IELD
      K=K+3
      L=NODE(I)
      IF (L.GE.1 .AND. L.LE.NUMNP) GO TO 176
      WRITE (6,2360) NG,N,IELD,(NODE(K),K=1,IELD)
      WRITE (6,2362) NUMNP
      STOP
  176 XYZ(K  ,N)=X(L)
      XYZ(K+1,N)=Y(L)
      XYZ(K+2,N)=Z(L)
      IF (NEGSKS.GT.0) ISKEW(I,N)=NODSYS(L)
  180 CONTINUE
C
      ICDM=ICDT
      NEL=N
      IF (ICDM.NE.0) GO TO 182
      CALL EPLANE (NG,CENTER(1,N),XYZ(1,N),NODE,ICDM,1)
  182 CENTER(1,N)=X(ICDM)
      CENTER(2,N)=Y(ICDM)
      CENTER(3,N)=Z(ICDM)
      IF (ICDT.EQ.0) GO TO 185
      CALL EPLANE (NG,CENTER(1,N),XYZ(1,N),NODE,ICDM,2)
C
  185 K=0
      DO 190 I=1,IELD
      L=NODE(I)
      LL=0
      DO 190 J=1,6
      K=K+1
      LM(K,N)=0
      IF (IDOF(J).EQ.1) GO TO 190
      LL=LL+1
      LM(K,N)=ID(LL,L)
  190 CONTINUE
C
      IELT(N)=IELD
      MATP(N)=MTYPE
      IPS(N)=IPST
C
      ND=6*IELD
      CALL COLHT (HT,ND,LM(1,N))
C
      IF (INDNL.EQ.0) GO TO 200
      DO 193 I=1,NDM
  193 EDIS(I,N)=0.0
      DO 115 I=1,INSR
  115 SR(I,N)=0.0
      DO 194 I=1,2
  194 RITZ(I,N)=0.0
      DO 197 I=1,5
  197 RERIT(I,N)=0.0
      IF (IDEATH.EQ.0) GO TO 195
      ETIME(N)=DIET*ETIMT
      IF (IDEATH.NE.1) GO TO 195
      DO 192 K=1,ND
  192 EDISOL(K,N)=0.
C
  195 IF (INDNL.NE.2) GO TO 198
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
      CALL FEULER (DMINT,EULER(1,N),IELD)
C
      KK=3*IELD
      DO 196 K=1,KK
  196 ROTOLD(K,N)=0.
C
  198 IF (MODEL.EQ.1) GO TO 200
      CALL INITIM (MODEL,NINT,IDW,PROP(1,MTYPE),WA(1,N),WA(1,N))
  200 CONTINUE
C
      IF (IDATWR.GT.1) GO TO 225
      WRITE (6,2210) N,IELD,IPST,MTYPE,KKK,ETIMT,INTLM,ICDM,
     1              (NODE(I),I=1,IELD)
  225 IF (IJPORT.EQ.0 .AND. INTLM.EQ.0) GO TO 235
C
C     CALCULATE GLOBAL COORDINATES OF INTEGRATION POINTS
C
C     1. CALCULATE UNIT VECTOR IN THE T-DIRECTION
C
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
      TX=VECS(1)
      TY=VECS(2)
      TZ=VECS(3)
      DST1=SECT(1,MTYPE)
      DST2=SECT(2,MTYPE)
      KINTP=0
      TOL=1.D-9
      DO 164 LR=1,INLEN
      RINTP=GATES(LR,INLENT)
C
      CALL SHAPES (H,HR,IELD,RINTP)
C
C     2. CALCULATE TANGENT TO CENTROIDAL AXIS AT  R=RINTP
C
      IX=0
      XINTR=0.
      YINTR=0.
      ZINTR=0.
      RX=0.
      RY=0.
      RZ=0.
      DO 165 L=1,IELD
      IX=IX+3
      XINTR=XINTR + H(L)*XYZ(IX-2,N)
      YINTR=YINTR + H(L)*XYZ(IX-1,N)
      ZINTR=ZINTR + H(L)*XYZ(IX,N)
      RX=RX + HR(L)*XYZ(IX-2,N)
      RY=RY + HR(L)*XYZ(IX-1,N)
  165 RZ=RZ + HR(L)*XYZ(IX,N)
      DETR=DSQRT(RX*RX + RY*RY + RZ*RZ)
      IF (DETR.GT.TOL) GO TO 166
      WRITE (6,3030) NG,N
      STOP
  166 RX=RX/DETR
      RY=RY/DETR
      RZ=RZ/DETR
C
C     3. CALCULATE UNIT VECTOR IN THE S-DIRECTION AT  R=RINTP
C
      SX=TY*RZ - TZ*RY
      SY=TZ*RX - TX*RZ
      SZ=TX*RY - TY*RX
C
      DO 164 LS=1,INTIK
      SINT=GATES(LS,INTIKT)*DST1
      DO 164 LT=1,INPER
      TINT=GATES(LT,INPERT)*DST2
      KINTP=KINTP+1
      XYZINT(1,KINTP)=XINTR + SX*SINT + TX*TINT
      XYZINT(2,KINTP)=YINTR + SY*SINT + TY*TINT
      XYZINT(3,KINTP)=ZINTR + SZ*SINT + TZ*TINT
C
C     PRINT INTEGRATION POINT LOCATIONS  IF INTLM.GT.0
C
      IF (IDATWR.GT.1 .OR. INTLM.LE.0) GO TO 164
      WRITE (6,2208) LR,LS,LT,(XYZINT(L,KINTP),L=1,3)
  164 CONTINUE
C
C***   D A T A    P O R T H O L E    (START)
C
      RECLAB=RECLB2
      IF (IJPORT.EQ.0) GO TO 235
      WRITE (LU1) RECLAB,N,IELD,IPST,MTYPE,ETIMT,INTLM,ICDM,NODE
      RECLAB = RECLB6
      WRITE (LU1) RECLAB,NINT,((XYZINT(L,I),L=1,3),I=1,NINT)
C
C***   D A T A    P O R T H O L E    (END)
C
  235 IF (N.EQ.NUME) GO TO 250
C
C
C     GENERATE, FOR THE (N+1)ST ELEMENT, WORKING VARIABLES
C     THAT ARE DIFFERENT THAN THOSE OF THE (N)TH ELEMENT
C
C
      N=N+1
      DO 240 I=1,IELD
  240 NODE(I)=NODE(I) + KKK
C
      IF (N-M) 175,155,104
C
  250 RETURN
C
C
  360 GO TO (400,600,600,700), IND
C
C
C     A S S E M B L E   L I N E A R   E L E M E N T
C     S T I F F N E S S   M A T R I X
C
  400 CALL CINTEG (NPAR)
      ISTIF=1
C
      DO 500 N=1,NUME
C
      NEL=N
      IELD=IELT(N)
      ND=6*IELD
      NDA=ND+2
      IDIM=(ND+1)*ND/2
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
      IF (ICODE.EQ.1) GO TO 500
C
      MTYPE=MATP(N)
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
C
      DO 410 IAS=1,NDA
      DO 410 JAS=1,NDA
  410 AS(IAS,JAS) = 0.0
C
      CALL LINSTF (XYZ(1,N),CENTER(1,N),SECT(1,MTYPE),PROP(1,MTYPE),AS,
     1             1)
      CALL SCTOR (AS,S,SR(1,N),XEI,RIT,RERIT,ND,INDNL,1)
C
      IF (NEGSKS.EQ.0)     GO TO 440
      IF (ISKEW(1,N).LT.0) GO TO 440
      J=-1
      DO 430 I=1,IELD
      J=J+2
      ILSK(J  )=ISKEW(I,N)
      ILSK(J+1)=ILSK(J)
  430 CONTINUE
      ITELD=2*IELD
      CALL ATKA (RSDCOS,S,ILSK,ITELD,3)
  440 CONTINUE
C
      CALL ADDBAN (A(N2),A(N1),S,RE,LM(1,N),ND,1)
  500 CONTINUE
C
      RETURN
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   A S E M B L E   M A S S   M A T R I C E S                       .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
  600 IF (IMASS.EQ.2) GO TO 625
C
C
C     LUMPED MASS DISCRETIZATION
C
      DO 620 N=1,NUME
      MTYPE=MATP(N)
      IF (DEN(MTYPE).EQ.0.) GO TO 620
C
      NEL=N
      IELD=IELT(N)
      ND=6*IELD
C
      CALL CELMAS (XYZ(1,N),SECT(1,MTYPE),DEN(MTYPE),S)
C
      CALL ADDMA (A(N4),S,LM(1,N),ND)
C
  620 CONTINUE
C
      RETURN
C
C
C     CONSISTENT MASS DISCRETIZATION
C
  625 DO 650 N=1,NUME
C
      MTYPE=MATP(N)
      IF (DEN(MTYPE).EQ.0.) GO TO 650
      IELD=IELT(N)
      ND=6*IELD
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
      IF (ICODE.EQ.1) GO TO 650
C
      IDIM=(ND*(ND+1))/2
      DO 626 I=1,IDIM
  626 S(I)=0.
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
      CALL CELMAS (XYZ(1,N),SECT(1,MTYPE),DEN(MTYPE),S)
C
      IF (NEGSKS.EQ.0)     GO TO 640
      IF (ISKEW(1,N).LT.0) GO TO 640
      J=-1
      DO 630 I=1,IELD
      J=J+2
      ILSK(J  )=ISKEW(I,N)
      ILSK(J+1)=ILSK(J)
  630 CONTINUE
      ITELD=2*IELD
      CALL ATKA (RSDCOS,S,ILSK,ITELD,3)
  640 CONTINUE
C
      CALL ADDBAN (A(N2),A(N1),S,RE,LM(1,N),ND,1)
C
  650 CONTINUE
C
C
      RETURN
C
C
C
C     A S S E M B L E   N O N L I N E A R   E L E M E N T
C     S T I F F N E S S   M A T R I X   A N D   L O A D   V E C T O R
C
C
  700 CALL CINTEG (NPAR)
      NINT=INLEN*INTIK*INPER
      IPSA=1
C
      MADR=N5
      ISTIF=0
      IF (ICOUNT.EQ.3) GO TO 702
      MADR=N3
      IF (IREF.EQ.0) ISTIF=1
  702 CONTINUE
C
      DO 750 N=1,NUME
C
      NEL=N
      IELD=IELT(N)
      ND=6*IELD
      NDA=ND+2
      IDIM=(ND+1)*ND/2
C
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
      IF (ICODE.EQ.1) IELCPL=IELCPL+1
      IF (ICODE.EQ.1) GO TO 750
C
      ISKEL=0
      IF (NEGSKS.EQ.0)     GO TO 705
      IF (ISKEW(1,N).LT.0) GO TO 705
      ISKEL=1
      ITELD=2*IELD
      J=-1
      DO 703 I=1,IELD
      J=J+2
      ILSK(J  )=ISKEW(I,N)
      ILSK(J+1)=ILSK(J)
  703 CONTINUE
C
  705 IF (IDEATH.EQ.0) GO TO 715
      ETIM=DABS(ETIME(N))
      IF (IDEATH.EQ.2) GO TO 710
      IF (TIME.LT.ETIM) GO TO 750
      IF (ETIME(N).GE.0.) GO TO 715
      ETIME(N)=ETIM
      DO 706 K=1,ND
      I=LM(K,N)
      IF (I.EQ.0) GO TO 706
      IF (I.LT.0) I=NEQ - I
      EDISOL(K,N)=X(I)
  706 CONTINUE
      GO TO 715
C
  710 IF (TIME.GT.ETIM) GO TO 750
C
  715 DO 720 K=1,ND
      RE(K)=0.
      EDISE(K)=0
      XEI(K)=0.0
      I=LM(K,N)
      IF (I) 717,720,718
  717 I=NEQ - I
  718 XEI(K)=EDIS(K,N)
      EDISE(K)=X(I)
  720 CONTINUE
      RE(ND+1) = 0.0
      RE(ND+2) = 0.0
C
      IF (IDEATH.NE.1) GO TO 725
      DO 724 K=1,ND
      EDISE(K)  = EDISE(K)  - EDISOL(K,N)
  724 CONTINUE
C
  725 IF (ISKEL.EQ.0) GO TO 722
      CALL DIRCOS (RSDCOS,EDISE,ILSK,ITELD,3,1)
C
  722 MTYPE=MATP(N)
      DO 723 K=1,ND
  723 XEI(K) = EDISE(K)  - XEI(K)
      DO 660 K=1,INSR
  660 SRE(K)=SR(K,N)
      DO 662 K=1,5
  662 RERITE(K)=RERIT(K,N)
      RITZE(1)=RITZ(1,N)
      RITZE(2)=RITZ(2,N)
C
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
      CALL NEWCOS(EULER(1,N),ROTOLD(1,N),EDISE,INDNL)
      CALL SCTOR (AS,S,SRE,XEI,RIT,RERITE,ND,INDNL,2)
C
C     OBTAIN TOTAL RITZ FUNCTION DISPLACEMENTS
      RITZE(1)  = RITZ(1,N) + RIT(1)
      RITZE(2)  = RITZ(2,N) + RIT(2)
C
      IF (ISTIF.EQ.0) GO TO 727
      DO 726 IAS=1,NDA
      DO 726 JAS=1,NDA
  726 AS(IAS,JAS) = 0.0
  727 CONTINUE
C
      CALL NONSTF (XYZ(1,N),CENTER(1,N),SECT(1,MTYPE),PROP(1,MTYPE),
     1             WA(1,N),IDW,AS,ISTAB(1,IPSA),EDISE,RITZE,
     2             SRE,RERITE,S)
C
      IF (ISKEL.EQ.0) GO TO 728
      CALL DIRCOS (RSDCOS,RE,ILSK,ITELD,3,2)
  728 CALL ADDBAN (A(MADR),A(N1),S,RE,LM(1,N),ND,2)
C
      IF (ISTIF.EQ.0) GO TO 740
      IF (ISKEL.EQ.0) GO TO 730
      CALL ATKA (RSDCOS,S,ILSK,ITELD,3)
  730 CALL ADDBAN (A(N4),A(N1),S,RE,LM(1,N),ND,1)
C
  740 IF (IUPDT.NE.0) GO TO 744
      DO 746 K=1,24
  746 EDIS(K,N)=EDISE(K)
      DO 760 K=1,INSR
  760 SR(K,N)=SRE(K)
      DO 762 K=1,5
  762 RERIT(K,N)=RERITE(K)
      RITZ(1,N)=RITZE(1)
      RITZ(2,N)=RITZE(2)
C
  744 IF (INDNL.NE.2 .OR. IUPDT.NE.0) GO TO 750
      CALL FEULER (DMT,EULER(1,N),IELD)
      KELD=3*IELD
      DO 742 K=1,KELD
  742 ROTOLD(K,N)=ROTOLD(K,N)+ROTIN(K)
C
  750 CONTINUE
C
      IF (IELCPL.EQ.NUME) IELCPL=-1
C
      RETURN
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   L I N E A R   S T R E S S   C A L C U L A T I O N               .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
  800 ISTIF=0
C
C***  DATA PORTHOLE (START)
C
      RECLAB = RECLB3
      IF (JNPORT.NE.0 .AND. KPLOTE.EQ.0)
     1  WRITE (LU1) RECLAB,NG,(NPAR(I),I=1,20),KSTEP,TIME,NEGL,NSUB
C
C***  DATA PORTHOLE (END)
C
C
      IF (INDNL.GT.0) GO TO 900
      CALL CINTEG (NPAR)
      DO 805 N=1,NUME
      IF (IPS(N).EQ.0) GO TO 805
      INUM=N
      IF (IPRI.NE.0) GO TO 810
      WRITE (6,2500) NG
      IF (NTABS.LT.0) WRITE (6,2550)
      IF (NTABS.GE.0 .AND. ISECT.EQ.IRECT) WRITE (6,2650)
      GO TO 810
  805 CONTINUE
      RETURN
C
  810 DO 875 N=INUM,NUME
      IPSA=IABS(IPS(N))
      IF (IPSA.EQ.0) GO TO 875
      IELD=IELT(N)
      ND=6*IELD
      NDA=ND+2
      IDIM=(ND+1)*ND/2
C
      MTYPE=MATP(N)
C
      DO 822 I=1,ND
      K=LM(I,N)
      XEI(I)=0.0
      IF (K) 818,822,819
  818 K=NEQ - K
  819 XEI(I)=X(K)
  822 CONTINUE
C
C     ROTATE XEI FROM NODAL (RST) TO GLOBAL (XYZ) SYSTEM
C
      IF (NEGSKS.EQ.0)     GO TO 828
      IF (ISKEW(1,N).LT.0) GO TO 828
      J=-1
      DO 825 I=1,IELD
      J=J+2
      ILSK(J  )=ISKEW(I,N)
      ILSK(J+1)=ILSK(J)
  825 CONTINUE
      ITELD=2*IELD
      CALL DIRCOS(RSDCOS,XEI,ILSK,ITELD,3,1)
  828 CONTINUE
C
      JPT=2
      ISTOP=0
      IF (NTABS.GE.0) GO TO 880
      DO 876 I=1,ND
  876 RE(I)=0.
  880 CONTINUE
C
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
C
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   RECTANGULAR CROSS-SECTION                   .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
      DEPH=SECT(1,MTYPE)
      WIDH=SECT(2,MTYPE)
C
      IPT=0
C
      NDB=ND+1
      DO 883 IAS=1,NDA
      DO 883 JAS=NDB,NDA
  883 AS(IAS,JAS)=0.0
      CALL LINSTF (XYZ(1,N),CENTER(1,N),SECT(1,MTYPE),PROP(1,MTYPE),AS,
     1             2)
C
C     CALCULATION OF TORSION RITZ FUNCTION COEFFICIENTS BY USING
C     THE LAST TWO ROWS OF THE UNCONDENSED ELEMENT STIFFNESS MATRIX.
C
      TEMP1=0.0
      TEMP2=0.0
      DO 884 IAS=1,ND
      TXEI=XEI(IAS)
      TEMP1 = TEMP1 - AS(IAS,NDB)*TXEI
  884 TEMP2 = TEMP2 - AS(IAS,NDA)*TXEI
      DAS = AS(NDB,NDB)*AS(NDA,NDA) - AS(NDB,NDA)*AS(NDB,NDA)
      RIT(1) = ( AS(NDA,NDA)*TEMP1 - AS(NDB,NDA)*TEMP2)/DAS
      RIT(2) = (-AS(NDB,NDA)*TEMP1 + AS(NDB,NDB)*TEMP2)/DAS
C
      IPT=0
      DO 890 INL=1,INLEN
      RX=GATES(INL,INLENT)
      WX=WATES(INL,INLENT)
      CALL SHAPES (H,HR,IELD,RX)
      DO 886 INT=1,INTIK
      RY=GATES(INT,INTIKT)
      WYWX=WX*WATES(INT,INTIKT)
      DSH=DEPH*RY
      DO 882 INP=1,INPER
      IPT=IPT+1
      IF (NTABS.LE.0) GO TO 881
      IF (ISTAB(JPT,IPSA).NE.IPT) GO TO 882
      IF (JPT.GT.ISTAB(1,IPSA)) ISTOP=1
      JPT=JPT+1
C
  881 RZ=GATES(INP,INPERT)
      WAT=WYWX*WATES(INP,INPERT)
      WTH=WIDH*RZ
C
      CALL IPTCOS (XYZ(1,N),DMINT,VECS,XJI,DET,DC)
      CALL BLNODE(B,BS,DMINT,DUMY)
C
C        CALCULATION OF STRAINS AND STRESSES
C
      DO 985 KI=1,3
      EPSDUM=0.0
      DO 990 KJ=1,ND
  990 EPSDUM=EPSDUM + B(KI,KJ)*XEI(KJ)
      EPSDUM=EPSDUM + RIT(1)*B(KI,NDB) + RIT(2)*B(KI,NDA)
  985 STRAIN(KI)=EPSDUM
      STRESS(1)=PROP(1,MTYPE)*STRAIN(1)
      STRESS(2)=PROP(2,MTYPE)*STRAIN(2)
      STRESS(3)=PROP(2,MTYPE)*STRAIN(3)
C
C
      IF (NTABS) 885,840,842
  840 IF (IPT-1) 845,845,850
  842 IF (JPT-3) 845,845,850
  845 IF (IPRI.EQ.0) WRITE (6,2400) N
  850 IF (IPRI.EQ.0) WRITE (6,2402) INL,INT,INP,STRESS
      IF (IPRI.EQ.0 .AND. IPS(N).LT.0)  WRITE (6,2410)  STRAIN
C
C***  DATA PORTHOLE (START)
C
      RECLAB = RECLB4
      IF (JNPORT.EQ.1 .AND. KPLOTE.EQ.0)
     1  WRITE (LU1) RECLAB,N,INL,INT,INP,(STRESS(I),I=1,3),
     2              (STRAIN(I),I=1,3)
C
C***  DATA PORTHOLE (END)
C
      IF (ISTOP) 882,882,875
C
  885 FACT=WAT*DET
      DO 889 I=1,NDA
      REDUM=0.
      DO 887 J=1,3
  887 REDUM=REDUM + B(J,I)*STRESS(J)
  889 RE(I)=RE(I) + FACT*REDUM
C
  882 CONTINUE
  886 CONTINUE
  890 CONTINUE
C
      IF (NTABS.GE.0) GO TO 875
C
C     ROTATE TO LOCAL SYSTEM
C
      DO 838 I=1,IELD
      L=9*(I-1) + 1
      K= 6*(I-1)+1
      CALL DIRCOS (DMINT(L),RE(K  ),1,1,3,2)
      CALL DIRCOS (DMINT(L),RE(K+3),1,1,3,2)
  838 CONTINUE
      IF (IPRI.NE.0) GO TO 865
C
      WRITE (6,2450) N
      DO 862 I=1,IELD
      J=6*(I-1) + 1
      JJ=J+5
  862 WRITE (6,2460) I,(RE(KJ),KJ=J,JJ)
C
C***  DATA PORTHOLE (START)
C
  865 RECLAB = RECLB4
      IF (JNPORT.NE.0 .AND. KPLOTE.EQ.0)
     1  WRITE (LU1) RECLAB,N,ND,(RE(I),I=1,ND)
C
C***  DATA PORTHOLE (END)
C
  875 CONTINUE
C
      RETURN
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   N O N L I N E A R   S T R E S S   C A L C U L A T I O N         .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
  900 CALL CINTEG (NPAR)
      NINT=INLEN*INTIK*INPER
      DO 905 N=1,NUME
      IF (IPS(N).EQ.0) GO TO 905
      INUM=N
      IF (IPRI.NE.0) GO TO 910
      WRITE (6,2500) NG
      IF (NTABS.GE.0) GO TO 902
      WRITE (6,2550)
      GO TO 910
  902 IF (MODEL.GT.1) GO TO 904
      IF (ISECT.EQ.IRECT) WRITE (6,2650)
      GO TO 910
  904 IF (ISECT.EQ.IRECT) WRITE (6,2660)
      GO TO 910
  905 CONTINUE
      RETURN
C
  910 DO 975 N=INUM,NUME
      NEL=N
      IPST=IPS(N)
      IPSA=IABS(IPST)
      IF (IPSA.EQ.0) GO TO 975
      IELD=IELT(N)
      ND=6*IELD
      NDA=ND+2
      IDIM=(ND+1)*ND/2
      ISKEL=0
      IF (NEGSKS.EQ.0)     GO TO 935
      IF (ISKEW(1,N).LT.0) GO TO 935
      ISKEL=1
      ITELD=2*IELD
      J=-1
      DO 925 I=1,IELD
      J=J+2
      ILSK(J  )=ISKEW(I,N)
      ILSK(J+1)=ILSK(J)
  925 CONTINUE
C
  935 IF (IDEATH.EQ.0) GO TO 960
      ETIM=DABS(ETIME(N))
      IF (IDEATH.EQ.2) GO TO 955
      IF (TIME.LT.ETIM) GO TO 975
      IF (ETIME(N).GE.0.) GO TO 960
      ETIME(N)=ETIM
      DO 936 K=1,ND
      I=LM(K,N)
      IF (I) 929,936,930
  929 I=NEQ - I
  930 EDISOL(K,N)=X(I)
  936 CONTINUE
      GO TO 960
C
  955 IF (TIME.GT.ETIM) GO TO 975
C
  960 DO 965 K=1,ND
      I=LM(K,N)
      XEI(K)=0.0
      IF (I) 962,965,963
  962 I=NEQ - I
  963 XEI(K)=EDIS(K,N)
      EDIS(K,N)=X(I)
  965 CONTINUE
  966 IF (IDEATH.NE.1) GO TO 970
      DO 968 K=1,ND
      EDIS(K,N)=EDIS(K,N) - EDISOL(K,N)
  968 CONTINUE
  970 IF (ISKEL.EQ.0) GO TO 972
      CALL DIRCOS (RSDCOS,EDIS(1,N),ILSK,ITELD,3,1)
  972 CONTINUE
      DO 980 K=1,ND
      XEI(K)=EDIS(K,N) - XEI(K)
  980 CONTINUE
C
      JPT=2
      IF (NTABS.GE.0) GO TO 950
      DO 940 I=1,NDA
  940 RE(I)=0.
  950 CONTINUE
C
      MTYPE=MATP(N)
      CALL NODCOS (XYZ(1,N),CENTER(1,N),DMINT,VECS)
      CALL NEWCOS(EULER(1,N),ROTOLD(1,N),EDIS(1,N),INDNL)
C
      CALL SCTOR (AS,S,SR(1,N),XEI,RIT,RERIT,ND,INDNL,2)
      RITZ(1,N) = RITZ(1,N) + RIT(1)
      RITZ(2,N) = RITZ(2,N) + RIT(2)
C
      CALL NONSTF (XYZ(1,N),CENTER(1,N),SECT(1,MTYPE),PROP(1,MTYPE),
     1             WA(1,N),IDW,AS,ISTAB(1,IPSA),EDIS(1,N),
     1             RITZ(1,N),SR(1,N),RERIT(1,N),S)
C
  975 CONTINUE
C
C
      RETURN
C
C
 1010 FORMAT (I5,3F10.0)
 1012 FORMAT (8F10.0)
 1100 FORMAT (16I5)
 1200 FORMAT (2I5,5X,3I5,F10.0,I5)
 2000 FORMAT (////37H M A T E R I A L    C O N S T A N T S)
 2010 FORMAT (//22H S E T   N U M B E R =,I5//4X,
     1        23H DENSITY. . . . . . . =,E16.6/)
 2015 FORMAT (4X,23H DEPTH. . . . . . . . =,E16.6/4X,
     1        23H WIDTH. . . . . . . . =,E16.6/)
 2050 FORMAT (4X,23H YOUNG*S MODULUS. . . =,E16.6/4X,
     1        23H POISSON*S RATIO. . . =,E16.6/)
 2060 FORMAT (4X,23H YOUNG*S MODULUS. . . =,E16.6/
     1        4X,23H POISSON*S RATIO. . . =,E16.6/
     2        4X,23H YIELD STRESS . . . . =,E16.6/
     3        4X,23H ET . . . . . . . . . =,E16.6)
 2100 FORMAT (///40H S T R E S S   O U T P U T   T A B L E S)
 2105 FORMAT (// 20H TABLE NUMBER......=,I3/20H NUMBER OF POINTS..=,I3//
     1        4X,24H POINT     INL  INT  INP/)
 2110 FORMAT (I9,3X,3I5)
 2200 FORMAT (///38H E L E M E N T   I N F O R M A T I O N//
     1 6H     M,2X,5H IELD,2X,5H  IPS,2X,5H MTYP,2X,5H   KG,5X,
     2 5HETIME,5X,6HINTLOC,14X,2HKK,3X,
     3 37HNODE(1)   NODE(2)   NODE(3)   NODE(4)/
     4 52X,17HINTEGRATION POINT,14X,19HGLOBAL  COORDINATES/
     5 52X,17HINR    INS    INT,10X,1HX,12X,1HY,12X,1HZ)
 2210 FORMAT (/I6,2X,4(I5,2X),E11.4,2X,I4,13X,I5,4X,I5,3(5X,I5))
 2208 FORMAT (52X,I2,2(5X,I2),5X,E11.4,2(2X,E11.4))
 2300 FORMAT (///16H ELEMENT GROUP =,I2,18H  (ISO-BEAM/CUTEL)  /
     1        17H ELEMENT NUMBER =,I4/
     2        7H IELD =,I3,26H IS GREATER THAN NPAR(7) =,I3/
     3        5H STOP)
 2310 FORMAT (///16H ELEMENT GROUP =,I2,18H  (ISO-BEAM/CUTEL)  /
     1        17H ELEMENT NUMBER =,I4/
     2        7H MTYP =,I3,27H IS GREATER THAN NPAR(16) =,I3/5H STOP)
 2320 FORMAT (///16H ELEMENT GROUP =,I2,18H  (ISO-BEAM/CUTEL)  /
     1        17H ELEMENT NUMBER =,I4/
     2        7H IPS  =,I3,27H IS GREATER THAN NPAR(13) =,I3/5H STOP)
 2330 FORMAT (///16H ELEMENT GROUP =,I2,18H  (ISO-BEAM/CUTEL)  /
     1        17H ELEMENT NUMBER =,I4/
     2 55H ELEMENT INFORMATION MUST START WITH ELEMENT NUMBER = 1//
     3        8H S T O P)
 2340 FORMAT (///30H ***  I N P U T   E R R O R  -//
     1        29H DETECTED BY SUBROUTINE CUTEL/
     2        33H WHILE READING ELEMENT GROUP DATA//
     3        5X,17H ELEMENT GROUP  =,I5/
     4        5X,17H ELEMENT NUMBER =,I5/
     5        5X,17H AUXILIARY NODE =,I5//
     6        29H AUXILIARY NODE (ICD) MUST BE/
     7        24H IN THE RANGE (0,NUMNP=,I5,2H).//8H S T O P)
 2360 FORMAT (///30H ***  I N P U T   E R R O R  -//
     1        29H DETECTED BY SUBROUTINE CUTEL/
     2        33H WHILE READING ELEMENT GROUP DATA//
     3        5X,17H ELEMENT GROUP  =,I5/
     4        5X,17H ELEMENT NUMBER =,I5/
     5        5X,17H NUMBER OF NODES=,I5/
     6        5X,17H NODE NUMBERS   =,4I5)
 2362 FORMAT (/37H NODE NUMBERS FOR THE ELEMENT MUST BE/
     1        24H IN THE RANGE (1, NUMNP=,I5,2H).//8H S T O P)
 2400 FORMAT (/I6)
 2402 FORMAT (7X,3I7,6X,3E16.6,E18.6,8X,A2,A6)
 2410 FORMAT (36X,3E16.6/)
 2450 FORMAT (I6)
 2460 FORMAT (10X,I4,2X,3E16.6,2X,3E16.6)
 2500 FORMAT (1H1,48HS T R E S S   C A L C U L A T I O N S   F O R     ,
     1        27HE L E M E N T   G R O U P  ,I5,13H   (ISO-BEAM))
 2550 FORMAT (/
     1 61H ELEMENT FORCES ARE CALCULATED IN THE LOCAL COORDINATE SYSTEM/
     2        /8H ELEMENT/8H  NUMBER,10H   NODE   ,6X,
     3         8H FORCE-R,8X,8H FORCE-S,8X,8H FORCE-T,10X,
     4         8HMOMENT-R,8X,8HMOMENT-S,8X,8HMOMENT-T  /)
 2650 FORMAT (/
     1 60H STRESSES ARE CALCULATED IN THE LOCAL COORDINATE SYSTEM     //
     2        8H ELEMENT,4X,17HINTEGRATION POINT,12X,9HSTRESS-RR,
     3        7X,9HSTRESS-RS,7X,9HSTRESS-RT/
     5        8H  NUMBER,4X,17HINR----INS----INT,12X,9HSTRAIN-RR,
     5        7X,9HSTRAIN-RS,7X,9HSTRAIN-RT)
 2660 FORMAT (/
     1 60H STRESSES ARE CALCULATED IN THE LOCAL COORDINATE SYSTEM     //
     2        8H ELEMENT,4X,17HINTEGRATION POINT,12X,9HSTRESS-RR,
     3        7X,9HSTRESS-RS,7X,9HSTRESS-RT,7X,17HEQUIVALENT STRESS,
     4        3X,12HSTRESS STATE/
     5        8H  NUMBER,4X,17HINR----INS----INT,12X,9HSTRAIN-RR,
     5        7X,9HSTRAIN-RS,7X,9HSTRAIN-RT)
C
 3010 FORMAT (///24H I N P U T   E R R O R -/
     1        29H DETECTED BY SUBROUTINE CUTEL/
     1 55H WHILE READING MATERIAL PROPERTY SETS FOR ELEMENT GROUP,I5/)
 3012 FORMAT (34H SETS ARE NOT IN ASCENDING ORDER -/
     1        5X,15H SET EXPECTED =,I5/
     1        5X,15H SET READ     =,I5/
     3       /8H S T O P)
 3020 FORMAT (///24H I N P U T   E R R O R -/
     1        29H DETECTED BY SUBROUTINE CUTEL/
     2 53H WHILE READING STRESS OUTPUT TABLES FOR ELEMENT GROUP,I5/)
 3022 FORMAT (36H TABLES ARE NOT IN ASCENDING ORDER -/
     1        5X,17H TABLE EXPECTED =,I5/5X,17H TABLE READ     =,I5//
     2        8H S T O P)
 3024 FORMAT (5X,15H TABLE NUMBER =,I5/5X,15H ENTRY NUMBER =,I5/
     2        5X,15H ENTRY        =,I5//
     2 55H REQUESTED STRESS OUTPUT POINT IS OUTSIDE RANGE OF     /
     3 55H INTEGRATION PARAMETERS -                              //
     4        5X,6H INL =,I5,29H    SHOULD BE IN (1,NPAR( 9)=,I2,1H)/
     4        5X,6H INT =,I5,29H    SHOULD BE IN (1,NPAR(10)=,I2,1H)/
     4        5X,6H INP =,I5,29H    SHOULD BE IN (1,NPAR(11)=,I2,1H)/
     5        /8H S T O P)
 3026 FORMAT (5X,15H TABLE NUMBER =,I5/5X,
     1        41H DUPLICATE ENTRY IN TABLE IS NOT ALLOWED.//8H S T O P)
 3028 FORMAT (5X,15H TABLE NUMBER =,I5/
     1        5X,41H NUMBER OF POINTS IN THIS TABLE  (NPTS) =,I5/
     2        /34H NPTS MUST BE LESS THAN NPAR(14) =,I3,1H.//8H S T O P)
 3030 FORMAT (///14H  *** STOP ***  //
     1           15H ELEMENT GROUP=  ,I5/12H ELEMENT NO. ,I5/
     2           32H ERROR IN ELEMENT CONFIGURATION   )
 3401 FORMAT (//50H INPUT ERROR DETECTED IN (CUTEL/ISOBEAM)           //
     1          19H ELEMENT GROUP NO =,I5/
     2          27H MATERIAL PROPERTY SET NO =,I5/
     3          38H ZERO OR NEGATIVE INITIAL YIELD STRESS   //)
 3402 FORMAT (//50H INPUT ERROR DETECTED IN (CUTEL/ISOBEAM)           //
     1          19H ELEMENT GROUP NO =,I5/
     2          27H MATERIAL PROPERTY SET NO =,I5/
     3          44H HARDENING MODULUS (ET) GREATER OR EQUAL TO   ,
     5          44H YOUNG*S MODULUS (E) IS NOT ALLOWED           //)
 3403 FORMAT (//50H INPUT ERROR ON MATERIAL PROPERTIES               //
     1          15H *** STOP ***    //)
C
      END
C *CDC* *DECK EPLANE
C *UNI* )FOR,IS N.EPLANE,R.EPLANE
      SUBROUTINE EPLANE (NG,CENTER,XYZ,NODE,ICDM,KIN)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   PROGRAM                                                         .
C .      . KIN=1   TO DETERMINE THE AUXILIARY NODE (ICDM=0)           .
C .      . KIN=2   TO DETERMINE WHETHER THE ELEMENT LIES IN A PLANE   .
C .                (IN THIS CASE, ICDM IS PROVIDED BY USER)           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
C
C     AA(1)   VECTOR FROM NODE 1  TO  NODE 2
C     AA(4)   VECTOR FROM NODE 2  TO  NODE 3
C     AA(7)   VECTOR FROM NODE 3  TO  NODE 4
C
      DIMENSION CENTER(3),XYZ(3,1),NODE(4)
      DIMENSION AA(9),AC(3),AD(3),DL(3)
C
      DIMENSION LNODE(4,3)
      DATA LNODE /1,2,0,0, 1,3,2,0, 1,3,4,2/
C
C
      IF (KIN.EQ.2) GO TO 5
      IF (IELD.EQ.2) GO TO 100
C
    5 ILM=IELD-1
      K=0
      DO 20 I=1,ILM
      NA=LNODE(I  ,ILM)
      NB=LNODE(I+1,ILM)
      DL(I)=0.D0
      DO 10 J=1,3
      K=K+1
      AA(K)=XYZ(J,NB) - XYZ(J,NA)
   10 DL(I)=DL(I) + AA(K)**2
      DL(I)=DSQRT(DL(I))
   20 CONTINUE
C
      DO 25 I=1,ILM
      IF (DL(I).LT.1.0D-08) GO TO 200
   25 CONTINUE
C
      IF (KIN.EQ.2) GO TO 600
C
      CALL CROSS (AA(1),AA(4),AC)
      DC=DSQRT(AC(1)**2 + AC(2)**2 + AC(3)**2)
      SANG=DC/(DL(1)*DL(2))
      IF (SANG.LT.1.0D-08) GO TO 50
      NA=LNODE(3,ILM)
      ICDM=NODE(NA)
      IF (IELD.EQ.4) GO TO 75
C
      RETURN
C
C     FIRST (3) NODES ARE ON A STRAIGHT LINE - CHECK NODE 4
C
   50 IF (IELD.EQ.3) GO TO 300
      CALL CROSS (AA(4),AA(7),AD)
      DD=DSQRT(AD(1)**2 + AD(2)**2 + AD(3)**2)
      SANG=DD/(DL(2)*DL(3))
      IF (SANG.LT.1.0D-08) GO TO 300
      NA=LNODE(4,ILM)
      ICDM=NODE(NA)
C
      RETURN
C
   75 DOT=AC(1)*AA(7) + AC(2)*AA(8) + AC(3)*AA(9)
      CANG=DABS(DOT)/(DC*DL(3))
      IF (CANG.GT.1.0D-06) GO TO 400
C
      RETURN
C
C
C     E R R O R   M E S S A G E S   F O R   KIN = 1
C
C     2-NODE ELEMENT
  100 WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2100)
      STOP
C
C     ZERO LENGTH BETWEEN NODES
  200 WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2200)
      STOP
C
C     STRAIGHT ELEMENT
  300 WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2300)
      STOP
C
C     ELEMENT NOT IN A PLANE
  400 WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2400)
      STOP
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   KIN=2                                       .
C .   CHECK WHETHER ELEMENT IS IN PLANE           .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     AC = VECTOR FROM (ICDM) TO NODE 1
C
  600 AC(1)=XYZ(1,1) - CENTER(1)
      AC(2)=XYZ(2,1) - CENTER(2)
      AC(3)=XYZ(3,1) - CENTER(3)
      DC=DSQRT(AC(1)**2 + AC(2)**2 + AC(3)**2)
      IF (DC.GT.1.0D-08) GO TO 620
C
      WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2600) ICDM,CENTER
      WRITE (6,2610)
      STOP
C
C
  620 CALL CROSS (AA,AC,AD)
      DD=DSQRT(AD(1)**2 + AD(2)**2 + AD(3)**2)
      SANG=DD/(DL(1)*DC)
      IF (SANG.GT.1.0D-08) GO TO 650
C
      WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2600) ICDM,CENTER
      WRITE (6,2620) LNODE(2,ILM)
      STOP
C
C
C     ICD, NODES 1  AND  2  DETERMINE A PLANE -
C     SEE IF NODE 3 IS IN THAT PLANE
C
  650 IF (IELD.EQ.2) GO TO 800
      DOT=AA(4)*AD(1) + AA(5)*AD(2) + AA(6)*AD(3)
      CANG=DABS(DOT)/(DL(2)*DD)
      IF (CANG.LT.1.0D-06) GO TO 675
      GO TO 700
C
C     SEE IF NODE 4 IS IN THE PLANE
C
  675 IF (IELD.EQ.3) GO TO 800
      DOT=AA(7)*AD(1) + AA(8)*AD(2) + AA(9)*AD(3)
      CANG=DABS(DOT)/(DL(3)*DD)
      IF (CANG.LT.1.D-06) GO TO 800
C
C     E R R O R -
C     ELEMENT DOES NOT LIE IN A PLANE
C
  700 WRITE (6,2000) NG,NEL,IELD,ICDM,(NODE(K),(XYZ(I,K),I=1,3),
     1               K=1,IELD)
      WRITE (6,2600) ICDM,CENTER
      WRITE (6,2400)
      STOP
  800 RETURN
C
C
 2000 FORMAT (///29H ***  I N P U T   E R R O R -/
     1        30H DETECTED BY SUBROUTINE EPLANE/
     2        45H WHILE READING ELEMENT INFORMATION   (ISOBM)   //
     3        17H ELEMENT GROUP  =,I5/
     3        17H ELEMENT NUMBER =,I5/
     3        17H NUMBER OF NODES=,I5/
     4        17H AUXILIARY NODE =,I5//
     5        //44H ELEMENT NODAL COORDINATES ARE GIVEN BELOW -//
     6        6H  NODE,15X,1HX,15X,1HY,15X,1HZ//(I6,3E16.6))
 2100 FORMAT (//49H FOR 2-NODE ELEMENT, AUXILIARY NODE (ICD) MUST BE,
     1        11H SPECIFIED.///12H *** S T O P)
 2200 FORMAT (//46H ELEMENT NODES OCCUPY THE SAME POINT IN SPACE.///
     1        12H *** S T O P)
 2300 FORMAT (//51H THIS IS A STRAIGHT ELEMENT, AND THE AUXILIARY NODE,
     1        24H (ICD) MUS BE SPECIFIED.///12H *** S T O P)
 2400 FORMAT (//38H THIS ELEMENT DOES NOT LIE IN A PLANE.///
     1        12H *** S T O P)
 2600 FORMAT (/I5,3E16.6)
 2610 FORMAT (//40H AUXILIARY NODE LOCATION COINCIDES WITH     /
     1          20H ELEMENT NODE 1                             //
     2          15H *** STOP ***                               //)
 2620 FORMAT (//39H AUXILIARY NODE AND ELEMENT NODES 1 AND,I1,
     1        24H LIE ON A STRAIGHT LINE.///12H *** S T O P)
C
      END
C *CDC* *DECK CINTEG
C *UNI* )FOR,IS N.CINTEG,R.CINTEG
      SUBROUTINE CINTEG (NPAR)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   PROGRAM                                                         .
C .      . TO CALCULATE INTEGRATION SUBSCRIPTS,                       .
C .        GIVEN THE NPAR VECTOR                                      .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION NPAR(20)
C
      COMMON /CINT/ IMLEN,INLEN,INLENT,IMTIK,INTIK,INTIKT,
     1              INPER,INPERT,WZ
      DATA IRECT /1/
C
      IMLEN=1
      INLEN=NPAR(9)
      IF (INLEN.GT.0)  GO TO 10
      IMLEN=2
      INLEN=-INLEN
   10 INLENT=INLEN
      IF (IMLEN.EQ.2) INLENT=4+(INLEN-1)/2
C
      IMTIK=1
      INTIK=NPAR(10)
      IF (INTIK.GT.0) GO TO 20
      IMTIK=2
      INTIK=-INTIK
   20 INTIKT=INTIK
      IF (IMTIK.EQ.2) INTIKT=4+(INTIK-1)/2
C
C
      IMPER=1
      INPER=NPAR(11)
      IF (INPER.GT.0) GO TO 30
      IMPER=2
      INPER=-INPER
   30 INPERT=INPER
      IF (IMPER.EQ.2) INPERT=4 + (INPER-1)/2
C
      RETURN
C
C
      END
C *CDC* *DECK INITIM
C *UNI* )FOR,IS N.INITIM,R.INITIM
      SUBROUTINE INITIM (MODEL,NINT,IDW,PROP,WA,IWA)
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /DPR/ ITWO
      DIMENSION PROP(1),WA(1),IWA(1)
C
      K=0
      ILAS=IDW-2
      DO 25 I=1,NINT
      DO 10 J=1,ILAS
      K=K+1
   10 WA(K)=0.
      K=K+1
      WA(K)=(PROP(3)**2)/3.
      K=K+1
      KK=ITWO*(K-1) + 1
      IWA(KK)=1
   25 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK CELMAS
C *UNI* )FOR,IS N.CELMAS,R.CELMAS
      SUBROUTINE CELMAS (XYZ,SECT,DEN,S)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   P R O G R A M                                                   .
C .       . TO CALCULATE THE MASS MATRIX                              .
C .         FOR THE VARIABLE NODE CURVED BEAM ELEMENT                 .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/     IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1                ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /GAUSS/  XG(4,4),WGT(4,4),EVAL2(9,2),EVAL3(27,3),E1,E2,E3
      COMMON /GASNEW/ TRAPS(12,3),GATES(7,7),WATES(7,7)
      COMMON /PIE/    PI,TOPI,DEGRAD,RADEG
C
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
      COMMON /CINT/   IMLEN,INLEN,INLENT,IMTIK,INTIK,INTIKT,
     1                INPER,INPERT,WZ
C
      DIMENSION XYZ(1),SECT(2),S(1)
      DIMENSION INTEGS(4),RL(4),PM(4)
C
      EQUIVALENCE (NPAR(5),ISECT)
C
      DATA IRECT /1/
      DATA INTEGS /0,1,2,3/
C
C
C     RL(I) IS THE ARCLENGTH FROM NODE (I-1) TO NODE (I)
C     INTEG = NO OF INTEGRATION POINTS USED IN CALCULATING ARCLENGTH
C             BETWEEN ARCLENGTH NODES (MAX=4 - SEE COMMON /GAUSS/ )
C
C
      IF (IMASS.EQ.2) GO TO 200
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   L U M P E D   M A S S                       .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
      INTEG=INTEGS(IELD)
      ARC=2./DBLE(FLOAT(IELD-1))
      BETA=ARC/2.
      ALFA=-(1.+BETA)
C
C
      RL(1)=0.
      DO 100 N=2,IELD
      RL(N)=0.
      ALFA=ALFA+ARC
      DO 90 I=1,INTEG
      R=ALFA + BETA*XG(I,INTEG)
      FACT=BETA*WGT(I,INTEG)
      CALL SHAPES (H,HR,IELD,R)
      DUM=0.
      DO 75 J=1,3
      TEMP=0.
      KK=J-3
      DO 60 K=1,IELD
      KK=KK+3
   60 TEMP=TEMP + HR(K)*XYZ(KK)
C
   75 DUM=DUM + TEMP*TEMP
      TEMP=DSQRT(DUM)
C
   90 RL(N)=RL(N) + FACT*TEMP
C
  100 CONTINUE
C
C
      PM(1)=.5*RL(2)
      PM(2)=.5*RL(IELD)
      IF (IELD-3) 120,115,110
  110 PM(4)=.5*(RL(3) + RL(4))
  115 PM(3)=.5*(RL(2) + RL(3))
C
C . . . . . . . . . . . . . . .
C .   RECTANGULAR SECTION     .
C . . . . . . . . . . . . . . .
C
  120 ADEN=DEN*(4.*SECT(1)*SECT(2))
      GO TO 130
C
C
  130 L=0
      DO 140 I=1,IELD
      XMM=ADEN*PM(I)
      DO 135 K=1,3
      L=L+1
  135 S(L)=XMM
      DO 136 K=1,3
      L=L+1
  136 S(L)=0.
  140 CONTINUE
C
C
      RETURN
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   C O N S I S T E N T   M A S S               .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
C
C . . . . . . . . . . . . . . .
C .   RECTANGULAR SECTION     .
C . . . . . . . . . . . . . . .
C
  200 DEPH=SECT(1)
      WIDH=SECT(2)
C
      DO 250 INL=1,INLEN
      RX=GATES(INL,INLENT)
      WX=WATES(INL,INLENT)
      CALL SHAPES (H,HR,IELD,RX)
      DO 250 INT=1,INTIK
      RY=GATES(INT,INTIKT)
      WYWX=WX*WATES(INT,INTIKT)
      DSH=DEPH*RY
      DO 250 INP=1,INPER
      RZ=GATES(INP,INPERT)
      WAT=WYWX*WATES(INP,INPERT)
      WTH=WIDH*RZ
C
      CALL IPTCOS (XYZ,DMINT,VECS,XJI,DET,DC)
      FACT=DEN*(DET*WAT)
      CALL CONMAS (DMINT,FACT,S,IELD)
C
  250 CONTINUE
C
      RETURN
C
C . . . . . . . . . . . . . . .
C     I SECTION ( TO BE INCLUDED IN FUTURE)
C . . . . . . . . . . . . . . .
C
C
      END
C *CDC* *DECK CONMAS
C *UNI* )FOR,IS N.CONMAS,R.CONMAS
      SUBROUTINE CONMAS (DM,FACT,S,IELD)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .      . TO CALCULATE THE CONSISTENT MASS MATRIX CONTRIBUTION       .
C .        AT ONE INTEGRATION POINT                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
C
      DIMENSION DM(9,1),S(1)
      DIMENSION RHX(4),RHY(4),RHZ(4)
C
C
C     CALCULATE SHAPE FUNCTIONS FOR ROTATIONAL DOF
C
      DO 50 I=1,IELD
      HI=H(I)
      RHX(I)=HI * (DSH*DM(4,I) + WTH*DM(7,I))
      RHY(I)=HI * (DSH*DM(5,I) + WTH*DM(8,I))
      RHZ(I)=HI * (DSH*DM(6,I) + WTH*DM(9,I))
   50 CONTINUE
C
C     M U L T I P L I C A T I O N
C
      L=0
      DO 200 I=1,IELD
C
      HI=FACT*H(I)
      DO 110 J=I,IELD
      L=L+1
      S(L)=S(L) + HI*H(J)
      L=L+4
      S(L)=S(L) + HI*RHZ(J)
      L=L+1
  110 S(L)=S(L) - HI*RHY(J)
C
      L=L-1
      DO 120 J=I,IELD
      L=L+2
      S(L)=S(L) + HI*H(J)
      L=L+2
      S(L)=S(L) - HI*RHZ(J)
      L=L+2
      S(L)=S(L) + HI*RHX(J)
  120 CONTINUE
C
      L=L-2
      DO 130 J=I,IELD
      L=L+3
      S(L)=S(L) + HI*H(J)
      L=L+1
      S(L)=S(L) + HI*RHY(J)
      L=L+1
      S(L)=S(L) - HI*RHX(J)
      L=L+1
  130 CONTINUE
C
      HX=FACT*RHX(I)
      HY=FACT*RHY(I)
      HZ=FACT*RHZ(I)
C
      J=I
  142 L=L+1
      S(L)=S(L) + HZ*RHZ(J) + HY*RHY(J)
      L=L+1
      S(L)=S(L) - HY*RHX(J)
      L=L+1
      S(L)=S(L) - HZ*RHX(J)
C
      IF (J.EQ.IELD) GO TO 150
C
      J=J+1
      L=L+2
      S(L)=S(L) - HZ*H(J)
      L=L+1
      S(L)=S(L) + HY*H(J)
      GO TO 142
C
C
  150 J=I
  152 L=L+1
      S(L)=S(L) + HZ*RHZ(J) + HX*RHX(J)
      L=L+1
      S(L)=S(L) - HZ*RHY(J)
C
      IF (J.EQ.IELD) GO TO 160
C
      J=J+1
      L=L+1
      S(L)=S(L) + HZ*H(J)
      L=L+2
      S(L)=S(L) - HX*H(J)
      L=L+1
      S(L)=S(L) - HX*RHY(J)
      GO TO 152
C
C
  160 J=I
  162 L=L+1
      S(L)=S(L) + HY*RHY(J) + HX*RHX(J)
C
      IF (J.EQ.IELD) GO TO 200
C
      J=J+1
      L=L+1
      S(L)=S(L) - HY*H(J)
      L=L+1
      S(L)=S(L) + HX*H(J)
      L=L+2
      S(L)=S(L) - HX*RHZ(J)
      L=L+1
      S(L)=S(L) - HY*RHZ(J)
      GO TO 162
C
  200 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK LINSTF
C *UNI* )FOR,IS N.LINSTF,R.LINSTF
      SUBROUTINE LINSTF (XYZ,CENTER,SECT,PROP,AS,IFLAG)
C
C     PROGRAM
C        . TO CALCULATE THE STIFFNESS MATRIX FOR THE LINEAR
C          CURVED TIMOSHENKO BEAM ELEMENT
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
      COMMON /GASNEW/ TRAPS(12,3),GATES(7,7),WATES(7,7)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
C
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /CINT  / IMLEN,INLEN,INLENT,IMTIK,INTIK,INTIKT,
     1                INPER,INPERT,WZ
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
C
      DIMENSION XYZ(1),CENTER(1),SECT(1),PROP(1)
      DIMENSION AS(26,26)
C
      EQUIVALENCE (NPAR(5),ISECT)
C
      DATA IRECT /1/
C
C
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   RECTANGULAR CROSS-SECTION                   .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
      DEPH=SECT(1)
      WIDH=SECT(2)
C
      IPT=0
C
      DO 150 INL=1,INLEN
      RX=GATES(INL,INLENT)
      WX=WATES(INL,INLENT)
      CALL SHAPES (H,HR,IELD,RX)
      DO 140 INT=1,INTIK
      RY=GATES(INT,INTIKT)
      WYWX=WX*WATES(INT,INTIKT)
      DSH=DEPH*RY
      DO 130 INP=1,INPER
      RZ=GATES(INP,INPERT)
      WAT=WYWX*WATES(INP,INPERT)
      WTH=WIDH*RZ
C
      IPT=IPT+1
      CALL IPTCOS (XYZ,DMINT,VECS,XJI,DET,DC)
C
      CALL BLNODE(B,BS,DMINT,DUMMY)
C
      FACT=DET*WAT
      CALL ELSTF (AS,B,PROP,FACT,ND,IFLAG)
C
  130 CONTINUE
  140 CONTINUE
  150 CONTINUE
C
C
      RETURN
      END
C *CDC* *DECK NONSTF
C *UNI* )FOR,IS N.NONSTF,R.NONSTF
      SUBROUTINE NONSTF(XYZ,CENTER,SECT,PROP,WA,IDW,AS,ISTAB,
     1                  EDIS,RITZ,SR,RERIT,S)
C
C     PROGRAM
C        . TO CALCULATE THE STIFFNESS MATRIX FOR THE NONLINEAR
C          CURVED TIMOSHENKO BEAM ELEMENT
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
      COMMON /GASNEW/ TRAPS(12,3),GATES(7,7),WATES(7,7)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
C
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /CINT  / IMLEN,INLEN,INLENT,IMTIK,INTIK,INTIKT,
     1                INPER,INPERT,WZ
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
      COMMON /PORT/ INPORT,JNPORT,NPUTSV,LUNODE,LU1,LU2,LU3,JDC,JVC,JAC
      COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
      DIMENSION AS(26,26),XEI(24),RIT(2),S(300)
      DIMENSION PREFIX(2)
      DIMENSION XYZ(1),CENTER(1),SECT(1),PROP(1),WA(IDW,1),ISTAB(1)
      DIMENSION EDIS(1),RITZ(1),SR(1),RERIT(1)
C
      EQUIVALENCE (NPAR(13),NTABS)
      EQUIVALENCE (NPAR(3),INDNL), (NPAR(5),ISECT), (NPAR(15),MODEL)
C
      DATA IRECT /1/
      DATA PREFIX /2H E, 2H*P/,  SUFFIX /6HLASTIC/
      DATA RECLB4/8HOUTPUT-5/
C
C
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . .
C .   RECTANGULAR CROSS-SECTION                   .
C . . . . . . . . . . . . . . . . . . . . . . . . .
C
      DEPH=SECT(1)
      WIDH=SECT(2)
      NDA=ND+2
C
C
      IF (INDNL.LE.1) GO TO 25
C
C     THE FOLLOWING 9 CARDS ARE NECESSARY TO PREVENT UNDERFLOW
C     ON  IBM  COMPUTERS
C
      KD=9*IELD
      XNORM=0.D0
      DO 31 IJ=1,KD
   31 XNORM=XNORM + EDIT(IJ)*EDIT(IJ)
      XNORM=2.D-8*DSQRT(XNORM)
      RITZ12=DABS(RITZ(1)) + DABS(RITZ(2))
      IF (RITZ12.GE.XNORM) GO TO 25
      RITZ(1)=0.D0
      RITZ(2)=0.D0
C
   25 CONTINUE
      IPT=0
      JPT=2
      ISTOP=0
C
      DO 150 INL=1,INLEN
      RX=GATES(INL,INLENT)
      WX=WATES(INL,INLENT)
      CALL SHAPES (H,HR,IELD,RX)
      DO 140 INT=1,INTIK
      RY=GATES(INT,INTIKT)
      WYWX=WX*WATES(INT,INTIKT)
      DSH=DEPH*RY
      DO 130 INP=1,INPER
C
      IPT=IPT+1
C
      IF (KPRI.NE.0)  GO TO 40
      IF (NTABS.LE.0) GO TO 40
      IF (ISTAB(JPT).NE.IPT) GO TO 130
      ISTOP=0
      IF (JPT.GT.ISTAB(1)) ISTOP=1
      JPT=JPT+1
   40 CONTINUE
C
      RZ=GATES(INP,INPERT)
      WAT=WYWX*WATES(INP,INPERT)
      WTH=WIDH*RZ
C
      CALL IPTCOS (XYZ,DMINT,VECS,XJI,DET,DC)
      FACT=WAT*DET
C
      CALL BLNODE(B,BS,DMT,RITZ)
C
C     CALCULATE STRAIN
C     CALCULATE STRESS
C
      CALL EPSIG(PROP,WA(1,IPT),EDIS,RITZ)
C
C
      IF (KPRI.NE.0) GO TO 75
      IF (NTABS) 75,50,52
   50 IF (IPT-1) 55,55,60
   52 IF (JPT-3) 55,55,60
   55 IF (IPRI.EQ.0)  WRITE (6,2500)  NEL
   60 IF (MODEL.GT.1) GO TO 64
      IF (IPRI.EQ.0)  WRITE (6,2510)  INL,INT,INP,STRESS
      GO TO 70
   64 IF (IPRI.EQ.0) WRITE (6,2510) INL,INT,INP,STRESS,ESIG,
     1                              PREFIX(IPELT),SUFFIX
   70 IF (IPST.LT.0 .AND. IPRI.EQ.0)  WRITE (6,2600) STRAIN
C
C***  DATA PORTHOLE (START)
C
      RECLAB = RECLB4
      IF (JNPORT.NE.0 .AND. KPLOTE.EQ.0)
     1  WRITE (LU1) RECLAB,NEL,INL,INT,INP,(STRESS(I),I=1,3),
     2              (STRAIN(I),I=1,3)
C
C***  DATA PORTHOLE (END)
C
      IF (ISTOP) 130,130,175
C
C
C     CALCULATE NODAL LOADS
C
   75 DO 80 I=1,NDA
      REDUM=0.
      DO 76 J=1,3
   76 REDUM=REDUM + B(J,I)*STRESS(J)
   80 RE(I)=RE(I) + FACT*REDUM
C
      IF (ISTIF.EQ.0) GO TO 130
      IF (MODEL.GT.1) GO TO 122
C
   85 CALL ELSTF (AS,B,PROP,FACT,ND,1)
      GO TO 125
C
  122 IF (IPELT.EQ.1) GO TO 85
      CALL MATSTF ( AS,B,CM,FACT,ND)
  125 IF (INDNL.NE.2) GO TO 130
      CALL SIGSTF (AS,BS,STRESS,FACT,ND)
C
  130 CONTINUE
  140 CONTINUE
  150 CONTINUE
C
      IF (ISTIF.EQ.0) GO TO 160
      CALL SCTOR (AS,S,SR,XEI,RIT,RERIT,ND,INDNL,1)
C
  160 NDB=ND+1
      ISTART=1
      JSTART=NDA
      DO 82 I=1,ND
      RE(I) = RE(I) - RE(NDB)*SR(JSTART) - RE(NDA)*(SR(ISTART) -
     1        SR(NDB)*SR(JSTART))
      ISTART=ISTART+1
      JSTART=JSTART+1
   82 CONTINUE
C
      RERIT(4) = RERIT(1)*RE(NDB) + RERIT(2)*RE(NDA)
      RERIT(5) = RERIT(2)*RE(NDB) + RERIT(3)*RE(NDA)
      RE(NDB)=0.0
      RE(NDA)=0.0
C
C
      IF (KPRI.NE.0)  GO TO 175
      IF (NTABS.LT.0) GO TO 800
C
  175 CONTINUE
C
C
      RETURN
C
C
  800 DO 825 I=1,IELD
      L=9*(I-1) + 1
      K=6*(I-1) + 1
      CALL DIRCOS (DMINT(L),RE(K  ),1,1,3,2)
      CALL DIRCOS (DMINT(L),RE(K+3),1,1,3,2)
  825 CONTINUE
C
      IF (IPRI.NE.0) GO TO 845
      WRITE (6,2450) NEL
      DO 840 I=1,IELD
      J=6*(I-1) + 1
      JJ=J+5
  840 WRITE (6,2460) I,(RE(KJ),KJ=J,JJ)
C
C
C***  DATA PORTHOLE (START)
C
  845 RECLAB = RECLB4
      IF (JNPORT.NE.0 .AND. KPLOTE.EQ.0)
     1  WRITE (LU1) RECLAB,NEL,ND,(RE(I),I=1,ND)
C
C***  DATA PORTHOLE (END)
C
      RETURN
C
 2450 FORMAT (I6)
 2460 FORMAT (10X,I4,2X,3E16.6,2X,3E16.6)
 2500 FORMAT (/I6)
 2510 FORMAT (7X,3I7,6X,3E16.6,E18.6,8X,A2,A6)
 2600 FORMAT (36X,3E16.6/)
C
C
      END
C *CDC* *DECK SCTOR
C *UNI* )FOR,IS  N.SCTOR,R.SCTOR
      SUBROUTINE SCTOR (AS,S,SR,XEI,RIT,RERIT,ND,INDNL,IFLAG)
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      DIMENSION SR(1)
      DIMENSION AS(26,26),S(300)
      DIMENSION XEI(24),RIT(2),RERIT(5)
C
C     IFLAG=1     STATIC CONDENSATION OF TORSION RITZ FUNCTIONS
C                 AT ELEMENT LEVEL.
C     IFLAG=2     RECOVERY OF THE DISPLACEMENTS CORRESPONDING TO
C                 TORSION RITZ FUNCTIONS ---- RITZ(1),RITZ(2).
C
      NDA=ND+2
      NDB=ND+1
      IF (IFLAG.EQ.2) GO TO 200
C
C     SR ARRAY CONTAINS THE GAUSS ELIMINATION COEFFICIENTS.
C
      N=0
      DO 100 I=1,2
      M1=NDA-I+1
      M2=M1-1
      DD=1.D0/AS(M1,M1)
      DO 100 J=1,M2
      N=N+1
      SR(N) = DD*AS(J,M1)
      DO 110 K=J,M2
  110 AS(J,K) = AS(J,K) -SR(N)*AS(K,M1)
  100 CONTINUE
C
      N=0
      DO 120 I=1,ND
      DO 120 J=I,ND
      N=N+1
  120 S(N)=AS(I,J)
      IF (INDNL .EQ. 0) RETURN
      DAS = AS(NDB,NDB)*AS(NDA,NDA) - AS(NDB,NDA)*AS(NDB,NDA)
      RERIT(1) = AS(NDA,NDA)/DAS
      RERIT(2) =-AS(NDB,NDA)/DAS
      RERIT(3) = AS(NDB,NDB)/DAS
      RETURN
C
C     RECOVERY OF RIT ARRAY DISPLACEMENTS
C
  200 ISTART = NDA
      RIT(1)=0.0
      RIT(2)=0.0
      DO 210 I=1,2
      TEMP=0.0
      IF (I.EQ.2) ISTART=1
      DO 220 J=1,ND
      TEMP=TEMP-SR(ISTART)*XEI(J)
  220 ISTART=ISTART+1
      IF ( I .EQ. 1 ) RIT(1)=TEMP
      IF ( I .EQ. 2 ) RIT(2)=TEMP - SR(ISTART)*RIT(1)
  210 CONTINUE
      IF (INDNL .EQ. 0) RETURN
      RIT(1) = RIT(1) - RERIT(4)
      RIT(2) = RIT(2) - RERIT(5)
      RETURN
      END
C *CDC* *DECK EPSIG
C *UNI* )FOR,IS N.EPSIG,R.EPSIG
      SUBROUTINE EPSIG(PROP,WA,EDIS,RITZ)
C
C     PROGRAM
C        . TO CALCULATE STRAINS AND STRESSES
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
C
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
      EQUIVALENCE (NPAR(3),INDNL), (NPAR(15),MODEL)
C
      DIMENSION PROP(1),WA(1)
      DIMENSION EDIS(1),RITZ(1)
C
C
      IF (INDNL.EQ.2) GO TO 75
C
      DO 25 I=1,3
      EPSDUM=0.
      DO 20 J=1,ND
   20 EPSDUM=EPSDUM + B(I,J)*EDIS(J)
      EPSDUM = EPSDUM + RITZ(1)*B(I,ND+1) + RITZ(2)*B(I,ND+2)
   25 STRAIN(I)=EPSDUM
C
C
   75 IF (MODEL-2) 110,120,130
C
C     LINEAR ELASTIC MODEL
C
  110 STRESS(1)=PROP(1)*STRAIN(1)
      STRESS(2)=PROP(2)*STRAIN(2)
      STRESS(3)=PROP(2)*STRAIN(3)
C
      RETURN
C
C
C     ELASTIC-PLASTIC MODEL (ISOTROPIC HARDENING)
C
  120 CALL ELPALT (PROP,WA(1),WA(4),WA(7),WA(8))
C
      RETURN
C
C
C     ELASTIC PLASTIC MODEL (KINEMATIC HARDENING)
C
  130 CALL ELPALT (PROP,WA(1),WA(4),WA(8),WA(9))
C
      RETURN
C
C
      END
C *CDC* *DECK ELPALT
C *UNI* )FOR,IS N.ELPALT,R.ELPALT
      SUBROUTINE ELPALT (PROP,SIG,EPS,YIELD,IPEL)
C
C     PROGRAM
C        . TO CALCULATE STRESSES FOR THE
C          ELASTIC-PLASTIC MATERIAL LAW
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /VAR/ NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,
     1             IREF,IEQUIT,IPRI,KPLOTN,KPLOTE
C
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /TIDEP/ E,G,PR,A1,B1,C1,BET,DEPS(4),TEPS(4),ALFA(4),DP(5,5)
C
C
      DIMENSION PROP(1),SIG(1),EPS(1)
      DIMENSION DELSIG(3),DELEPS(4)
C
      EQUIVALENCE (NPAR(15),MODEL)
C
      DATA INTMAX /10/
      DATA ISOT /2/,  KINEM /3/
C
C     CALCULATE MATERIAL CONSTANTS
C
      E=PROP(1)
      G=PROP(2)
      PR=.5*(E/G) - 1.
      ET=PROP(4)
C
      C1=G
      A1=2.*G/(1.-2.*PR)
      B1=A1*PR
      A1=A1-B1
C
      CEEH=(E*ET)/(E-ET)/3.
      CEE =2.*CEEH
      HP  =(G*G)/(CEEH+G)
      FTA=0.0
      FTB =YIELD
      BET =HP/YIELD
C
C     ASSUMING ELASTIC BEHAVIOR,
C     CALCULATE INCREMENTAL STRESSES
C
      DO 120 I=1,3
  120 DELEPS(I)=STRAIN(I)-EPS(I)
      DELSIG(1)=E*DELEPS(1)
      DELSIG(2)=G*DELEPS(2)
      DELSIG(3)=G*DELEPS(3)
      DELEPS(4)=(-PR)*DELEPS(1)
C
C     CALCULATE THE VALUE OF YIELD FUNCTION
C
      DM=DELSIG(1)/3.
      SM=SIG(1)/3.
      SXX=SIG(1)-SM
      SYY=      -SM
      SXY=SIG(2)
      SXZ=SIG(3)
C
      IF (MODEL.EQ.ISOT) GO TO 150
C
      EPSEL=SIG(1)/E
      ALFA(1)=CEE * (EPS(1)-EPSEL)
      ALFA(2)=CEEH * (EPS(2)-SIG(2)/G)
      ALFA(3)=CEEH * (EPS(3)-SIG(3)/G)
      ALFA(4)=CEE * (EPS(4) + PR*EPSEL)
C
      SXX=SXX - ALFA(1)
      SXY=SXY - ALFA(2)
      SXZ=SXZ - ALFA(3)
      SYY=SYY - ALFA(4)
C
  150 RA=DELSIG(1)*DM + DELSIG(2)**2 + DELSIG(3)**2
      IPELT=IPEL
      IF (RA.EQ.0.) GO TO 175
      RB=(SXX-SYY)*DM + SXY*DELSIG(2) + SXZ*DELSIG(3)
      RD=FTB
      IF (IPEL.EQ.2) GO TO 160
      RD=.5*(SXX**2) + SYY**2 + SXY**2 + SXZ**2
C
  160 FTA=RA + 2.*RB + RD
C
      IF (FTA-FTB) 170,170,300
C
C
C     ASSUMPTION OF ELASTIC BEHAVIOR HOLDS
C
  170 IPELT=1
  175 DO 180 I=1,3
      STRESS(I)=SIG(I) + DELSIG(I)
  180 CONTINUE
      IF (MODEL.EQ.KINEM) TEPS(4)=EPS(4) + DELEPS(4)
      GO TO 600
C
C
C     MATERIAL YIELDS -
C     DETERMINE STRESSES AT INITIATION OF YIELD
C
  300 IPELT=2
      RC=RD-FTB
      RATIO=(-RB + DSQRT(RB*RB-RA*RC))/RA
      DO 320 I=1,3
      STRESS(I)=SIG(I) + RATIO*DELSIG(I)
  320 CONTINUE
C
      IF (MODEL.EQ.ISOT) GO TO 340
C
      DO 325 I=1,4
  325 TEPS(I)=EPS(I) + RATIO*DELEPS(I)
C
  340 INTER=20.*(DSQRT(FTA/FTB)-1.) + 1.
      IF (INTER.GT.INTMAX) INTER=INTMAX
      XM=(1.-RATIO)/DBLE(FLOAT(INTER))
C
      DO 380 I=1,3
  380 DEPS(I)=XM*DELEPS(I)
C
C     INTEGRATION OF ELASTIC-PLASTIC LAW
C
C
      DO 500 IN=1,INTER
C
      CALL MIDEPT (MODEL)
C
      DO 420 I=1,3
      DO 420 J=1,3
  420 STRESS(I)=STRESS(I) + DP(I,J)*DEPS(J)
      IF (MODEL.EQ.ISOT) GO TO 440
C
      DO 430 I=1,4
  430 TEPS(I)=TEPS(I) + DEPS(I)
C
      EPSEL=STRESS(1)/E
      ALFA(1)=CEE * (TEPS(1)-EPSEL)
      ALFA(2)=CEEH * (TEPS(2) - STRESS(2)/G)
      ALFA(3)=CEEH * (TEPS(3) - STRESS(3)/G)
      ALFA(4)=CEE * (TEPS(4) + PR*EPSEL)
      GO TO 500
C
C
  440 SM=STRESS(1)/3.
      FTA=STRESS(1)*SM + STRESS(2)**2 + STRESS(3)**2
      BET=HP/FTA
C
  500 CONTINUE
C
C     UPDATE WA ARRAY
C
  600 ESIG=DSQRT(3.*FTA)
      IF (IUPDT.NE.0) GO TO 615
      IPEL=IPELT
      IF (MODEL.EQ.ISOT .AND. IPELT.EQ.2) YIELD=FTA
      DO 610 I=1,3
      SIG(I)=STRESS(I)
  610 EPS(I)=STRAIN(I)
      IF (MODEL.EQ.KINEM) EPS(4)=TEPS(4)
C
C     FORM MATERIAL LAW
C
  615 IF (ISTIF.EQ.0) RETURN
      IF (IPELT.EQ.2) GO TO 650
      DO 625 I=1,3
      DO 625 J=1,3
  625 CM(I,J)=0.
      CM(1,1)=E
      CM(2,2)=G
      CM(3,3)=G
      RETURN
C
C
  650 CALL MIDEPT (MODEL)
      DO 660 I=1,3
      DO 660 J=1,3
  660 CM(I,J)=DP(I,J)
C
      RETURN
C
C
      END
C *CDC* *DECK MIDEPT
C *UNI* )FOR,IS N.MIDEPT,R.MIDEPT
      SUBROUTINE MIDEPT (MODEL)
C
C     PROGRAM
C        TO CALCULATE THE ELASTIC-PLASTIC MATERIAL LAW
C        FOR ISO/BEAM ELEMENTS
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /TIDEP/ E,G,PR,A1,B1,C1,BET,DEPS(4),TEPS(4),ALFA(4),DP(5,5)
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1         STRAIN(3),CM(3,3),ESIG,IPELT
      DIMENSION D(25)
       EQUIVALENCE  ( D(1),DP(1,1) )
C
      DATA ISOT /2/, KINEM /3/
C
C
      SM=STRESS(1)/3.
C
      SXX=STRESS(1)-SM
      SYY=         -SM
      SXY=STRESS(2)
      SXZ=STRESS(3)
C
      IF (MODEL.EQ.ISOT) GO TO 20
C
      SXX=SXX-ALFA(1)
      SYY=SYY-ALFA(4)
      SXY=SXY-ALFA(2)
      SXZ=SXZ-ALFA(3)
C
   20 BETA=BET*SYY
      D(16)=B1 - BETA*SXX
      D(17)=   - BETA*SXY
      D(18)=   - BETA*SXZ
      D(19)=A1 - BETA*SYY
      D(20)=B1 - BETA*SYY
C
      D(21)=D(16)
      D(22)=D(17)
      D(23)=D(18)
      D(24)=D(20)
      D(25)=D(19)
C
      DEPS(4)=(-1.)*(D(16)*DEPS(1) + D(17)*DEPS(2) + D(18)*DEPS(3)) /
     1        (D(19) + D(20))
      WP=SXX*DEPS(1) + SXY*DEPS(2) + SXZ*DEPS(3) + 2.*SYY*DEPS(4)
C
      IF (WP.GE.0.) GO TO 50
      DO 30 I=1,25
   30 D(I)=0.
      D( 1)=E
      D( 7)=G
      D(13)=G
      DEPS(4)=(-PR)*DEPS(1)
C
      RETURN
C
C
   50 BETT=BET
C
      BETA=BETT*SXX
      D(1)=A1 - BETA*SXX
      D(2)=   - BETA*SXY
      D(3)=   - BETA*SXZ
      D(4)=B1 - BETA*SYY
      D(5)=B1 - BETA*SYY
C
      BETA=BETT*SXY
      D( 6)=D(2)
      D( 7)=C1 - BETA*SXY
      D( 8)=   - BETA*SXZ
      D( 9)=   - BETA*SYY
      D(10)=   - BETA*SYY
C
      BETA=BETT*SXZ
      D(11)=D(3)
      D(12)=D(8)
      D(13)=C1 - BETA*SXZ
      D(14)=   - BETA*SYY
      D(15)=   - BETA*SYY
C
C
C     CONDENSE THE STRESS-STRAIN LAW
C
      DO 75 K=1,2
      L=5-K
      M=L+1
      DN=1./DP(M,M)
      DO 75 I=1,L
      DL=DN*DP(I,M)
      DO 70 J=I,L
   70 DP(I,J)=DP(I,J) - DL*DP(J,M)
   75 CONTINUE
      DP(2,1)=DP(1,2)
      DP(3,1)=DP(1,3)
      DP(3,2)=DP(2,3)
C
      RETURN
C
C
      END
C *CDC* *DECK NODCOS
C *UNI* )FOR,IS N.NODCOS,R.NODCOS
      SUBROUTINE NODCOS (XX,CENTER,DM,VECT)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   PROGRAM                                                         .
C .      . TO CALCULATE DIRECTION COSINES AT NODAL POINTS             .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     THE ELEMENT IS ASSUMED TO LIE IN A PLANE,
C     WITH THE T-DIRECTION PERPENDICULAR TO IT.
C
C     DM=(RX,RY,RZ, SX,SY,SZ, TX,TY,TZ)
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
C
      DIMENSION XX(1),CENTER(3),DM(9,1),VECT(3)
      DIMENSION RNODE(12),VEC(3)
C
      DATA RNODE/-1., 1., 2*0.,  -1., 1., .5, 0.,
     1           -1., 1., -.3333333333333D0, .3333333333333D0/
C
C
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   LAGRANGE INTERPOLATION OF GEOMETRY  (GENERAL CASE)              .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     DETERMINE TANGENT AT ALL NODES (S=0., T=0.)
C
      L=4*(IELD-2)
      DO 200 I=1,IELD
      L=L+1
      RN=RNODE(L)
      CALL SHAPES (H,HR,IELD,RN)
      XR=0.
      YR=0.
      ZR=0.
      K=0
      DO 100 J=1,IELD
      XR=XR + HR(J)*XX(K+1)
      YR=YR + HR(J)*XX(K+2)
      ZR=ZR + HR(J)*XX(K+3)
  100 K=K+3
C
      DS=DSQRT(XR**2 + YR**2 + ZR**2)
      DM(1,I)=XR/DS
      DM(2,I)=YR/DS
      DM(3,I)=ZR/DS
C
  200 CONTINUE
C
C
C     FIND T-DIRECTION  (COMMON TO ALL NODES)
C
C     USER DETERMINES PLANE OF ELEMENT VIA AUXILIARY NODE (ICD).
C     R AND S DIRECTIONS LIE IN PLANE OF ELEMENT.
C     T DIRECTION IS PERPENDICULAR TO THIS PLANE.
C
      DO 250 I=1,3
      VEC(I)=CENTER(I) - XX(I)
  250 CONTINUE
      CALL CROSS (DM,VEC,VECT)
      DS=0.
      DO 260 I=1,3
  260 DS=DS + VECT(I)**2
      DS=DSQRT(DS)
      IF (DS.LT.1.0D-08) GO TO 600
      DO 270 I=1,3
  270 VECT(I)=VECT(I)/DS
C
C
      DO 300 I=1,IELD
      DM(7,I)=VECT(1)
      DM(8,I)=VECT(2)
      DM(9,I)=VECT(3)
      CALL CROSS (DM(7,I),DM(1,I),DM(4,I))
  300 CONTINUE
C
      RETURN
C
C     E R R O R   M E S S A G E
C
  600 IL=3*IELD
      WRITE (6,2000) NEL,IELD,(XX(I),I=1,IL)
      WRITE (6,2010) (CENTER(I),I=1,3)
      WRITE (6,2020) (DM(I,1),I=1,3)
      WRITE (6,2030) VEC
      WRITE (6,2040)
      STOP
C
C
 2000 FORMAT (///16H *** E R R O R -//
     1        43H DETECTED BY SUBROUTINE NODCOS   (ISO/BEAM)   /
     2        49H WHILE CALCULATING DIRECTION COSINES OF NORMAL TO,
     3        14H ELEMENT PLANE//
     4        17H ELEMENT NUMBER =,I5/
     5        17H NUMBER OF NODES=,I5//
     6        44H ELEMENT NODAL COORDINATES ARE GIVEN BELOW -//
     7        1X,14X,1HX,14X,1HY,14X,1HZ//(1X,3E15.6))
 2010 FORMAT (// 36H COORDINATES OF AUXILIARY NODE ARE -//(1X,3E15.6))
 2020 FORMAT (// 48H THE TANGENT AT NODE 1 HAS THE DIRECTION COSINES,
     1        3E14.6,2H .)
 2030 FORMAT (// 51H THIS TANGENT IS PARALLEL TO THE VECTOR FROM NODE 1/
     2        45H TO THE AUXILIARY NODE (DIRECTION COSINES ARE,
     3        3E14.6,3H ).)
 2040 FORMAT (// 43H HENCE, THE CROSS PRODUCT CANNOT BE USED TO,
     1        53H DETERMINE THE T-DIRECTION (NORMAL TO ELEMENT PLANE)./
     2        46H USER SHOULD DESIGNATE A DIFFERENT NODE AS THE,
     3        16H AUXILIARY NODE.///12H *** S T O P)
C
      END
C *CDC* *DECK NEWCOS
C *UNI* )FOR,IS N.NEWCOS,R.NEWCOS
      SUBROUTINE NEWCOS(EULER,ROTOLD,EDIS,INDNL)
C
C     PROGRAM
C        . TO FIND THE DIRECTION COSINES AT TIME (T+DT),
C          GIVEN DIRECTION COSINES AT TIME T (DCOLD) AND
C          INCREMENTAL ROTATIONS (ROTIN)
C
C     THIS ROUTINE ASSUMES THAT ANGULAR VELOCITY IS
C     CONSTANT IN THE INTERVAL (DT).
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /JUNKEL/ XJI(9),DMINT(36),DMT(36),VECS(3),DC(9),
     1                B(3,26),BS(9,26)
C
      DIMENSION EULER(1),ROTOLD(1)
      DIMENSION EDIS(1)
      DIMENSION A(3),AA(9),DMOLD(9)
C
      IF (INDNL.EQ.2) GO TO 15
C
      K=0
      DO 10 I=1,IELD
      DO 10 J=1,9
      K=K+1
   10 DMT(K)=DMINT(K)
C
      RETURN
C
C
   15 K =0
      L =0
      KK=0
      DO 30 I=1,IELD
      DO 20 J=1,3
      K=K+1
      KK=KK+1
   20 EDIT(K)=EDIS(KK)
      K=K+6
      DO 25 J=1,3
      L=L+1
      KK=KK+1
   25 ROTIN(L)=EDIS(KK) - ROTOLD(L)
   30 CONTINUE
C
C
      DO 100 I=1,IELD
C
      L=3*(I-1)
      CALL DIRCEL (EULER(L+1),EULER(L+2),EULER(L+3),DMOLD)
C
      ROTS=ROTIN(L+1)**2 + ROTIN(L+2)**2 + ROTIN(L+3)**2
      ROT =DSQRT(ROTS)
      IF (ROT) 45,35,45
C
   35 KK=9*(I-1)
      DO 40 J=1,9
      KK=KK+1
   40 DMT(KK)=DMOLD(J)
      GO TO 80
C
C
   45 CB=DSIN(ROT)/ROT
      CC=(1.-DCOS(ROT))/ROTS
C
      A(1)=CB*ROTIN(L+1)
      A(2)=CB*ROTIN(L+2)
      A(3)=CB*ROTIN(L+3)
C
      AA(1)=CC*(ROTIN(L+2)**2 + ROTIN(L+3)**2)
      AA(2)=CC*(ROTIN(L+1)*ROTIN(L+2))
      AA(3)=CC*(ROTIN(L+1)*ROTIN(L+3))
      AA(4)=AA(2)
      AA(5)=CC*(ROTIN(L+1)**2 + ROTIN(L+3)**2)
      AA(6)=CC*(ROTIN(L+2)*ROTIN(L+3))
      AA(7)=AA(3)
      AA(8)=AA(6)
      AA(9)=CC*(ROTIN(L+1)**2 + ROTIN(L+2)**2)
C
      AA(1)=1. - AA(1)
      AA(2)=     AA(2) - A(3)
      AA(3)=     AA(3) + A(2)
      AA(4)=     AA(4) + A(3)
      AA(5)=1. - AA(5)
      AA(6)=     AA(6) - A(1)
      AA(7)=     AA(7) - A(2)
      AA(8)=     AA(8) + A(1)
      AA(9)=1. - AA(9)
C
C
      J=9*(I-1)
      DO 75 II=1,3
      LL=3*(II-1)
      K =0
      DO 60 JJ=1,3
      J=J+1
      DMT(J)=0.
      L=LL
      DO 50 KK=1,3
      K=K+1
      L=L+1
   50 DMT(J)=DMT(J) + AA(K)*DMOLD(L)
   60 CONTINUE
   75 CONTINUE
C
C     SET UP THE EDIT MATRIX
C
   80 K=9*(I-1)+3
      DO 90 J=1,6
      K=K+1
   90 EDIT(K)=DMT(K) - DMINT(K)
C
  100 CONTINUE
C
C
      RETURN
C
C
      END
C *CDC* *DECK FEULER
C *UNI* )FOR,IS N.FEULER,R.FEULER
      SUBROUTINE FEULER (DM,EULER,IELD)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   PROGRAM                                                         .
C .      . GIVEN THE DIRECTION COSINES, FIND THE EULER ANGLES         .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /PIE/ PI,TOPI,DEGRAD,RADEG
      DIMENSION DM(9,1),EULER(3,1)
C
      DATA SBMAX /.9999999999D0/
C
      DO 100 I=1,IELD
      SB=DM(7,I)
      IF (DABS(SB).GT.SBMAX) GO TO 60
      CB=DSQRT(1.D0-SB*SB)
      BETA=DATAN2(SB,CB)
      IF (BETA.GT.PI) BETA=BETA - 2.D0*PI
C
      CBM=-CB
C
      SA=DM(8,I)/CBM
      CA=DM(9,I)/CB
      ALFA=DATAN2(SA,CA)
C
      SG=DM(4,I)/CBM
      CG=DM(1,I)/CB
      GAMMA=DATAN2(SG,CG)
C
      EULER(1,I)=ALFA
      EULER(2,I)=BETA
      EULER(3,I)=GAMMA
C
      GO TO 100
C
C
C     PHI=ALFA (+ OR -) GAMMA
C
   60 PHI=DATAN2(DM(6,I),DM(5,I))
      EULER(1,I)=PHI
      EULER(2,I)=PI/2.
      IF (SB.LT.0.) EULER(2,I)=-(PI/2.)
      EULER(3,I)=0.
C
C
  100 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK DIRCEL
C *UNI* )FOR,IS N.DIRCEL,R.DIRCEL
      SUBROUTINE DIRCEL (ALFA,BETA,GAMMA,DM)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   PROGRAM                                                         .
C .      . GIVEN EULER ANGLES, FIND THE DIRECTION COSINES             .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION DM(1)
C
      DATA SBMAX /.9999999999D0/
C
      SA=DSIN(ALFA)
      CA=DCOS(ALFA)
      SB=DSIN(BETA)
      IF (DABS(SB).GT.SBMAX) GO TO 60
      CB=DCOS(BETA)
      SG=DSIN(GAMMA)
      CG=DCOS(GAMMA)
C
      CBM=-CB
      DUMA=SA*SB
      DUMB=CA*SB
C
      DM(1)=CG*CB
      DM(2)=CG*DUMA + SG*CA
      DM(3)=SA*SG - CG*DUMB
C
      DM(4)=SG*CBM
      DM(5)=CA*CG - SG*DUMA
      DM(6)=SA*CG + SG*DUMB
C
      DM(7)=SB
      DM(8)=SA*CBM
      DM(9)=CA*CB
C
      RETURN
C
C
   60 SN=1.
      IF (SB.LT.0.) SN=-1.
      DM(1)=0.
      DM(2)=SN*SA
      DM(3)=(-SN)*CA
      DM(4)=0.
      DM(5)=CA
      DM(6)=SA
      DM(7)=SN
      DM(8)=0.
      DM(9)=0.
C
      RETURN
C
C
      END
C *CDC* *DECK IPTCOS
C *UNI* )FOR,IS N.IPTCOS,R.IPTCOS
      SUBROUTINE IPTCOS (XX,DM,VECT,XJI,DET,DC)
C
C     PROGRAM
C        . TO CALCULATE THE JACOBIAN (XJ) AND ITS INVERSE (XJI)
C        . TO CALCULATE THE DIRECTION COSINES
C          AT AN INTEGRATION POINT
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /VAR/   NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,IREF,
     1               IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
C
      DIMENSION XJ(9)
      DIMENSION XX(1),DM(1),VECT(3),XJI(9),DC(9)
C
C     DM = DIRECTION COSINES AT NODAL POINTS
C     DC = DIRECTION COSINES AT INTEGRATION POINT (OF NORMAL)
C
C     STORAGE
C     XJ = (XR,XS,XT, YR,YS,YT, ZR,ZS,ZT)
C     DC = (RX,RY,RZ, SX,SY,SZ, TX,TY,TZ)
C
C
C     XJ(3,3) IS THE JACOBIAN.
C
C
      DO 100 L=1,9
  100 XJ(L)=0.
C
      J=0
      K=-3
      DO 300 I=1,IELD
      HI=H(I)
      HRI=HR(I)
      K=K+6
      L=0
      DO 250 LL=1,3
      K=K+1
      CS=DM(K)
      CT=DM(K+3)
C
      J=J+1
      L=L+1
      XJ(L)=XJ(L) + HRI * (XX(J) + DSH*CS + WTH*CT)
      L=L+1
      XJ(L)=XJ(L) + HI*CS
      L=L+1
      XJ(L)=XJ(L) + HI*CT
C
  250 CONTINUE
  300 CONTINUE
C
      L=0
      DO 350 LL=1,3
      L=L+2
      XJ(L)=DEPH*XJ(L)
      L=L+1
      XJ(L)=WIDH*XJ(L)
  350 CONTINUE
C
C
      XJI(1)=XJ(5)*XJ(9) - XJ(6)*XJ(8)
      XJI(2)=XJ(3)*XJ(8) - XJ(2)*XJ(9)
      XJI(3)=XJ(2)*XJ(6) - XJ(3)*XJ(5)
      XJI(4)=XJ(6)*XJ(7) - XJ(4)*XJ(9)
      XJI(5)=XJ(1)*XJ(9) - XJ(3)*XJ(7)
      XJI(6)=XJ(3)*XJ(4) - XJ(1)*XJ(6)
      XJI(7)=XJ(4)*XJ(8) - XJ(5)*XJ(7)
      XJI(8)=XJ(7)*XJ(2) - XJ(1)*XJ(8)
      XJI(9)=XJ(1)*XJ(5) - XJ(2)*XJ(4)
C
      DET=XJ(1)*XJI(1) + XJ(4)*XJI(2) + XJ(7)*XJI(3)
      IF (DET .LE. 1.0D-08) GO TO 600
C
      DETIN=1./DET
C
      DO 400 I=1,9
      XJI(I)=DETIN*XJI(I)
  400 CONTINUE
C
C
C     COLUMN 3 - T DIRECTION  (COMMON TO ALL)
C
      DC(7)=VECT(1)
      DC(8)=VECT(2)
      DC(9)=VECT(3)
C
C
C     COLUMN 1 - R DIRECTION
C
      DN=DSQRT(XJ(1)**2 + XJ(4)**2 + XJ(7)**2)
C
      DC(1)=XJ(1)/DN
      DC(2)=XJ(4)/DN
      DC(3)=XJ(7)/DN
C
C     COLUMN 2 - S DIRECTION
C
      CALL CROSS (DC(7),DC(1),DC(4))
C
      RETURN
C
C
C
  600 WRITE (6,2000) NG,NEL,DET
      WRITE (6,2100)
      DO 650 I=1,IELD
      KI=3*(I-1)+1
      KJ=KI+2
      WRITE (6,2150) I,(XX(K),K=KI,KJ)
  650 CONTINUE
      WRITE (6,2200)
      STOP
C
C
 2000 FORMAT (////14H *** ERROR ***/18H ELEMENT GROUP NO.,I5/
     1        43H DETECTED BY SUBROUTINE IPTCOS  (ISO/BEAM)    //
     2        28H ZERO JACOBIAN DETERMINANT -/
     3        5X,17H ELEMENT NUMBER =,I3/
     4        5X,6H DET =,E14.6)
 2100 FORMAT (//44H ELEMENT NODAL COORDINATES ARE GIVEN BELOW -//
     1        5X,6H LOCAL/5X,6H  NODE,15X,1HX,15X,1HY,15X,1HZ/)
 2150 FORMAT (I10,1X,3E16.6)
 2200 FORMAT (//42H CHECK NODE NUMBERS AND NODAL COORDINATES.///
     1        12H *** S T O P)
C
      END
C *CDC* *DECK BLNODE
C *UNI* )FOR,IS N.BLNODE,R.BLNODE
      SUBROUTINE BLNODE(B,BS,DMT,RITZ)
C
C     PROGRAM
C        . TO CALCULATE THE B- AND BS-MATRICES
C
C     DOF = (U,V,W, DSX,DSY,DSZ, DTX,DTY,DTZ)
C
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /ISOBMS/ NEL,IELD,ND,KDOF,IDIM,ISTIF,IPT,JPT,IPST
      COMMON /EL/ IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1            ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
C
      COMMON /ESHAPE/ H(4),HR(4),DEPH,WIDH,DSH,WTH
      COMMON /ELBEL/ EDIT(36),ROTIN(12),RE(26),STRESS(3),
     1                STRAIN(3),CM(3,3),ESIG,IPELT
      COMMON /JUNKEL/ XJI(9),DMINT(36),ADMT(36),VECS(3),DC(9),
     1                AB(3,26),ASB(9,26)
C
      EQUIVALENCE (NPAR(3),INDNL)
C
C
      DIMENSION B(3,1),BS(9,1),DMT(9,1)
      DIMENSION AT(3,5),AXYZ(3),BD(9,38),BT(3,38),DISD(9)
      DIMENSION RITZ(1)
C
C     THE RITZ FUNCTIONS FOR TORSION ARE
C               1)     (BS)*(AT)
C               2)     ( (BS)**3 )*( (AT) ) - ( (BS) )*( (AT)**3 )
C
C
      KD=9*IELD
      KDOF=KD+2
C
      DO 50 J=1,KDOF
      DO 50 I=1,9
   50 BD(I,J) = 0.0
C
      D2 = 4.0*DSH*DSH
      W2 = 4.0*WTH*WTH
      DW2=D2-W2
C
      DO 100 I=1,IELD
C
      HI=H(I)
      HRI=HR(I)
      DR=DSH*HRI
      DH=DEPH*HI
      WR=WTH*HRI
      WH=WIDH*HI
      DO 180 J=1,5
      DO 180 K=1,3
  180 AT(K,J)=0.0
C
      AT(1,1) = HRI
      AT(1,2)=DR
      AT(1,3)=WR
      AT(1,4) = 4.0*DSH*AT(1,3)
      AT(1,5) = AT(1,4)*DW2
C
      AT(2,2)=DH
      AT(2,4) = 4.0*WTH*AT(2,2)
      AT(2,5) = AT(2,4)*(DW2+2.0*D2)
C
      AT(3,3)=WH
      AT(3,4)=4.0*DSH*AT(3,3)
      AT(3,5) = AT(3,4)*(DW2-2.0*W2)
C
      DO 195 K=1,5
      DO 185 J=1,3
      AXYZ(J) = XJI(J)*AT(1,K) + XJI(J+3)*AT(2,K) + XJI(J+6)*AT(3,K)
  185 CONTINUE
C
C     FOLLOWING AT MATRIX CONTAINS DERIVATIVES OF GLOBAL XYZ
C     DISPLACEMENTS WITH RESPECT TO NORAML N, AND S,T.
C
      L=0
      DO 190 J=1,7,3
      L=L+1
      AT(L,K) = DC(J)*AXYZ(1) + DC(J+1)*AXYZ(2) + DC(J+2)*AXYZ(3)
  190 CONTINUE
C
  195 CONTINUE
C
C     BD IS THE DISP DERIVATIVE (LOCAL DOF)
C
C     BD RELATES (U,V,W, DSX,DSY,DSZ, DTX,DTY,DTZ) - NODAL QUANTITIES
C     TO NORMAL DERIVATIVES OF NORMAL DISPLACEMENTS.
C
C     (DUN/DN,DUN/DS,DUN/DT, DUS/DN,DUS/DS,DUS/DT, DUT/DN,DUT/DS,DUT/DT)
C     WHERE UN,US,UT ARE THE NORMAL DISPLACEMENTS, AND
C     N IS THE NORMAL, S,T ARE THE OTHER DIRECTIONS.
C
      IST = 9*(I-1)
      DO 200 L=1,3
      LST = 3*(L-1)
      CONST = DC(LST+1)*DC(1) + DC(LST+2)*DC(2) + DC(LST+3)*DC(3)
      MUP=3
      IF (INDNL.NE.2 .AND. L.GT.1) MUP=1
      DO 205 M=1,MUP
      DO 210 J=1,3
      JST = IST + 3*(J-1)
      DO 210 K=1,3
      K1 = LST + K
      BD(LST+M,JST+K) = DC(K1)*AT(M,J)
  210 CONTINUE
      BD(LST+M , KD+1) = BD(LST+M , KD+1) + AT(M,4)*CONST
      BD(LST+M , KD+2) = BD(LST+M , KD+2) + AT(M,5)*CONST
  205 CONTINUE
  200 CONTINUE
C
  100 CONTINUE
C
C     CALCULATE THE BT MATRIX (B MATRIX IN LOCAL DOF)
C
      DO 120 K=1,KDOF
      BT(1,K)=BD(1,K)
      BT(2,K)=BD(2,K) + BD(4,K)
  120 BT(3,K)=BD(3,K) + BD(7,K)
C
      IF (INDNL.NE.2) GO TO 175
C
C     FOR TL, CALCULATE DISP DERIVATIVES AND STRAIN
C
      DO 135 J=1,9
      DISD(J)=0.
      DO 130 K=1,KD
      DISD(J)=DISD(J) + BD(J,K)*EDIT(K)
  130 CONTINUE
      DISD(J) = DISD(J) + BD(J,KD+1)*RITZ(1) + BD(J,KD+2)*RITZ(2)
  135 CONTINUE
C
      STRAIN(1)=DISD(1) + .5 * (DISD(1)**2 + DISD(4)**2 + DISD(7)**2)
      STRAIN(2)=DISD(2) + DISD(4) + DISD(1)*DISD(2) + DISD(4)*DISD(5)
     1                            + DISD(7)*DISD(8)
      STRAIN(3)=DISD(3) + DISD(7) + DISD(1)*DISD(3) + DISD(4)*DISD(6)
     1                            + DISD(7)*DISD(9)
C
C     ADD INITIAL STRAIN EFFECT
C
      DO 160 K=1,KDOF
      BT(1,K)=BT(1,K) + DISD(1)*BD(1,K) + DISD(4)*BD(4,K)
     1                + DISD(7)*BD(7,K)
      BT(2,K)=BT(2,K) + DISD(2)*BD(1,K) + DISD(1)*BD(2,K)
     1                + DISD(5)*BD(4,K) + DISD(4)*BD(5,K)
     2                + DISD(8)*BD(7,K) + DISD(7)*BD(8,K)
      BT(3,K)=BT(3,K) + DISD(3)*BD(1,K) + DISD(1)*BD(3,K)
     1                + DISD(6)*BD(4,K) + DISD(4)*BD(6,K)
     2                + DISD(9)*BD(7,K) + DISD(7)*BD(9,K)
  160 CONTINUE
C
  175 CALL CEPDIS (B,BT,DMT,IELD,3)
C
      IF (ISTIF.EQ.0) RETURN
      IF (INDNL.NE.2) RETURN
C
C
C     CALCULATE INITIAL STRESS MATRIX BS
C
      CALL CEPDIS (BS,BD,DMT,IELD,9)
C
      RETURN
C
C
      END
C *CDC* *DECK CEPDIS
C *UNI* )FOR,IS N.CEPDIS,R.CEPDIS
      SUBROUTINE CEPDIS (B,A,DMT,IELD,IROW)
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION B(1),A(1),DMT(9,1)
C
C
      KD=0
      KS=0
      DO 50 I=1,IELD
C
      DO 20 L=1,3
      DO 20 M=1,IROW
      KS=KS+1
      KD=KD+1
   20 B(KS)=A(KD)
C
      SX=DMT(4,I)
      SY=DMT(5,I)
      SZ=DMT(6,I)
      TX=DMT(7,I)
      TY=DMT(8,I)
      TZ=DMT(9,I)
C
      DO 30 M=1,IROW
C
      K1=KD+M
      K2=K1+IROW
      K3=K2+IROW
      K4=K3+IROW
      K5=K4+IROW
      K6=K5+IROW
C
      KT=KS+M
      B(KT)=A(K3)*SY - A(K2)*SZ + A(K6)*TY - A(K5)*TZ
C
      KT=KT+IROW
      B(KT)=A(K1)*SZ - A(K3)*SX + A(K4)*TZ - A(K6)*TX
C
      KT=KT+IROW
      B(KT)=A(K2)*SX - A(K1)*SY + A(K5)*TX - A(K4)*TY
C
   30 CONTINUE
C
      KD=K6
      KS=KT
C
   50 CONTINUE
C
C     TO INCLUDE THE EFFECT OF TORSION RITZ FUNCTIONS
C
      DO 60 L=1,2
      DO 60 M=1,IROW
      KS=KS+1
      KD=KD+1
   60 B(KS)=A(KD)
C
      RETURN
C
C
      END
C *CDC* *DECK ELSTF
C *UNI* )FOR,IS N.ELSTF,R.ELSTF
      SUBROUTINE ELSTF (AS,B,PROP,FACT,ND,IFLAG)
C
C     PROGRAM
C        . TO CALCULATE THE STIFFNESS MATRIX
C          FOR ELASTIC MATERIAL LAW
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION B(1),PROP(1)
      DIMENSION AS(26,26)
C
      EFACT=FACT*PROP(1)
      GFACT=FACT*PROP(2)
C
      NDA = ND+2
      K=-2
      DO 120 I=1,NDA
      K=K+3
      TEMP1=B(K  )*EFACT
      TEMP2=B(K+1)*GFACT
      TEMP3=B(K+2)*GFACT
C
      IF (IFLAG.EQ.2) GO TO 100
      M=K-3
      IJ=I
      GO TO 105
C
  100 M=3*ND-2
      IJ=ND+1
C
  105 DO 110 J=IJ,NDA
      M=M+3
  110 AS(I,J) = AS(I,J) + TEMP1*B(M) + TEMP2*B(M+1) + TEMP3*B(M+2)
C
  120 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK MATSTF
C *UNI* )FOR,IS N.MATSTF,R.MATSTF
      SUBROUTINE MATSTF (AS,BP,CP,FACT,ND)
C
C     PROGRAM
C        . TO CALCULATE THE STIFFNESS MATRIX
C          FOR A FULL MATERIAL MATRIX (PLASTIC STATE)
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION CP(1),BP(1)
      DIMENSION AS(26,26),DP(9)
C
      DO 20 I=1,9
   20 DP(I)=FACT*CP(I)
C
      NDA=ND+2
      K1=-2
      DO 50 I=1,NDA
      M1=K1
      K1=K1+3
      K2=K1+1
      K3=K2+1
      TEMP1=BP(K1)*DP(1) + BP(K2)*DP(2) + BP(K3)*DP(3)
      TEMP2=BP(K1)*DP(4) + BP(K2)*DP(5) + BP(K3)*DP(6)
      TEMP3=BP(K1)*DP(7) + BP(K2)*DP(8) + BP(K3)*DP(9)
      DO 40 J=I,NDA
      M1=M1+3
   40 AS(I,J) = AS(I,J) + TEMP1*BP(M1) + TEMP2*BP(M1+1) + TEMP3*BP(M1+2)
   50 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK SIGSTF
C *UNI* )FOR,IS N.SHAPES,R.SHAPES
      SUBROUTINE SIGSTF (AS,BS,STRESS,FACT,ND)
C
C     PROGRAM TO CALCULATE THE GEOMETRIC STIFFNESS MATRIX
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION BS(9,1),STRESS(1)
      DIMENSION AS(26,26)
      DIMENSION SIG(3),TEMP(9)
C
      DO 10 I=1,3
   10 SIG(I)=FACT*STRESS(I)
C
      NDA=ND+2
      DO 50 I=1,NDA
      KA=-2
      DO 20 M=1,3
      KA=KA+3
      KB=KA+1
      KC=KA+2
      TEMP(KA)=BS(KA,I)*SIG(1) + BS(KB,I)*SIG(2) + BS(KC,I)*SIG(3)
      TEMP(KB)=BS(KA,I)*SIG(2)
      TEMP(KC)=BS(KA,I)*SIG(3)
   20 CONTINUE
C
      DO 40 J=I,NDA
      DO 30 M=1,9
   30 AS(I,J) = AS(I,J) + TEMP(M)*BS(M,J)
   40 CONTINUE
C
   50 CONTINUE
C
      RETURN
C
C
      END
C *CDC* *DECK SHAPES
C *UNI* )FOR,IS N.SIGSTF,R.SIGSTF
      SUBROUTINE SHAPES (H,HR,IELD,R)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   P R O G R A M                                                   .
C .       . TO CALCULATE INTERPOLATION FUNCTIONS, AND THEIR           .
C .         DERIVATIVES FOR VARIABLE NODE CURVED TIMOSHENKO BEAM      .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION H(4),HR(4)
C
C
      GO TO (10,20,30,40), IELD
C
   10 STOP
C
C
   20 H(1)=.5*(1.-R)
      H(2)=.5*(1.+R)
      HR(1)=-.5
      HR(2)= .5
C
      GO TO 100
C
C
   30 RR=R*R
C
      H(1)=(-.5)*(R-RR)
      H(2)=( .5)*(R+RR)
      H(3)=(1.-RR)
C
      HR(1)=(-.5)+R
      HR(2)=( .5)+R
      HR(3)=(-2.)*R
C
      GO TO 100
C
C
   40 TR=3.*R
      R1=TR+3.
      R2=TR-3.
      R3=TR+1.
      R4=TR-1.
C
      H(1)=(R2*R3*R4) / (-48.)
      H(2)=(R1*R3*R4) / ( 48.)
      H(3)=(R1*R2*R4) / ( 16.)
      H(4)=(R1*R2*R3) / (-16.)
C
      HR(1)=(-.0625) * (R3*R4 + R2*R4 + R2*R3)
      HR(2)=( .0625) * (R3*R4 + R1*R4 + R1*R3)
      HR(3)=( .1875) * (R2*R4 + R1*R4 + R1*R2)
      HR(4)=(-.1875) * (R2*R3 + R1*R3 + R1*R2)
C
C
  100 RETURN
C
C
      END
C *CDC* *DECK,OVL70
C *CDC*       OVERLAY (ADINA,7,0)
C *CDC* *DECK,PLATE
C *UNI* )FOR,IS  N.PLATE,  R.PLATE
C *CDC*       PROGRAM PLATE
      SUBROUTINE PLATE
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   M O D E L S                                                     .
C .                                                                   .
C .   MODEL = 1  LINEAR ISOTROPIC                                     .
C .           2  LINEAR ORTHOTROPIC                                   .
C .           3  ISOTROPIC ELASTIC-PLASTIC  (ILYUSHIN)                .
C .           4  EMPTY MODEL                                          .
C .                                                                   .
C .   S T O R A G E                                                   .
C .                                                                   .
C .      N101    DEN     MASS PER UNIT VOLUME                         .
C .      N102    LM      CONNECTIVITY                                 .
C .      N103    XYZ     ELEMENT NODAL COORDINATES                    .
C .      N104    MATP    MATERIAL PROPERTY SET NUMBER                 .
C .      N105    THICI   THICKNESS                                    .
C .      N106    IPS     STRESS PRINTING FLAG                         .
C .      N107    ETIMV   ELEMENT EXPIRY TIME ARRAY (FOR IDEATH.NE.0)  .
C .      N108    EDISB   ELEMENT BIRTH NODAL COOR  (FOR IDEATH.EQ.1)  .
C .      N109    PROP    MATERIAL CONSTANTS                           .
C .      N110    WA      WORKING ARRAY                                .
C .      N111    ITABLE  STRESS OUTPUT LOCATION TABLES                .
C .      N112    ISKEW   SKEW COORDINATES FLAG     (FOR NEGSKS.GT.0)  .
C .      N113    BETA    ARRAY FOR ORTHOTROPIC PROPERTY DIRECTIONS    .
C .      N114    PDIS    ARRAY FOR DISPLACEMENTS AT PREVIOUS TIME     .
C .                      STEP  (FOR NONLINEAR ANALYSIS ONLY)          .
C .      N121    ELM     ARRAY FOR ELEMENT MOMENTS AT INTEGRATION     .
C .                      POINTS  (FOR INDNL.EQ.2 .AND. MODEL.LT.3)    .
C .      NLAST   LAST ADDRESS REQUIRED                                .
C .                                                                   .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
C
      COMMON /SOL/    NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
      COMMON /DIM/    N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,
     1                N15
      COMMON /DIMETC/ N01,N02,N03,N04,N05,N06,N07,N08,N09
      COMMON /FREQIF/ ISTOH,N1A,N1B,N1C
      COMMON /DIMEL/  N101,N102,N103,N104,N105,N106,N107,N108,N109,N110,
     1                N111,N112,N113,N114,N120,N121,N122,N123,N124,N125
      COMMON /EL/     IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1                ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /DPR/    ITWO
      COMMON /ELGLTH/ NFIRST,NLAST,NBCEL
      COMMON /VAR/    NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,IREF,
     1                IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /SKEW/   NSKEWS
      COMMON /ELSTP/  TIME,IDTHF
      COMMON /PRCON/  IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
      COMMON /PORT/   INPORT,JNPORT,NPUTSV,LUNODE,LU1,LU2,LU3,
     1                JDC,JVC,JAC
      COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
      COMMON A(1)
      REAL A
      DIMENSION IA(1)
      EQUIVALENCE (A(1),IA(1))
C
      EQUIVALENCE (NPAR(1),NPAR1),(NPAR(2),NUME),(NPAR(3),INDNL),
     1            (NPAR(4),IDEATH),(NPAR(5),ITYPT),(NPAR(6),NEGSKS),
     2            (NPAR(10),ININT),(NPAR(13),NTABLE),(NPAR(15),MODEL),
     3            (NPAR(16),NUMMAT)
C
      DIMENSION NMCON(5),IDWAS(5),INPAR(20),NINTV(4)
C
      DATA NMCON /2,4,5,0,0/,
     1     IDWAS /0,0,13,0,0/,
     2     NINTV /1,3,3,7/
C
      DATA RECLB1 /8HTYPE-6  /
C
      DO 5 I=1,20
    5 INPAR(I)=NPAR(I)
C
      IF(IND.NE.0) GO TO 100
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   I N P U T    P H A S E                                          .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C     CHECK ON RANGE AND SET DEFAULTS FOR NPAR VECTOR
C
      ISTOP=0
      NINT=4
      MXNODS=3
      MODMAX=5
C
      IF(NUME.GT.0) GO TO 10
      ISTOP=ISTOP+1
      IF(ISTOP.EQ.1) WRITE(6,2100) NG
      ISUB=2
      IRANGE=1
      WRITE(6,2400) ISTOP,ISUB,IRANGE,ISUB,NPAR(ISUB)
C
   10 IF (INDNL.GE.0.AND.INDNL.LE.2) GO TO 15
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=3
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
      INMIN=0
      INMAX=2
      WRITE (6,2250) ISUB,INMIN,INMAX
C
   15 IF (IDEATH.NE.0) IDTHF=1
      IF (IDEATH.GE.0.AND.IDEATH.LE.2) GO TO 20
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
C
      ISUB=4
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
      INMIN=0
      INMAX=2
      WRITE (6,2250) ISUB,INMIN,INMAX
C
C
   20 IF (ININT.LE.0) ININT=2
      IF (ININT.LE.NINT) GO TO 30
      ISTOP=ISTOP+1
      IF(ISTOP.EQ.1) WRITE(6,2100) NG
      ISUB=10
      WRITE(6,2300) ISTOP,ISUB,NINT,ISUB,NPAR(ISUB)
C
   30 IF (NTABLE.GE.0 .AND. NTABLE.LE.10) GO TO 35
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUB=13
      WRITE (6,2200) ISTOP,ISUB,ISUB,NPAR(ISUB)
      INMIN=0
      INMAX=10
      WRITE (6,2250) ISUB,INMIN,INMAX
C
   35 IF (MODEL.LE.0) MODEL=1
      IF (MODEL.LE.MODMAX) GO TO 40
      ISTOP=ISTOP+1
      IF(ISTOP.EQ.1) WRITE(6,2100) NG
      ISUB=15
      WRITE(6,2300) ISTOP,ISUB,MODMAX,ISUB,NPAR(ISUB)
C
   40 IF (NUMMAT.LE.0) NUMMAT=1
C
      IF (MODEL.GT.3) GO TO 45
C
      NCON = NMCON(MODEL)
      IDW = IDWAS(MODEL)
      GO TO 50
C
C     EMPTY MODEL - STOP IMMEDIATELY
C
C
   45 ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      WRITE (6,2450) ISTOP,MODEL
      WRITE (6,2700) ISTOP
      WRITE (6,2800) (I,I=1,8),INPAR
      STOP
C
C
C        CHECK ON COMPATILITY BETWEEN ELEMENTS OF NPAR
C
C             1.  COMPATILITY OF INDNL AND IDEATH
C
   50 ISUB=3
      IF (INDNL.GT.0) GO TO 65
      IF (IDEATH.EQ.0) GO TO 60
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUD=4
      WRITE (6,2500) ISTOP,ISUB,NPAR(ISUB),ISUD,NPAR(ISUD)
C
C             2.  COMPATILITY OF INDNL AND MODEL
C
C                 INDNL=0
   60 IF (MODEL.LE.2) GO TO 65
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      ISUD=15
      WRITE (6,2500) ISTOP,ISUB,NPAR(ISUB),ISUD,NPAR(ISUD)
C
C             3.  COMPATILITY OF NEGSKS AAND NSKEWS
C
   65 IF (NEGSKS.EQ.0)  GO TO 70
      IF (NSKEWS.GT.0)  GO TO 70
      ISUB=6
      ISTOP=ISTOP+1
      IF (ISTOP.EQ.1) WRITE (6,2100) NG
      WRITE (6,2550) ISTOP,NSKEWS,ISUB,NPAR(ISUB)
C
   70 IF (ISTOP.EQ.0) GO TO 75
      WRITE (6,2700) ISTOP
      WRITE (6,2800) (I,I=1,8),INPAR
C
      GO TO 80
C
   75 IF (IDATWR.GT.1) GO TO 90
C
C     PRINT OUT NPAR VECTOR
C
   80 WRITE (6,2900) NPAR1,NUME
      WRITE (6,2940) INDNL,IDEATH
      WRITE (6,2960) NEGSKS,ININT
      WRITE (6,2980) NTABLE,MODEL,NUMMAT
      IF (INDNL.GT.1) WRITE (6,2698)
C
   90 IF (ISTOP.EQ.0) GO TO 95
      WRITE(6,2750)
      STOP
C
C
C***  DATA PORTHOLE  *************************  (START)
C
   95 IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) GO TO 100
      RECLAB=RECLB1
      WRITE (LU3) RECLAB,NG,(NPAR(I),I=1,20),NSUB
C
C***  DATA PORTHOLE  *************************  ( END )
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   E N D   O F   C H E C K   O N   N P A R   V E C T O R           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
C        STORAGE ALLOCATION FOR PLATE ELEMENTS
C
  100 NDM=18
      NDMX=9
      NTH=7
      NINT=NINTV(ININT)
      IDWA=IDWAS(MODEL)*NINT
      NIPT=3*NINT
      NCON=NMCON(MODEL)
      MXNODS=3
      NFIRST=N6
      IF (IND.EQ.4) NFIRST=N10
      N101=NFIRST + 20
      N102=N101 + NUMMAT*ITWO
      N103=N102 + NDM*NUME
      N104=N103 + NDMX*NUME*ITWO
      N105=N104 + NUME
      N106=N105 + NUME*ITWO
      N107=N106 + NUME
      MOPT=0
      IF (IDEATH.GT.0) MOPT=1
      N108=N107 + MOPT*NUME*ITWO
      MOPT=0
      IF (IDEATH.EQ.1) MOPT=1
      N109=N108 + MOPT*NDM*NUME*ITWO
      N110=N109 + NCON*NUMMAT*ITWO
      N111=N110 + IDWA*NUME*ITWO
      N112=N111 + NTABLE*NTH
      MOPT=0
      IF (NEGSKS.GT.0) MOPT=1
      N113=N112 + MOPT*NUME*MXNODS
      MOPT=0
      IF (MODEL.EQ.2) MOPT=1
      N114=N113 + MOPT*NUME*ITWO
      MOPT=0
      IF (INDNL.GE.2 .OR. MODEL.GE.3) MOPT=1
      N121=N114 + MOPT*NUME*NDM*ITWO
      NLAST=N121 - 1
      IF (INDNL.EQ.2 .AND. MODEL.LE.2)
     1  NLAST=N121 + NIPT*NUME*ITWO - 1
C
      IF(IND.NE.0) GO TO 105
      DO 102 I=1,20
  102 IA(NFIRST+I-1) = NPAR(I)
C
      MIDEST=(NLAST-NFIRST)+1
      IF(IDATWR.LE.1) WRITE(6,2000) NG,MIDEST
      CALL SIZE(NLAST)
C
  105 IF (IND.GT.3) GO TO 110
      M2=N2
      M3=N3
      M4=N4
      GO TO 120
  110 M2=N2
      M3=N7
      M4=N8
      IF (ICOUNT.EQ.3) M2=N6
C
  120 CALL PLATEL (A(N06),A(N1A),A(N1),A(M2),A(M3),A(M4),A(N5),
     1             A(N101),A(N102),A(N103),A(N104),A(N105),A(N106),
     2             A(N107),A(N108),A(N109),A(N110),A(N111),
     3             A(N112),A(N113),A(N114),A(N121),
     4             IDWA,NTH,NCON,NDOF,NDM,NDMX,MXNODS,NTABLE,NIPT)
C
      RETURN
C
 2000 FORMAT (///38H S T O R A G E   I N F O R M A T I O N/
     1        ///49H LENGTH OF ARRAY NEEDED FOR STORING ELEMENT GROUP/
     3        12H DATA (GROUP,I3,26H). . . . . . . . . . . . .,
     4        15H( MIDEST ). . =,I5//)
C
 2100 FORMAT (////28H *** I N P U T   E R R O R- //
     1        54H ERROR IN ELEMENT GROUP CONTROL CARDS  (PLATE ELEMENT)/
     2        15H ELEMENT GROUP=,I5/)
 2200 FORMAT (I5,7H. NPAR(,I2,27H) IS OUT OF RANGE ... NPAR(,I2,
     1        3H) =,I5)
 2250 FORMAT (6X,8H ( NPAR(,I2,15H) SHOULD BE GE.,I1,8H AND LE.,I1,2H ))
 2300 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .LE., I2,10H ... NPAR(,I2,
     1        3H) =,I5)
 2400 FORMAT (I5,7H. NPAR(,I2,16H) SHOULD BE .GE., I2,10H ... NPAR(,I2,
     1        3H) =,I5)
 2450 FORMAT (I5,48H. REQUESTED MATERIAL MODEL IS NOT AVAILABLE ... ,
     1        11H NPAR(15) =,I2/)
 2500 FORMAT (I5,7H. NPAR(,I2,3H) =,I2,10H AND NPAR(,I2,3H) =,I2,
     1        19H ARE NOT COMPATIBLE )
 2550 FORMAT (I5,10H. NSKEWS =,I2,10H AND NPAR(,I2,3H) =,I2,
     1        19H ARE NOT COMPATIBLE )
 2698 FORMAT (////16H *** N O T E ***//
     1  52H IN GEOMETRIC NONLINEAR ANALYSIS, I.E., INDNL.GT.1, /
     2  52H THE TOTAL ROTATIONS AT THE NODAL POINTS PRINTED IN /
     3  52H THE STEP-BY-STEP SOLUTION ARE NOT USED.            //
     4  52H THE ELEMENT KINEMATICS AND STRESSES ARE CALCULATED /
     5  52H USING INCREMENTAL ROTATIONS.                       ///)
 2700 FORMAT (//25H TOTAL NUMBER OF ERRORS =,I5//
     1          48H CARD IMAGE LISTING AND PRINT-OUT OF NPAR VECTOR/
     2          48H (WITH DEFAULTS ENFORCED) ARE GIVEN BELOW-------)
 2750 FORMAT (//// 23H STOP  (ERRORS IN NPAR)  )
 2800 FORMAT (///34H CARD IMAGE LISTING OF NPAR VECTOR //29X,
     1        8(I1,9X)/15H COLUMN NUMBERS,5X,8(10H1234567890)/
     2        15H NPAR VECTOR   ,5X,20I4//)
C
 2900 FORMAT (36H E L E M E N T  D E F I N I T I O N ///,
     1        14H ELEMENT TYPE ,13(2H .),16H( NPAR(1) ). . =,I5/,
     2        30H     EQ.1,      TRUSS ELEMENTS/
     3        30H     EQ.2,      2-DIM ELEMENTS/
     4        30H     EQ.3,      3-DIM ELEMENTS/
     5        30H     EQ.4,      BEAM  ELEMENTS/
     5        33H     EQ.5,      ISO/BEAM ELEMENTS  /,
     6        30H     EQ.6,      PLATE ELEMENTS/
     7        30H     EQ.7,      SHELL ELEMENTS/
     8        21H     EQ.8,9,10, EMPTY/
     9        36H     EQ.11,     2-DIM FLUID ELEMENTS/
     A        36H     EQ.12,     3-DIM FLUID ELEMENTS//
     B        20H NUMBER OF ELEMENTS.,10(2H .),16H( NPAR(2) ). . =,I5//)
 2940 FORMAT (18H TYPE OF ANALYSIS ,11(2H .),16H( NPAR(3) ). . =,I5/
     1        43H     EQ.0, LINEAR                          /
     2        43H     EQ.1, MATERIAL NONLINEARITY ONLY      /
     4        43H     EQ.2, UPDATED LAGRANGIAN FORMULATION  //
     5        32H ELEMENT BIRTH AND DEATH OPTION ,4(2H .),
     6        16H( NPAR(4) ). . =,I5/
     7        30H     EQ.0, OPTION NOT ACTIVE  /
     8        30H     EQ.1, BIRTH OPTION ACTIVE/
     9        30H     EQ.2, DEATH OPTION ACTIVE //)
 2960 FORMAT (23H SKEW COORDINATE SYSTEM/
     1        20H REFERENCE INDICATOR,10(2H .),
     2        16H( NPAR(6) ). . =,I5/
     3        35H     EQ.0, GLOBAL COORDINATE SYSTEM/
     4        35H     EQ.1, SKEW   COORDINATE SYSTEM//
     5        23H INTEGRATION SCHEME FOR/
     6        22H STIFFNESS CALCULATION, 9(2H .),
     7        16H( NPAR(10)). . =,I5/
     8        45H     EQ.1, AT CENTROID ONLY        (1 POINT )/
     9        45H     EQ.2, AT 3 INTERIOR LOCATIONS (3 POINTS)/
     A        45H     EQ.3, AT 3 MID-SIDE LOCATIONS (3 POINTS)/
     B        45H     EQ.4, AT 7 INTERIOR LOCATIONS (7 POINTS)//)
 2980 FORMAT (32H NUMBER OF STRESS OUTPUT TABLES ,4(2H .),
     1        16H( NPAR(13)). . =,I5/
     2        32H     EQ.0, AT INTEGRATION POINTS//
     7        16H MATERIAL MODEL.,12(2H .),16H( NPAR(15)). . =,I5/
     8        40H     EQ.1, HOMOGENEOUS LINEAR ISOTROPIC /
     9        41H     EQ.2, HOMOGENEOUS LINEAR ORTHOTROPIC/
     A        40H     EQ.3, ISOTROPIC ELASTIC-PLASTIC     /
     B        40H     EQ.4, EMPTY MODEL                  //
     D        37H NUMBER OF DIFFERENT SETS OF MATERIAL          /
     E        14H     CONSTANTS,13(2H .),16H( NPAR(16)). . =,I5//)
C
      END
C *CDC* *DECK,PLATEL
C
C *UNI* )FOR,IS N.PLATEL , R.PLATEL
      SUBROUTINE PLATEL (RSDCOS,NODSYS,ID,X,Y,Z,HT,
     1                   DEN,LM,XYZ,MATP,THICI,IPS,ETIMV,EDISB,PROP,
     2                   WA,ITABLE,ISKEW,BETA,PDIS,ELM,
     3                   IDWA,NTH,NCON,NDOF,NDM,NDMX,MXNODS,NTABLE,NIPT)
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /SOL/    NUMNP,NEQ,NWK,NWM,NWC,NUMEST,MIDEST,MAXEST,NSTE,MA
      COMMON /EL/     IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1                ISTAT,NDOFDM,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /DIM/    N0,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,
     1                N15
      COMMON /VAR/    NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,IREF,
     1                IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /PRCON/  IDATWR,IPRIC,NPB,IDC,IVC,IAC,IPC,IPNODE(3,15)
      COMMON /PORT/   INPORT,JNPORT,NPUTSV,LUNODE,LU1,LU2,LU3,JDC,JVC,
     1                JAC
      COMMON /MDFRDM/ IDOF(6)
      COMMON /ELSTP/  TIME,IDTHF
      COMMON /SKEW/   NSKEWS
      COMMON /RANDI / N0A,N1D,IELCPL
      COMMON /HAMMS / PSIV(14),ETAV(14),WGTV(14)
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /PROPTY/ C(3,3),CD(3,3),D(3,3),YM,PV,ET,QTM
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
      COMMON /STSPLT/ EPS(3),FN(3),CURV(3),TM(3)
      COMMON /ELINF / THIC,BETE,WAA(13),NEL,IP,NINT,IPT
      COMMON /ILYSHN/ GAMMA,D11,D12,D22,D33,HA,THIC2,THIC3,THIC4,THICM
      COMMON /FSTPLT/ RN(6),RM(9),RE(18),SML(21),SBL(45),S(171),
     1                SNL(6),SCL(54)
      COMMON /XYZLOC/ XYZR(3,3)
      COMMON /ISUBST/ ISUBC,NSUBST,NSUB,NTUSE,NEGLS,NEGNLS,NUMNPS,
     1                NODCON,NODRET,IDOFS(6),NDOFS,NEQS,NWKS,MAXESC,
     2                MAS,NSTAPE,ILOA(13),KRSIZM,NEQC
C
      COMMON A(1)
      REAL A
C
      DIMENSION ID(NDOF,1),X(1),Y(1),Z(1),HT(1),DEN(1),LM(NDM,1),
     1          XYZ(NDMX,1),MATP(1),THICI(1),IPS(1),ETIMV(1),
     2          EDISB(NDM,1),PROP(NCON,1),WA(IDWA,1),ITABLE(NTH,NTABLE),
     3          ISKEW(MXNODS,1),BETA(1),PDIS(NDM,1),ELM(NIPT,1),
     4          RSDCOS(9,1),NODSYS(1)
C
      DIMENSION NODE(3),NODEM(3),XXT(9),XXX(9),XM(18),NPICK(4),NINTV(4),
     1          PSITBL(7),ETATBL(7),XYZINT(3,7),ILSK(6)
C
      EQUIVALENCE (NPAR(1),NPAR1),(NPAR(2),NUME),(NPAR(3),INDNL),
     1            (NPAR(4),IDEATH),(NPAR(5),ITYPT),(NPAR(6),NEGSKS),
     2            (NPAR(10),ININT),(NPAR(15),MODEL),(NPAR(16),NUMMAT)
C
      DATA PSITBL/0., 1., 0., 0.5, 0.5, 0., 0.3333333333333D0/,
     1     ETATBL/0., 0., 1., 0., 0.5, 0.5, 0.3333333333333D0/,
     2     NPICK /0,1,4,7/,
     3     NINTV /1,3,3,7/
C
      DATA RECLB1  /8H TYPE-6 /,
     3     RECLB2  /8HMATERAL6/,
     4     RECLB3  /8HOUTABLE6/,
     4     RECLB4  /8HELEMENT6/,
     5     RECLB5  /8HNEWSTEP6/,
     6     RECLB6  /8HOUTPUT-6/
      DATA RECLB7  /8HIPOINT-6/
C
C     *** NOTE ***     DURING TIME INTEGRATION:
C                      X = LATEST TOTAL DISPLACEMENTS
C                      Y = VELOCITIES
C                      Z = ACCELERATIONS
C
      IP=NPICK(ININT)
      NINT=NINTV(ININT)
      IDW=IDWA/NINT
      IELCPL=0
C
      IF (KPRI.EQ.0) GO TO 800
      IF (IND.GT.0) GO TO 420
C
      ISCONT=0
      IF (NSKEWS.GT.0 .AND. NEGSKS.EQ.0) ISCONT=1
      IJPORT=1
      IF (JNPORT.EQ.0 .OR. NPUTSV.EQ.0) IJPORT=0
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .   R E A D   A N D    G E N E R A T E    E L E M E N T             .
C .   I N F O R M A T I O N                                           .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
C
C
C        1. READ MATERIAL PROPERTIES
C
C
      IF (IDATWR.LE.1) WRITE (6,2000)
C
      IBUG=0
      DO 50 I=1,NUMMAT
      READ (5,1000) N,DEN(N)
      IF (IDATWR.LE.1) WRITE (6,2005) N,DEN(N)
C
      GO TO (20,30,40,40,45),MODEL
C
C     LINEAR ELASTIC HOMOGENEOUS ISOTROPIC PROPERTIES  (MODEL 1)
C
   20 IF (IDATWR.LE.1) WRITE (6,2010)
      READ (5,1010) (PROP(J,N),J=1,NCON)
      IF (IDATWR.LE.1) WRITE (6,2015) (PROP(J,N),J=1,NCON)
      GO TO 50
C
C     LINEAR ELASTIC HOMOGENEOUS ORTHOTROPIC PROPERTIES  (MODEL 2)
C
   30 IF (IDATWR.LE.1) WRITE (6,2020)
      READ (5,1010) (PROP(J,N),J=1,NCON)
      IF (IDATWR.LE.1) WRITE (6,2025) (PROP(J,N),J=1,NCON)
      GO TO 50
C
C     ISOTHERMAL ELASTIC-PLASTIC PROPERTIES  (MODEL 3)
C
   40 IF (IDATWR.LE.1) WRITE (6,2030)
      READ (5,1010) (PROP(J,N),J=1,NCON)
      IF (IDATWR.LE.1) WRITE (6,2035) (PROP(J,N),J=1,NCON)
      IF (PROP(3,N).GT.0.0) GO TO 42
      IBUG=1
      WRITE (6,3401) NG,N
   42 IF (PROP(4,N).LT.PROP(1,N)) GO TO 50
      IBUG=1
      WRITE (6,3402) NG,N
      GO TO 50
C
   45 READ (5,1010) (PROP(J,N),J=1,NCON)
      IF (IDATWR.LE.1) WRITE (6,2045) (J,PROP(J,N),J=1,NCON)
   50 CONTINUE
C
      IF (MODEX.EQ.0 .OR. IBUG.EQ.0) GO TO 53
      WRITE (6,3403)
      STOP
C
   53 IF (NTABLE.EQ.0) GO TO 95
      IF (IDATWR.LE.1) WRITE (6,2050)
      DO 55 L=1,NTABLE
      READ (5,1200) (ITABLE(I,L),I=1,NTH)
      IF (IDATWR.LE.1) WRITE (6,2055) L,(ITABLE(I,L),I=1,NTH)
   55 CONTINUE
C
C *** DATA PORTHOLE  (START) ***
C
   95 IF (IJPORT.EQ.0) GO TO 98
      RECLAB=RECLB2
      WRITE (LU3) RECLAB,NUMMAT,NCON,(DEN(I),I=1,NUMMAT),
     1            ((PROP(I,J),I=1,NCON),J=1,NUMMAT)
      RECLAB=RECLB3
      IF (NTABLE.EQ.0)
     1WRITE (LU3) RECLAB,NTABLE
      IF (NTABLE.GT.0)
     1   WRITE (LU3) RECLAB,NTABLE,((ITABLE(I,J),J=1,NTABLE),I=1,NTH)
C
C *** DATA PORTHOLE  (END) ***
C
C
C        2.  READ ELEMENT INFORMATION
C
   98 IF (IDATWR.LE.1) WRITE (6,2200)
C
      N=1
      IREAD=5
      IF (INPORT.GT.0) IREAD=59
  105 READ (IREAD,1100) M,IS,MTYP,KG,BET,THIC,ETIME,INTLOC
      READ (IREAD,1200) (NODE(K),K=1,3)
C
      IF (N.EQ.1 .AND. M.NE.1) GO TO 115
      IF (M.NE.1 .AND. THIC.EQ.0.) THIC=THICI(1)
      IF (MTYP.LE.0) MTYP=1
      IF (MTYP.GT.NUMMAT) GO TO 110
      IF (KG.LE.0) KG=1
      IF (IDEATH.EQ.2 .AND. ETIME.EQ.0.) ETIME=10000000.
      GO TO 120
C
  110 WRITE(6,2310) NG,M,MTYP,NUMMAT
      STOP
  115 WRITE (6,2315) NSUB,NG
      STOP
C
  120 IF (M.NE.N) GO TO 130
  121 DO 122 I=1,MXNODS
  122 NODEM(I)=NODE(I)
      MTYPE=MTYP
      KKK=KG
      THICK=THIC
      BETE=BET
      IPST=IS
      IELD=MXNODS
      ETIM=ETIME
      INTLM=INTLOC
C
C     SAVE ELEMENT INFORMATION
C
  130 CONTINUE
      L=1
      DO 140 LL=1,IELD
      I=NODEM(LL)
      XYZ(L,N)=X(I)
      XYZ(L+1,N)=Y(I)
      XYZ(L+2,N)=Z(I)
      L=L+3
      IF (ISCONT.EQ.0) GO TO 135
      IF (NODSYS(I).EQ.0) GO TO 140
      WRITE (6,2410) NG,N,NEGSKS
      STOP
  135 IF (NEGSKS.GT.0) ISKEW(LL,N)= NODSYS(I)
  140 CONTINUE
C
C
      MATP(N)=MTYPE
      THICI(N)=THICK
      IPS(N)=IPST
      IF (MODEL.EQ.2) BETA(N)=BETE
      ND=NDM
C
C
C     INITIALIZE DISPLACEMENT AND MOMENT STORAGE FOR NONLINEAR ANALYSIS
C
      IF (INDNL.LE.1 .AND. MODEL.LE.2) GO TO 208
      DO 202 J=1,NDM
  202 PDIS(J,N)=0.
      IF (MODEL.GE.3) GO TO 208
      DO 205 K=1,NIPT
  205 ELM(K,N)=0.
C
  208 DO 222 L=1,ND
  222 LM(L,N)=0
      LL=1
      DO 240 L=1,6
      IF(IDOF(L).EQ.1) GO TO 240
      LP=L-6
      DO 241 LK=1,IELD
      LP=LP+6
      II=NODEM(LK)
      LM(LP,N)=ID(LL,II)
  241 CONTINUE
      LL=LL+1
  240 CONTINUE
C
      IF (NEGSKS.EQ.0) GO TO 250
      DO 252 I=1,IELD
      IF (ISKEW(I,N).NE.0) GO TO 250
  252 CONTINUE
      ISKEW(1,N)=-1
C
  250 IF (IDEATH.EQ.0) GO TO 260
      IF (IDEATH.EQ.2) GO TO 264
      DO 266 L=1,ND
  266 EDISB(L,N)=0.
      ETIMV(N)=-ETIM
      GO TO 260
  264 ETIMV(N)=ETIM
C
C     UPDATE COLUMN HEIGHTS AND BANDWIDTH
C
  260 CALL COLHT (HT,ND,LM(1,N))
C
C
C     INITIALIZE WORKING ARRAYS FOR ELASTIC-PLASTIC MATERIAL LAW
C
      IF (MODEL.GE.3)
     1    CALL INWA (PROP(1,MTYPE),WA(1,N),IDW)
C
      IF(IDATWR.GT.1) GO TO 298
      WRITE (6,2210) N,IPST,MTYPE,KG,BET,THICK,ETIME,INTLM,
     1              (NODEM(LL),LL=1,IELD)
  298 IF (IJPORT.EQ.0 .AND. INTLM.EQ.0) GO TO 310
C
C     CALCULATE GLOBAL COORDINATES OF INTEGRATION POINTS
C
      CALL TRAN (N,XYZ(1,N))
      CALL AREAT (XYZ(1,N))
C
C     1.  CALCULATE INTEGRATION POINT COORDINATES IN THE LOCAL SYSTEM
C
      KINTP=0
      DO 164 INT=1,NINT
      PSI=PSIV(IP+INT)
      ETA=ETAV(IP+INT)
      KINTP=KINTP+1
      XINT=PSI*X2 + ETA*X3
      YINT=ETA*Y3
C
C     2.  TRANSFORM LOCATIONS TO GLOBAL COORDINATE SYSTEM
C
      XINT=XINT + XYZR(1,1)
      YINT=YINT + XYZR(2,1)
      ZINT=XYZR(3,1)
      XYZINT(1,KINTP)=T(1,1)*XINT + T(2,1)*YINT + T(3,1)*ZINT
      XYZINT(2,KINTP)=T(1,2)*XINT + T(2,2)*YINT + T(3,2)*ZINT
      XYZINT(3,KINTP)=T(1,3)*XINT + T(2,3)*YINT + T(3,3)*ZINT
C
C     3.  PRINT LOCATIONS IF INTLM.NE.0
C
      IF (IDATWR.GT.1 .OR. INTLM.LE.0) GO TO 164
      WRITE (6,2262) KINTP,(XYZINT(L,KINTP),L=1,3)
  164 CONTINUE
C
C ***  DATA PORTHOLE (START) ***
C
      RECLAB=RECLB4
      IF (IJPORT.EQ.0) GO TO 310
      WRITE (LU3) RECLAB,N,IPST,MTYPE,THICK,ETIM,INTLM,(NODEM(I),I=1,3)
      RECLAB = RECLB7
      WRITE (LU3) RECLAB,NINT,((XYZINT(L,I),L=1,3),I=1,NINT)
C
C ***  DATA PORTHOLE  (END) ***
C
  310 CONTINUE
      IF(N.EQ.NUME) GO TO 325
      N=N+1
      DO 320 LL=1,IELD
  320 NODEM(LL)=NODEM(LL) + KKK
      IF (N-M) 130,121,105
C
  325 IF (NEGSKS.EQ.0) RETURN
      DO 375 N=1,NUME
      IF (ISKEW(1,N).GE.0) GO TO 380
  375 CONTINUE
      WRITE (6,2400) NG,NEGSKS
  380 RETURN
C
C
  420 GO TO (440,560,560,700) ,IND
C
C
C    A S S E M B L E  L I N E A R   S T I F F N E S S    M A T R I C E S
C
C
  440 ND=18
C
      DO 500 N=1,NUME
C
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
      IF (ICODE.EQ.1) GO TO 500
C
      MTYPE=MATP(N)
      IF (MODEL.EQ.2) BETE=BETA(N)
      THIC=THICI(N)
      NEL=N
C
      CALL PLSTIF (XYZ(1,N),PROP(1,MTYPE),ELM(1,N),WA(1,N),NIPT,IDW)
C
      IF (NEGSKS.EQ.0) GO TO 490
      IF (ISKEW(1,N).LT.0) GO TO 490
      J=1
      DO 480 I=1,3
      ILSK(J)=ISKEW(I,N)
      ILSK(J+1)=ISKEW(I,N)
  480 J=J+2
      CALL ATKA (RSDCOS,S,ILSK,6,3)
  490 CALL ADDBAN (A(N2),A(N1),S,RE,LM(1,N),ND,1)
C
  500 CONTINUE
C
      RETURN
C
C
C    A S S E M B L E   M A S S   M A T R I C E S
C
C     MASS MATRIX WHETHER LUMPED OR CONSISTENT CORRESPONDS
C     ONLY TO THE TRANSLATIONAL DEGREES-OF-FREEDOM
C
C
  560 ND=18
      DO 640 N=1,NUME
      MTYPE=MATP(N)
      NEL=N
      RHO=DEN(MTYPE)
      THIC=THICI(N)
      IF (IMASS.EQ.1) GO TO 570
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
      IF (ICODE.EQ.1) GO TO 640
C
  570 CALL TRAN (N,XYZ(1,N))
      CALL AREAT (XYZ(1,N))
      IF (IMASS.EQ.2) GO TO 665
C
C     LUMPED MASS MATRIX   -   XM(18)
C
      DO 650 K=1,18
  650 XM(K)=0.
      XMLUMP=RHO*THIC*TWOA/6.
      IM=0
      DO 655 J=1,3
      DO 660 I=1,3
  660 XM(I+IM)=XMLUMP
  655 IM=IM+6
C
      CALL ADDMA (A(N4),XM,LM(1,N),ND)
      GO TO 640
C
C     CONSISTENT MASS MATRIX  -  STORED IN  S(171)
C
  665 DGMASS=RHO*THIC*TWOA/12.
      OFFDGM=0.5*DGMASS
      DO 666 I=1,171
  666 S(I)=0.
      INS=1
      JNS=94
      KNS=151
      DO 670 K=1,3
      S(INS)=DGMASS
      S(INS+6)=OFFDGM
      S(INS+12)=OFFDGM
      S(JNS)=DGMASS
      S(JNS+6)=OFFDGM
      S(KNS)=DGMASS
      INS=INS+19-K
      JNS=JNS+13-K
      KNS=KNS+7-K
  670 CONTINUE
C
      IF (NEGSKS.EQ.0) GO TO 685
      IF (ISKEW(1,N).LT.0) GO TO 685
      J=1
      DO 672 I=1,3
      ILSK(J)=ISKEW(I,N)
      ILSK(J+1)=ISKEW(I,N)
  672 J=J+2
      CALL ATKA (RSDCOS,S,ILSK,6,3)
  685 CALL ADDBAN (A(N2),A(N1),S,RE,LM(1,N),ND,1)
C
  640 CONTINUE
C
      RETURN
C
C
C     A S S E M B L E   N O N L I N E A R   F I N A L   S T I F F -
C     N E S S   A N D   E F F E C T I V E   L O A D
C
C
  700 ND=NDM
C
      DO 710 N=1,NUME
C
      NEL=N
      MTYPE=MATP(N)
      THIC=THICI(N)
      IF (MODEL.EQ.2) BETE=BETA(N)
C
      CALL ECHECK (LM(1,N),ND,ICODE,IUPDT)
C
      IF (ICODE.EQ.1) IELCPL=IELCPL+1
      IF (ICODE.EQ.1) GO TO 710
      IF (IDEATH.EQ.0) GO TO 720
C
C     BIRTH AND DEATH OPTION ACTIVE
C
      ETIM=DABS(ETIMV(N))
      IF (IDEATH.EQ.2) GO TO 715
      IF (TIME.LT.ETIM) GO TO 710
      IF (ETIMV(N).GE.0) GO TO 720
      ETIMV(N)=ETIM
C
      DO 718 K=1,ND
      I=LM(K,N)
      IF (I.EQ.0) GO TO 718
      IF (I.LT.0) I=NEQ-I
      EDISB(K,N)=X(I)
  718 CONTINUE
      IF (NEGSKS.LT.1) GO TO 720
      IF (ISKEW(1,N).LT.0) GO TO 720
      J=1
      DO 714 I=1,3
      ILSK(J)=ISKEW(I,N)
      ILSK(J+1)=ISKEW(I,N)
  714 J=J+2
      CALL DIRCOS (RSDCOS,EDISB(1,N),ILSK,6,3,1)
      GO TO 720
  715 IF (TIME.GT.ETIM) GO TO 710
C
  720 DO 722 L=1,NDMX
  722 XXX(L)=XYZ(L,N)
C
      DO 730 I=1,ND
      EDIS(I)=0.
      EDISI(I)=0.
      EDIST(I)=0.
      II=LM(I,N)
      IF (II) 733,730,737
  733 II=NEQ-II
  737 EDIS(I)=X(II)
  730 CONTINUE
C
      IF (NEGSKS.LT.1) GO TO 735
      IF (ISKEW(1,N).LT.0) GO TO 735
      J=1
      DO 736 I=1,3
      ILSK(J)=ISKEW(I,N)
      ILSK(J+1)=ISKEW(I,N)
  736 J=J+2
      CALL DIRCOS (RSDCOS,EDIS,ILSK,6,3,1)
C
  735 IF (IDEATH.NE.1) GO TO 740
      DO 745 I=1,ND
  745 EDIS(I)=EDIS(I) - EDISB(I,N)
      IX=0
      IB=0
      DO 747 I=1,3
      DO 746 J=1,3
  746 XXX(J+IX)=XXX(J+IX) + EDISB(J+IB,N)
      IX=IX+3
  747 IB=IB+6
C
  740 IF (INDNL.LE.1 .AND. MODEL.LE.2) GO TO 750
      DO 754 L=1,ND
      EDISI(L)=EDIS(L)-PDIS(L,N)
      EDIST(L)=PDIS(L,N)
      IF (ICOUNT.LE.2 .AND. IUPDT.EQ.0) PDIS(L,N)=EDIS(L)
  754 CONTINUE
C
  750 CONTINUE
C
      CALL PLSTIF (XXX,PROP(1,MTYPE),ELM(1,N),WA(1,N),NIPT,IDW)
C
      IF (NEGSKS.LT.1) GO TO 760
      IF (ISKEW(1,N).LT.0) GO TO 760
      CALL DIRCOS (RSDCOS,RE,ILSK,6,3,2)
C
  760 MADR=N3
      IF (ICOUNT.EQ.3) MADR=N5
      CALL ADDBAN (A(MADR),A(N1),S,RE,LM(1,N),ND,2)
C
      IF (ICOUNT-2) 770,770,710
  770 IF (IREF) 710,780,710
  780 IF (NEGSKS.LT.1) GO TO 790
      IF (ISKEW(1,N).LT.0) GO TO 790
      CALL ATKA (RSDCOS,S,ILSK,6,3)
C
  790 CALL ADDBAN (A(N4),A(N1),S,RE,LM(1,N),ND,1)
C
  710 CONTINUE
      IF (IELCPL.EQ.NUME) IELCPL=-1
C
      RETURN
C
C
C     S T R E S S  C A L C U L A T I O N S
C
C
C
C     *** DATA PORTHOLE (START) ***
C
  800 IF (JNPORT.EQ.0 .OR.KPLOTE.NE.0) GO TO 805
      RECLAB=RECLB5
      WRITE (LU3) RECLAB,NG,(NPAR(I),I=1,20),KSTEP,TIME,NEGL,NSUB
C
C     *** DATA PORTHOLE (END) ***
C
  805 IPRNT=0
      ND=18
C
      DO 810 N=1,NUME
      NEL=N
C
      IF (IDEATH.EQ.0) GO TO 825
      ETIM=DABS(ETIMV(N))
      IF (IDEATH.EQ.2) GO TO 815
      IF (TIME.LT.ETIM) GO TO 810
      GO TO 825
  815 IF (TIME.GT.ETIM) GO TO 810
C
  825 IPST=IPS(N)
      IF (IPST.EQ.0) GO TO 810
      IF (IPRI.NE.0) GO TO 828
      IPRNT=IPRNT+1
      IF (IPRNT.NE.1) GO TO 828
      WRITE (6,2500) NG
      IF (MODEL.EQ.3) GO TO 827
      WRITE (6,2800)
      GO TO 828
  827 WRITE (6,2802)
  828 MTYPE=MATP(N)
      THIC=THICI(N)
      IF (MODEL.EQ.2) BETE=BETA(N)
C
      DO 830 I=1,ND
      EDIS(I)=0.
      EDISI(I)=0.
      EDIST(I)=0.
      II=LM(I,N)
      IF (II.EQ.0) GO TO 830
      IF (II.LT.0) II=NEQ-II
      EDIS(I)=X(II)
  830 CONTINUE
C
      IF (NEGSKS.LT.1) GO TO 832
      IF (ISKEW(1,N).LT.0) GO TO 832
      J=1
      DO 829 I=1,3
      ILSK(J)=ISKEW(I,N)
      ILSK(J+1)=ISKEW(I,N)
  829 J=J+2
      CALL DIRCOS (RSDCOS,EDIS,ILSK,6,3,1)
C
  832 DO 840 I=1,NDMX
  840 XXX(I)=XYZ(I,N)
C
      IF (IDEATH.NE.1) GO TO 838
C
C     BIRTH OPTION ACTIVE - UPDATE DISPLACEMENTS AND COORDINATES
C
      DO 835 I=1,ND
  835 EDIS(I) = EDIS(I) - EDISB(I,N)
C
      MX=0
      MD=0
      DO 844 I=1,3
      DO 842 J=1,3
  842 XXX(MX+J)=XXX(MX+J)  +  EDISB(MD+J,N)
      MX=MX+3
  844 MD=MD+6
C
  838 IF (INDNL.LE.1 .AND. MODEL.LE.2) GO TO  848
      DO 846 L=1,ND
      EDISI(L)=EDIS(L)-PDIS(L,N)
  846 EDIST(L)=PDIS(L,N)
C
  848 CALL TRAN (N,XXX)
      CALL AREAT (XXX)
C
      IF (INDNL-1) 861,857,850
C
C     LARGE DISPLACEMENT ANALYSIS - (INDNL.EQ.2)
C     UPDATE NODAL COORDINATES AND CALCULATE LOCAL DISPLACEMENTS
C     AND/OR DISPLACEMENT INCREMENTS
C
  850 KX=0
      KD=0
      DO 854 I=1,3
      DO 852 J=1,3
      XXT(KX+J)=XXX(KX+J) + EDIST(KD+J)
  852 XXX(KX+J)=XXX(KX+J) + EDIS (KD+J)
      KX=KX+3
  854 KD=KD+6
C
      CALL GNLDIS (N,MODEL,XXT,XXX)
C
      GO TO 868
C
C     MATERIAL NONLINEAR ONLY ANALYSIS - (INDNL.EQ.1)
C     TRANSFORM DISP INC TO UNDEFORMED CONFIGURATION
C
  857 IF (MODEL.LE.2) GO TO 861
      IR=0
      IE=0
      DO 858 K=1,3
      DO 859 I=1,3
      TX=0.
      RX=0.
      DO 860 J=1,3
      TX=TX + T(I,J)*EDISI(J+IE)
  860 RX=RX + T(I,J)*EDISI(J+IE+3)
      TDIS(I+IR)=TX
  859 RDIS(I+IR)=RX
      IR=IR+3
  858 IE=IE+6
      GO TO 868
C
C
C     LINEAR ELASTIC ANALYSIS - (INDNL.EQ.0)
C     TRANSFORM DISPLACEMENT TO UNDEFORMED CONFIGURATION
C
  861 IR=0
      IE=0
      DO 862 K=1,3
      DO 864 I=1,3
      TX=0.
      RX=0.
      DO 865 J=1,3
      TX=TX + T(I,J)*EDIS(J+IE)
  865 RX=RX + T(I,J)*EDIS(J+IE+3)
      TDIS(I+IR)=TX
  864 RDIS(I+IR)=RX
      IR=IR+3
  862 IE=IE+6
C
C     CALCULATE MEMBRANE STRAINS
C
  868 CALL STRCSE (INDNL)
C
C     CALCULATE STRESS STRAIN LAW AND MEMBRANE FORCES FOR LINEAR MODELS
C     (MODEL.EQ.1 OR 2)
C
      IF (MODEL.GT.2) GO TO 880
C
      CALL PROPTL (MODEL,PROP(1,MTYPE),BETE)
C
      DO 869 I=1,2
      TX=0.
      DO 867 J=1,2
  867 TX=TX + C(I,J)*EPS(J)
  869 FN(I)=TX
      FN(3)=C(3,3)*EPS(3)
C
C     PRINT FORCES AND MOMENTS
C
      IF (IPRI.EQ.0)  WRITE (6,2039) N,(FN(K),K=1,3)
C
C     CALCULATE MOMENTS AT *IPST* LOCATIONS
C
      IF (INDNL.GT.0) GO TO 880
      IF (NTABLE.EQ.0) GO TO 880
C
      DO 870 II=1,NTH
      I=ITABLE(II,IPST)
      IF (I.EQ.0) GO TO 870
      PSI=PSITBL(I)
      ETA=ETATBL(I)
C
      CALL STRDKT (PSI,ETA)
C
      CALL PROPTN (MODEL,PROP(1,MTYPE))
      IF (IPRI.EQ.0)  WRITE (6,2040) I,(TM(J),J=1,3)
C
C ***  DATA PORTHOLE  (START)
C
      RECLAB=RECLB6
      IF (JNPORT.NE.0 .AND. KPLOTE.EQ.0)
     1  WRITE (LU3) RECLAB,I,FN,TM,EPS,CURV
C
C ***  DATA PORTHOLE  (END)
C
  870 CONTINUE
      GO TO 810
C
C     CALCULATE MOMENTS AT INTEGRATION POINTS
C     PRINT FORCES AND MOMENTS
C
  880 RECLAB=RECLB6
C
      KELM=0
C
      DO 882 INT=1,NINT
      IPT=INT
      PSI=PSIV(IP+INT)
      ETA=ETAV(IP+INT)
C
      CALL STRDKT (PSI,ETA)
      IF (MODEL.LE.2) GO TO 886
C
      JWA=IDW*(INT-1)
      DO 887 KWA=1,IDW
  887 WAA(KWA)=WA(JWA+KWA,N)
C
  886 CALL PROPTN (MODEL,PROP(1,MTYPE))
C
      IF (MODEL.GT.2) GO TO 889
      IF (INDNL.LE.1) GO TO 892
C
C     ADD MOMENT INC TO MOMENTS AT LAST TIME STEP FOR LARGE
C     DISPLACEMENT ELASTIC ANALYSIS
C
      DO 888 KM=1,3
  888 TM(KM)=ELM(KM+KELM,N) + TM(KM)
      KELM=KELM+3
C
  892 IF (IPRI.EQ.0)  WRITE (6,2040) INT,(TM(L),L=1,3)
C
C ***  DATA PORTHOLE  (START)
C
  889 CONTINUE
      IF (JNPORT.EQ.0 .OR. KPLOTE.NE.0) GO TO 882
      WRITE (LU3) RECLAB,INT,FN,TM,EPS,CURV
C
C ***  DATA PORTHOLE  (END)
C
  882 CONTINUE
  810 CONTINUE
C
C
C
 1000 FORMAT (I5,4F10.0)
 1010 FORMAT (8F10.0)
 1100 FORMAT (4I5,3F10.0,I5)
 1200 FORMAT (16I5)
C
 2000 FORMAT (//36H M A T E R I A L   C O N S T A N T S //)
 2005 FORMAT (26H MATERIAL PROPERTY SET NO., I5//
     1        16H      DENSITY = ,E15.6//)
 2010 FORMAT (21H ISOTROPIC PROPERTIES  /)
 2015 FORMAT (21H YOUNGS MODULUS  E = ,E15.6/
     1        21H POISSONS RATIO NU = ,E15.6//)
 2020 FORMAT (23H ORTHOTROPIC PROPERTIES   /)
 2025 FORMAT (16H MODULUS  EAA = ,E15.6/
     1        16H MODULUS  EAB = ,E15.6/
     2        16H MODULUS  EBB = ,E15.6/
     3        16H MODULUS  GAB = ,E15.6//)
 2030 FORMAT (28H ELASTIC-PLASTIC PROPERTIES  /)
 2035 FORMAT (25H YOUNGS MODULUS      E = ,E15.6/
     1        25H POISSONS RATIO     NU = ,E15.6/
     2        25H YIELD STRESS    SIG-Y = ,E15.6/
     3        25H HARDENING MODULUS  ET = ,E15.6/
     4        25H COUPLING FACTOR GAMMA = ,E15.6//)
 2039 FORMAT (//I6,14X,3(E13.6,4X))
 2040 FORMAT (10X,I5,52X,3(4X,E13.6))
 2045 FORMAT (1H ,4X,5HPROP(I2,10H) ...... =,6E15.6//)
 2050 FORMAT(///40H S T R E S S   O U T P U T   T A B L E  //
     1          10H     TABLE,9X,1H1,9X,1H2,9X,1H3,9X,1H4,9X,1H5,
     2          9X,1H6,9X,1H7/)
 2055 FORMAT (10I10)
 2200 FORMAT (///38H E L E M E N T   I N F O R M A T I O N//
     3           5X,1HN,4X,3HIPS,3X,4HMTYP,4X,2HKG,6X,3HBET,8X,
     4           10H   THIC   ,5X,5HETIME,4X,6HINTLOC,9X,
     5           28H NODE(1)  NODE(2)  NODE(3)      //
     6           58X,11HINTEGRATION,17X,19HGLOBAL  COORDINATES/
     7           61X,5HPOINT,16X,1HX,12X,1HY,12X,1HZ)
 2262 FORMAT (1H ,59X,I4,12X,2(E11.4,2X),E11.4)
 2210 FORMAT (/2I6,2I7,3X,2(E11.4,2X),E11.4,I5,12X,3(I6,3X))
 2400 FORMAT (///16H ELEMENT GROUP =,I2,22H   (PLATE  ELEMENT)   /
     1           19H ALTHOUGH NPAR(6) =,I2,22H, NONE OF THE ELEMENTS/
     2           49H IN THIS GROUP REFERS TO SKEW COORDINATE SYSTEM. /
     3           50H IT IS ADVISED THAT NPAR(6) BE SET TO ZERO TO SAVE,
     4           15H STORAGE SPACE.//
     5           39H THIS IS ONLY AN INFORMATIONAL MESSAGE.///)
 2410 FORMAT (///16H ELEMENT GROUP =,I2,22H   (ELEMENT PLATE)     /
     2           42H SINCE NODES OF THIS ELEMENT REFER TO SKEW,
     3           48H COORDINATE SYSTEM(S), NPAR(6) MUST BE SET TO 1.//
     4           8H S T O P//)
 2800 FORMAT (//8H ELEMENT,9H   OUTPUT,10X,17HMEMBRANE FORCES  ,
     1          18H (PER UNIT LENGTH),15X,16H BENDING MOMENTS  ,
     A          20H   (PER UNIT LENGTH)  /
     2          1H ,9X,8HLOCATION/1H ,7X,12HFOR  MOMENTS,6X,2HNX,15X,
     3          2HNY,15X,3HNXY,14X,2HMX,15X,2HMY,15X,3HMXY//)
 2802 FORMAT (//8H ELEMENT,5H  INT,8H   STATE,14X,15HMEMBRANE FORCES,3X,
     1          17H(PER UNIT LENGTH),15X,16H BENDING MOMENTS,3X,
     2          17H(PER UNIT LENGTH)/8X,5H   PT,21X,2HNX,15X,2HNY,
     3          15X,3HNXY,14X,2HMX,15X,2HMY,15X,3HMXY//)
 2310 FORMAT (///16H ELEMENT GROUP =,I2,18H (PLATE ELEMENTS)  /
     1        17H ELEMENT NUMBER =,I4/
     2        7H MTYP =,I3,27H IS GREATER THAN NPAR(16) =,I3/5H STOP)
 2315 FORMAT (///23H INPUT ERROR **********/
     1           19H SUBSTRUCTURE  NO =,I3/
     2           19H ELEMENT GROUP NO =,I3/
     3           31H FIRST ELEMENT NUMBER MUST BE 1)
 2500 FORMAT (1H1,48HS T R E S S   C A L C U L A T I O N S   F O R     ,
     1        27HE L E M E N T   G R O U P  ,I5,
     2        31H  ( PLATE TRIANGULAR ELEMENTS )  //)
 3401 FORMAT (//50H INPUT ERROR DETECTED IN (PLATEL/PLATE)            //
     1          19H ELEMENT GROUP NO =,I5/
     2          27H MATERIAL PROPERTY SET NO =,I5/
     2          38H ZERO OR NEGATIVE INITIAL YIELD STRESS  //)
 3402 FORMAT (//50H INPUT ERROR DETECTED IN (PLATEL/PLATE)            //
     1          19H ELEMENT GROUP NO =,I5/
     2          27H MATERIAL PROPERTY SET NO =,I5/
     3          44H HARDENING MODULUS (ET) GREATER OR EQUAL TO   ,
     4          44H YOUNG*S MODULUS (E) IS NOT ALLOWED           //)
 3403 FORMAT (//33H ERROR IN MATERIAL PROPERTY INPUT //
     1          15H *** STOP ***    //)
C
      RETURN
C
      END
C *CDC* *DECK INWA
C *UNI* )FOR,IS  N.INWA, R.INWA
      SUBROUTINE INWA (PROP,WA,IDW)
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /DPR/    ITWO
      COMMON /ELINF / THIC,BETE,WAA(13),NEL,IP,NINT,IPT
C
      DIMENSION PROP(1),WA(IDW,1)
C
C     SET INITIAL STRESS RESULTANTS AND STRAINS TO ZERO
C     SET INITIAL STATE TO *ELASTIC*
C     WA(13,INT) IS THE SQUARE OF THE INITIAL YIELD STRESS
C
C
      DO 10 J=1,NINT
      DO 15 I=1,12
   15 WA(I,J)=0.0
   10 WA(13,J)=PROP(3)*PROP(3)
C
      RETURN
C
C
      END
C *CDC* *DECK PLSTIF
C *UNI* )FOR,IS  N.PLSTIF,  R.PLSTIF
      SUBROUTINE PLSTIF (XYZ,PROP,ELM,WA,NIPT,IDW)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C . P  R  O  G  R  A  M                                               .
C .                                                                   .
C .      TO CALCULATE THE PLATE STIFFNESS AND THE OUT-OF-BALANCE LOAD .
C .                                                                   .
C .      THE MEMBRANE BEHAVIOR IS REPRESENRED BY A CONSTANT STRAIN    .
C .      ELEMENT  (CST)                                               .
C .                                                                   .
C .      THE BENDING BEHAVIOR IS REPRESENTED BY A DISCRETE KIRCHHOFF  .
C .      ELEMENT  (DKT)                                               .
C .                                                                   .
C .      THE MEMBRANE AND BENDING ACTIONS ARE UNCOUPLED IN ELASTIC    .
C .      ANALYSIS (MODEL.LE.2)                                        .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /EL/     IND,ICOUNT,NPAR(20),NUMEG,NEGL,NEGNL,IMASS,IDAMP,
     1                ISTAT,NDOF,KLIN,IEIG,IMASSN,IDAMPN
      COMMON /VAR/    NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,IREF,
     1                IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /HAMMS / PSIV(14),ETAV(14),WGTV(14)
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /PROPTY/ C(3,3),CD(3,3),D(3,3),YM,PV,ET,QTM
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
      COMMON /STSPLT/ EPS(3),FN(3),CURV(3),TM(3)
      COMMON /FSTPLT/ RN(6),RM(9),RE(18),SML(21),SBL(45),S(171),
     1                SNL(6),SCL(54)
      COMMON /ELINF / THIC,BETE,WAA(13),NEL,IP,NINT,IPT
      COMMON /ILYSHN/ GAMMA,D11,D12,D22,D33,HA,THIC2,THIC3,THIC4,THICM
C
      DIMENSION XYZ(1),PROP(1),ELM(1),WA(IDW,1)
      DIMENSION XXT(9),XXX(9),BMU(3),BMV(3)
C
      EQUIVALENCE (NPAR(3),INDNL),(NPAR(5),ITYPT),(NPAR(10),ININT),
     1            (NPAR(15),MODEL),(NPAR(7),IDEBUG)
C
      IF (IND.GE.4) GO TO 200
C
C     E V A L U A T E   S T I F F N E S S   F O R   L I N E A R
C     A N A L Y S I S
C
C
      CALL TRAN (NEL,XYZ)
      CALL AREAT (XYZ)
C
C     FIND LINEAR STRESS STRAIN CONSTANTS
C
      CALL PROPTL (MODEL,PROP)
C
C     CALCULATE LINEAR MEMBRANE STIFFNESS IN CLOSED-FORM
C     CALCULATE BENDING STIFFNESS WITH NUMERICAL INTEGRATION SCHEME
C     SET AT ININT.EQ.2        (3 POINT INTEGRATION)
C
      DO 105 I=1,45
  105 SBL(I)=0.
      DO 115 I=1,6
  115 SNL(I)=0.
C
      WGT=TWOA/6.
      CALL STFCSE (WGT,MODEL)
C
      DO 180 INT=1,3
      PSI=PSIV(INT+1)
      ETA=ETAV(INT+1)
      CALL STFDKT (PSI,ETA,WGT)
  180 CONTINUE
C
C     ASSEMBLE AND TRANSFORM STIFFNESS TO GLOBAL SYSTEM
C
      CALL ASSEMK (MODEL)
C
      RETURN
C
C
C     F I N D   N O N L I N E A R   E L M E N T   M A T R I C E S
C
C
  200 CALL TRAN (NEL,XYZ)
      CALL AREAT (XYZ)
      IF (INDNL.EQ.2) GO TO 210
C
C     TRANSFORM DISPLACEMENTS (MODEL.LE.2) OR DISPLACEMENT INCREMENTS
C     (MODEL.GT.2) TO UNDEFORMED CONFIGURATION FOR SMALL DISPLACEMENT
C     ANALYSIS  (INDNL.EQ.1)
C
      IR=0
      IE=0
      IF (MODEL.LE.2) GO TO 205
C
      DO 204 K=1,3
      DO 202 I=1,3
      TX=0.
      RX=0.
      DO 203 J=1,3
      TX=TX + T(I,J)*EDISI(J+IE)
  203 RX=RX + T(I,J)*EDISI(J+IE+3)
      TDIS(I+IR)=TX
  202 RDIS(I+IR)=RX
      IR=IR+3
  204 IE=IE+6
      GO TO 350
C
  205 DO 207 K=1,3
      DO 208 I=1,3
      TX=0.
      RX=0.
      DO 209 J=1,3
      TX=TX + T(I,J)*EDIS(J+IE)
  209 RX=RX + T(I,J)*EDIS(J+IE+3)
      TDIS(I+IR)=TX
  208 RDIS(I+IR)=RX
      IR=IR+3
  207 IE=IE+6
      GO TO 350
C
C     LARGE DISPLACEMENTS/ROTATIONS SMALL STRAINS ANALYSIS -
C     UPDATED LAGRANGIAN FORMULATION     (INDNL.EQ.2)
C
  210 IR=0
      IE=0
      DO 230 I=1,3
      DO 220 J=1,3
      XXT(J+IR)=XYZ(J+IR) + EDIST(J+IE)
  220 XXX(J+IR)=XYZ(J+IR) + EDIS (J+IE)
      IR=IR+3
  230 IE=IE+6
C
C     CALCULATE UPDATED LOCAL DISPLACEMENT INC
C
      CALL GNLDIS (NEL,MODEL,XXT,XXX)
C
C     FIND MEMBRANE STRAIN
C
  350 AR=0.5*TWOA
C
      CALL STRCSE (INDNL)
C
C     CALCULATE STRESS STRAIN LAW AND MEMBRANE FORCES FOR
C     LINEAR MODELS     (MODEL.EQ.1 OR 2)
C
      IF (MODEL.GE.3) GO TO 400
C
      CALL PROPTL (MODEL,PROP)
C
      DO 380 I=1,2
      TX=0.
      DO 360 J=1,2
  360 TX=TX + C(I,J)*EPS(J)
  380 FN(I)=TX
      FN(3)=C(3,3)*EPS(3)
C
C     CALCULATE ELEMENT NODAL FORCE VECTOR AND STIFFNESS.
C
C     IN ELASTIC ANALYSIS (MODEL.LE.2), THE MEMBRANE CONTRIBUTIONS
C     ARE EVALUATED IN CLOSED-FORM AND THE BENDING CONTRIBUTIONS ARE
C     EVALUATED NUMERICALLY.
C
C     IN ELASTIC-PLASTIC ANALYSIS, ALL CONTRIBUTIONS ARE EVALUATED
C     USING NUMERICAL INTEGRATION.
C
  400 DO 430 I=1,21
  430 SML(I)=0.
      DO 440 I=1,45
  440 SBL(I)=0.
      DO 460 J=1,6
  460 SNL(J)=0.
      DO 450 I=1,54
  450 SCL(I)=0.
      DO 470 K=1,6
  470 RN(K)=0.
      DO 480 I=1,9
  480 RM(I)=0.
C
      KELM=0
C
      DO 500 INT=1,NINT
      PSI=PSIV(IP+INT)
      ETA=ETAV(IP+INT)
      WGT=WGTV(IP+INT)*AR
      IPT=INT
C
      CALL STRDKT (PSI,ETA)
      IF (MODEL.LE.2) GO TO 533
C
C     CALCULATE STRESS-STRAIN LAW FOR NONLINEAR MATERIAL MODELS AND
C     ELEMENT FORCE AND MOMENT INC
C
      DO 532 I=1,IDW
  532 WAA(I)=WA(I,INT)
  533 CALL PROPTN (MODEL,PROP)
C
      IF (ICOUNT.EQ.3 .OR. MODEL.LE.2) GO TO 535
C
      DO 534 I=1,IDW
  534 WA(I,INT)=WAA(I)
  535 CONTINUE
C
C
C     ADD MOMENT INC TO MOMENTS AT LAST TIME STEP FOR LARGE DISP-
C     LACEMENT ELASTIC ANALYSIS
C
      IF (INDNL.LE.1 .OR. MODEL.GE.3) GO TO 555
C
      DO 540 K=1,3
      TM(K)=TM(K) + ELM(K+KELM)
      IF (ICOUNT.LE.2.AND.IUPDT.EQ.0) ELM(K+KELM)=TM(K)
  540 CONTINUE
      KELM=KELM+3
C
  555 DO 560 I=1,9
      DO 580 J=1,3
  580 RM(I)=RM(I) + WGT*B(J,I)*TM(J)
  560 CONTINUE
C
C     CALCULATE AND ASSEMBLE ELEMENT FORCE VECTOR.  FOR ELASTIC ANA-
C     LYSIS THE MEMBRANE CONTRIBUTIONS ARE ASSEMBLED ONLY AT THE
C     LAST INTEGRATION POINT
C
      IF(MODEL.GT.2) GO TO 600
      IF (INT.LT.NINT) GO TO 640
C
      DO 620 I=1,3
      RN(I)=AR*(BM(I)*FN(1) + BM(I+3)*FN(3))
  620 RN(I+3)=AR*(BM(I)*FN(3) + BM(I+3)*FN(2))
C
      CALL ASSEMF (MODEL,INDNL)
C
      GO TO 640
C
  600 DO 630 I=1,3
      RN(I)=RN(I) + WGT*(BM(I)*FN(1) + BM(I+3)*FN(3))
  630 RN(I+3)=RN(I+3) + WGT*(BM(I)*FN(3) + BM(I+3)*FN(2))
C
      IF (INT.EQ.NINT) CALL ASSEMF (MODEL,INDNL)
C
C     CALCULATE STIFFNESS IF NECESSARY
C
  640 IF (ICOUNT-2) 660,660,500
  660 IF (IREF) 500,680,500
C
C     CALCULATE BENDING CONTRIBUTION
C
  680 CALL STFDKT (PSI,ETA,WGT)
C
      IF (MODEL.LE.2) GO TO 780
C
C     CALCULATE MEMBRANE-BENDING COUPLING TERMS WITH ELASTIC-
C     PLASTIC MODELS  (MODEL.GE.3)
C
      ISC=0
      IU=1
      IV=4
      DO 768 L=1,3
      DO 770 I=1,3
      BMU(I)=BM(IU)*CD(1,I) + BM(IV)*CD(3,I)
  770 BMV(I)=BM(IV)*CD(2,I) + BM(IU)*CD(3,I)
      MSC=3*L-2
      DO 772 J=1,9
      CX=0.
      DO 774 K=1,3
  774 CX=CX + BMU(K)*B(K,J)
      ISC=ISC+1
  772 SCL(ISC)=SCL(ISC) + CX*WGT
      DO 776 J=1,9
      CX=0.
      DO 778 K=1,3
  778 CX=CX + BMV(K)*B(K,J)
      ISC=ISC+1
  776 SCL(ISC)=SCL(ISC) + CX*WGT
      IU=IU+1
  768 IV=IV+1
C
C     CALCULATE MEMBRANE CONTRIBUTION FOR ELASTIC-PLASTIC MODEL
C
      CALL STFCSE (WGT,MODEL)
C
  780 IF (INDNL.LE.1) GO TO 795
C
C     CALCULATE GEOMETRIC NONLINEAR STIFFNESS MATRIX IN LARGE
C     DISPLACEMENT ANALYSIS  (INDNL.EQ.2)
C
      IF (MODEL.GT.2) GO TO 792
      IF (INT.LT.NINT) GO TO 500
C
      FAC3=0.5/TWOA
      SS11=(Y3*Y3*FN(1) + X3*X3*FN(2) - 2.*X3*Y3*FN(3))*FAC3
      SS12=(TWOA*FN(3) - X2*X3*FN(2))*FAC3
      SS22=X2*X2*FN(2)*FAC3
C
      SNL(1)= SS11+SS12+SS12+SS22
      SNL(2)=-SS11-SS12
      SNL(3)=-SS12-SS22
      SNL(4)= SS11
      SNL(5)= SS12
      SNL(6)= SS22
C
      GO TO 797
C
  792 FAC3=WGT/(TWOA*TWOA)
      SS11=(Y3*Y3*FN(1) + X3*X3*FN(2) - 2.*X3*Y3*FN(3))*FAC3
      SS12=(TWOA*FN(3) - X2*X3*FN(2))*FAC3
      SS22=X2*X2*FN(2)*FAC3
C
      SNL(1)=SNL(1)+SS11+SS12+SS12+SS22
      SNL(2)=SNL(2)-SS11-SS12
      SNL(3)=SNL(3)-SS12-SS22
      SNL(4)=SNL(4)+SS11
      SNL(5)=SNL(5)+SS12
      SNL(6)=SNL(6)+SS22
C
      GO TO 795
C
C     CALCULATE LINEAR MEMBRANE STIFFNESS MATRIX  AND  ASSEMBLE AND
C     CALCULATE ELEMENT GLOBAL STIFFNESS  WHEN INT.EQ.NINT
C
  795 IF (INT.LT.NINT) GO TO 500
C
  797 IF (MODEL.LE.2) CALL STFCSE (WGT,MODEL)
      CALL ASSEMK (MODEL)
C
  500 CONTINUE
C
      RETURN
C
      END
C *CDC* *DECK TRAN
C *UNI* )FOR,IS  N.TRAN,  R.TRAN
      SUBROUTINE TRAN (N,XYZ)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .                                                                   .
C .      TO CALCULATE THE GLOBAL TO LOCAL TRANSFORMATION MATRIX  T    .
C .      USING THE GLOBAL NODAL COORDINATES  XYZ                      .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /VAR/   NG,MODEX,IUPDT,KSTEP,ITEMAX,IEQREF,ITE,KPRI,IREF,
     1               IEQUIT,IPRI,KPLOTN,KPLOTE
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
C
      DIMENSION XYZ(3,3)
C
      TOL=0.1D-9
C
      GX21=XYZ(1,2) - XYZ(1,1)
      GX31=XYZ(1,3) - XYZ(1,1)
      GY21=XYZ(2,2) - XYZ(2,1)
      GY31=XYZ(2,3) - XYZ(2,1)
      GZ21=XYZ(3,2) - XYZ(3,1)
      GZ31=XYZ(3,3) - XYZ(3,1)
C
      XY = GX21*GY31 - GY21*GX31
      YZ = GY21*GZ31 - GZ21*GY31
      ZX = GZ21*GX31 - GX21*GZ31
C
      SX = DSQRT(GX21*GX21 + GY21*GY21 + GZ21*GZ21)
      IF (SX.LT.TOL)  GO TO 60
      SZ=DSQRT(YZ*YZ + ZX*ZX + XY*XY)
      IF (SZ.LT.TOL) GO TO 70
      SY=SZ*SX
C
      T(1,1)= GX21/SX
      T(1,2)= GY21/SX
      T(1,3)= GZ21/SX
      T(2,1)=(GZ21*ZX - GY21*XY)/SY
      T(2,2)=(GX21*XY - GZ21*YZ)/SY
      T(2,3)=(GY21*YZ - GX21*ZX)/SY
      T(3,1)= YZ/SZ
      T(3,2)= ZX/SZ
      T(3,3)= XY/SZ
C
      RETURN
C
   60 WRITE (6,2000) NG,N,SX
      STOP
   70 WRITE (6,2050) NG,N,SZ
      STOP
C
 2000 FORMAT (////14H *** ERROR ***/18H ELEMENT GROUP NO.,I5/
     1        50H ZERO OR NEGATIVE JACOBIAN DETERMINANT FOR ELEMENT,
     2        I5,10X,22H LENGTH OF SIDE 1-2=  ,F10.4)
 2050 FORMAT (////14H *** ERROR ***/18H ELEMENT GROUP NO.,I5/
     1        50H ZERO OR NEGATIVE JACOBIAN DETERMINANT FOR ELEMENT,
     2        I5,10X,18H TWICE THE AREA=  ,F10.4)
C
C
      END
C *CDC* *DECK,AREAT
C *UNI* )FOR,IS N.AREAT,R.AREAT
      SUBROUTINE AREAT (XYZ)
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .                                                                   .
C .      TO CALCULATE THE REQUIRED GEOMETRIC QUANTITIES WITH RESPECT  .
C .      TO THE LOCAL COORDINATE SYSTEM                               .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /XYZLOC/ XYZR(3,3)
C
      DIMENSION XYZ(3,3)
C
C     TRANSFORM THE NODAL COORDINATES
C
C
      DO 30 K=1,3
      DO 30 J=1,3
      TEMP=0.
      DO 35 I=1,3
   35 TEMP=TEMP + T(K,I)*XYZ(I,J)
   30 XYZR(K,J)=TEMP
C
C     CALCULATE THE LOCAL NODAL COOR WITH NODE 1 AS ORIGIN
C
      X2=XYZR(1,2) - XYZR(1,1)
      X3=XYZR(1,3) - XYZR(1,1)
      Y3=XYZR(2,3) - XYZR(2,1)
C
C     CALCULATE TWICE THE AREA (TWOA) OF THE ELEMENT MID-SURFACE
C
      TWOA=X2*Y3
C
      RETURN
C
      END
C *CDC* *DECK GNLDIS
C *UNI* )FOR,IS N.GNLDIS, R.GNLDIS
      SUBROUTINE GNLDIS (N,MODEL,XXT,XXX)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P R O G R A M                                                   .
C .      TO CALCULATE THE DISPLACEMENTS OR DISP  INC  IN GEOMETRIC    .
C .      NONLINEAR ANALYSIS                                           .
C .                                                                   .
C .      NOTE - XXT STORES THE GLOBAL NODAL COOR  AT THE LAST         .
C .             TIME STEP                                             .
C .           - XXX STORES THE GLOBAL NODAL COOR  AT THE CURRENT      .
C .             TIME STEP                                             .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
C
      DIMENSION XXT(1),XXX(1)
C
      X02=X2
      X03=X3
      Y03=Y3
C
C
      DO 100 I=1,9
  100 TDIS(I)=0.
C
C     OBTAIN TRANSFORMATION MATRIX CORRESPONDS TO PREVIOUS CONFIGU-
C     RATION. SAVE LOCAL NODAL COOR  FOR NONLINEAR MATERIAL MODEL.
C
      CALL TRAN (N,XXT,IPST)
C
      IF (MODEL.LE.2) GO TO 200
C
      CALL AREAT (XXT)
      XT2=X2
      XT3=X3
      YT3=Y3
C
C     OBTAIN THE TRANSVERSE DISP  INC  ( W )  WITH RESPECT TO THE
C     PREVIOUS CONFIGURATION
C
  200 IR=3
      IE=0
      DO 240 K=1,3
      TX=0.
      DO 220 I=1,3
  220 TX=TX + T(3,I)*EDISI(I+IE)
      TDIS(IR)=TX
      IR=IR+3
  240 IE=IE+6
C
C     OBTAIN THE ROTATIONAL INC  WITH RESPECT TO THE PREVIOUS
C     CONFIGURATION
C
      IR=0
      IE=3
      DO 280 K=1,3
      DO 270 I=1,3
      TX=0.
      DO 260 J=1,3
  260 TX=TX + T(I,J)*EDISI(J+IE)
  270 RDIS(I+IR)=TX
      IR=IR+3
  280 IE=IE+6
C
C     CALCULATE THE MEMBRANE DISP  AT CURRENT CONFIGURATION FOR
C     ELASTIC MODELS OR MEMBRANE DISP  INC  FOR NONLINEAR MAT  MODEL
C
      CALL TRAN (N,XXX,IPST)
      CALL AREAT (XXX)
C
      IF (MODEL.LE.2) GO TO 320
      TDIS(4)=X2-XT2
      TDIS(7)=X3-XT3
      TDIS(8)=Y3-YT3
      GO TO 350
C
  320 TDIS(4)=X2-X02
      TDIS(7)=X3-X03
      TDIS(8)=Y3-Y03
C
C     RE-SET  X2,X3,Y3  TO THE UNDEFORMED CONFIGURATION FOR
C     SUBSEQUENT CALCULATIONS
C
  350 X2=X02
      X3=X03
      Y3=Y03
      TWOA=X02*Y03
C
      RETURN
C
      END
C *CDC* *DECK STFCSE
C *UNI* )FOR,IS N.STFCSE, R.STFCSE
      SUBROUTINE STFCSE (WGT,MODEL)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .      TO CALCULATE THE STIFFNESS MATRIX FOR THE CONSTANT STRAIN    .
C .      TRIANGLE CORRESPONDING TO THE DISPLACEMENT VECTOR  --        .
C .      (U1,U2,U3,V1,V2,V3)                                          .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /PROPTY/ C(3,3),CD(3,3),D(3,3),YM,PV,ET,QTM
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /FSTPLT/ RN(6),RM(9),RE(18),SML(21),SBL(45),S(171),
     1                SNL(6),SCL(54)
C
C     CALCULATE THE IN-PLANE STRAIN-DISPLACEMENT MATRIX  BM
C
      XINV2=1./X2
      BM(1)=-XINV2
      BM(2)= XINV2
      BM(3)= 0.
      BM(4)=(X3-X2)/TWOA
      BM(5)=-X3/TWOA
      BM(6)=X2/TWOA
C
C     EVALUATE THE STRESS-STRAIN MATRIX
C
      AR=0.5*TWOA
      IF (MODEL.EQ.3) AR=WGT
      C11=C(1,1)*AR
      C12=C(1,2)*AR
      C13=C(1,3)*AR
      C22=C(2,2)*AR
      C23=C(2,3)*AR
      C33=C(3,3)*AR
C
C     CALCULATE THE MEMBRANE STIFFNESS   SML(21)
C
      K1=0
      K2=15
      K3=3
C
      IF (MODEL.EQ.3) GO TO 500
C
      DO 200 J=1,3
      DO 250 I=J,3
      SML(I+K1)=C11*BM(J)*BM(I) + C33*BM(J+3)*BM(I+3)
  250 SML(I+K2)=C22*BM(J+3)*BM(I+3) + C33*BM(J)*BM(I)
      K1=K1+6-J
  200 K2=K2+3-J
C
      DO 300 J=1,3
      DO 350 I=1,3
  350 SML(I+K3)=C12*BM(J)*BM(I+3) + C33*BM(J+3)*BM(I)
  300 K3=K3+6-J
C
      RETURN
C
  500 DO 600 J=1,3
      DO 650 I=J,3
      SML(I+K1)=SML(I+K1) + C11*BM(J)*BM(I) + C13*BM(J)*BM(I+3)
     1                    + C13*BM(J+3)*BM(I) + C33*BM(J+3)*BM(I+3)
      SML(I+K2)=SML(I+K2) + C22*BM(J+3)*BM(I+3) + C23*BM(J+3)*BM(I)
     1                    + C23*BM(J)*BM(I+3) + C33*BM(J)*BM(I)
  650 CONTINUE
      K1=K1+6-J
  600 K2=K2+3-J
C
      DO 700 J=1,3
      DO 750 I=1,3
      SML(I+K3)=SML(I+K3) + C12*BM(J)*BM(I+3) + C13*BM(J)*BM(I)
     1                    + C23*BM(J+3)*BM(I+3) + C33*BM(J+3)*BM(I)
  750 CONTINUE
  700 K3=K3+6-J
C
      RETURN
C
      END
C *CDC* *DECK STRCSE
C *UNI* )FOR.IS N.STRCSE, R.STRCSE
      SUBROUTINE STRCSE (INDNL)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .      TO CALCULATE THE MEMBRANE STRAINS FOR THE CONSTANT STRAIN    .
C .      TRIANGLE                                                     .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /STSPLT/ EPS(3),FN(3),CURV(3),TM(3)
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
C
      DIMENSION UIP(6)
C
C     CALCULATE THE IN-PLANE STRAIN-DISPLACEMENT MATRIX  BM
C
      XINV2=1./X2
      BM(1)=-XINV2
      BM(2)= XINV2
      BM(3)= 0.
      BM(4)=(X3-X2)/TWOA
      BM(5)=-X3/TWOA
      BM(6)= X2/TWOA
C
      IF (INDNL.EQ.2) GO TO 100
C
C     INFINITESIMAL DISPLACEMENT ANALYSIS -
C
      UIP(1)=TDIS(1)
      UIP(2)=TDIS(4)
      UIP(3)=TDIS(7)
      UIP(4)=TDIS(2)
      UIP(5)=TDIS(5)
      UIP(6)=TDIS(8)
C
      DO 20 I=1,3
   20 EPS(I)=0.
      DO 30 J=1,3
      EPS(1)=EPS(1) + BM(J)*UIP(J)
      EPS(2)=EPS(2) + BM(J+3)*UIP(J+3)
   30 EPS(3)=EPS(3) + BM(J+3)*UIP(J) + BM(J)*UIP(J+3)
C
      RETURN
C
C     LARGE DISPLACEMENT ANALYSIS -
C
  100 EPS(1)=TDIS(4)/X2
      EPS(2)=TDIS(8)/Y3
      EPS(3)=TDIS(7)/Y3 - X3*TDIS(4)/TWOA
C
      RETURN
C
      END
C *CDC* *DECK,STFDKT
C *UNI* )FOR,IS N.STFDKT , R.STFDKT
      SUBROUTINE STFDKT (PSI,ETA,WGT)
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P R O G R A M                                                   .
C .                                                                   .
C .      TO CALCULATE THE LOCAL DKT ELEMENT BENDING STIFFNESS AT      .
C .      INTEGRATION POINT  (PSI,ETA)                                 .
C .                                                                   .
C .   NOTE                                                            .
C .      DISP. VECTOR: (W1, THETA-X1, THETA-Y1, W2, THETA-X2, THETA-Y2.
C .                     W3, THETA-X3, THETA-Y3 )                      .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /PROPTY/ C(3,3),CD(3,3),D(3,3),YM,PV,ET,QTM
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /FSTPLT/ RN(6),RM(9),RE(18),SML(21),SBL(45),S(171),
     1                SNL(6),SCL(54)
C
      DIMENSION DB(3)
C
C
C     CALCULATE STRAIN-DISPLACEMENT OPERATOR B(3,9) AT INTEGRATION
C        POINT  (PSI,ETA)
C
      CALL BDKT9 (PSI,ETA)
C
C     CALCULATE BENDING STIFFNESS  SBL(45)
C
      IJ=0
      DO 30 J=1,9
      DO 36 K=1,3
      STIFF=0.D0
      DO 38 M=1,3
   38 STIFF=STIFF + D(K,M)*B(M,J)
   36 DB(K)=STIFF*WGT
C
      DO 40 I=J,9
      STIFF=0.
      DO 45 L=1,3
   45 STIFF=STIFF+B(L,I)*DB(L)
      IJ=IJ+1
   40 SBL(IJ)=SBL(IJ) + STIFF
   30 CONTINUE
C
      RETURN
C
      END
C *CDC* *DECK,BDKT9
C *UNI* )FOR,IS N.BDKT9,R.BDKT9
C *UNI* )FOR,IS N.BDKT9, R.BDKT9
      SUBROUTINE BDKT9 (PSI,ETA)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .      TO CALCULATE THE BENDING STRAIN-DISP  MATRIX  B(3,9) AT THE  .
C .      INTEGRATION POINT GIVEN BY  (PSI,ETA)                        .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
C
      DIMENSION BXP(9),BYP(9),BXE(9),BYE(9)
C
      X32=X3-X2
      XX2=X2*X2
      XX3=X3*X3
      XX32=X32*X32
      YY3=Y3*Y3
      QQ4=1./(XX32 + YY3)
      QQ5=1./(XX3 + YY3)
      QQ6=1./XX2
      SU4=3.*QQ4*YY3
      SU5=3.*QQ5*YY3
      D4=3.*QQ4*X32*Y3
      D5=3.*QQ5*X3*Y3
      CL4=6.*QQ4*X32
      CL5=-X3*6.*QQ5
      CL6=6.*QQ6*X2
      SL4=6.*QQ4*Y3
      SL5=-Y3*6.*QQ5
C
      PS2=1.-2.*PSI
      ET2=1.-2.*ETA
      SU5E=SU5*ET2
C
C     DERIVATIVE OF BETAX(I) WITH RESPECT TO PSI
C
      BXP(1)=CL6*PS2+ETA*(CL5-CL6)
      BXP(2)=-ETA*D5
      BXP(3)=-4. + 6.*(PSI+ETA) - ETA*SU5
      BXP(4)=-CL6*PS2+ETA*(CL4+CL6)
      BXP(5)=ETA*D4
      BXP(6)=-2. + 6.*PSI + ETA*SU4
      BXP(7)=-ETA*(CL5+CL4)
      BXP(8)=ETA*(D4-D5)
      BXP(9)=-ETA*(SU5-SU4)
C
C   DERIVATIVES OF BETAY(I) WITH RESPECT TO PSI
C
      BYP(1)=ETA*SL5
      BYP(2)=1. - ETA*SU5
      BYP(3)=-BXP(2)
      BYP(4)=ETA*SL4
      BYP(5)=-1. + ETA*SU4
      BYP(6)=-BXP(5)
      BYP(7)=-ETA*(SL5+SL4)
      BYP(8)=BXP(9)
      BYP(9)=-BXP(8)
C
C   DERIVATIVES OF BETAX(I) WITH RESPECT TO ETA
C
      BXE(1)=-CL5*ET2-PSI*(CL6-CL5)
      BXE(2)=D5*(ET2-PSI)
      BXE(3)=-4. + 6.*(PSI+ETA) + SU5E - PSI*SU5
      BXE(4)=PSI*(CL4+CL6)
      BXE(5)=PSI*D4
      BXE(6)=PSI*SU4
      BXE(7)=CL5*ET2-PSI*(CL4+CL5)
      BXE(8)=D5*ET2+PSI*(D4-D5)
      BXE(9)=-2.+6.*ETA+SU5E+PSI*(SU4-SU5)
C
C   DERIVATIVES OF BETAY(I) WITH RESPECT TO ETA
C
      BYE(1)=SL5*(PSI-ET2)
      BYE(2)=1. + SU5E - PSI*SU5
      BYE(3)=-BXE(2)
      BYE(4)=PSI*SL4
      BYE(5)=BXE(6)
      BYE(6)=-BXE(5)
      BYE(7)=SL5*ET2-PSI*(SL4+SL5)
      BYE(8)=-1.+SU5E+PSI*(SU4-SU5)
      BYE(9)=-BXE(8)
C
C     DEFINITION OF B(3,9)
C
       DO 10 I=1,9
      B(1,I)=  Y3*BXP(I)/TWOA
      B(2,I)=(-X3*BYP(I)+X2*BYE(I))/TWOA
      B(3,I)=(-X3*BXP(I)+X2*BXE(I)+Y3*BYP(I))/TWOA
   10 CONTINUE
C
      RETURN
C
      END
C *CDC* *DECK,STRDKT
C *UNI* )FOR,IS N.STRDKT , R.STRDKT
      SUBROUTINE STRDKT (PSI,ETA)
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .                                                                   .
C .      TO CALCULATE THE BENDING CURVATURES USING THE DKT ELEMENT    .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
      COMMON /STSPLT/ EPS(3),FN(3),CURV(3),TM(3)
C
      DIMENSION U(9)
C
C     PICK OUT THE BENDING D.O.F.S
C
      U(1) = TDIS(3)
      U(2) = RDIS(1)
      U(3) = RDIS(2)
      U(4) = TDIS(6)
      U(5) = RDIS(4)
      U(6) = RDIS(5)
      U(7) = TDIS(9)
      U(8) = RDIS(7)
      U(9) = RDIS(8)
C
C     FIND STRAIN DISPLACEMENT OPERATOR  B(3,9)
C
      CALL BDKT9 (PSI,ETA)
C
C     CALCULATE CURVATURES
C
      DO 100 I=1,3
      CX=0.
      DO 150 J=1,9
  150 CX=CX + B(I,J)*U(J)
  100 CURV(I)=CX
C
      RETURN
C
      END
C *CDC* *DECK ASSEMF
C *UNI* )FOR,IS N.ASSEMF, R.ASSEMF
      SUBROUTINE ASSEMF (MODEL,INDNL)
C
C
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C .                                                                   .
C .   P  R  O  G  R  A  M                                             .
C .                                                                   .
C .      TO ASSEMBLE AND TRANSFORM TO GLOBAL SYSTEM THE ELEMENT       .
C .      STRESS-EQUIVALENT NODAL FORCE VECTOR                         .
C .                                                                   .
C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
C
      IMPLICIT REAL*8 (A-H,O-Z)
C
      COMMON /GEOPLT/ T(3,3),TWOA,X2,X3,Y3,BM(6),B(3,9)
      COMMON /DISPLT/ EDIS(18),EDIST(18),EDISI(18),TDIS(9),RDIS(9)
      COMMON /PROPTY/ C(3,3),CD(3,3),D(3,3),YM,PV,ET,QTM
      COMMON /ELINF / THIC,BETE,WAA(13),NEL,IP,NINT,IPT
      COMMON /FSTPLT/ RN(6),RM(9),RE(18),SML(21),SBL(45),S(171),
     1                SNL(6),SCL(54)
C
      DIMENSION REL(18)
C
C     ASSIGN Z-ROTATIONAL STIFFNESS  (D11)
C
      D11=YM*THIC*THIC*THIC*0.0001/TWOA
C
      IF (MODEL.LE.2 .AND. INDNL.LE.1) GO TO 20
C
C     CALCULATE TOTAL Z-ROTATIONS AT THE NODES
C
      RZ1=0.
      RZ2=0.
      RZ3=0.
      DO 30 I=1,3
      RZ1=RZ1 + T(3,I)*EDIS(I+3)
      RZ2=RZ2 + T(3,I)*EDIS(I+9)
   30 RZ3=RZ3 + T(3,I)*EDIS(I+15)
C
      GO TO 50
C
   20 RZ1=RDIS(3)
      RZ2=RDIS(6)
      RZ3=RDIS(9)
C
C
C     ASSEMBLE LOCAL ELEMENT FORCE VECTOR
C
   50 REL( 1)=RN(1)
      REL( 2)=RN(4)
      REL( 3)=RM(1)
      REL( 4)=RM(2)
      REL( 5)=RM(3)
      REL( 6)=D11*RZ1
      REL( 7)=RN(2)
      REL( 8)=RN(5)
      REL( 9)=RM(4)
      REL(10)=RM(5)
      REL(11)=RM(6)
      REL(12)=D11*RZ2
      REL(13)=RN(3)
      REL(14)=RN(6)
      REL(15)=RM(7)
      REL(16)=RM(8)
      REL(17)=RM(9)
      REL(18)=D11*RZ3
C
C     TRANSFORM ELEMENT FORCE VECTOR TO GLOBAL SYSTEM
C
      IR=0
      DO 100 K=1,6
      DO 140 I=1,3
      RX=0.
      DO 160 J=1,3
  160 RX=RX + T(J,I)*REL(J+IR)
  140 RE(I+IR)=RX
  100 IR=IR+3
C
      RETURN
C
      END