C
C =====================================================================
C ========================= L O A D ===================================
C =====================================================================
C
      SUBROUTINE LOAD (R)
C
C =====================================================================
C I                                                                   I
C I    P R O G R A M                                                  I
C I                                                                   I
C I    LOAD ASSEMBLES THE LOAD VECTOR BY CONSIDERING THE              I
C I    EXTERNALY APPLIED LOADS AND THE GRAVITY LOADS WHICH ARE        I
C I    SUPERIMPOSED ON THE STRUCTURE.                                 I
C I                                                                   I
C I                                                                   I
C I    A R G U M E N T   L I S T                                      I
C I                                                                   I
C I      R(I)      =  LOAD VECTOR TO BE ASSEMBLED                     I
C I                                                                   I
C I                                                                   I
C I    C O M M O N   B L O C K S                                      I
C I                                                                   I
C I    REFFER TO THE COMMON BLOCK DESCRIPTIONS.                       I
C I      N(I,J)    =  SHAPE FUNCTION FOR NODE I AT INTEGR. POINT J    I
C I      W(I)      =  GAUSSIAN WEIGHTING FUNCTIONS                    I
C I      XGAUSS    =  X COORDINATE OF THE GAUSSIAN POINTS IN THE ELEM.I
C I      WGTX(I)   =  SPECIFIC WEIGHT OF MATERIAL I IN THE X DIR.     I
C I      WGTY(I)   =  SPECIFIC WEIGHT OF MATERIAL I IN THE Y DIR.     I
C I      WGTZ(I)   =  SPECIFIC WEIGHT OF MATERIAL I IN THE Z DIR.     I
C I      THICK     =  THICKNESS OF THE ELEMENTS FOR PLANE STR & STN   I
C I                =  2*PI*XGAUSS FOR AXISYMETRIC PROBLEMS            I
C I                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER STRS_STRN_REL,AXISYMMETRIC,MAT_ELAS_DAM,MAT_PLAS_DAM
      INTEGER MAX_NODES,MAX_ELEMENTS,MAX_ELEM_NODES,MAX_GAUSS_PTS,
     .        MAX_MAT_TYPE,MNNDF,MAX_NODES_DOF
      PARAMETER (MAX_NODES=3000,MAX_ELEMENTS=400,MAX_ELEM_NODES=20,
     .           MAX_GAUSS_PTS=27,MAX_MAT_TYPE=10,MNNDF=3,
     .           MAX_NODES_DOF=MAX_NODES*MNNDF)
      PARAMETER (AXISYMMETRIC=3,MAT_ELAS_DAM=3,MAT_PLAS_DAM=4)
      INTEGER IDIM,INCREMENTS,INTGPN,ISTART,ITERATIONS,K,K1,K2,K3
      INTEGER LINES,M1,MATNUM,NELEM,NINODE,NNDF,INTCOD,NIP
      INTEGER NNEL,NNODES,NOP,ELNUM,ELEM_TYPE,SAVED_ETYPE
      INTEGER NIPXI,NIPETA,NIPSI,MATYPE,PROBTYPE,I_OUT,I_IN,I_GRAPH
      REAL*8 N,NXI,NETA,NSI,CST,DETJAC,RAD,THICK,R(*),RX,RY,RZ,W
      REAL*8 WGTX,WGTY,WGTZ
      LOGICAL LINEAR,SYMMETRIC
      COMMON/INPUT1/NIPXI,NIPETA,NIPSI,NIP,INTCOD
      COMMON/INPUT2/NOP(MAX_ELEM_NODES,MAX_ELEMENTS)
      COMMON/INPUT6/WGTX(MAX_MAT_TYPE),WGTY(MAX_MAT_TYPE),
     .              WGTZ(MAX_MAT_TYPE)
      COMMON/INPUT7/RX(MAX_NODES_DOF),RY(MAX_NODES_DOF),
     .              RZ(MAX_NODES_DOF)
      COMMON/INPUT8/NNODES,NELEM,NNDF,INCREMENTS,ITERATIONS,LINEAR,
     .              SYMMETRIC,IDIM,NINODE
      COMMON/INPUT9/THICK,STRS_STRN_REL
      COMMON/ISHAP1/N(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NXI(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NETA(MAX_ELEM_NODES,MAX_GAUSS_PTS),
     .              NSI(MAX_ELEM_NODES,MAX_GAUSS_PTS)
      COMMON/ISHAP2/W(MAX_GAUSS_PTS)
      COMMON/INPUTF/MATYPE(MAX_MAT_TYPE)
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
C ----- FIND THE CONTRIBUTION OF THE GRAVITY WEIGHTS FOR 2D ELEMENTS
C
      SAVED_ETYPE = 0
      DO ELNUM = 1 , NELEM
        CALL ELINFO(ELNUM,ELEM_TYPE,NNEL,MATNUM,STRS_STRN_REL,
     .              ISTART,LINES)
        PROBTYPE=MATYPE(MATNUM)
        IF (ELEM_TYPE.GT.300) THEN
          IF (ELEM_TYPE.NE.SAVED_ETYPE) THEN
            IF (INTCOD.GE.140) THEN
              CALL ISH3DI(ELEM_TYPE,NNEL)
            ELSE
              CALL ISH3DG(ELEM_TYPE,NNEL)
            END IF
          END IF
          SAVED_ETYPE = ELEM_TYPE
          DO INTGPN = 1 , NIP
            CALL JACB3D(INTGPN,ELNUM,NNEL,DETJAC)
            CST = DETJAC*W( INTGPN )
            DO K1 = 1 , NNEL
              M1 = NOP(K1 , ELNUM)
              RX( M1 ) = RX( M1 ) + N(K1 , INTGPN)*WGTX( MATNUM )*CST
              RY( M1 ) = RY( M1 ) + N(K1 , INTGPN)*WGTY( MATNUM )*CST
              RZ( M1 ) = RZ( M1 ) + N(K1 , INTGPN)*WGTZ( MATNUM )*CST
            END DO
          END DO
        ELSE
          IF(PROBTYPE.EQ.MAT_ELAS_DAM.OR.PROBTYPE.EQ.MAT_PLAS_DAM) THEN
            WRITE(*,*)'SOLUTION TERMINATED.  INCOMPATIABLE ELEMENTS'//
     .                ' USED WITH DAMAGE MATERIAL MODEL'
            WRITE(I_OUT,*)'SOLUTION TERMINATED.  INCOMPATIABLE '//
     .                'ELEMENTS USED WITH DAMAGE MATERIAL MODEL'
            STOP
          ENDIF
          IF (ELEM_TYPE.NE.SAVED_ETYPE) CALL ISH2DG(ELEM_TYPE,NNEL)
          SAVED_ETYPE = ELEM_TYPE
          DO INTGPN = 1 , NIP
            CALL JACB2D(INTGPN,ELNUM,NNEL,DETJAC)
            IF (STRS_STRN_REL.EQ.AXISYMMETRIC)
     .                CALL AXISYM(INTGPN,ELNUM,NNEL,RAD,THICK)
            CST = DETJAC*THICK*W( INTGPN )
            DO K1 = 1 , NNEL
              M1 = NOP(K1 , ELNUM)
              RX( M1 ) = RX( M1 ) + N(K1 , INTGPN)*WGTX( MATNUM )*CST
              RY( M1 ) = RY( M1 ) + N(K1 , INTGPN)*WGTY( MATNUM )*CST
            END DO
          END DO
        END IF
      END DO
C
C --- PLACE RX' S AND RY' S IN THE RIGHT POSITIONS IN THE
C --- LOAD ARRAY.
C
      IF (IDIM.EQ.2) THEN
        DO K = 1 , NNODES
          K2 = 2*K
          K1 = K2 - 1
          R( K1 )=RX( K )
          R( K2 )=RY( K )
        END DO
      ELSE IF(IDIM.EQ.3) THEN
        DO K = 1 , NNODES
          K3 = 3*K
          K2 = K3 - 1
          K1 = K3 - 2
          R( K1 )=RX( K )
          R( K2 )=RY( K )
          R( K3 )=RZ( K )
        END DO
      END IF
C
      END
