C     Last change:  TJD  23 Oct 2005    4:21 pm
C
C     ------------------------------------
      SUBROUTINE SAMG1(RNAME,ISEL,OUTFILE)
C     ------------------------------------
C
C     SUBROUTINE AUTHOR:
C     TIM DURBIN
C     TIMOTHY J. DURBIN, INC.
C     5330 PRIMROSE DRIVE, SUITE 228
C     FAIR OAKS, CA 95628
C     (916) 536-2314
C
C     PURPOSE:
C     THIS SUBROUTINE INPUTS PAPAMETERS THIS SUBROUTINE SOLVES THE
C      SYSTEM OF EQUATIONS A*U=F USING THE ALGEBRAIC MULTIGRID METHOD.
C     TO SOLVE A SYSTEM OF EQUATIONS, THIS SUBROUTINE CALLS SUBROUTINE
C     AMG1R5 WITHIN THE AMG SOLVER PACKAGE.
C
      INCLUDE 'DIMEN.INC'
      INCLUDE 'WUNITS.INC'
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      PARAMETER (MAXAJ=5*MAXNON+5*MAXNN,MAXIFU=3*MAXNN,MAXIG=6*MAXNN)
C
C     INTERNAL SCALARS AND ARRAYS:
C     OUTFILE     OUTPUT FILE NAME.
C     RNAME       SIMULATION NAME.
C     IOUT()      SWITCH FOR OUTPUT CONTROL
C     LEVELX()    MAXIMUN NUMBER OF MULTIGRID LEVELS
C     NCYC()      SWITCHES FOR CYCLE TYPE, SWITCH FOR USING CONJUGATE
C                 GRADIENT, SWITCH FOR CLOSURE CRITERION TYPE, AND
C                 MAXIMUM NUMBER OF CYCLES
C     EPS()       CLOSURE CRITERION.
C     A()         LEFTTHAND MATRIX WITHIN SYSTEM OF EQUATIONS.
C     X()         VECTOR OF UNKNOWNS WITHIN SYSTEM OF EQUATIONS.
C     B()         RIGHTHAND VECTOR WITHIN SYSTEM OF EQUATIONS.
C     IA()        VECTOR INDICATING NUMBER OF NON-ZERO COEFFICIENTS
C                 IN A ROW OF THE LEFTHAND MATRIX.
C     JA()        VECTOR INDICATING COLUMN NUMBER OF A NON-ZERO
C                 COEFFICIENT WITHIN A ROW OF THE LEFTHAND MATRIX.
C     A0()        MATRIX A AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     X0()        MATRIX X AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     B0()        VECTOR B AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     IA0()       VECTOR IA AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     JA0()       VECTOR JA AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     U()         FIRST APPROXIMATION TO SOLUTION AS PASSED TO AND
C                 MODIFIED BY SUBROUTINE AMG1R5.
C     F()         RIGHT HAND SIDE AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     IG()        DIMENSIONING OF VECTOR IG IN CALLING PROGRAM AS PASSED
C                 TO AND MODIFIED BY SUBROUTINE AMG1R5.
C     ISEL        SWITCH FOR SELECTING PARAMETER SET FOR SOLVING
C                 GROUNDWATER-FLOW OR SOLUTE-TRANSPORT EQUATIONS.
C     IDEFAULT    SWITCH TO USE AMG DEFAULT OPTIMIZED INPUTS.
C     NCYC1       1ST DIGIT OF NCYC AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     NCYC2       2ND DIGIT OF NCYC AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     NCYC3       3RD DIGIT OF NCYC AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C     NCYC4       REST OF NCYC AS PASSED TO AND MODIFIED BY
C                 SUBROUTINE AMG1R5.
C
      CHARACTER*80 OUTFILE
      CHARACTER*12 RNAME
      REAL*8 EPS(2)
      INTEGER*4 IOUT(2),LEVELX(2),NCYC(2)
      REAL*8 A0(MAXNON),B0(MAXNN),X0(MAXNN)
      INTEGER*4 IA0(MAXNN+1),JA0(MAXNON)
      REAL*8 A(MAXAJ),U(MAXIFU),F(MAXIFU)
      INTEGER*4 IA(MAXIFU),JA(MAXAJ),IG(MAXIG)
      SAVE
C
C     INPUT SOLVER PARAMETERS.
      IF (ISEL.EQ.1) THEN
          WRITE(IWBAS,906)
      ELSE
          WRITE(IWBAS,908)
      ENDIF
