Encyclopaedia Index
C.... FILE NAME GROUND.FTN--------------------------------230597
C#### IP 23.05.97 Introduced section 5 into Group 10 for CVM
c#### dbs 14.07.96 nfm introduced via geni
c#### dbs 08.07.96 Group 21 added
c#### dbs 13.09.95 igr 1 isc 3 added
c#### dbs 21.08.95 DVEL/DP section introduced into group 8
C#### dbs 24.04.95 message to screen condition simplified
c#### dbs/hqq 08.12.94 UCONV comments provided
c#### dbs/mrm 10.08.94 new access point on group 19, section 11
SUBROUTINE GROUND
INCLUDE '/phoenics/d_includ/satear'
INCLUDE '/phoenics/d_includ/grdloc'
INCLUDE '/phoenics/d_includ/grdear'
INCLUDE '/phoenics/d_includ/grdbfc'
COMMON/GENI/NXNY,IGFIL1(8),NFM,IGF(21),IPRL,IBTAU,ILTLS,IGFIL(15),
1 ITEM1,ITEM2,ISPH1,ISPH2,ICON1,ICON2,IPRPS,IRADX,IRADY,IRADZ,IVFOL
COMMON/DRHODP/ITEMP,IDEN/DVMOD/IDVCGR
CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX USER SECTION STARTS:
C
C 1 Set dimensions of data-for-GROUND arrays here. WARNING: the
C corresponding arrays in the MAIN program of the satellite
C and EARTH must have the same dimensions.
PARAMETER (NLG=100, NIG=200, NRG=200, NCG=100)
C
COMMON/LGRND/LG(NLG)/IGRND/IG(NIG)/RGRND/RG(NRG)/CGRND/CG(NCG)
LOGICAL LG
CHARACTER*4 CG
C
C 2 User dimensions own arrays here, for example:
C DIMENSION GUH(10,10),GUC(10,10),GUX(10,10),GUZ(10)
C
C 3 User places his data statements here, for example:
C DATA NXDIM,NYDIM/10,10/
C
C 4 Insert own coding below as desired, guided by GREX examples.
C Note that the satellite-to-GREX special data in the labelled
C COMMONs /RSG/, /ISG/, /LSG/ and /CSG/ can be included and
C used below but the user must check GREX for any conflicting
C uses. The same comment applies to the EARTH-spare working
C arrays EASP1, EASP2,....EASP20. In addition to the EASPs,
C there are 10 GRound-earth SPare arrays, GRSP1,...,GRSP10,
C supplied solely for the user, which are not used by GREX. If
C the call to GREX has been deactivated then all of the arrays
C may be used without reservation.
C
c***********************************************************************
c
IXL=IABS(IXL)
IF(IGR.EQ.13) GO TO 13
IF(IGR.EQ.19) GO TO 19
GO TO (1,2,3,4,5,6,25,8,9,10,11,12,13,14,25,25,25,25,19,20,25,
121,23,24),IGR
25 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 1. Run title and other preliminaries
C
1 GO TO (1001,1002,1003),ISC
C
1001 CONTINUE
CALL MAKE(DXU2D )
CALL MAKE(DYG2D )
CALL MAKE(DYV2D )
CALL MAKE(DXG2D )
C
C * -----------GROUP 1 SECTION 3 ---------------------------
C---- Use this group to create storage via MAKE, GXMAKE etc which it is
C essential to dump to PHI (or PHIDA) for restarts
C User may here change message transmitted to the VDU screen
IF(.NOT.NULLPR.AND.IDVCGR.EQ.0)
1 CALL WRYT40('GROUND file is GROUND.F of: 230597 ')
C
RETURN
C * -----------GROUP 1 SECTION 3 ---------------------------
C---- Use this group to create storage via GXMAKE which it is not
C necessary to dump to PHI (or PHIDA) for restarts
C
1003 CONTINUE
GO TO 25
1002 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 2. Transience; time-step specification
C
2 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 3. X-direction grid specification
C
3 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 4. Y-direction grid specification
C
4 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 5. Z-direction grid specification
C
5 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 6. Body-fitted coordinates or grid distortion
C
6 CONTINUE
RETURN
C*****************************************************************
C * Make changes for this group only in group 19.
C--- GROUP 7. Variables stored, solved & named
C*****************************************************************
C
C--- GROUP 8. Terms (in differential equations) & devices
C
8 GO TO (81,82,83,84,85,86,87,88,89,810,811,812,813,814,815,816)
1,ISC
81 CONTINUE
C * ------------------- SECTION 1 ---------------------------
C For U1AD.LE.GRND--- phase 1 additional velocity. Index VELAD
RETURN
82 CONTINUE
C * ------------------- SECTION 2 ---------------------------
C For U2AD.LE.GRND--- phase 2 additional velocity. Index VELAD
RETURN
83 CONTINUE
C * ------------------- SECTION 3 ---------------------------
C For V1AD.LE.GRND--- phase 1 additional velocity. Index VELAD
RETURN
84 CONTINUE
C * ------------------- SECTION 4 ---------------------------
C For V2AD.LE.GRND--- phase 2 additional velocity. Index VELAD
RETURN
85 CONTINUE
C * ------------------- SECTION 5 ---------------------------
C For W1AD.LE.GRND--- phase 1 additional velocity. Index VELAD
RETURN
86 CONTINUE
C * ------------------- SECTION 6 ---------------------------
C For W2AD.LE.GRND--- phase 2 additional velocity. Index VELAD
RETURN
87 CONTINUE
C * ------------------- SECTION 7 ---- Volumetric source for gala
RETURN
88 CONTINUE
C * ------------------- SECTION 8 ---- Convection fluxes
C--- Entered when UCONV =.TRUE.; block-location indices are:
C LD11 for east and north (accessible at the same time),
C LD12 for west and south (accessible at the same time),
C LD2 for high (which becomes low for the next slab).
C User should provide INDVAR and NDIREC IF's as appropriate.
RETURN
89 CONTINUE
C * ------------------- SECTION 9 ---- Diffusion coefficients
C--- Entered when UDIFF =.TRUE.; block-location indices are LAE
C for east, LAW for west, LAN for north, LAS for
C south, LD11 for high, and LD11 for low.
C User should provide INDVAR and NDIREC IF's as above.
C EARTH will apply the DIFCUT and GP12 modifications after the user
C has made his settings.
C
RETURN
810 CONTINUE
C * ------------------- SECTION 10 --- Convection neighbours
RETURN
811 CONTINUE
C * ------------------- SECTION 11 --- Diffusion neighbours
RETURN
812 CONTINUE
C * ------------------- SECTION 12 --- Linearised sources
RETURN
813 CONTINUE
C * ------------------- SECTION 13 --- Correction coefficients
RETURN
814 CONTINUE
C * ------------------- SECTION 14 --- User's own solver
RETURN
815 CONTINUE
C * ------------------- SECTION 15 --- Change solution
RETURN
816 CONTINUE
C * ------------------- SECTION 16 --- Change DVEL/DPs
RETURN
C
C * See the equivalent section in GREX for the indices to be
C used in sections 7 - 16
C
C * Make all other group-8 changes in GROUP 19.
C*****************************************************************
C
C--- GROUP 9. Properties of the medium (or media)
C
C The sections in this group are arranged sequentially in their
C order of calling from EARTH. Thus, as can be seen from below,
C the temperature sections (10 and 11) precede the density
C sections (1 and 3); so, density formulae can refer to
C temperature stores already set.
9 GO TO (91,92,93,94,95,96,97,98,99,900,901,902,903,904,905),ISC
C*****************************************************************
900 CONTINUE
C * ------------------- SECTION 10 ---------------------------
C For TMP1.LE.GRND--------- phase-1 temperature Index TEMP1
RETURN
901 CONTINUE
C * ------------------- SECTION 11 ---------------------------
C For TMP2.LE.GRND--------- phase-2 temperature Index TEMP2
RETURN
902 CONTINUE
C * ------------------- SECTION 12 ---------------------------
C For EL1.LE.GRND--------- phase-1 length scale Index LEN1
RETURN
903 CONTINUE
C * ------------------- SECTION 13 ---------------------------
C For EL2.LE.GRND--------- phase-2 length scale Index LEN2
RETURN
904 CONTINUE
C * ------------------- SECTION 14 ---------------------------
C For SOLVE(TEM1)-------- phase-1 specific heat
RETURN
905 CONTINUE
C * ------------------- SECTION 15 ---------------------------
C For SOLVE(TEM2)-------- phase-2 specific heat
RETURN
91 CONTINUE
C * ------------------- SECTION 1 ---------------------------
C For RHO1.LE.GRND--- density for phase 1 Index DEN1
RETURN
92 CONTINUE
C * ------------------- SECTION 2 ---------------------------
C For DRH1DP.LE.GRND--- D(LN(DEN))/DP for phase 1
C Index D1DP
RETURN
93 CONTINUE
C * ------------------- SECTION 3 ---------------------------
C For RHO2.LE.GRND--- density for phase 2 Index DEN2
RETURN
94 CONTINUE
C * ------------------- SECTION 4 ---------------------------
C For DRH2DP.LE.GRND--- D(LN(DEN))/DP for phase 2
C Index D2DP
RETURN
95 CONTINUE
C * ------------------- SECTION 5 ---------------------------
C For ENUT.LE.GRND--- reference turbulent kinematic viscosity
C Index VIST
RETURN
96 CONTINUE
C * ------------------- SECTION 6 ---------------------------
C For ENUL.LE.GRND--- reference laminar kinematic viscosity
C Index VISL
RETURN
97 CONTINUE
C * ------------------- SECTION 7 ---------------------------
C For PRNDTL( ).LE.GRND--- laminar PRANDTL nos., or diffusivity
C Index LAMPR
RETURN
98 CONTINUE
C * ------------------- SECTION 8 ---------------------------
C For PHINT( ).LE.GRND--- interface value of first phase
C Index FII1
RETURN
99 CONTINUE
C * ------------------- SECTION 9 ---------------------------
C For PHINT( ).LE.GRND--- interface value of second phase
C Index FII2
RETURN
C*****************************************************************
C
C--- GROUP 10. Inter-phase-transfer processes and properties
C
10 GO TO (101,102,103,104,105),ISC
101 CONTINUE
C * ------------------- SECTION 1 ---------------------------
C For CFIPS.LE.GRND--- inter-phase friction coeff.
C Index INTFRC
RETURN
102 CONTINUE
C * ------------------- SECTION 2 ---------------------------
C For CMDOT.EQ.GRND- inter-phase mass transfer Index INTMDT
c l0mdt=l0f(intmdt)
c l0c2=l0f(c2)
c l0r1=l0f(9)
c l0vol=l0f(LVOL)
c do i=1,nx*ny
c f(l0mdt+i)= - cmdta * (phint(c2) - f(l0c2+i)) *
c 1 f(l0r1+i) * f(l0vol+i)
c enddo
RETURN
103 CONTINUE
C * ------------------- SECTION 3 ---------------------------
C For CINT( ).EQ.GRND--- phase1-to-interface transfer coefficients
C Index COI1
RETURN
104 CONTINUE
C * ------------------- SECTION 4 ---------------------------
C For CINT( ).EQ.GRND--- phase2-to-interface transfer coefficients
C Index COI2
RETURN
105 CONTINUE
C * ------------------- SECTION 5 ---------------------------
C For CVM.EQ.GRND--- virtual mass coefficient
C Index LD12
RETURN
C*****************************************************************
C
C--- GROUP 11. Initialization of variable or porosity fields
C Index VAL
11 CONTINUE
C Initial fields name: INIT01
IF(INDVAR.EQ.INAME('CON1 ').AND.NPATCH.EQ.'STELC ') THEN
LFVAL =L0F(VAL )
DO 11001 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 11001 IY=IYF ,IYL
I=IY+IADD
L0VAL =LFVAL +I
11001 F(L0VAL )=(1.-RG(4))/((1.+RG(4))*(1-2.*RG(4)))
ENDIF
C Initial fields name: INIT02
IF(INDVAR.EQ.INAME('CON2 ').AND.NPATCH.EQ.'STELC ') THEN
LFVAL =L0F(VAL )
DO 11002 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 11002 IY=IYF ,IYL
I=IY+IADD
L0VAL =LFVAL +I
11002 F(L0VAL )=RG(4)/((1.+RG(4))*(1-2.*RG(4)))
ENDIF
C Initial fields name: INIT03
IF(INDVAR.EQ.INAME('CON3 ').AND.NPATCH.EQ.'STELC ') THEN
LFVAL =L0F(VAL )
DO 11003 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 11003 IY=IYF ,IYL
I=IY+IADD
L0VAL =LFVAL +I
11003 F(L0VAL )=1./(1.-2.*RG(4))
ENDIF
C Initial fields name: INIT04
IF(INDVAR.EQ.INAME('CON4 ').AND.NPATCH.EQ.'STELC ') THEN
LFVAL =L0F(VAL )
DO 11004 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 11004 IY=IYF ,IYL
I=IY+IADD
L0VAL =LFVAL +I
11004 F(L0VAL )=1./(2.*(1+RG(4)))
ENDIF
RETURN
C*****************************************************************
C
C--- GROUP 12. Convection and diffusion adjustments
C
12 CONTINUE
RETURN
C*****************************************************************
C
C--- GROUP 13. Boundary conditions and special sources
C Index for Coefficient - CO
C Index for Value - VAL
13 CONTINUE
GO TO (130,131,132,133,134,135,136,137,138,139,1310,
11311,1312,1313,1314,1315,1316,1317,1318,1319,1320,1321),ISC
130 CONTINUE
C------------------- SECTION 1 ------------- coefficient = GRND
RETURN
131 CONTINUE
C------------------- SECTION 2 ------------- coefficient = GRND1
RETURN
132 CONTINUE
C------------------- SECTION 3 ------------- coefficient = GRND2
RETURN
133 CONTINUE
C------------------- SECTION 4 ------------- coefficient = GRND3
RETURN
134 CONTINUE
C------------------- SECTION 5 ------------- coefficient = GRND4
RETURN
135 CONTINUE
C------------------- SECTION 6 ------------- coefficient = GRND5
RETURN
136 CONTINUE
C------------------- SECTION 7 ------------- coefficient = GRND6
RETURN
137 CONTINUE
C------------------- SECTION 8 ------------- coefficient = GRND7
RETURN
138 CONTINUE
C------------------- SECTION 9 ------------- coefficient = GRND8
RETURN
139 CONTINUE
C------------------- SECTION 10 ------------- coefficient = GRND9
RETURN
1310 CONTINUE
C------------------- SECTION 11 ------------- coefficient = GRND10
RETURN
1311 CONTINUE
C------------------- SECTION 12 ------------------- value = GRND
C Source name: SORC01
IF(INDVAR.EQ.INAME('U1 ').AND.NPATCH.EQ.'EASZN ') THEN
LFVAL =L0F(VAL)
LFU1 =L0F(U1 )
LFP1 =L0F(P1 )
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFDXU2=L0F(DXU2D )
DO 13801 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13801 IY=IYF ,IYL
I=IY+IADD
L0U1 =LFU1 +I
L0P1 =LFP1 +I
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0DXU2=LFDXU2+I
13801 F(LFVAL+I)=F(L0U1-NY)+0.333*(F(L0P1)+4.*(F(L0THEX)*
1F(L0TEM )+RG(3)/F(L0STIF)))*F(L0DXU2)
ENDIF
C Source name: SORC02
IF(INDVAR.EQ.INAME('V1 ').AND.NPATCH.EQ.'EASZS ') THEN
LFVAL =L0F(VAL)
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 13802 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13802 IY=IYF ,IYL
I=IY+IADD
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
13802 F(LFVAL+I)=-(F(L0U1-NY+1)-F(L0U1-NY))/F(L0DYG2)
ENDIF
C Source name: SORC03
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'FXDEAS ') THEN
LFVAL =L0F(VAL)
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFV1 =L0F(V1 )
LFDYV2=L0F(DYV2D )
DO 13803 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13803 IY=IYF ,IYL
I=IY+IADD
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0V1 =LFV1 +I
L0DYV2=LFDYV2+I
13803 F(LFVAL+I)=2.*(F(L0THEX)*F(L0TEM)-RG(3)/F(L0STIF))-1.5
1*(F(L0V1 )-F(L0V1-1))/F(L0DYV2)
ENDIF
C Source name: SORC04
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'FXDEAC ') THEN
LFVAL =L0F(VAL)
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFV1 =L0F(V1 )
LFDYV2=L0F(DYV2D )
DO 13804 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13804 IY=IYF ,IYL
I=IY+IADD
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0V1 =LFV1 +I
L0DYV2=LFDYV2+I
13804 F(LFVAL+I)=2.*(F(L0THEX)*F(L0TEM)-RG(3)/F(L0STIF))-1.5
1*(F(L0V1 +1)-F(L0V1))/F(L0DYV2+1)
ENDIF
C Source name: SORC05
IF(INDVAR.EQ.INAME('V1 ').AND.NPATCH.EQ.'NORZN ') THEN
LFVAL =L0F(VAL)
LFV1 =L0F(V1 )
LFP1 =L0F(P1 )
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFDYV2=L0F(DYV2D )
DO 13805 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13805 IY=IYF ,IYL
I=IY+IADD
L0V1 =LFV1 +I
L0P1 =LFP1 +I
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0DYV2=LFDYV2+I
13805 F(LFVAL+I)=F(L0V1-1)+0.333*(F(L0P1)+4.*(F(L0THEX)*F(L0TEM)
1+RG(2)/F(L0STIF)))*F(L0DYV2)
ENDIF
C Source name: SORC06
IF(INDVAR.EQ.INAME('U1 ').AND.NPATCH.EQ.'NORZS ') THEN
LFVAL =L0F(VAL)
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 13806 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13806 IY=IYF ,IYL
I=IY+IADD
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
13806 F(LFVAL+I)=-(F(L0V1+NY-1)-F(L0V1-1))/F(L0DXG2)
ENDIF
C Source name: SORC07
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'FDNW ') THEN
LFVAL =L0F(VAL)
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFU1 =L0F(U1 )
LFDXU2=L0F(DXU2D )
DO 13807 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13807 IY=IYF ,IYL
I=IY+IADD
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0U1 =LFU1 +I
L0DXU2=LFDXU2+I
13807 F(LFVAL+I)=2.*(F(L0THEX)*F(L0TEM)-RG(2)/F(L0STIF))-1.5
1*(F(L0U1 +NY)-F(L0U1))/F(L0DXU2+NY)
ENDIF
C Source name: SORC08
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'FDNOR ') THEN
LFVAL =L0F(VAL)
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFU1 =L0F(U1 )
LFDXU2=L0F(DXU2D )
DO 13808 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13808 IY=IYF ,IYL
I=IY+IADD
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0U1 =LFU1 +I
L0DXU2=LFDXU2+I
13808 F(LFVAL+I)=2.*(F(L0THEX)*F(L0TEM)-RG(2)/F(L0STIF))-1.5
1*(F(L0U1 )-F(L0U1-NY))/F(L0DXU2)
ENDIF
C Source name: SORC09
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'FDNEC ') THEN
LFVAL =L0F(VAL)
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFSTIF=L0F(INAME('STIF '))
LFU1 =L0F(U1 )
LFDXU2=L0F(DXU2D )
DO 13809 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13809 IY=IYF ,IYL
I=IY+IADD
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0STIF=LFSTIF+I
L0U1 =LFU1 +I
L0DXU2=LFDXU2+I
13809 F(LFVAL+I)=2.*(F(L0THEX)*F(L0TEM)-RG(2)/F(L0STIF))-1.5
1*(F(L0U1 -NY)-F(L0U1-NY*2))/F(L0DXU2-NY)
ENDIF
C Source name: SORC99
IF(INDVAR.EQ.INAME('P1 ').AND.NPATCH.EQ.'DILAT ') THEN
LFVAL =L0F(VAL)
LFP1 =L0F(P1 )
LFCON3=L0F(INAME('CON3 '))
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFCON4=L0F(INAME('CON4 '))
DO 13899 IX=IXF ,IXL
IADD=NY*(IX-1)
DO 13899 IY=IYF ,IYL
I=IY+IADD
L0P1 =LFP1 +I
L0CON3=LFCON3+I
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0CON4=LFCON4+I
13899 F(LFVAL+I)=-F(L0P1)/F(L0CON3)+F(L0THEX)*F(L0TEM)/F(L0CON4)
ENDIF
RETURN
1312 CONTINUE
C------------------- SECTION 13 ------------------- value = GRND1
RETURN
1313 CONTINUE
C------------------- SECTION 14 ------------------- value = GRND2
RETURN
1314 CONTINUE
C------------------- SECTION 15 ------------------- value = GRND3
RETURN
1315 CONTINUE
C------------------- SECTION 16 ------------------- value = GRND4
RETURN
1316 CONTINUE
C------------------- SECTION 17 ------------------- value = GRND5
RETURN
1317 CONTINUE
C------------------- SECTION 18 ------------------- value = GRND6
RETURN
1318 CONTINUE
C------------------- SECTION 19 ------------------- value = GRND7
RETURN
1319 CONTINUE
C------------------- SECTION 20 ------------------- value = GRND8
RETURN
1320 CONTINUE
C------------------- SECTION 21 ------------------- value = GRND9
RETURN
1321 CONTINUE
C------------------- SECTION 22 ------------------- value = GRND10
RETURN
C***************************************************************
C
C--- GROUP 14. Downstream pressure for PARAB=.TRUE.
C
14 CONTINUE
RETURN
C***************************************************************
C* Make changes to data for GROUPS 15, 16, 17, 18 GROUP 19.
C***************************************************************
C
C--- GROUP 19. Special calls to GROUND from EARTH
C
19 GO TO (191,192,193,194,195,196,197,198,199,1910,1911),ISC
191 CONTINUE
C * ------------------- SECTION 1 ---- Start of time step.
RETURN
192 CONTINUE
C * ------------------- SECTION 2 ---- Start of sweep.
RETURN
193 CONTINUE
C * ------------------- SECTION 3 ---- Start of iz slab.
RETURN
194 CONTINUE
C * ------------------- SECTION 4 ---- Start of iterations over slab.
RETURN
1911 CONTINUE
C * ------------------- SECTION 11---- After calculation of convection
C fluxes for scalars, and of volume
C fractions, but before calculation of
C scalars or velocities
RETURN
199 CONTINUE
C * ------------------- SECTION 9 ---- Start of solution sequence for
C a variable
RETURN
1910 CONTINUE
C * ------------------- SECTION 10---- Finish of solution sequence for
C a variable
RETURN
195 CONTINUE
C * ------------------- SECTION 5 ---- Finish of iterations over slab.
RETURN
196 CONTINUE
C * ------------------- SECTION 6 ---- Finish of iz slab.
C Special calls name: SC0601
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.NZ ) THEN
LFDIL =L0F(INAME('DIL '))
LFP1 =L0F(P1 )
LFCON3=L0F(INAME('CON3 '))
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
LFCON4=L0F(INAME('CON4 '))
DO 19601 IX=1 ,NX
IADD=NY*(IX-1)
DO 19601 IY=1 ,NY
I=IY+IADD
L0DIL =LFDIL +I
L0P1 =LFP1 +I
L0CON3=LFCON3+I
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
L0CON4=LFCON4+I
19601 F(L0DIL )=-F(L0P1)/F(L0CON3)+F(L0THEX)*F(L0TEM)/F(L0CON4)
ENDIF
ENDIF
C Special calls name: SC0602
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPST =L0F(INAME('EPST '))
LFTHEX=L0F(INAME('THEX '))
LFTEM =L0F(INAME('TEM '))
DO 19602 IX=1 ,NX
IADD=NY*(IX-1)
DO 19602 IY=1 ,NY
I=IY+IADD
L0EPST=LFEPST+I
L0THEX=LFTHEX+I
L0TEM =LFTEM +I
19602 F(L0EPST )=F(L0THEX)*F(L0TEM)
ENDIF
ENDIF
C Special calls name: SC0603
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSX =L0F(INAME('EPSX '))
LFU1 =L0F(U1 )
LFU1W =L0F(WEST (U1 ))
LFDXU2=L0F(DXU2D )
DO 19603 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19603 IY=1 ,NY
I=IY+IADD
L0EPSX=LFEPSX+I
L0U1 =LFU1 +I
L0U1W =LFU1W +I
L0DXU2=LFDXU2+I
19603 F(L0EPSX )=(F(L0U1)-F(L0U1W))/F(L0DXU2)
ENDIF
ENDIF
C Special calls name: SC0604
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSX =L0F(INAME('EPSX '))
LFU1 =L0F(U1 )
LFDXU2=L0F(DXU2D )
DO 19604 IX=1 ,1
IADD=NY*(IX-1)
DO 19604 IY=1 ,NY
I=IY+IADD
L0EPSX=LFEPSX+I
L0U1 =LFU1 +I
L0DXU2=LFDXU2+I
19604 F(L0EPSX )=(F(L0U1+NY)-F(L0U1))/F(L0DXU2+NY)
ENDIF
ENDIF
C Special calls name: SC0605
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSX =L0F(INAME('EPSX '))
LFU1 =L0F(U1 )
LFDXU2=L0F(DXU2D )
DO 19605 IX=NX ,NX
IADD=NY*(IX-1)
DO 19605 IY=1 ,NY
I=IY+IADD
L0EPSX=LFEPSX+I
L0U1 =LFU1 +I
L0DXU2=LFDXU2+I
19605 F(L0EPSX )=(F(L0U1-NY)-F(L0U1-NY*2))/F(L0DXU2-NY)
ENDIF
ENDIF
C Special calls name: SC0606
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSY =L0F(INAME('EPSY '))
LFV1 =L0F(V1 )
LFV1S =L0F(SOUTH(V1 ))
LFDYV2=L0F(DYV2D )
DO 19606 IX=1 ,NX
IADD=NY*(IX-1)
DO 19606 IY=2 ,NY-1
I=IY+IADD
L0EPSY=LFEPSY+I
L0V1 =LFV1 +I
L0V1S =LFV1S +I
L0DYV2=LFDYV2+I
19606 F(L0EPSY )=(F(L0V1)-F(L0V1S))/F(L0DYV2)
ENDIF
ENDIF
C Special calls name: SC0607
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSY =L0F(INAME('EPSY '))
LFV1 =L0F(V1 )
LFDYV2=L0F(DYV2D )
DO 19607 IX=1 ,NX
IADD=NY*(IX-1)
DO 19607 IY=1 ,1
I=IY+IADD
L0EPSY=LFEPSY+I
L0V1 =LFV1 +I
L0DYV2=LFDYV2+I
19607 F(L0EPSY )=(F(L0V1+1)-F(L0V1))/F(L0DYV2+1)
ENDIF
ENDIF
C Special calls name: SC0608
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFEPSY =L0F(INAME('EPSY '))
LFV1 =L0F(V1 )
LFDYV2=L0F(DYV2D )
DO 19608 IX=1 ,NX
IADD=NY*(IX-1)
DO 19608 IY=NY ,NY
I=IY+IADD
L0EPSY=LFEPSY+I
L0V1 =LFV1 +I
L0DYV2=LFDYV2+I
19608 F(L0EPSY )=(F(L0V1-1)-F(L0V1-2))/F(L0DYV2-1)
ENDIF
ENDIF
C Special calls name: SC0609
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFSTRX =L0F(INAME('STRX '))
LFSTIF=L0F(INAME('STIF '))
LFCON1=L0F(INAME('CON1 '))
LFEPSX=L0F(INAME('EPSX '))
LFCON2=L0F(INAME('CON2 '))
LFEPSY=L0F(INAME('EPSY '))
LFCON3=L0F(INAME('CON3 '))
LFEPST=L0F(INAME('EPST '))
DO 19609 IX=1 ,NX
IADD=NY*(IX-1)
DO 19609 IY=1 ,NY
I=IY+IADD
L0STRX=LFSTRX+I
L0STIF=LFSTIF+I
L0CON1=LFCON1+I
L0EPSX=LFEPSX+I
L0CON2=LFCON2+I
L0EPSY=LFEPSY+I
L0CON3=LFCON3+I
L0EPST=LFEPST+I
19609 F(L0STRX )=F(L0STIF)*(F(L0CON1)*F(L0EPSX)+F(L0CON2)*F(L0EPSY)-
1F(L0CON3)*F(L0EPST))
ENDIF
ENDIF
C Special calls name: SC0610
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFSTRY =L0F(INAME('STRY '))
LFSTIF=L0F(INAME('STIF '))
LFCON1=L0F(INAME('CON1 '))
LFEPSY=L0F(INAME('EPSY '))
LFCON2=L0F(INAME('CON2 '))
LFEPSX=L0F(INAME('EPSX '))
LFCON3=L0F(INAME('CON3 '))
LFEPST=L0F(INAME('EPST '))
DO 19610 IX=1 ,NX
IADD=NY*(IX-1)
DO 19610 IY=1 ,NY
I=IY+IADD
L0STRY=LFSTRY+I
L0STIF=LFSTIF+I
L0CON1=LFCON1+I
L0EPSY=LFEPSY+I
L0CON2=LFCON2+I
L0EPSX=LFEPSX+I
L0CON3=LFCON3+I
L0EPST=LFEPST+I
19610 F(L0STRY )=F(L0STIF)*(F(L0CON1)*F(L0EPSY)+F(L0CON2)*F(L0EPSX)-
1F(L0CON3)*F(L0EPST))
ENDIF
ENDIF
C Special calls name: SC0611
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19611 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19611 IY=2 ,NY-1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19611 F(L0DDYU )=0.25*((F(L0U1)-F(L0U1-1))/F(L0DYG2-1)+(
1F(L0U1 +1)-F(L0U1))/F(L0DYG2)+(F(L0U1-NY)-F(L0U1-NY-1))
1/F(L0DYG2-1)+(F(L0U1-NY+1)-F(L0U1-NY))/F(L0DYG2))
ENDIF
ENDIF
C Special calls name: SC0612
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19612 IX=1 ,1
IADD=NY*(IX-1)
DO 19612 IY=2 ,NY-1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19612 F(L0DDYU )=0.5*((F(L0U1)-F(L0U1-1))/F(L0DYG2-1)+(
1F(L0U1 +1)-F(L0U1))/F(L0DYG2))
ENDIF
ENDIF
C Special calls name: SC0613
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19613 IX=1 ,1
IADD=NY*(IX-1)
DO 19613 IY=1 ,1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19613 F(L0DDYU )=(F(L0U1+1)-F(L0U1))/F(L0DYG2)
ENDIF
ENDIF
C Special calls name: SC0614
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19614 IX=1 ,1
IADD=NY*(IX-1)
DO 19614 IY=NY ,NY
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19614 F(L0DDYU )=(F(L0U1)-F(L0U1-1))/F(L0DYG2-1)
ENDIF
ENDIF
C Special calls name: SC0615
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19615 IX=NX ,NX
IADD=NY*(IX-1)
DO 19615 IY=2 ,NY-1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19615 F(L0DDYU )=0.5*((F(L0U1-NY)-F(L0U1-NY-1))/F(L0DYG2-1)+
1(F(L0U1 -NY+1)-F(L0U1-NY))/F(L0DYG2))
ENDIF
ENDIF
C Special calls name: SC0616
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19616 IX=NX ,NX
IADD=NY*(IX-1)
DO 19616 IY=1 ,1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19616 F(L0DDYU )=(F(L0U1-NY+1)-F(L0U1-NY))/F(L0DYG2)
ENDIF
ENDIF
C Special calls name: SC0617
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19617 IX=NX ,NX
IADD=NY*(IX-1)
DO 19617 IY=NY ,NY
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19617 F(L0DDYU )=(F(L0U1-NY)-F(L0U1-NY-1))/F(L0DYG2-1)
ENDIF
ENDIF
C Special calls name: SC0618
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19618 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19618 IY=NY ,NY
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19618 F(L0DDYU )=0.5*((F(L0U1)-F(L0U1-1))/F(L0DYG2-1)+(
1F(L0U1 -NY)-F(L0U1-NY-1))/F(L0DYG2-1))
ENDIF
ENDIF
C Special calls name: SC0619
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDYU =L0F(INAME('DDYU '))
LFU1 =L0F(U1 )
LFDYG2=L0F(DYG2D )
DO 19619 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19619 IY=1 ,1
I=IY+IADD
L0DDYU=LFDDYU+I
L0U1 =LFU1 +I
L0DYG2=LFDYG2+I
19619 F(L0DDYU )=0.5*((F(L0U1+1)-F(L0U1))/F(L0DYG2)+(
1F(L0U1 -NY+1)-F(L0U1-NY))/F(L0DYG2))
ENDIF
ENDIF
C Special calls name: SC0620
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19620 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19620 IY=2 ,NY-1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19620 F(L0DDXV )=0.25*((F(L0V1+NY-1)-F(L0V1-1))/F(L0DXG2)+
1(F(L0V1 +NY)-F(L0V1))/F(L0DXG2)+(F(L0V1-1)-F(L0V1-NY-1))
1/F(L0DXG2-NY)+(F(L0V1)-F(L0V1-NY))/F(L0DXG2-NY))
ENDIF
ENDIF
C Special calls name: SC0621
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19621 IX=1 ,1
IADD=NY*(IX-1)
DO 19621 IY=1 ,1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19621 F(L0DDXV )=(F(L0V1+NY)-F(L0V1))/F(L0DXG2)
ENDIF
ENDIF
C Special calls name: SC0622
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19622 IX=1 ,1
IADD=NY*(IX-1)
DO 19622 IY=2 ,NY-1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19622 F(L0DDXV )=0.5*((F(L0V1+NY-1)-F(L0V1-1))/F(L0DXG2)+
1(F(L0V1 +NY)-F(L0V1))/F(L0DXG2))
ENDIF
ENDIF
C Special calls name: SC0623
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19623 IX=1 ,1
IADD=NY*(IX-1)
DO 19623 IY=NY ,NY
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19623 F(L0DDXV )=(F(L0V1+NY-1)-F(L0V1-1))/F(L0DXG2)
ENDIF
ENDIF
C Special calls name: SC0624
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19624 IX=NX ,NX
IADD=NY*(IX-1)
DO 19624 IY=1 ,1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19624 F(L0DDXV )=(F(L0V1)-F(L0V1-NY))/F(L0DXG2-NY)
ENDIF
ENDIF
C Special calls name: SC0625
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19625 IX=NX ,NX
IADD=NY*(IX-1)
DO 19625 IY=2 ,NY-1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19625 F(L0DDXV )=0.5*((F(L0V1-1)-F(L0V1-NY-1))/F(L0DXG2-NY)+
1(F(L0V1 )-F(L0V1-NY))/F(L0DXG2-NY))
ENDIF
ENDIF
C Special calls name: SC0626
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19626 IX=NX ,NX
IADD=NY*(IX-1)
DO 19626 IY=NY ,NY
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19626 F(L0DDXV )=(F(L0V1-1)-F(L0V1-NY-1))/F(L0DXG2-NY)
ENDIF
ENDIF
C Special calls name: SC0627
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19627 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19627 IY=1 ,1
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19627 F(L0DDXV )=0.5*((F(L0V1+NY)-F(L0V1))/F(L0DXG2)+(F(L0V1)-
1F(L0V1 -NY))/F(L0DXG2-NY))
ENDIF
ENDIF
C Special calls name: SC0628
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFDDXV =L0F(INAME('DDXV '))
LFV1 =L0F(V1 )
LFDXG2=L0F(DXG2D )
DO 19628 IX=2 ,NX-1
IADD=NY*(IX-1)
DO 19628 IY=NY ,NY
I=IY+IADD
L0DDXV=LFDDXV+I
L0V1 =LFV1 +I
L0DXG2=LFDXG2+I
19628 F(L0DDXV )=0.5*((F(L0V1+NY-1)-F(L0V1-1))/F(L0DXG2)+
1(F(L0V1 -1)-F(L0V1-NY-1))/F(L0DXG2-NY))
ENDIF
ENDIF
C Special calls name: SC0629
IF(ISTEP.GE.1 .AND.ISTEP.LE.LSTEP ) THEN
IF(IZ.GE.1 .AND.IZ.LE.1 ) THEN
LFTAXY =L0F(INAME('TAXY '))
LFSTIF=L0F(INAME('STIF '))
LFCON4=L0F(INAME('CON4 '))
LFDDYU=L0F(INAME('DDYU '))
LFDDXV=L0F(INAME('DDXV '))
DO 19629 IX=1 ,NX
IADD=NY*(IX-1)
DO 19629 IY=1 ,NY
I=IY+IADD
L0TAXY=LFTAXY+I
L0STIF=LFSTIF+I
L0CON4=LFCON4+I
L0DDYU=LFDDYU+I
L0DDXV=LFDDXV+I
19629 F(L0TAXY )=F(L0STIF)*F(L0CON4)*(F(L0DDYU)+F(L0DDXV))
ENDIF
ENDIF
RETURN
197 CONTINUE
C * ------------------- SECTION 7 ---- Finish of sweep.
RETURN
198 CONTINUE
C * ------------------- SECTION 8 ---- Finish of time step.
C
RETURN
C***************************************************************
C
C--- GROUP 20. Preliminary print-out
C
20 CONTINUE
RETURN
C***************************************************************
C--- GROUP 21. Special print-out to screen
21 CONTINUE
GO TO 25
C***************************************************************
C* Make changes to data for GROUP 22 only in GROUP 19.
C***************************************************************
C
C--- GROUP 23. Field print-out and plot control
23 CONTINUE
RETURN
C***************************************************************
C
C--- GROUP 24. Dumps for restarts
C
24 CONTINUE
END