c
c
c
C.... SUBROUTINE GXCLDA is called from group 13 of GREX3, and is
C entered when the patch name begins with characters 'CLDA'
C It creates the CO and VAL for the variables of which the NAMEs
C have NOR, SOU, EAS, WES, OLD and NEW as the second, third and
C fourth characters.
C
SUBROUTINE GXCLDA
include 'farray'
INCLUDE 'grdloc'
INCLUDE 'satgrd'
INCLUDE 'grdear'
COMMON/LDATA/LDAT1(7),XCYCLE,LDAT2(10),STEADY,LDAT3(65)
COMMON /NAMFN/NAMFUN,NAMSUB
COMMON /IDATA/NX,NY,NZ,IDFIL(116),NPHI
COMMON/HDA1/NAME(150)
CHARACTER*6 NAMFUN,NAMSUB
CHARACTER*3 NAM
CHARACTER*4 NAME,NAM4
LOGICAL FIRST,LDAT1,XCYCLE,LDAT2,STEADY,LDAT3,deb
SAVE FIRST,INOR,ISOU,IEAS,IWES,IOLD,INEW,LASTEP,LASTIZ,
1 INDFRS,IOLN
DATA FIRST/.TRUE./
C
deb=.false.
c if(deb) then
c write(buff,'(a,2i6,1x,l1)') 'gxclda entered, nx,ny,steady =',
c 1 NX,NY,STEADY
c call put_line(buff,.false.)
c write(buff,'(a,1x,l1,1x,i6)') ',first, isc =',FIRST,ISC
c call put_line(buff,.true.)
c endif
NAMSUB = 'GXCLDA'
IF(FIRST) THEN
C.... Establish the indices of the relevant solved-for variables
CALL SUB4(INOR,0,ISOU,0,IEAS,0,IWES,0)
CALL SUB4(IOLD,0,INEW,0,IOLN,0,INDFRS,0)
CALL SUB3(LASTEP,1,LASTIZ,0,LASTIT,0)
DO 1 I=1,nphi
IF(STORE(I)) THEN
NAM4=NAME(I)
NAM=NAM4(2:4)
IF(NAM.EQ.'NOR') THEN
INOR = I
ELSEIF(NAM.EQ.'SOU') THEN
ISOU = I
ELSEIF(NAM.EQ.'EAS') THEN
IEAS = I
ELSEIF(NAM.EQ.'WES') THEN
IWES = I
ELSEIF(NAM.EQ.'OLD') THEN
IOLD = I
ELSEIF(NAM.EQ.'NEW') THEN
INEW = I
ELSEIF(NAM.EQ.'NEO') THEN
IOLN = I
ENDIF
ENDIF
1 CONTINUE
IF(INOR.NE.0) INDFRS=INOR
IF(ISOU.NE.0) INDFRS=MIN0(INDFRS,ISOU)
IF(IEAS.NE.0) INDFRS=MIN0(INDFRS,IEAS)
IF(IWES.NE.0) INDFRS=MIN0(INDFRS,IWES)
IF(INEW.NE.0) INDFRS=MIN0(INDFRS,INEW)
IF(IOLD.NE.0) INDFRS=MIN0(INDFRS,IOLD)
FIRST=.FALSE.
ENDIF
L0CO=L0F(CO)
c if(deb) then
c write(buff,'(a,2i9)') 'CO, L0CO =',CO,L0CO
c call put_line(buff,.true.)
c endif
IF(ISC.LE.11) THEN
FCODB = F(L0CO+1)
F(L0CO+1)=0.0
c if(deb) then
c write(buff,'(a,1x,1pe10.3)') '1, RETURN FOR ISC.LE.11,
c 1 F(L0CO+1)', fcodb
c call put_line(buff,.false.)
c write(buff,'(a,1x,1pe10.3)') '2, RETURN FOR ISC.LE.11,
c 1 F(L0CO+1)', F(L0CO+1)
c call put_line(buff,.true.)
c endif
RETURN
ENDIF
C.... L0...'S
L0VAL=L0F(VAL)
C.... Return if called with isc.le.co because the coefficients
C will be calculated later; but restore the first-cell value
C which is used in earth to test whether values have been set
IF(NY.GT.1) THEN
L0SOU=L0F(ISOU)
L0NOR=L0F(INOR)
L0CNA=L0F(LCNA)
L0CNAS=L0CNA-1
ENDIF
IF(NX.GT.1) THEN
L0EAS=L0F(IEAS)
L0WES=L0F(IWES)
L0CEA=L0F(LCEA)
L0CEAW=L0CEA-NY
ENDIF
IF(.NOT.STEADY) THEN
RECDT=1.0/DT
L0NEW=L0F(INEW)
L0OLD=L0F(IOLD)
L0OLN=L0F(IOLN)
C.... Note that it is strictly-speaking necessary to distinguish the
C old from the new time flux.
L0MAS=L0F(LM1)
C.... At start of new slab and
IF((ISTEP.NE.LASTEP.OR.IZSTEP.NE.LASTIZ).AND.
1 ISWEEP.EQ.1.AND.INDVAR.EQ.INDFRS.AND.ITHYD.EQ.1) THEN
CALL FN0(-L0OLN,-L0NEW)
c if(deb) call prn('olnu',-l0oln)
CALL SUB2(LASTEP,ISTEP,LASTIZ,IZSTEP)
ENDIF
ENDIF
C.... DO loops begin
IF(NX.GT.1.AND.NY.GT.1.AND..NOT.STEADY) THEN
C.... nx.gt.1, ny.gt.1, unsteady
DO 10 IX=IXF,IXL
CDIR$ IVDEP
DO 10 IY=IYF,IYL
I=IY+(IX-1) * NY
CNA=F(L0CNA+I)
CNAS=F(L0CNAS+I)
IF(IY.EQ.1) CNAS=CNA
IF(IY.EQ.NY) CNA=CNAS
CEA=F(L0CEA+I)
CEAW=F(L0CEAW+I)
IF(.NOT.XCYCLE) THEN
IF(IX.EQ.1) CEAW=CEA
IF(IX.EQ.NX) CEA=CEAW
ENDIF
COL=F(L0MAS+I)*RECDT
C.... INDVAR is north
IF(INDVAR.EQ.INOR) THEN
C.... Donor is south
CNAN=CNA
IF(IY.EQ.NY) CNAN=0.0
CONV=AMAX1(0.0,-CNAN)
FLUX=CONV*F(L0SOU+1+I)
COEF=CONV
C.... Donor is east
CONV=0.25*AMAX1(0.0,-CEA+CNA)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.25*AMAX1(0.0,CEAW+CNA)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... Donor is new
CONV=0.25*AMAX1(0.0,-COL+CNA)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.25*AMAX1(0.0,COL+CNA)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is south
ELSEIF(INDVAR.EQ.ISOU) THEN
C.... Donor is north
CNASS=CNAS
IF(IY.EQ.1) CNASS=0.0
CONV=AMAX1(0.0,CNASS)
FLUX=CONV*F(L0NOR-1+I)
COEF=CONV
C.... Donor is east
CONV=0.25*AMAX1(0.0,-CEA-CNAS)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.25*AMAX1(0.0,CEAW-CNAS)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... Donor is new
CONV=0.25*AMAX1(0.0,-COL-CNAS)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.25*AMAX1(0.0,COL-CNAS)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is east
ELSEIF(INDVAR.EQ.IEAS) THEN
C.... Donor is north
CONV=0.25*AMAX1(0.0,-CNA+CEA)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.25*AMAX1(0.0,CNAS+CEA)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is west
CEAE=CEA
IF(IX.EQ.NX.AND..NOT.XCYCLE) CEAE=0.0
CONV=AMAX1(0.0,-CEAE)
FLUX=FLUX+CONV*F(L0WES+NY+I)
COEF=COEF+CONV
C.... Donor is new
CONV=0.25*AMAX1(0.0,-COL+CEA)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.25*AMAX1(0.0,COL+CEA)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is west
ELSEIF(INDVAR.EQ.IWES) THEN
C.... Donor is north
CONV=0.25*AMAX1(0.0,-CNA-CEAW)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.25*AMAX1(0.0,CNAS-CEAW)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is east
CEAWW=CEAW
IF(IX.EQ.1.AND..NOT.XCYCLE) CEAWW=0.0
CONV=AMAX1(0.0,CEAWW)
FLUX=FLUX+CONV*F(L0EAS-NY+I)
COEF=COEF+CONV
C.... Donor is new
CONV=0.25*AMAX1(0.0,-COL-CEAW)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.25*AMAX1(0.0,COL-CEAW)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is new
ELSEIF(INDVAR.EQ.INEW) THEN
C.... Donor is north
CONV=0.25*AMAX1(0.0,-CNA-COL)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.25*AMAX1(0.0,CNAS+COL)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is east
CONV=0.25*AMAX1(0.0,-CEA+COL)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.25*AMAX1(0.0,CEAW+COL)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... INDVAR is old
ELSEIF(INDVAR.EQ.IOLD) THEN
C.... Donor is north
CONV=0.25*AMAX1(0.0,-CNA-COL)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.25*AMAX1(0.0,CNAS-COL)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is east
CONV=0.25*AMAX1(0.0,-CEA-COL)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.25*AMAX1(0.0,CEAW-COL)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... Donor is new
CONV=COL
FLUX=FLUX+CONV*F(L0OLN+I)
COEF=COEF+CONV
ENDIF
F(L0VAL+I)=FLUX/(COEF+1.E-20)
F(L0CO+I)=COEF
10 CONTINUE
C.... nx.gt.1, ny.gt.1, steady
ELSEIF(NX.GT.1.AND.NY.GT.1.AND.STEADY) THEN
DO 20 IX=IXF,IXL
CDIR$ IVDEP
DO 20 IY=IYF,IYL
I=IY+(IX-1) * NY
FLUX=0.0
COEF=0.0
CNA=F(L0CNA+I)
CNAS=F(L0CNAS+I)
IF(IY.EQ.1) CNAS=CNA
IF(IY.EQ.NY) CNA=CNAS
CEA=F(L0CEA+I)
CEAW=F(L0CEAW+I)
IF(.NOT.XCYCLE) THEN
IF(IX.EQ.1) CEAW=CEA
IF(IX.EQ.NX) CEA=CEAW
ENDIF
C.... INDVAR is north
IF(INDVAR.EQ.INOR) THEN
C.... Donor is south
CNAN=CNA
IF(IY.EQ.NY) CNAN=0.0
CONV=AMAX1(0.0,-CNAN)
FLUX=CONV*F(L0SOU+1+I)
COEF=CONV
C.... Donor is east
CONV=0.5*AMAX1(0.0,-CEA+CNA)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.5*AMAX1(0.0,CEAW+CNA)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... INDVAR is south
ELSEIF(INDVAR.EQ.ISOU) THEN
C.... Donor is north
CNASS=CNAS
IF(IY.EQ.1) CNASS=0.0
CONV=AMAX1(0.0,CNASS)
FLUX=CONV*F(L0NOR-1+I)
COEF=CONV
C.... Donor is east
CONV=0.5*AMAX1(0.0,-CEA-CNAS)
FLUX=FLUX+CONV*F(L0EAS+I)
COEF=COEF+CONV
C.... Donor is west
CONV=0.5*AMAX1(0.0,CEAW-CNAS)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... INDVAR is east
ELSEIF(INDVAR.EQ.IEAS) THEN
C.... Donor is north
CONV=0.5*AMAX1(0.0,-CNA+CEA)
FLUX=CONV*F(L0NOR+I)
c if(deb) call writ1r('conv n ',conv)
COEF=CONV
C.... Donor is south
CONV=0.5*AMAX1(0.0,CNAS+CEA)
FLUX=FLUX+CONV*F(L0SOU+I)
c if(deb) call writ1r('conv s ',conv)
COEF=COEF+CONV
C.... Donor is west
CEAWW=CEAW
IF(IX.EQ.1.AND..NOT.XCYCLE) CEAWW=0.0
CONV=AMAX1(0.0,-CEAWW)
FLUX=FLUX+CONV*F(L0WES+NY+I)
c if(deb) call writ1r('conv w ',conv)
COEF=COEF+CONV
C.... INDVAR is west
ELSEIF(INDVAR.EQ.IWES) THEN
C.... Donor is north
CONV=0.5*AMAX1(0.0,-CNA-CEAW)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.5*AMAX1(0.0,CNAS-CEAW)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is east
CEAWW=CEAW
IF(IX.EQ.1.AND..NOT.XCYCLE) CEAWW=0.0
CONV=AMAX1(0.0,CEAWW)
FLUX=FLUX+CONV*F(L0EAS-NY+I)
COEF=COEF+CONV
ENDIF
F(L0VAL+I)=FLUX/(COEF+1.E-20)
F(L0CO+I)=COEF
20 CONTINUE
ELSEIF(NX.GT.1.AND..NOT.STEADY) THEN
C.... ny.eq.1, nx.gt.1, unsteady
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CDIR$ IVDEP
DO 30 IX=IXF,IXL
I=IX
CEA=F(L0CEA+I)
CEAW=F(L0CEAW+I)
IF(IX.EQ.1) CEAW=CEA
IF(IX.EQ.NX) CEA=CEAW
COL=F(L0MAS+I)*RECDT
C.... INDVAR is east
IF(INDVAR.EQ.IEAS) THEN
C.... Donor is west
CEAE=CEA
IF(IX.EQ.NX.AND..NOT.XCYCLE) CEAE=0.0
CONV=AMAX1(0.0,-CEAE)
FLUX=CONV*F(L0WES+NY+I)
COEF=CONV
C.... Donor is new
CONV=0.5*AMAX1(0.0,-COL+CEA)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.5*AMAX1(0.0,COL+CEA)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is west
ELSEIF(INDVAR.EQ.IWES) THEN
C.... Donor is east
CEAWW=CEAW
IF(IX.EQ.1) CEAWW=0.0
CONV=AMAX1(0.0,CEAWW)
FLUX=CONV*F(L0EAS-NY+I)
COEF=CONV
C.... Donor is new
CONV=0.5*AMAX1(0.0,-COL-CEAW)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.5*AMAX1(0.0,COL-CEAW)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is new
ELSEIF(INDVAR.EQ.INEW) THEN
C.... Donor is east
CONV=0.5*AMAX1(0.0,-CEA+COL)
FLUX=CONV*F(L0EAS+I)
COEF=CONV
C.... Donor is west
CONV=0.5*AMAX1(0.0,CEAW+COL)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... INDVAR is old
ELSEIF(INDVAR.EQ.IOLD) THEN
C.... Donor is east
CONV=0.5*AMAX1(0.0,-CEA-COL)
FLUX=CONV*F(L0EAS+I)
COEF=CONV
C.... Donor is west
CONV=0.5*AMAX1(0.0,CEAW-COL)
FLUX=FLUX+CONV*F(L0WES+I)
COEF=COEF+CONV
C.... Donor is new
CONV=COL
FLUX=FLUX+CONV*F(L0OLN+I)
COEF=COEF+CONV
ENDIF
F(L0VAL+I)=FLUX/(COEF+1.E-20)
F(L0CO+I)=COEF
30 CONTINUE
ELSEIF(NY.GT.1.AND..NOT.STEADY) THEN
C.... nx.eq.1, ny.gt.1, unsteady
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CDIR$ IVDEP
DO 40 IY=IYF,IYL
I=IY
CNA=F(L0CNA+I)
CNAS=F(L0CNAS+I)
IF(IY.EQ.1) CNAS=CNA
IF(IY.EQ.NY) CNA=CNAS
COL=F(L0MAS+I)*RECDT
C.... INDVAR is north
IF(INDVAR.EQ.INOR) THEN
C.... Donor is south
CNAN=CNA
IF(IY.EQ.NY) CNAN=0.0
CONV=AMAX1(0.0,-CNAN)
FLUX=CONV*F(L0SOU+1+I)
COEF=CONV
C.... Donor is new
CONV=0.5*AMAX1(0.0,-COL+CNA)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.5*AMAX1(0.0,COL+CNA)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is south
ELSEIF(INDVAR.EQ.ISOU) THEN
C.... Donor is north
CNASS=CNAS
IF(IY.EQ.1) CNASS=0.0
CONV=AMAX1(0.0,CNASS)
FLUX=CONV*F(L0NOR-1+I)
COEF=CONV
C.... Donor is new
CONV=0.5*AMAX1(0.0,-COL-CNAS)
FLUX=FLUX+CONV*F(L0NEW+I)
COEF=COEF+CONV
C.... Donor is old
CONV=0.5*AMAX1(0.0,COL-CNAS)
FLUX=FLUX+CONV*F(L0OLD+I)
COEF=COEF+CONV
C.... INDVAR is new
ELSEIF(INDVAR.EQ.INEW) THEN
C.... Donor is north
CONV=0.5*AMAX1(0.0,-CNA-COL)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.5*AMAX1(0.0,CNAS+COL)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... INDVAR is old
ELSEIF(INDVAR.EQ.IOLD) THEN
C.... Donor is north
CONV=0.5*AMAX1(0.0,-CNA-COL)
FLUX=CONV*F(L0NOR+I)
COEF=CONV
C.... Donor is south
CONV=0.5*AMAX1(0.0,CNAS-COL)
FLUX=FLUX+CONV*F(L0SOU+I)
COEF=COEF+CONV
C.... Donor is new
CONV=COL
FLUX=FLUX+CONV*F(L0OLN+I)
COEF=COEF+CONV
ENDIF
F(L0VAL+I)=FLUX/(COEF+1.E-20)
F(L0CO+I)=COEF
40 CONTINUE
ENDIF
c if(deb) then
c call writ1i('indvar ',indvar)
c call prn('co ',co)
c call prn('val ',val)
c endif
END
c