C
C =====================================================================
C =========================== C H E C K ===============================
C =====================================================================
C
      SUBROUTINE CHECK(RE1,MDF,ITEST,I_OUT)
      IMPLICIT NONE
      INTEGER DIVER_STOP,MAX_NODES,MNNDF,MAX_NODES_DOF
      PARAMETER (MAX_NODES=3000,MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER INCREM,ITEST,I_OUT,K,MDF,NDIVER,NIT
      REAL*8 RE1(*),CONV_FAC,ZERO,ENRG,ENRG1,RE,RINC,RIT,U,UINC
      COMMON/CONTR1/INCREM,NIT
      COMMON/MAIN1/U(MAX_NODES_DOF)
      COMMON/MAIN4/RE(MAX_NODES_DOF)
      COMMON/INPUT7/RIT(MAX_NODES_DOF),RINC(MAX_NODES_DOF),
     .              UINC(MAX_NODES_DOF)
      COMMON/INPUTB/CONV_FAC,ENRG1,NDIVER,DIVER_STOP
C
      DATA ZERO /0.0D0/
C
C      ITEST = 0; NO CONVERGANCE
C            = 1; CONVERGANCE
C            = 2; TERMINATE PROGRAM DUE TO EXCEEDING THE ALLOWED
C                 NUMBER OF DIVERGING ITERATIONS
C
      ITEST = 0
      ENRG = ZERO
C
C        CALCULATE THE INCREMENT OF THE INTERNAL ENEGRY DUE TO THE
C        OUT OF BALANCE FORCES. AND REINITIALIZE THE INCREMENTAL
C        DISPLACEMENT VECTOR 'U'.
C
      DO K = 1 , MDF
        ENRG = ENRG + U( K )*(RE( K ) - RE1( K ))
      END DO
      IF (NIT.EQ.1.OR.ENRG1.EQ.ZERO) THEN
        ENRG1 = ENRG
      ELSE
        IF (ENRG.GT.ENRG1) THEN
          NDIVER = NDIVER + 1
          WRITE(I_OUT , 100)INCREM,NIT
          IF (NDIVER.GE.DIVER_STOP) THEN
            WRITE(I_OUT , 200)
            ITEST = 2
            PRINT*,'>>>>>>> PROGRAM TERMINATED DO TO EXEEDING '
     .             //'THE ALLOWABLE NUMBER OF DIVERGING '//
     .             'ITERATIONS'
          END IF
        ELSE IF(ENRG.LE.CONV_FAC*ENRG1) THEN
          ITEST = 1
          NDIVER = 0
        END IF
      END IF
 100  FORMAT(/1X,'>>>>>>> DIVERGANCE DETECTED',
     . ' AT LOAD INCREMENT ',I4,' ITERATION NO. ',I4)
 200  FORMAT(/1X,'>>>>>>> PROGRAM TERMINATED DO TO EXEEDING THE '/
     . 9X,'ALLOWABLE NUMBER OF DIVERGING ITERATIONS')
C
      END
C
C =====================================================================
C ====================== U T I L I T ==================================
C =====================================================================
C
      SUBROUTINE UTILIT
      IMPLICIT NONE
      INTEGER MAX_NODES,MNNDF,MAX_NODES_DOF
      PARAMETER (MAX_NODES=3000,MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER IERROR,INCREM,ISTART,ISWAP,I_GRAPH,I_IN,I_OUT,K1,LDEV
      INTEGER LDEV1,LDEV2,LDEV10,LDEV3,LDEV4,LDEV5,LDEV6,LDEV7
      INTEGER LDEV8,LDEV9,LDEVST,MDF
      REAL*8 RE,UTOTAL
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
      COMMON/DEV1/LDEV5,LDEV6,LDEV7,LDEV8,LDEV9,LDEV10
      COMMON/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/MAIN4/RE(MAX_NODES_DOF)
      COMMON/IN_IO/I_OUT,I_IN,I_GRAPH
C
C ============== E N T R Y     S W A P ================================
C
      ENTRY SWAP
      ISWAP = LDEV1
      LDEV1 = LDEV2
      LDEV2 = ISWAP
      RETURN
C
C ============== E N T R Y     R E W I N ==============================
C
      ENTRY REWIN
      REWIND(UNIT=LDEV1,ERR=1000,IOSTAT=IERROR)
      REWIND(UNIT=LDEV2,ERR=1000,IOSTAT=IERROR)
      RETURN
C
C ============== E N T R Y     R E S T O R ============================
C
      ENTRY RESTOR(MDF,ISTART)
      READ(LDEVST , *,ERR=1002)ISTART,LDEV1,LDEV2,LDEV3,LDEV4,
     .                LDEV5,LDEV6,LDEV7,LDEV8,LDEV9,LDEV10
      DO K1 = 1 , MDF
        READ(LDEVST, *,ERR=1002)RE( K1 ),UTOTAL( K1 )
      END DO
      REWIND(UNIT=LDEVST,ERR=1000,IOSTAT=IERROR)
      RETURN
C
C ============== E N T R Y     S T O R E ==============================
C
      ENTRY STORE(MDF,INCREM)
      WRITE(LDEVST , *,ERR=1003)INCREM,LDEV1,LDEV2,LDEV3,LDEV4,
     .               LDEV5,LDEV6,LDEV7,LDEV8,LDEV9,LDEV10
      DO K1 = 1 , MDF
        WRITE(LDEVST , *,ERR=1003)RE( K1 ),UTOTAL( K1 )
      END DO
      REWIND(UNIT=LDEVST,ERR=1000,IOSTAT=IERROR)
      RETURN
 1000 WRITE(I_OUT , 1001)
 1001 FORMAT(1H0,1X,'ERROR IN REWINDING UTILITY FILES IS DETECTED',
     .  ' BY ROUTINE CONTRL')
      STOP
 1002 PRINT*, 'ERROR READING FROM UTILITY FILE ON UNIT LDEVST'
      RETURN
 1003 PRINT*, 'ERROR WRITING TO UTILITY FILE ON UNIT LDEVST'
C
      END
