C
C =====================================================================
C ========================== C O N T R L ==============================
C =====================================================================
C
      SUBROUTINE CONTRL(SKG,SKGL,R,IDOF,JDIAG,NTSK,NTDF,I_OUT,MBAND)
C
C =====================================================================
C I                                                                   I
C I    P R O G R A M:                                                 I
C I                                                                   I
C I    SUBROUTINE 'CONTRL' CONTROLS THE INCREMENTAL LOADING AND THE   I
C I    NEWTON RAPHSON ITERATIVE PROCESS FOR THE TOTAL LAGRANGIAN      I
C I    GEOMETRIC AND MATERIAL NONLINEARITIES.                         I
C I                                                                   I
C I    A R G U M E N T   L I S T:                                     I
C I                                                                   I
C I    SKG(I)      =  GLOBAL STIFFNESS MATRIX STORED AS A ONE         I
C I                   DIMENSIONAL ARRAY                               I
C I    R(I)        =  LOAD VECTOR                                     I
C I    IDOF(I)     =  VECTOR CONTAINING THE D.O.F. NUMBERS OF JOINTS  I
C I    JDIAG(I)    =  LOCATION OF THE DIAGONAL TERMS OF EACH COLUMN   I
C I                   IN THE GLOBAL STIFFNESS MATRIX 'SKG'            I
C I    NTSK        =  TOTAL NUMBER OF TERMS IN THE 'SKG' MATRIX       I
C I    NTDF        =  NUMBER OF TOTAL D.O.F. IN THE PROBLEM           I
C I                   NOT INCLUDING THE CONSTRAINED BOUNDARIES        I
C I    I_OUT       =  OUTPUT DEVICE                                   I
C I    MBAND       =  HALF BAND WIDTH OF THE STIFFNESS MATRIX         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                                                                   I
C =====================================================================
C
      IMPLICIT NONE
      INTEGER MAX_NODES,MNNDF,MAX_NODES_DOF
      PARAMETER (MAX_NODES=3000,MNNDF=3,MAX_NODES_DOF=MAX_NODES*MNNDF)
      INTEGER GRAPHICS_INTR,OUTPUT_INTR,I,ICODE,ICOUNT,ID,IDIM,IDIR
      INTEGER IFINAL,INCREM,INCREMENTS,IOCNT,IPLCNT,ISTART,ITERATIONS
      INTEGER ITEST,I_OUT,K1,K2,K3,LAST,LDEV,LDEV1,LDEV2,LDEV3,LDEV4
      INTEGER LDEVST,MBAND,MDF,NELEM,NINODE,NIT,NNDF,NNODES,NTDF,NTSK
      INTEGER IDOF(*),JDIAG(*),ISPB,STR$COLLAPSE,LSTR1,LSTR2,LITSTR
      LOGICAL ISAVE,LINEAR,RESTART,SYMMETRIC,YES,GRAPHICS_OUT
      REAL*8 R(*),SKG(*),SKGL(*),DUMMY(3),RE1(MAX_NODES_DOF)
      REAL*8 CST,DLINC,DC,RE,RINC,RIT,U,UINC,UTOTAL,ZERO
      CHARACTER*40 STR1,STR2,ITSTR
      COMMON/TRANS/DC(3,3)
      COMMON/INPUTE/ISPB(MAX_NODES)
      COMMON/MAIN1/U(MAX_NODES_DOF)
      COMMON/MAIN2/UTOTAL(MAX_NODES_DOF)
      COMMON/MAIN4/RE(MAX_NODES_DOF)
      COMMON/INPUT7/RIT(MAX_NODES_DOF),RINC(MAX_NODES_DOF),
     .              UINC(MAX_NODES_DOF)
      COMMON/INPUT8/NNODES,NELEM,NNDF,INCREMENTS,ITERATIONS,LINEAR,
     .              SYMMETRIC,IDIM,NINODE
      COMMON/INPUTG/RESTART,OUTPUT_INTR,GRAPHICS_INTR,GRAPHICS_OUT
      COMMON/CONTR1/INCREM,NIT
      COMMON/DEVICE/LDEV1,LDEV2,LDEV3,LDEV4,LDEV,LDEVST
