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
      COMMON/SPLVRB/RES
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(DYG2D )
       CALL MAKE(YV2D  )
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
      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
C      Source name: SORC77
      IF(INDVAR.EQ.INAME('G     ').AND.NPATCH.EQ.'SORG    ') THEN
       LFCO  =L0F(CO )
       LFEPKE=L0F(INAME('EPKE  '))
       DO 13777 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13777 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
13777 F(LFCO +I)=2.0*1*F(L0EPKE)
      ENDIF
C      Source name: SORC01
      IF(INDVAR.EQ.INAME('F1    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFCO  =L0F(CO )
       LFEPKE=L0F(INAME('EPKE  '))
       LFF3  =L0F(INAME('F3    '))
       LFF5  =L0F(INAME('F5    '))
       LFF7  =L0F(INAME('F7    '))
       LFF9  =L0F(INAME('F9    '))
       LFF11 =L0F(INAME('F11   '))
       LFF13 =L0F(INAME('F13   '))
       LFF15 =L0F(INAME('F15   '))
       LFF17 =L0F(INAME('F17   '))
       DO 13701 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13701 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F3  =LFF3  +I
       L0F5  =LFF5  +I
       L0F7  =LFF7  +I
       L0F9  =LFF9  +I
       L0F11 =LFF11 +I
       L0F13 =LFF13 +I
       L0F15 =LFF15 +I
       L0F17 =LFF17 +I
13701 F(LFCO +I)=RG(1)*F(L0EPKE)*(F(L0F3)+F(L0F5)+F(L0F7)+
     1F(L0F9  )+F(L0F11)+F(L0F13)+F(L0F15)+F(L0F17))
      ENDIF
C      Source name: SORC17
      IF(INDVAR.EQ.INAME('F17   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFCO  =L0F(CO )
       LFEPKE=L0F(INAME('EPKE  '))
       LFF1  =L0F(INAME('F1    '))
       LFF3  =L0F(INAME('F3    '))
       LFF5  =L0F(INAME('F5    '))
       LFF7  =L0F(INAME('F7    '))
       LFF9  =L0F(INAME('F9    '))
       LFF11 =L0F(INAME('F11   '))
       LFF13 =L0F(INAME('F13   '))
       LFF15 =L0F(INAME('F15   '))
       DO 13717 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13717 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F1  =LFF1  +I
       L0F3  =LFF3  +I
       L0F5  =LFF5  +I
       L0F7  =LFF7  +I
       L0F9  =LFF9  +I
       L0F11 =LFF11 +I
       L0F13 =LFF13 +I
       L0F15 =LFF15 +I
13717 F(LFCO +I)=RG(1)*F(L0EPKE)*(F(L0F1)+F(L0F3)+F(L0F5)+
     1F(L0F7  )+F(L0F9)+F(L0F11)+F(L0F13)+F(L0F15))
      ENDIF
      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: SORC77
      IF(INDVAR.EQ.INAME('G     ').AND.NPATCH.EQ.'SORG    ') THEN
       LFVAL =L0F(VAL)
       LFGENG=L0F(INAME('GENG  '))
       LFEPKE=L0F(INAME('EPKE  '))
       DO 13877 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13877 IY=IYF     ,IYL
        I=IY+IADD
       L0GENG=LFGENG+I
       L0EPKE=LFEPKE+I
13877 F(LFVAL+I)=F(L0GENG)/(2.0*1*F(L0EPKE)+TINY)
      ENDIF
C      Source name: SORC88
      IF(INDVAR.EQ.INAME('G     ').AND.NPATCH.EQ.'WG      ') THEN
       LFVAL =L0F(VAL)
       LFGENG=L0F(INAME('GENG  '))
       LFEPKE=L0F(INAME('EPKE  '))
       DO 13888 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13888 IY=IYF     ,IYL
        I=IY+IADD
       L0GENG=LFGENG+I
       L0EPKE=LFEPKE+I
13888 F(LFVAL+I)=F(L0GENG)/(2.0*1*F(L0EPKE)+TINY)
      ENDIF
C      Source name: SORC02
      IF(INDVAR.EQ.INAME('F2    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF1  =L0F(INAME('F1    '))
       LFF3  =L0F(INAME('F3    '))
       LFF4  =L0F(INAME('F4    '))
       LFF6  =L0F(INAME('F6    '))
       LFF8  =L0F(INAME('F8    '))
       LFF10 =L0F(INAME('F10   '))
       LFF12 =L0F(INAME('F12   '))
       LFF14 =L0F(INAME('F14   '))
       LFF16 =L0F(INAME('F16   '))
       LFF2  =L0F(INAME('F2    '))
       DO 13802 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13802 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F1  =LFF1  +I
       L0F3  =LFF3  +I
       L0F4  =LFF4  +I
       L0F6  =LFF6  +I
       L0F8  =LFF8  +I
       L0F10 =LFF10 +I
       L0F12 =LFF12 +I
       L0F14 =LFF14 +I
       L0F16 =LFF16 +I
       L0F2  =LFF2  +I
13802 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F1)*F(L0F3))-RG(
     11)*F(L0EPKE)*(F(L0F4)+F(L0F6)+F(L0F8)+F(L0F10)+F(L0F12)
     1+F(L0F14 )+F(L0F16))*F(L0F2)
      ENDIF
C      Source name: SORC03
      IF(INDVAR.EQ.INAME('F3    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF2  =L0F(INAME('F2    '))
       LFF4  =L0F(INAME('F4    '))
       LFF1  =L0F(INAME('F1    '))
       LFF5  =L0F(INAME('F5    '))
       LFF17 =L0F(INAME('F17   '))
       LFF7  =L0F(INAME('F7    '))
       LFF9  =L0F(INAME('F9    '))
       LFF11 =L0F(INAME('F11   '))
       LFF13 =L0F(INAME('F13   '))
       LFF15 =L0F(INAME('F15   '))
       LFF3  =L0F(INAME('F3    '))
       DO 13803 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13803 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F2  =LFF2  +I
       L0F4  =LFF4  +I
       L0F1  =LFF1  +I
       L0F5  =LFF5  +I
       L0F17 =LFF17 +I
       L0F7  =LFF7  +I
       L0F9  =LFF9  +I
       L0F11 =LFF11 +I
       L0F13 =LFF13 +I
       L0F15 =LFF15 +I
       L0F3  =LFF3  +I
13803 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F2)*F(L0F4)+F(L0F1)*
     1F(L0F5  ))-RG(1)*F(L0EPKE)*(F(L0F1)+F(L0F17)+F(L0F5)+
     1F(L0F7  )+F(L0F9)+F(L0F11)+F(L0F13)+F(L0F15))*F(L0F3)
      ENDIF
C      Source name: SORC04
      IF(INDVAR.EQ.INAME('F4    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF3  =L0F(INAME('F3    '))
       LFF5  =L0F(INAME('F5    '))
       LFF2  =L0F(INAME('F2    '))
       LFF6  =L0F(INAME('F6    '))
       LFF1  =L0F(INAME('F1    '))
       LFF7  =L0F(INAME('F7    '))
       LFF8  =L0F(INAME('F8    '))
       LFF10 =L0F(INAME('F10   '))
       LFF12 =L0F(INAME('F12   '))
       LFF14 =L0F(INAME('F14   '))
       LFF16 =L0F(INAME('F16   '))
       LFF4  =L0F(INAME('F4    '))
       DO 13804 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13804 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F3  =LFF3  +I
       L0F5  =LFF5  +I
       L0F2  =LFF2  +I
       L0F6  =LFF6  +I
       L0F1  =LFF1  +I
       L0F7  =LFF7  +I
       L0F8  =LFF8  +I
       L0F10 =LFF10 +I
       L0F12 =LFF12 +I
       L0F14 =LFF14 +I
       L0F16 =LFF16 +I
       L0F4  =LFF4  +I
13804 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F3)*F(L0F5)+F(L0F2)*
     1F(L0F6  )+F(L0F1)*F(L0F7))-RG(1)*F(L0EPKE)*(F(L0F2)+
     1F(L0F6  )+F(L0F8)+F(L0F10)+F(L0F12)+F(L0F14)+F(L0F16))
     1*F(L0F4  )
      ENDIF
C      Source name: SORC05
      IF(INDVAR.EQ.INAME('F5    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF4  =L0F(INAME('F4    '))
       LFF6  =L0F(INAME('F6    '))
       LFF3  =L0F(INAME('F3    '))
       LFF7  =L0F(INAME('F7    '))
       LFF2  =L0F(INAME('F2    '))
       LFF8  =L0F(INAME('F8    '))
       LFF1  =L0F(INAME('F1    '))
       LFF9  =L0F(INAME('F9    '))
       LFF17 =L0F(INAME('F17   '))
       LFF11 =L0F(INAME('F11   '))
       LFF13 =L0F(INAME('F13   '))
       LFF15 =L0F(INAME('F15   '))
       LFF5  =L0F(INAME('F5    '))
       DO 13805 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13805 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F4  =LFF4  +I
       L0F6  =LFF6  +I
       L0F3  =LFF3  +I
       L0F7  =LFF7  +I
       L0F2  =LFF2  +I
       L0F8  =LFF8  +I
       L0F1  =LFF1  +I
       L0F9  =LFF9  +I
       L0F17 =LFF17 +I
       L0F11 =LFF11 +I
       L0F13 =LFF13 +I
       L0F15 =LFF15 +I
       L0F5  =LFF5  +I
13805 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F4)*F(L0F6)+F(L0F3)*
     1F(L0F7  )+F(L0F2)*F(L0F8)+F(L0F1)*F(L0F9))-RG(1
     1)*F(L0EPKE)*(F(L0F1)+F(L0F3)+F(L0F17)+F(L0F7)+F(L0F9)+
     1F(L0F11 )+F(L0F13)+F(L0F15))*F(L0F5)
      ENDIF
C      Source name: SORC06
      IF(INDVAR.EQ.INAME('F6    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF5  =L0F(INAME('F5    '))
       LFF7  =L0F(INAME('F7    '))
       LFF4  =L0F(INAME('F4    '))
       LFF8  =L0F(INAME('F8    '))
       LFF3  =L0F(INAME('F3    '))
       LFF9  =L0F(INAME('F9    '))
       LFF2  =L0F(INAME('F2    '))
       LFF10 =L0F(INAME('F10   '))
       LFF1  =L0F(INAME('F1    '))
       LFF11 =L0F(INAME('F11   '))
       LFF12 =L0F(INAME('F12   '))
       LFF14 =L0F(INAME('F14   '))
       LFF16 =L0F(INAME('F16   '))
       LFF6  =L0F(INAME('F6    '))
       DO 13806 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13806 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F5  =LFF5  +I
       L0F7  =LFF7  +I
       L0F4  =LFF4  +I
       L0F8  =LFF8  +I
       L0F3  =LFF3  +I
       L0F9  =LFF9  +I
       L0F2  =LFF2  +I
       L0F10 =LFF10 +I
       L0F1  =LFF1  +I
       L0F11 =LFF11 +I
       L0F12 =LFF12 +I
       L0F14 =LFF14 +I
       L0F16 =LFF16 +I
       L0F6  =LFF6  +I
13806 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F5)*F(L0F7)+F(L0F4)*
     1F(L0F8  )+F(L0F3)*F(L0F9)+F(L0F2)*F(L0F10)+F(L0F1)*
     1F(L0F11 ))-RG(1)*F(L0EPKE)*(F(L0F2)+F(L0F4)+F(L0F8)+
     1F(L0F10 )+F(L0F12)+F(L0F14)+F(L0F16))*F(L0F6)
      ENDIF
C      Source name: SORC07
      IF(INDVAR.EQ.INAME('F7    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF6  =L0F(INAME('F6    '))
       LFF8  =L0F(INAME('F8    '))
       LFF5  =L0F(INAME('F5    '))
       LFF9  =L0F(INAME('F9    '))
       LFF4  =L0F(INAME('F4    '))
       LFF10 =L0F(INAME('F10   '))
       LFF3  =L0F(INAME('F3    '))
       LFF11 =L0F(INAME('F11   '))
       LFF2  =L0F(INAME('F2    '))
       LFF12 =L0F(INAME('F12   '))
       LFF1  =L0F(INAME('F1    '))
       LFF13 =L0F(INAME('F13   '))
       LFF17 =L0F(INAME('F17   '))
       LFF15 =L0F(INAME('F15   '))
       LFF7  =L0F(INAME('F7    '))
       DO 13807 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13807 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F6  =LFF6  +I
       L0F8  =LFF8  +I
       L0F5  =LFF5  +I
       L0F9  =LFF9  +I
       L0F4  =LFF4  +I
       L0F10 =LFF10 +I
       L0F3  =LFF3  +I
       L0F11 =LFF11 +I
       L0F2  =LFF2  +I
       L0F12 =LFF12 +I
       L0F1  =LFF1  +I
       L0F13 =LFF13 +I
       L0F17 =LFF17 +I
       L0F15 =LFF15 +I
       L0F7  =LFF7  +I
13807 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F6)*F(L0F8)+F(L0F5)*
     1F(L0F9  )+F(L0F4)*F(L0F10)+F(L0F3)*F(L0F11)+F(L0F2)*
     1F(L0F12 )+F(L0F1)*F(L0F13))-RG(1)*F(L0EPKE)*(F(L0F1)+
     1F(L0F3  )+F(L0F5)+F(L0F17)+F(L0F9)+F(L0F11)+F(L0F13)+
     1F(L0F15 ))*F(L0F7)
      ENDIF
C      Source name: SORC08
      IF(INDVAR.EQ.INAME('F8    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF7  =L0F(INAME('F7    '))
       LFF9  =L0F(INAME('F9    '))
       LFF6  =L0F(INAME('F6    '))
       LFF10 =L0F(INAME('F10   '))
       LFF5  =L0F(INAME('F5    '))
       LFF11 =L0F(INAME('F11   '))
       LFF4  =L0F(INAME('F4    '))
       LFF12 =L0F(INAME('F12   '))
       LFF3  =L0F(INAME('F3    '))
       LFF13 =L0F(INAME('F13   '))
       LFF2  =L0F(INAME('F2    '))
       LFF14 =L0F(INAME('F14   '))
       LFF1  =L0F(INAME('F1    '))
       LFF15 =L0F(INAME('F15   '))
       LFF16 =L0F(INAME('F16   '))
       LFF8  =L0F(INAME('F8    '))
       DO 13808 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13808 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F7  =LFF7  +I
       L0F9  =LFF9  +I
       L0F6  =LFF6  +I
       L0F10 =LFF10 +I
       L0F5  =LFF5  +I
       L0F11 =LFF11 +I
       L0F4  =LFF4  +I
       L0F12 =LFF12 +I
       L0F3  =LFF3  +I
       L0F13 =LFF13 +I
       L0F2  =LFF2  +I
       L0F14 =LFF14 +I
       L0F1  =LFF1  +I
       L0F15 =LFF15 +I
       L0F16 =LFF16 +I
       L0F8  =LFF8  +I
13808 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F7)*F(L0F9)+F(L0F6)*
     1F(L0F10 )+F(L0F5)*F(L0F11)+F(L0F4)*F(L0F12)+F(L0F3)*
     1F(L0F13 )+F(L0F2)*F(L0F14)+F(L0F1)*F(L0F15))-RG(1
     1)*F(L0EPKE)*(F(L0F2)+F(L0F4)+F(L0F6)+F(L0F10)+F(L0F12)+
     1F(L0F14 )+F(L0F16))*F(L0F8)
      ENDIF
C      Source name: SORC09
      IF(INDVAR.EQ.INAME('F9    ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF8  =L0F(INAME('F8    '))
       LFF10 =L0F(INAME('F10   '))
       LFF7  =L0F(INAME('F7    '))
       LFF11 =L0F(INAME('F11   '))
       LFF6  =L0F(INAME('F6    '))
       LFF12 =L0F(INAME('F12   '))
       LFF5  =L0F(INAME('F5    '))
       LFF13 =L0F(INAME('F13   '))
       LFF4  =L0F(INAME('F4    '))
       LFF14 =L0F(INAME('F14   '))
       LFF3  =L0F(INAME('F3    '))
       LFF15 =L0F(INAME('F15   '))
       LFF2  =L0F(INAME('F2    '))
       LFF16 =L0F(INAME('F16   '))
       LFF1  =L0F(INAME('F1    '))
       LFF17 =L0F(INAME('F17   '))
       LFF9  =L0F(INAME('F9    '))
       DO 13809 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13809 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F8  =LFF8  +I
       L0F10 =LFF10 +I
       L0F7  =LFF7  +I
       L0F11 =LFF11 +I
       L0F6  =LFF6  +I
       L0F12 =LFF12 +I
       L0F5  =LFF5  +I
       L0F13 =LFF13 +I
       L0F4  =LFF4  +I
       L0F14 =LFF14 +I
       L0F3  =LFF3  +I
       L0F15 =LFF15 +I
       L0F2  =LFF2  +I
       L0F16 =LFF16 +I
       L0F1  =LFF1  +I
       L0F17 =LFF17 +I
       L0F9  =LFF9  +I
13809 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F8)*F(L0F10)+F(L0F7)*
     1F(L0F11 )+F(L0F6)*F(L0F12)+F(L0F5)*F(L0F13)+F(L0F4)*
     1F(L0F14 )+F(L0F3)*F(L0F15)+F(L0F2)*F(L0F16)+F(L0F1)*
     1F(L0F17 ))-RG(1)*F(L0EPKE)*(F(L0F1)+F(L0F3)+F(L0F5)+
     1F(L0F7  )+F(L0F17)+F(L0F11)+F(L0F13)+F(L0F15))*F(L0F9)
      ENDIF
C      Source name: SORC10
      IF(INDVAR.EQ.INAME('F10   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF9  =L0F(INAME('F9    '))
       LFF11 =L0F(INAME('F11   '))
       LFF8  =L0F(INAME('F8    '))
       LFF12 =L0F(INAME('F12   '))
       LFF7  =L0F(INAME('F7    '))
       LFF13 =L0F(INAME('F13   '))
       LFF6  =L0F(INAME('F6    '))
       LFF14 =L0F(INAME('F14   '))
       LFF5  =L0F(INAME('F5    '))
       LFF15 =L0F(INAME('F15   '))
       LFF4  =L0F(INAME('F4    '))
       LFF16 =L0F(INAME('F16   '))
       LFF3  =L0F(INAME('F3    '))
       LFF17 =L0F(INAME('F17   '))
       LFF2  =L0F(INAME('F2    '))
       LFF10 =L0F(INAME('F10   '))
       DO 13810 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13810 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F9  =LFF9  +I
       L0F11 =LFF11 +I
       L0F8  =LFF8  +I
       L0F12 =LFF12 +I
       L0F7  =LFF7  +I
       L0F13 =LFF13 +I
       L0F6  =LFF6  +I
       L0F14 =LFF14 +I
       L0F5  =LFF5  +I
       L0F15 =LFF15 +I
       L0F4  =LFF4  +I
       L0F16 =LFF16 +I
       L0F3  =LFF3  +I
       L0F17 =LFF17 +I
       L0F2  =LFF2  +I
       L0F10 =LFF10 +I
13810 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F9)*F(L0F11)+F(L0F8)*
     1F(L0F12 )+F(L0F7)*F(L0F13)+F(L0F6)*F(L0F14)+F(L0F5)*
     1F(L0F15 )+F(L0F4)*F(L0F16)+F(L0F3)*F(L0F17))-RG(1
     1)*F(L0EPKE)*(F(L0F2)+F(L0F4)+F(L0F6)+F(L0F8)+F(L0F12)+
     1F(L0F14 )+F(L0F16))*F(L0F10)
      ENDIF
C      Source name: SORC11
      IF(INDVAR.EQ.INAME('F11   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF10 =L0F(INAME('F10   '))
       LFF12 =L0F(INAME('F12   '))
       LFF9  =L0F(INAME('F9    '))
       LFF13 =L0F(INAME('F13   '))
       LFF8  =L0F(INAME('F8    '))
       LFF14 =L0F(INAME('F14   '))
       LFF7  =L0F(INAME('F7    '))
       LFF15 =L0F(INAME('F15   '))
       LFF6  =L0F(INAME('F6    '))
       LFF16 =L0F(INAME('F16   '))
       LFF5  =L0F(INAME('F5    '))
       LFF17 =L0F(INAME('F17   '))
       LFF1  =L0F(INAME('F1    '))
       LFF3  =L0F(INAME('F3    '))
       LFF11 =L0F(INAME('F11   '))
       DO 13811 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13811 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F10 =LFF10 +I
       L0F12 =LFF12 +I
       L0F9  =LFF9  +I
       L0F13 =LFF13 +I
       L0F8  =LFF8  +I
       L0F14 =LFF14 +I
       L0F7  =LFF7  +I
       L0F15 =LFF15 +I
       L0F6  =LFF6  +I
       L0F16 =LFF16 +I
       L0F5  =LFF5  +I
       L0F17 =LFF17 +I
       L0F1  =LFF1  +I
       L0F3  =LFF3  +I
       L0F11 =LFF11 +I
13811 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F10)*F(L0F12)+F(L0F9)*
     1F(L0F13 )+F(L0F8)*F(L0F14)+F(L0F7)*F(L0F15)+F(L0F6)*
     1F(L0F16 )+F(L0F5)*F(L0F17))-RG(1)*F(L0EPKE)*(F(L0F1)+
     1F(L0F3  )+F(L0F5)+F(L0F7)+F(L0F9)+F(L0F17)+F(L0F13)+
     1F(L0F15 ))*F(L0F11)
      ENDIF
C      Source name: SORC12
      IF(INDVAR.EQ.INAME('F12   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF11 =L0F(INAME('F11   '))
       LFF13 =L0F(INAME('F13   '))
       LFF10 =L0F(INAME('F10   '))
       LFF14 =L0F(INAME('F14   '))
       LFF9  =L0F(INAME('F9    '))
       LFF15 =L0F(INAME('F15   '))
       LFF8  =L0F(INAME('F8    '))
       LFF16 =L0F(INAME('F16   '))
       LFF7  =L0F(INAME('F7    '))
       LFF17 =L0F(INAME('F17   '))
       LFF2  =L0F(INAME('F2    '))
       LFF4  =L0F(INAME('F4    '))
       LFF6  =L0F(INAME('F6    '))
       LFF12 =L0F(INAME('F12   '))
       DO 13812 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13812 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F11 =LFF11 +I
       L0F13 =LFF13 +I
       L0F10 =LFF10 +I
       L0F14 =LFF14 +I
       L0F9  =LFF9  +I
       L0F15 =LFF15 +I
       L0F8  =LFF8  +I
       L0F16 =LFF16 +I
       L0F7  =LFF7  +I
       L0F17 =LFF17 +I
       L0F2  =LFF2  +I
       L0F4  =LFF4  +I
       L0F6  =LFF6  +I
       L0F12 =LFF12 +I
13812 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F11)*F(L0F13)+F(L0F10)*
     1F(L0F14 )+F(L0F9)*F(L0F15)+F(L0F8)*F(L0F16)+F(L0F7)*
     1F(L0F17 ))-RG(1)*F(L0EPKE)*(F(L0F2)+F(L0F4)+F(L0F6)+
     1F(L0F8  )+F(L0F10)+F(L0F14)+F(L0F16))*F(L0F12)
      ENDIF
C      Source name: SORC13
      IF(INDVAR.EQ.INAME('F13   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF12 =L0F(INAME('F12   '))
       LFF14 =L0F(INAME('F14   '))
       LFF11 =L0F(INAME('F11   '))
       LFF15 =L0F(INAME('F15   '))
       LFF10 =L0F(INAME('F10   '))
       LFF16 =L0F(INAME('F16   '))
       LFF9  =L0F(INAME('F9    '))
       LFF17 =L0F(INAME('F17   '))
       LFF1  =L0F(INAME('F1    '))
       LFF3  =L0F(INAME('F3    '))
       LFF5  =L0F(INAME('F5    '))
       LFF7  =L0F(INAME('F7    '))
       LFF13 =L0F(INAME('F13   '))
       DO 13813 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13813 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F12 =LFF12 +I
       L0F14 =LFF14 +I
       L0F11 =LFF11 +I
       L0F15 =LFF15 +I
       L0F10 =LFF10 +I
       L0F16 =LFF16 +I
       L0F9  =LFF9  +I
       L0F17 =LFF17 +I
       L0F1  =LFF1  +I
       L0F3  =LFF3  +I
       L0F5  =LFF5  +I
       L0F7  =LFF7  +I
       L0F13 =LFF13 +I
13813 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F12)*F(L0F14)+F(L0F11)*
     1F(L0F15 )+F(L0F10)*F(L0F16)+F(L0F9)*F(L0F17))-RG(1
     1)*F(L0EPKE)*(F(L0F1)+F(L0F3)+F(L0F5)+F(L0F7)+F(L0F9)+
     1F(L0F11 )+F(L0F15)+F(L0F17))*F(L0F13)
      ENDIF
C      Source name: SORC14
      IF(INDVAR.EQ.INAME('F14   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF13 =L0F(INAME('F13   '))
       LFF15 =L0F(INAME('F15   '))
       LFF12 =L0F(INAME('F12   '))
       LFF16 =L0F(INAME('F16   '))
       LFF11 =L0F(INAME('F11   '))
       LFF17 =L0F(INAME('F17   '))
       LFF2  =L0F(INAME('F2    '))
       LFF4  =L0F(INAME('F4    '))
       LFF6  =L0F(INAME('F6    '))
       LFF8  =L0F(INAME('F8    '))
       LFF10 =L0F(INAME('F10   '))
       LFF14 =L0F(INAME('F14   '))
       DO 13814 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13814 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F13 =LFF13 +I
       L0F15 =LFF15 +I
       L0F12 =LFF12 +I
       L0F16 =LFF16 +I
       L0F11 =LFF11 +I
       L0F17 =LFF17 +I
       L0F2  =LFF2  +I
       L0F4  =LFF4  +I
       L0F6  =LFF6  +I
       L0F8  =LFF8  +I
       L0F10 =LFF10 +I
       L0F14 =LFF14 +I
13814 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F13)*F(L0F15)+F(L0F12)*
     1F(L0F16 )+F(L0F11)*F(L0F17))-RG(1)*F(L0EPKE)*(F(L0F2)+
     1F(L0F4  )+F(L0F6)+F(L0F8)+F(L0F10)+F(L0F12)+F(L0F16))
     1*F(L0F14 )
      ENDIF
C      Source name: SORC15
      IF(INDVAR.EQ.INAME('F15   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF14 =L0F(INAME('F14   '))
       LFF16 =L0F(INAME('F16   '))
       LFF13 =L0F(INAME('F13   '))
       LFF17 =L0F(INAME('F17   '))
       LFF1  =L0F(INAME('F1    '))
       LFF3  =L0F(INAME('F3    '))
       LFF5  =L0F(INAME('F5    '))
       LFF7  =L0F(INAME('F7    '))
       LFF9  =L0F(INAME('F9    '))
       LFF11 =L0F(INAME('F11   '))
       LFF15 =L0F(INAME('F15   '))
       DO 13815 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13815 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F14 =LFF14 +I
       L0F16 =LFF16 +I
       L0F13 =LFF13 +I
       L0F17 =LFF17 +I
       L0F1  =LFF1  +I
       L0F3  =LFF3  +I
       L0F5  =LFF5  +I
       L0F7  =LFF7  +I
       L0F9  =LFF9  +I
       L0F11 =LFF11 +I
       L0F15 =LFF15 +I
13815 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F14)*F(L0F16)+F(L0F13)*
     1F(L0F17 ))-RG(1)*F(L0EPKE)*(F(L0F1)+F(L0F3)+F(L0F5)+
     1F(L0F7  )+F(L0F9)+F(L0F11)+F(L0F13)+F(L0F17))*F(L0F15)
      ENDIF
C      Source name: SORC16
      IF(INDVAR.EQ.INAME('F16   ').AND.NPATCH.EQ.'MIX     ') THEN
       LFVAL =L0F(VAL)
       LFEPKE=L0F(INAME('EPKE  '))
       LFF15 =L0F(INAME('F15   '))
       LFF17 =L0F(INAME('F17   '))
       LFF2  =L0F(INAME('F2    '))
       LFF4  =L0F(INAME('F4    '))
       LFF6  =L0F(INAME('F6    '))
       LFF8  =L0F(INAME('F8    '))
       LFF10 =L0F(INAME('F10   '))
       LFF12 =L0F(INAME('F12   '))
       LFF14 =L0F(INAME('F14   '))
       LFF16 =L0F(INAME('F16   '))
       DO 13816 IX=IXF     ,IXL
        IADD=NY*(IX-1)
       DO 13816 IY=IYF     ,IYL
        I=IY+IADD
       L0EPKE=LFEPKE+I
       L0F15 =LFF15 +I
       L0F17 =LFF17 +I
       L0F2  =LFF2  +I
       L0F4  =LFF4  +I
       L0F6  =LFF6  +I
       L0F8  =LFF8  +I
       L0F10 =LFF10 +I
       L0F12 =LFF12 +I
       L0F14 =LFF14 +I
       L0F16 =LFF16 +I
13816 F(LFVAL+I)=2.*RG(1)*F(L0EPKE)*(F(L0F15)*F(L0F17))-RG(
     11)*F(L0EPKE)*(F(L0F2)+F(L0F4)+F(L0F6)+F(L0F8)+F(L0F10)
     1+F(L0F12 )+F(L0F14))*F(L0F16)
      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: SC0655
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       IF(IZ.EQ.1       ) RES   =0
       LFVOL =L0F(VOL   )
       LFGENG=L0F(INAME('GENG  '))
       LFEPKE=L0F(INAME('EPKE  '))
       LFG   =L0F(INAME('G     '))
       DO 19655 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19655 IY=1       ,NY
        I=IY+IADD
       L0VOL =LFVOL +I
       L0GENG=LFGENG+I
       L0EPKE=LFEPKE+I
       L0G   =LFG   +I
19655 RES=RES+F(L0VOL)*(F(L0GENG)-2.*1*F(L0EPKE)*F(L0G))/
     1(NY*NZ)
       ENDIF
      ENDIF
C      Special calls name: SC0656
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       DO 19656 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19656 IY=1       ,NY
        I=IY+IADD
19656 RESREF(INAME('G'))=RES
       ENDIF
      ENDIF
C      Special calls name: SC0607
      IF(ISTEP.GE.1       .AND.ISTEP.LE.1       ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ-1    ) THEN
       LFDFZ  =L0F(INAME('DFZ   '))
       LFH1  =L0F(H1    )
       L0DZGN=L0F(DZGNZ )+IZ
       DO 19607 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19607 IY=1       ,NY
        I=IY+IADD
       L0DFZ =LFDFZ +I
       L0H1  =LFH1  +I
19607 F(L0DFZ   )=((F(L0H1+NFM)-F(L0H1))/F(L0DZGN))**2
       ENDIF
      ENDIF
C      Special calls name: SC0609
      IF(ISTEP.GE.1       .AND.ISTEP.LE.1       ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFDFY  =L0F(INAME('DFY   '))
       LFH1  =L0F(H1    )
       LFDYG2=L0F(DYG2D )
       DO 19609 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19609 IY=1       ,NY-1
        I=IY+IADD
       L0DFY =LFDFY +I
       L0H1  =LFH1  +I
       L0DYG2=LFDYG2+I
19609 F(L0DFY   )=((F(L0H1+1)-F(L0H1))/F(L0DYG2))**2
       ENDIF
      ENDIF
C      Special calls name: SC0610
      IF(ISTEP.GE.1       .AND.ISTEP.LE.1       ) THEN
       IF(IZ.GE.NZ      .AND.IZ.LE.NZ      ) THEN
       LFDFZH =L0F(INAME('DFZH  '))
       LFH1  =L0F(H1    )
       L0DZGN=L0F(DZGNZ )+IZ
       DO 19610 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19610 IY=1       ,NY
        I=IY+IADD
       L0DFZH=LFDFZH+I
       L0H1  =LFH1  +I
19610 F(L0DFZH  )=((F(L0H1)-F(L0H1-NFM))/F(L0DZGN-1))**2
       ENDIF
      ENDIF
C      Special calls name: SC0611
      IF(ISTEP.GE.1       .AND.ISTEP.LE.1       ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFDFYN =L0F(INAME('DFYN  '))
       LFH1  =L0F(H1    )
       LFDYG2=L0F(DYG2D )
       DO 19611 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19611 IY=NY      ,NY
        I=IY+IADD
       L0DFYN=LFDFYN+I
       L0H1  =LFH1  +I
       L0DYG2=LFDYG2+I
19611 F(L0DFYN  )=((F(L0H1)-F(L0H1-1))/F(L0DYG2-1))**2
       ENDIF
      ENDIF
C      Special calls name: SC0612
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFGENG =L0F(INAME('GENG  '))
       LFENUT=L0F(INAME('ENUT  '))
       LFDFZ =L0F(INAME('DFZ   '))
       LFDFY =L0F(INAME('DFY   '))
       LFDFZH=L0F(INAME('DFZH  '))
       LFDFYN=L0F(INAME('DFYN  '))
       DO 19612 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19612 IY=1       ,NY
        I=IY+IADD
       L0GENG=LFGENG+I
       L0ENUT=LFENUT+I
       L0DFZ =LFDFZ +I
       L0DFY =LFDFY +I
       L0DFZH=LFDFZH+I
       L0DFYN=LFDFYN+I
19612 F(L0GENG  )=2.8*1*F(L0ENUT)*(F(L0DFZ)+F(L0DFY)+F(L0DFZH)+
     1F(L0DFYN))
       ENDIF
      ENDIF
C      Special calls name: SC0613
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFGG   =L0F(INAME('GG    '))
       LFG   =L0F(INAME('G     '))
       DO 19613 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19613 IY=1       ,NY
        I=IY+IADD
       L0GG  =LFGG  +I
       L0G   =LFG   +I
19613 F(L0GG    )=SQRT(F(L0G))
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0614
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFGGF  =L0F(INAME('GGF   '))
       LFGG  =L0F(INAME('GG    '))
       LFH1  =L0F(H1    )
       DO 19614 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19614 IY=1       ,NY
        I=IY+IADD
       L0GGF =LFGGF +I
       L0GG  =LFGG  +I
       L0H1  =LFH1  +I
19614 F(L0GGF   )=F(L0GG)/(F(L0H1)+TINY)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0601
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFCAV  =L0F(INAME('CAV   '))
       LFF1  =L0F(INAME('F1    '))
       LFF2  =L0F(INAME('F2    '))
       LFF3  =L0F(INAME('F3    '))
       LFF4  =L0F(INAME('F4    '))
       LFF5  =L0F(INAME('F5    '))
       LFF6  =L0F(INAME('F6    '))
       LFF7  =L0F(INAME('F7    '))
       LFF8  =L0F(INAME('F8    '))
       LFF9  =L0F(INAME('F9    '))
       LFF10 =L0F(INAME('F10   '))
       LFF11 =L0F(INAME('F11   '))
       LFF12 =L0F(INAME('F12   '))
       LFF13 =L0F(INAME('F13   '))
       LFF14 =L0F(INAME('F14   '))
       LFF15 =L0F(INAME('F15   '))
       LFF16 =L0F(INAME('F16   '))
       LFF17 =L0F(INAME('F17   '))
       DO 19601 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19601 IY=1       ,NY
        I=IY+IADD
       L0CAV =LFCAV +I
       L0F1  =LFF1  +I
       L0F2  =LFF2  +I
       L0F3  =LFF3  +I
       L0F4  =LFF4  +I
       L0F5  =LFF5  +I
       L0F6  =LFF6  +I
       L0F7  =LFF7  +I
       L0F8  =LFF8  +I
       L0F9  =LFF9  +I
       L0F10 =LFF10 +I
       L0F11 =LFF11 +I
       L0F12 =LFF12 +I
       L0F13 =LFF13 +I
       L0F14 =LFF14 +I
       L0F15 =LFF15 +I
       L0F16 =LFF16 +I
       L0F17 =LFF17 +I
19601 F(L0CAV   )=16./16.*F(L0F1)+15./16.*F(L0F2)+14./16.
     1*F(L0F3  )+13./16.*F(L0F4)+12./16.*F(L0F5)+11./16.*
     1F(L0F6  )+10./16.*F(L0F7)+9./16.*F(L0F8)+8./16.*F(L0F9)+
     17./16.*F(L0F10)+6./16.*F(L0F11)+5./16.*F(L0F12)+4./1
     16.*F(L0F13 )+3./16.*F(L0F14)+2./16.*F(L0F15)+1./16.*F(L0F16)
     1+0./16.*F(L0F17)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0602
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFMAS  =L0F(INAME('MAS   '))
       LFF1  =L0F(INAME('F1    '))
       LFF2  =L0F(INAME('F2    '))
       LFF3  =L0F(INAME('F3    '))
       LFF4  =L0F(INAME('F4    '))
       LFF5  =L0F(INAME('F5    '))
       LFF6  =L0F(INAME('F6    '))
       LFF7  =L0F(INAME('F7    '))
       LFF8  =L0F(INAME('F8    '))
       LFF9  =L0F(INAME('F9    '))
       LFF10 =L0F(INAME('F10   '))
       LFF11 =L0F(INAME('F11   '))
       LFF12 =L0F(INAME('F12   '))
       LFF13 =L0F(INAME('F13   '))
       LFF14 =L0F(INAME('F14   '))
       LFF15 =L0F(INAME('F15   '))
       LFF16 =L0F(INAME('F16   '))
       LFF17 =L0F(INAME('F17   '))
       DO 19602 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19602 IY=1       ,NY
        I=IY+IADD
       L0MAS =LFMAS +I
       L0F1  =LFF1  +I
       L0F2  =LFF2  +I
       L0F3  =LFF3  +I
       L0F4  =LFF4  +I
       L0F5  =LFF5  +I
       L0F6  =LFF6  +I
       L0F7  =LFF7  +I
       L0F8  =LFF8  +I
       L0F9  =LFF9  +I
       L0F10 =LFF10 +I
       L0F11 =LFF11 +I
       L0F12 =LFF12 +I
       L0F13 =LFF13 +I
       L0F14 =LFF14 +I
       L0F15 =LFF15 +I
       L0F16 =LFF16 +I
       L0F17 =LFF17 +I
19602 F(L0MAS   )=F(L0F1)+F(L0F2)+F(L0F3)+F(L0F4)+F(L0F5)+
     1F(L0F6  )+F(L0F7)+F(L0F8)+F(L0F9)+F(L0F10)+F(L0F11)+
     1F(L0F12 )+F(L0F13)+F(L0F14)+F(L0F15)+F(L0F16)+F(L0F17)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0603
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFGAV  =L0F(INAME('GAV   '))
       LFCAV =L0F(INAME('CAV   '))
       LFF1  =L0F(INAME('F1    '))
       LFF2  =L0F(INAME('F2    '))
       LFF3  =L0F(INAME('F3    '))
       LFF4  =L0F(INAME('F4    '))
       LFF5  =L0F(INAME('F5    '))
       LFF6  =L0F(INAME('F6    '))
       LFF7  =L0F(INAME('F7    '))
       LFF8  =L0F(INAME('F8    '))
       LFF9  =L0F(INAME('F9    '))
       LFF10 =L0F(INAME('F10   '))
       LFF11 =L0F(INAME('F11   '))
       LFF12 =L0F(INAME('F12   '))
       LFF13 =L0F(INAME('F13   '))
       LFF14 =L0F(INAME('F14   '))
       LFF15 =L0F(INAME('F15   '))
       LFF16 =L0F(INAME('F16   '))
       LFF17 =L0F(INAME('F17   '))
       DO 19603 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19603 IY=1       ,NY
        I=IY+IADD
       L0GAV =LFGAV +I
       L0CAV =LFCAV +I
       L0F1  =LFF1  +I
       L0F2  =LFF2  +I
       L0F3  =LFF3  +I
       L0F4  =LFF4  +I
       L0F5  =LFF5  +I
       L0F6  =LFF6  +I
       L0F7  =LFF7  +I
       L0F8  =LFF8  +I
       L0F9  =LFF9  +I
       L0F10 =LFF10 +I
       L0F11 =LFF11 +I
       L0F12 =LFF12 +I
       L0F13 =LFF13 +I
       L0F14 =LFF14 +I
       L0F15 =LFF15 +I
       L0F16 =LFF16 +I
       L0F17 =LFF17 +I
19603 F(L0GAV   )=ABS(F(L0CAV)-16./16)*F(L0F1)+ABS(F(L0CAV)-
     115./16.)*F(L0F2)+ABS(F(L0CAV)-14./16)*F(L0F3)+ABS(
     1F(L0CAV )-13./16.)*F(L0F4)+ABS(F(L0CAV)-12./16)*F(L0F5)+
     1ABS(F(L0CAV )-11./16.)*F(L0F6)+ABS(F(L0CAV)-10./16)*
     1F(L0F7  )+ABS(F(L0CAV)-9./16.)*F(L0F8)+ABS(F(L0CAV)-
     18./16)*F(L0F9)+ABS(F(L0CAV)-7./16.)*F(L0F10)+ABS(F(L0CAV)-
     16./16)*F(L0F11)+ABS(F(L0CAV)-5./16.)*F(L0F12)+ABS(F(L0CAV)-
     14./16)*F(L0F13)+ABS(F(L0CAV)-3./16.)*F(L0F14)+ABS(F(L0CAV)-
     12./16)*F(L0F15)+ABS(F(L0CAV)-1./16.)*F(L0F16)+ABS(F(L0CAV)-
     10./16)*F(L0F17)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0606
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.NZ      ) THEN
       LFGF   =L0F(INAME('GF    '))
       LFGAV =L0F(INAME('GAV   '))
       LFCAV =L0F(INAME('CAV   '))
       DO 19606 IX=1       ,NX
        IADD=NY*(IX-1)
       DO 19606 IY=1       ,NY
        I=IY+IADD
       L0GF  =LFGF  +I
       L0GAV =LFGAV +I
       L0CAV =LFCAV +I
19606 F(L0GF    )=F(L0GAV)/(F(L0CAV)+TINY)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0638
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.1       .AND.IZ.LE.1       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF1  =L0F(INAME('F1    '))
       LFYV2D=L0F(YV2D  )
       DO 19638 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19638 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F1  =LFF1  +I
       L0YV2D=LFYV2D+I
19638 F(L0FPD   )=F(L0F1+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F1+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F1  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0639
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.2       .AND.IZ.LE.2       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF2  =L0F(INAME('F2    '))
       LFYV2D=L0F(YV2D  )
       DO 19639 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19639 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F2  =LFF2  +I
       L0YV2D=LFYV2D+I
19639 F(L0FPD   )=F(L0F2+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F2+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F2  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0640
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.3       .AND.IZ.LE.3       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF3  =L0F(INAME('F3    '))
       LFYV2D=L0F(YV2D  )
       DO 19640 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19640 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F3  =LFF3  +I
       L0YV2D=LFYV2D+I
19640 F(L0FPD   )=F(L0F3+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F3+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F3  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0641
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.4       .AND.IZ.LE.4       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF4  =L0F(INAME('F4    '))
       LFYV2D=L0F(YV2D  )
       DO 19641 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19641 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F4  =LFF4  +I
       L0YV2D=LFYV2D+I
19641 F(L0FPD   )=F(L0F4+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F4+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F4  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0642
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.5       .AND.IZ.LE.5       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF5  =L0F(INAME('F5    '))
       LFYV2D=L0F(YV2D  )
       DO 19642 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19642 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F5  =LFF5  +I
       L0YV2D=LFYV2D+I
19642 F(L0FPD   )=F(L0F5+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F5+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F5  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0643
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.6       .AND.IZ.LE.6       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF6  =L0F(INAME('F6    '))
       LFYV2D=L0F(YV2D  )
       DO 19643 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19643 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F6  =LFF6  +I
       L0YV2D=LFYV2D+I
19643 F(L0FPD   )=F(L0F6+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F6+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F6  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0644
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.7       .AND.IZ.LE.7       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF7  =L0F(INAME('F7    '))
       LFYV2D=L0F(YV2D  )
       DO 19644 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19644 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F7  =LFF7  +I
       L0YV2D=LFYV2D+I
19644 F(L0FPD   )=F(L0F7+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F7+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F7  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0645
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.8       .AND.IZ.LE.8       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF8  =L0F(INAME('F8    '))
       LFYV2D=L0F(YV2D  )
       DO 19645 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19645 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F8  =LFF8  +I
       L0YV2D=LFYV2D+I
19645 F(L0FPD   )=F(L0F8+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F8+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F8  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0646
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.9       .AND.IZ.LE.9       ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF9  =L0F(INAME('F9    '))
       LFYV2D=L0F(YV2D  )
       DO 19646 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19646 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F9  =LFF9  +I
       L0YV2D=LFYV2D+I
19646 F(L0FPD   )=F(L0F9+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F9+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F9  +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0647
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.10      .AND.IZ.LE.10      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF10 =L0F(INAME('F10   '))
       LFYV2D=L0F(YV2D  )
       DO 19647 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19647 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F10 =LFF10 +I
       L0YV2D=LFYV2D+I
19647 F(L0FPD   )=F(L0F10+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F10+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F10 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0648
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.11      .AND.IZ.LE.11      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF11 =L0F(INAME('F11   '))
       LFYV2D=L0F(YV2D  )
       DO 19648 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19648 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F11 =LFF11 +I
       L0YV2D=LFYV2D+I
19648 F(L0FPD   )=F(L0F11+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F11+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F11 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0649
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.12      .AND.IZ.LE.12      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF12 =L0F(INAME('F12   '))
       LFYV2D=L0F(YV2D  )
       DO 19649 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19649 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F12 =LFF12 +I
       L0YV2D=LFYV2D+I
19649 F(L0FPD   )=F(L0F12+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F12+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F12 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0650
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.13      .AND.IZ.LE.13      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF13 =L0F(INAME('F13   '))
       LFYV2D=L0F(YV2D  )
       DO 19650 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19650 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F13 =LFF13 +I
       L0YV2D=LFYV2D+I
19650 F(L0FPD   )=F(L0F13+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F13+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F13 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0651
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.14      .AND.IZ.LE.14      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF14 =L0F(INAME('F14   '))
       LFYV2D=L0F(YV2D  )
       DO 19651 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19651 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F14 =LFF14 +I
       L0YV2D=LFYV2D+I
19651 F(L0FPD   )=F(L0F14+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F14+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F14 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0652
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.15      .AND.IZ.LE.15      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF15 =L0F(INAME('F15   '))
       LFYV2D=L0F(YV2D  )
       DO 19652 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19652 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F15 =LFF15 +I
       L0YV2D=LFYV2D+I
19652 F(L0FPD   )=F(L0F15+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F15+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F15 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0653
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.16      .AND.IZ.LE.16      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF16 =L0F(INAME('F16   '))
       LFYV2D=L0F(YV2D  )
       DO 19653 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19653 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F16 =LFF16 +I
       L0YV2D=LFYV2D+I
19653 F(L0FPD   )=F(L0F16+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F16+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F16 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
C      Special calls name: SC0654
      IF(ISTEP.GE.1       .AND.ISTEP.LE.LSTEP   ) THEN
      IF(ISWEEP.EQ.LSWEEP) THEN
       IF(IZ.GE.17      .AND.IZ.LE.17      ) THEN
       LFFPD  =L0F(INAME('FPD   '))
       LFF17 =L0F(INAME('F17   '))
       LFYV2D=L0F(YV2D  )
       DO 19654 IX=1       ,1
        IADD=NY*(IX-1)
       DO 19654 IY=1       ,NY
        I=IY+IADD
       L0FPD =LFFPD +I
       L0F17 =LFF17 +I
       L0YV2D=LFYV2D+I
19654 F(L0FPD   )=F(L0F17+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))*
     1AMAX1(ABS(F(L0F17+NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))-F(L0YV2D)
     1)/(F(L0F17 +NY*(1-IX)+IG(1)-IY+NFM*(IG(2)-IZ))+0.-F(L0YV2D))
     1,0.0)
       ENDIF
      ENDIF
      ENDIF
      RETURN
  197 CONTINUE
C   * ------------------- SECTION 7 ---- Finish of sweep.
      RETURN
  198 CONTINUE
C   * ------------------- SECTION 8 ---- Finish of time step.
       LU=1
       OPEN(UNIT=LU,FILE='GLOBCALC',STATUS='UNKNOWN')
       WRITE(LU,*) 'Global calculations:'
       WRITE(LU,*) 'RES                           ',' = ',RES
       CLOSE(LU)
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