c

C file-name               GXGAUSS.HTM            200900
C**** SUBROUTINE GXGAUS is called from GREX3, group 8, section 14;
C     and it is entered when USOLVE is set TRUE in
C     the SATELLITE, and also SLVR is set equal to 'GAUS'.
C
C.... The dummy OVRRLX is an over-relaxation factor for use in
C     the whole-field linear-equation solvers; LITDSH is the maxmum
C     number of iterations which are to be performed by the linear-
C     equation solver for variable phi; IXMON, IYMON and IZMON are
C     IX-, IY- and IZ-value of spot-value location respectively;
C     ENDIT is the iteration-termination criterion; XCYCLE is an
C     logical for setting cyclic boundary conditions along the
C     east and west boundaries of the integration domain; LUPR1 and
C     LUPR3 are the logical units.
C
C.....The library case 103 exemplifies its use.
C
      SUBROUTINE GXGAUS(OVRRLX,LITDSH,IXMON,IYMON,IZMON,ENDIT,
     1                  XCYCLE,LUPR1,LUPR3)
      INCLUDE '/phoenics/d_includ/farray'
      INCLUDE '/phoenics/d_includ/grdloc'
      INCLUDE '/phoenics/d_includ/satgrd'
      COMMON/IDATA/NX,NY,NZ,IFL2(117)
      LOGICAL EQZ
      COMMON /IGE/IXF,IXL,IYF,IYL,IREG,NZSTEP,IGR,ISC,IRUN,IZSTEP,ITHYD,
     1       ISWEEP,ISTEP,INDVAR,VAL,CO,NDIREC,WALDIS,PATGEO,IGES20(6)
      INTEGER VAL,CO,WALDIS,PATGEO
      LOGICAL XCYCLE,DONE,MON,MONZ,MONX,MONY
      SAVE DONE
      COMMON /NAMFN/NAMFUN,NAMSUB
      CHARACTER*6 NAMFUN,NAMSUB
      COMMON /LDATA/ LDAT(84)
      LOGICAL LDAT,NULLPR
      EQUIVALENCE (NULLPR,LDAT(32))
      DATA DONE/.FALSE./
C
      NAMSUB = 'GXGAUS'
C.... Initialize the variable solved on the first visit...
      NXNY = NX*NY
      IF(.NOT.DONE) THEN
      CALL ZERNUM(L0F(L3PHI),NXNY*NZ)
      DONE = .TRUE.
      ENDIF
      RLX = OVRRLX
      IF(EQZ(OVRRLX)) RLX = 1.0
      LUPRST = LUPR1
      LIT = IABS(LITDSH)
      IF(LITDSH.LT.0) THEN
        LUPR1 = LUPR3
        IF(.NOT.NULLPR) THEN
c          CALL WRIT40('output from solver subroutine gxgaus    ')
c          CALL WRIT3I('indvar  ',indvar,'isweep  ',isweep,'istep   ',
c     1                  istep)
        ENDIF
      ENDIF
      IPHI0 = L0F(L3PHI)
      ISU0 = L0F(L3SU)
      IAP0 = L0F(L3AP)
      IF(NX.GT.1) IAE0 = L0F(L3AE)
      IF(NY.GT.1) IAN0 = L0F(L3AN)
      IF(NZ.GT.1) IAH0 = L0F(L3AH)
      MON = LITDSH .LT. 0
      DO 20 ITER = 1,LIT
      IPHI = IPHI0
      ISU = ISU0
      IAP = IAP0
      IAE = IAE0
      IAN = IAN0
      IAH = IAH0
      DO 30 IZZ = 1,NZ
          MONZ = MON .AND. IZZ .EQ. IZMON
          DO 40 IX = 1,NX
            MONX = IX .EQ. IXMON .AND. MONZ
            DO 50 IY = 1,NY
              MONY = IY .EQ. IYMON .AND. MONX
              SNUMER = 0.0
              SDENOM = 0.0
              IPHI = IPHI + 1
              IF(NX.NE.1) THEN
                IAE = IAE + 1
                IF(IX.NE.1) THEN
                  SNUMER = F(IAE-NY)*F(IPHI-NY)
                  SDENOM = SDENOM + F(IAE-NY)
                ENDIF
                IF(IX.NE.NX) THEN
                  SNUMER = SNUMER + F(IAE)*F(IPHI+NY)
                  SDENOM = SDENOM + F(IAE)
                ENDIF
              ENDIF
              IF(NY.NE.1) THEN
                IAN = IAN + 1
                IF(IY.NE.1) THEN
                  SNUMER = SNUMER + F(IAN-1)*F(IPHI-1)
                  SDENOM = SDENOM + F(IAN-1)
                ENDIF
                IF(IY.NE.NY) THEN
                  SNUMER = SNUMER + F(IAN)*F(IPHI+1)
                  SDENOM = SDENOM + F(IAN)
                ENDIF
              ENDIF
              IF(NZ.NE.1) THEN
                IAH = IAH + 1
                IF(IZZ.NE.1) THEN
                  SNUMER = SNUMER + F(IAH-NXNY)*F(IPHI-NXNY)
                  SDENOM = SDENOM + F(IAH-NXNY)
                ENDIF
                IF(IZZ.NE.NZ) THEN
                  SNUMER = SNUMER + F(IAH)*F(IPHI+NXNY)
                  SDENOM = SDENOM + F(IAH)
                ENDIF
              ENDIF
              ISU = ISU + 1
              IAP = IAP + 1
              PHINEW = (SNUMER+F(ISU))/ (SDENOM+F(IAP))
              PHIOLD = F(IPHI)
              F(IPHI) = PHIOLD + RLX* (PHINEW-PHIOLD)
              IF(MONY) THEN
                IF(.NOT.NULLPR) THEN
c                  IF(MOD(ITER,10).EQ.0) CALL WRIT2I('ISWEEP  ',ISWEEP,
c     1              'ITER.NO.',ITER)
c                  CALL WRIT2R('SPOT VAL',F(IPHI),'SPOT DIF',
c     1                      F(IPHI)-PHIOLD)
                  IF(ITER.GT.2*NZ .AND. ABS(F(IPHI)-PHIOLD).LE.
     1              ENDIT) GO TO 60
                ENDIF
              ENDIF
   50       CONTINUE
   40     CONTINUE
   30   CONTINUE
   20 CONTINUE
C---------------------------------------------- end of loop
   60 LUPR1 = LUPRST
      END
c