C
      DATA YES,ZERO/.TRUE.,0.0D0/
C
C       MDF       = MAXIMUM DEGREES OF FREEDOM INCLUDING THE SUPPORTS
C
      MDF = NNODES*NNDF
      IF (OUTPUT_INTR.EQ.0) OUTPUT_INTR = INCREMENTS
C
C       IF THIS RUN IS A RESTART THEN RESTORE THE LAST CONVERGED VALUES
C       OF THE EQUILIBRIUM LOAD VECTOR AND THE TOTAL DISPLACEMENT VECTOR
C
      IF (RESTART) THEN
        CALL RESTOR(MDF,ISTART)
        IFINAL=ISTART+INCREMENTS
        ISAVE=LINEAR
        ISTART=ISTART+1
      ELSE
        ISTART = 1
        IFINAL = INCREMENTS
C
C       FOR THE FIRST ITERATION OF THE FIRST INCREMENT USE THE
C       GEOMETRIC LINEARITY ROUTINES.
C
C       LINEAR = TRUE; GEOMETRIC LINARITY
C              = FALSE; GEOMETRIC NON-LINEARITY
C       ISAVE  = DUMMY VARIABLE USED TO STORE THE VALUE OF 'LINEAR'
C
        ISAVE = LINEAR
        LINEAR = .TRUE.
      END IF
      IF (GRAPHICS_INTR.GT.0.AND.GRAPHICS_OUT) THEN
        IF (NINODE.GT.0) CALL CURVE
        CALL PLOTER(NNODES,NELEM,NNDF,IDIM,NINODE)
      END IF
C
C       CALCULATE THE PROPER LOAD OR DISPLACEMENT INCREMENT
C
C       UINC( K ) = APPLIED INCREMENT OF DISPLACEMENT
C       U( K )    = TOTAL APPLIED DISPLACEMENTS
C       R( K )    = TOTAL APPLIED LOADS
C       RINC( K ) = INCREMENT OF APPLIED LOADS
C       RE( K )   = EQUILIBRIUM LOAD VECTOR
C       INCREMENTS = NUMBER OF LOAD INCREMENTS
C
      DLINC = DFLOAT( INCREMENTS )
      DO K1 = 1 , MDF
        UINC( K1 ) = U( K1 )/DLINC
        RINC( K1 ) = (R( K1 ) - RE( K1 ))/DLINC
      END DO
C
C       ICOUNT = ITERATION COUNT FOR THE RUN
C       IOCNT  = INCREMENT COUNT FROM THE START OR SINCE THE LAST
C                OUTPUT. WHEN 'IOCNT' IS EQUAL TO 'OUTPUT_INTR' A COMPLETE
C                OUTPUT WILL BE GENERATED.
C
      ICOUNT = 0
      IOCNT = 0
      IPLCNT = 0
C
C                      S T A R T      O F
C              I N C R E M E N T      L O O P
C
C
      DO INCREM = ISTART , IFINAL
        IOCNT = IOCNT + 1
        IPLCNT = IPLCNT + 1
        WRITE(STR1,'(I39)')INCREM
        WRITE(STR2,'(I39)')IFINAL
        LSTR1=STR$COLLAPSE(STR1,STR1)
        LSTR2=STR$COLLAPSE(STR2,STR2)
        WRITE(*,*)'LOAD INCREMENT # '//STR1(:LSTR1)//' OF '//
     .             STR2(:LSTR2)