C
C     READING PARAMETERS FROM *.BAS
      READ(IRBAS,901) IDEFAULT
      IF (IDEFAULT.EQ.0) THEN
C
C         USER SPECIFICATION OF PARAMETERS.
          READ(IRBAS,902) IOUT(ISEL),LEVELX(ISEL),NCYC1,NCYC2,NCYC3,
     +        NCYC4,EPS(ISEL)
          WRITE(IWBAS,910) IDEFAULT,IOUT(ISEL),LEVELX(ISEL),
     +        NCYC1,NCYC2,NCYC3,NCYC4,EPS(ISEL),OUTFILE
          IF (NCYC4.GE.1 .AND. NCYC4.LE.9) THEN
              NCYC(ISEL)=NCYC1*1000+NCYC2*100+NCYC3*10+NCYC4
          ELSEIF (NCYC4.GE.10 .AND. NCYC4.LE.99) THEN
              NCYC(ISEL)=NCYC1*10000+NCYC2*1000+NCYC3*100+NCYC4
          ELSEIF (NCYC4.GE.100 .AND. NCYC4.LE.999) THEN
              NCYC(ISEL)=NCYC1*100000+NCYC2*10000+NCYC3*1000+NCYC4
          ENDIF
C
C         CHECK VALUE OF OUPPUT CONTROL.
          IF (IOUT(ISEL).NE.10 .AND. IOUT(ISEL).NE.11 .AND.
     +        IOUT(ISEL).NE.12 .AND. IOUT(ISEL).NE.13) THEN
              WRITE(*,914)
              WRITE(*,916)
              STOP
          ENDIF
C
C         CHECK NUMBER OF MULTIGRID LEVELS.
          IF (LEVELX(ISEL).LE.0) THEN
              WRITE(*,918)
              WRITE(*,916)
              STOP
          ENDIF
C
C         CHECK CYCLE TYPE.
          IF (NCYC1.LE.0 .OR. NCYC1.GE.5) THEN
              WRITE(*,920)
              WRITE(*,916)
              STOP
          ENDIF
C
C         CHECK NUMBER OF CYCLES.
          IF (NCYC4.LE.0 .OR. NCYC4.GE.1000) THEN
              WRITE(*,921)
              WRITE(*,916)
              STOP
          ENDIF

C         CHECK USE OF CONJUGATE GRADIENT METHOD.
          IF (NCYC2.LE.-1 .OR. NCYC2.GE.3) THEN
              WRITE(*,922)
              WRITE(*,916)
              STOP
          ENDIF
C
C         CHECK CONVERGENCE CRITERION.
          IF (NCYC3.LE.0 .OR. NCYC3.GE.5) THEN
              WRITE(*,924)
              WRITE(*,916)
              STOP
          ENDIF
C
      ELSE
C
C     DEFAULT PARAMETERS.
          IOUT(ISEL) = 10
          LEVELX(ISEL) = 25
          NCYC1=1
          NCYC2=0
          NCYC3=1
          NCYC4=10
          NCYC(ISEL) = 10110
          EPS(ISEL) = 1.D-15
          WRITE(IWBAS,910) IDEFAULT,IOUT(ISEL),LEVELX(ISEL),
     +        NCYC1,NCYC2,NCYC3,NCYC4,EPS(ISEL),OUTFILE
      ENDIF
C
C     FIXED PARAMETERS.
      IF (ISEL.EQ.1) THEN
          MATRIX=12
      ELSE
          MATRIX=22
      ENDIF
      ISWTCH=4
      IPRINT=10000+IWSOL*100+IWSOL
      IFIRST=10
      NSOLCO=10
      MADAPT=27
      NRD=1231
      NRU=1231
      ECG1=0.0
      ECG2=0.25
      EWT2=0.35
      NWT=2
      NTR=0
      RETURN
C
C     FORMATS:
901   FORMAT(I10)
902   FORMAT(6I10,F10.0)
904   FORMAT(6I10)
906   FORMAT(/1X,'FLOW EQUATIONS')
908   FORMAT(/1X,'TRANSPORT EQUATIONS')
910   FORMAT(1X,'MULTIGRID SOLUTION PARAMETERS:'/
     +    1X,'SWITCH FOR DEFAULT PARAMETERS...........',I10/
     +    1X,'SWITCH FOR OUTPUT CONTROL...............',I10/
     +    1X,'MAXIMUN NUMBER OF MULTIGRID LEVELS......',I10/
     +    1X,'SWITCH FOR CYCLE TYPE...................',I10/
     +    1X,'SWITCH FOR USING CONJUGATE GRADIENT.....',I10/
     +    1X,'SWITCH FOR CLOSURE CRITERION TYPE.......',I10/
     +    1X,'MAXIMUM NUMBER OF CYCLES................',I10/
     +    1X,'CLOSURE CRITERION.......................',1PE10.2/
     +    1X,'OUTPUT FILE FOR SOLVER..................',A80)
