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 'farray'
INCLUDE 'grdloc'
INCLUDE '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