C
C       ADJUST THE BOUNDARY CONDITIONS FOR THE INTERFACE NODES
C
        IF (NINODE.GT.0) THEN
          CALL BOUND(IDOF,NNDF,NINODE,ICODE,I_OUT)
          IF (ICODE.EQ.1) THEN
            CALL GLOB2(NNODES,NNDF,NTDF,IDOF)
            CALL DIAGNL(NELEM,NNDF,NTDF,IDOF,JDIAG,NTSK,MBAND,
     .                  SYMMETRIC,I_OUT)
          END IF
        END IF
C
C       U( K )   = INCREMENT OF THE APPLIED DISPLACEMENTS USED
C                   FOR THE FIRST ITERATION
C       RIT( K ) = TOTAL APPLIED LOAD AT THE END OF THE INCREMENT
C
        DO K1 = 1 , MDF
          U( K1 ) = UINC( K1 )
          RIT( K1 ) = RINC( K1 ) + RE( K1 )
        END DO
C
C                      S T A R T      O F
C              I T E R A T I O N      L O O P
C
        DO NIT = 1 , ITERATIONS
C
C       NIT =  ITERATION NUMBER
C       ITERATIONS = MAXIMUM NUMBER OF ITERATIONS ALLOWED
C         
          WRITE(ITSTR,'(I39)')NIT
          LITSTR=STR$COLLAPSE(ITSTR,ITSTR)
          IF(NIT.EQ.1)THEN
            WRITE(*,'(1X,A,$)')'ITERATIONS: '//ITSTR(:LITSTR)
          ELSE
            WRITE(*,'(A,$)')','//ITSTR(:LITSTR)
          ENDIF
          DO K1 = 1 , NNODES
            I = NNDF*(K1 - 1)
            ICODE = ISPB( K1 )
            DO K2 = 1 , NNDF
              IDIR = I + K2
              DUMMY( K2 ) = RIT( IDIR ) - RE( IDIR )
            END DO
            IF (ICODE.GT.0) THEN
              CALL DIRCOS(ICODE,IDIM)
              DO K2 = 1 , IDIM
                CST = ZERO
                DO K3 = 1 , IDIM
                  IDIR = I + K3
                  CST = CST + (RIT( IDIR ) - RE( IDIR ))*DC(K3 , K2)
                END DO
                DUMMY( K2 ) = CST
              END DO
            END IF
            DO K2 = 1 , NNDF
              IDIR = I + K2
              ID = IDOF( IDIR )
              IF(ID.GT.0) R( ID ) = DUMMY( K2 )
            END DO
          END DO
          IF (NIT.EQ.1) THEN
            LDEV = LDEV1
          ELSE
            LDEV = LDEV2
          END IF
          CALL ASSEMB(SKG,SKGL,R,U,IDOF,JDIAG,NTSK,MBAND,I_OUT)
          CALL REWIN
          IF (SYMMETRIC) THEN
            CALL SOLVE2(SKG,R,JDIAG,NTDF,1,I_OUT)
            CALL SOLVE2(SKG,R,JDIAG,NTDF,2,I_OUT)
          ELSE IF(.NOT.SYMMETRIC) THEN
            CALL SOLVE1(SKG,SKGL,R,JDIAG,NTDF,YES,YES)
          END IF
          DO K1 = 1 , MDF
            ID = IDOF( K1 )
            IF(ID.GT.0) U( K1 ) = U( K1 ) + R( ID )
          END DO
          DO K1 = 1 , NNODES
            I = NNDF*(K1 - 1)
            ICODE = ISPB( K1 )
            DO K2 = 1 , NNDF
              IDIR = I + K2
              DUMMY( K2 ) = U( IDIR )
            END DO
            IF (ICODE.GT.0) THEN
              CALL DIRCOS(ICODE,IDIM)
              DO K2 = 1 , IDIM
                CST = ZERO
                DO K3 = 1 , IDIM
                  IDIR = I + K3
                  CST = CST + DC(K2 , K3)*U( IDIR )
                END DO
                DUMMY( K2 ) = CST
              END DO
            END IF
            DO K2 = 1 , NNDF
              IDIR = I + K2
              UTOTAL( IDIR ) = UTOTAL( IDIR ) + DUMMY( K2 )
              U( IDIR ) = DUMMY( K2 )
            END DO
          END DO
          LINEAR = ISAVE
          DO K1 = 1 , MDF
            RE1( K1 ) = RE( K1 )
            RE( K1 ) = ZERO
          END DO
          CALL GETSTR(I_OUT)
          CALL CHECK(RE1,MDF,ITEST,I_OUT)
          DO K1 = 1 , MDF
            U( K1 ) = ZERO
          END DO
          CALL REWIN
          IF(ITEST.EQ.1) THEN
            WRITE(*,*)
            GOTO 600
          ELSE IF (ITEST.EQ.2) THEN
            WRITE(*,*)
            GO TO 590
          END IF
        END DO
        WRITE(*,*)