914   FORMAT(1X,'*ERROR* OUTPUT CONTROL NOT VALID')
916   FORMAT(1X,'*ERROR* SIMULATION TURMINATED FOR ERROR IN SAMG')
918   FORMAT(1X,'*ERROR* NUMBER OF MULTIGRID LEVELS INVALID')
920   FORMAT(1X,'*ERROR* CYCLE TYPE INVALID')
921   FORMAT(1X,'*ERROR* NUMBER OF CYCLES INVALID')
922   FORMAT(1X,'*ERROR* APPLICATION OF CONJUGATE GRADIENT INVALID')
924   FORMAT(1X,'*ERROR* CONVERGENCE TYPE INVALID')
C
C     --------------------------------------------------
      ENTRY SAMG2(IA0,JA0,A0,X0,B0,NEQ,ISTEP,JITER,ISEL)
C     --------------------------------------------------
C
C     ARRAY DIMENSIONS WITHIN AMG.
      NDA=MAXAJ
      NDIA=MAXIFU
      NDJA=MAXAJ
      NDU=MAXIFU
      NDF=MAXIFU
      NDIG=MAXIG
C
C     LOAD ARRAYS FOR PASSING TO AMG.
      DO II=1,MAXNON
          A(II)=A0(II)
          JA(II)=JA0(II)
      END DO
C
C     MOVE DIAGONAL ELEMENT TO BEGINNING OF ROW FIRST
      DO II=1,NEQ
          I1 = IA0(II)
          I2 = IA0(II+1)-1
          DO JJ=I1+1,I2
              IF (JA(JJ).NE.II) CYCLE
              ITMP = JA(JJ)
              JA(JJ) = JA(I1)
              JA(I1) = ITMP
              TMP = A(JJ)
              A(JJ) = A(I1)
              A(I1) = TMP
          END DO
          IA(II)=IA0(II)
          U(II)=X0(II)
          F(II)=B0(II)
      END DO
      IA(NEQ+1)=IA0(NEQ+1)
C
C     SOLVE SYSTEM OF EQUATIONS A*X=B OR A*U=F.
      IF (ISEL.EQ.1) THEN
          WRITE(IWSOL,924)
      ELSE
          WRITE(IWSOL,936)
      ENDIF
      WRITE(IWSOL,938) ISTEP,JITER
      CALL AMG1R5(A,IA,JA,U,F,IG,
     +    NDA,NDIA,NDJA,NDU,NDF,NDIG,NEQ,MATRIX,
     +    ISWTCH,IOUT(ISEL),IPRINT,
     +    LEVELX(ISEL),IFIRST,NCYC(ISEL),EPS(ISEL),
     +    MADAPT,NRD,NSOLCO,NRU,
     +    ECG1,ECG2,EWT2,NWT,NTR,
     +    IERR)
      WRITE(*,932) IERR
      WRITE(IWSOL,940) ISTEP,JITER,IERR
      DO II=1,NEQ
          X0(II)=U(II)
      END DO
      RETURN
C
C     FORMATS:
932   FORMAT(1X,'ERROR CODE ',I10)
934   FORMAT(/1X,'FLOW EQUATIONS')
936   FORMAT(/1X,'TRANSPORT EQUATIONS')
938   FORMAT(/1X,'ITERATION RESULTS:'/
     +    1X,'TIME STEP...............................',I10/
     +    1X,'TIME-STEP ITERATION.....................',I10/)
940   FORMAT(/1X,'FINAL SOLUTION RESULTS:'/
     +    1X,'TIME STEP...............................',I10/
     +    1X,'NUMBER OF ITERATIONS....................',I10/
     +    1X,'CLOSURE STATUS..........................',I10)
      END SUBROUTINE
C
C     ----------------------
      SUBROUTINE CTIME(TIME)
C     ----------------------
      REAL TIME
      RETURN
      END
      INCLUDE 'AMG1R5.FOR'