C
C                        E N D        O F
C              I T E R A T I O N      L O O P
C
        IF (ITERATIONS.EQ.1) GO TO 600
        WRITE(I_OUT , 1003) INCREM , INCREM-1
        WRITE(STR1,'(I39)') INCREM-1
        LSTR1=STR$COLLAPSE(STR1,STR1)
        PRINT*,'MAXIMUM NUMBER OF ITERATIONS EXCEEDED. '//
     .         'PROGRAM TERMINATED'
 590    IF(INCREM.LE.1) GOTO 800
        CALL RESTOR(MDF,LAST)
        WRITE(*,*)'WRITING OUTPUT FOR LOAD INCREMENT # '//STR1(:LSTR1)
        CALL OUTPUT(I_OUT)
        CALL REWIN
        IF (GRAPHICS_INTR.GT.0.AND.GRAPHICS_OUT) THEN
          WRITE(*,*)'WRITING GRAPHICS OUTPUT FOR '//
     .                        'LOAD INCREMENT # '//STR1(:LSTR1)
          IF (NINODE.GT.0) CALL CURVE
          CALL PLOTER(NNODES,NELEM,NNDF,IDIM,NINODE)
        END IF
        GO TO 800
 600    CALL SWAP
        CALL STORE(MDF,INCREM)
        ICOUNT = ICOUNT + NIT
        IF(OUTPUT_INTR.GT.0) THEN
          IF (MOD(IOCNT,OUTPUT_INTR).EQ.0) THEN
            WRITE(*,*)'WRITING OUTPUT FOR LOAD INCREMENT # '//
     .                          STR1(:LSTR1)
            WRITE(I_OUT , 1004) INCREM
            CALL OUTPUT(I_OUT)
            CALL REWIN
          ENDIF
        END IF
        IF(GRAPHICS_INTR.GT.0.AND.GRAPHICS_OUT) THEN
          IF (MOD(IPLCNT,GRAPHICS_INTR).EQ.0) THEN
            WRITE(*,*)'WRITING GRAPHICS OUTPUT FOR '//
     .                          'LOAD INCREMENT # '//STR1(:LSTR1)
            IF (NINODE.GT.0) CALL CURVE
            CALL PLOTER(NNODES,NELEM,NNDF,IDIM,NINODE)
          END IF
        ENDIF
      END DO
 800  WRITE(I_OUT , 1002) ICOUNT
 1002 FORMAT(//1X,'>>>>>>> TOTAL NUMBER OF ITERATIONS FOR THIS RUN IS'
     . ,' = ',I5)
 1003 FORMAT(/1X,'>>>>>>> PROGRAM TERMINATED DUE TO EXEEDING THE '/
     . 9X,'ALLOWABLE NUMBER OF ITERATIONS AT LOAD INCREMENT ',I4//
     . 1X,'>>>>>>> OUTPUTS ARE FOR THE LAST CONVERGED INCREMENT ',I4)
 1004 FORMAT(///1X,'>>>>>>> OUTPUTS AT INCREMENT ',I4)
C
      END

