CMAX: [Version 1.0 (6/22/93)]
CMAX: ----------------------------------------------------
CMAX: Transformation of VTERPV from vterpv.f
CMAX: ----------------------------------------------------
      SUBROUTINE vterpv_v2(alat,os,ln,alon,os100,ln100,prs,os101,ln101,
     &    val,len,q)
      include '/usr/include/cm/CMF_defs.h'

C  3-DIMENSIONAL BILINEAR INTERPOLATION OF A FIELD, Q, TO A SET OF
C  LAT/LON/PRESSURE LOCATIONS
C  ALAT(I) IS ASSUMED TO BE BETWEEN  -90.0 AND  +90.0
C  ALON(I) IS ASSUMED TO BE BETWEEN -180.0 AND +180.0
C  VERTICAL INTERPOLATION IS LINEAR IN PRESSURE
cmax: Changed argument ALAT to passed with index
      INTEGER os
      INTEGER ln
cmax: Changed argument ALON to passed with index
      INTEGER os100
      INTEGER ln100
cmax: Changed argument PRS to passed with index
      INTEGER os101
      INTEGER ln101
      DIMENSION alat(1-os+1:ln+1-os)
      DIMENSION alon(1-os100+1:ln100+1-os100)
      REAL AMLEV
      REAL fill
      REAL HL (1)
      INTEGER II
      INTEGER I0
      INTEGER I1
      INTEGER IPRS
      INTEGER J0
      INTEGER J1
      INTEGER len
      DIMENSION prs(1-os101+1:ln101+1-os101)
      DIMENSION Q (IM, JNP, MLEV)
      REAL QDEGDX
      REAL QDEGDY
      DIMENSION VAL (len)
      REAL VALDN (1)
      REAL VALUP (1)
      REAL WTJ1
      REAL XI
      REAL YJ
C  IM AND JNP ARE NEEDED FROM COMMON BLOCK /CONTRL/
      LOGICAL STRAT, SLP, FDCOS, FEXP, SAVEAE, SIGDAT
      COMMON / CONTRL / IM, JNP, NB, NDALT, NHMS, NLAY, NLAYM1, NLAYP1, 
     &NYMD, STRAT, IDIMEN, SLP, FDCOS, FEXP, SAVEAE, SIGDAT, MAXREP
C  VERTICAL INDICES
      COMMON / MLAY / MLEV, MLEVM1, MMIX, MMIXM1, LS, LSM1
!hpf$ distribute alat(block)
!hpf$ distribute alon(block)
!hpf$ distribute hl(block)
!hpf$ distribute prs(block)
!hpf$ distribute q(block,block,block)
!hpf$ distribute val(block)
!hpf$ distribute valdn(block)
!hpf$ distribute valup(block)
      LOGICAL lif(len)
!hpf$ distribute lif(block)
      LOGICAL lif100(len)
!hpf$ distribute lif100(block)
      LOGICAL lif101(len)
!hpf$ distribute lif101(block)
      LOGICAL lif102(len)
!hpf$ distribute lif102(block)
      REAL  WTJ1100(1-os+1:ln+1-os)
!hpf$ distribute wtj1100(block)
      INTEGER  IQA100(len)
!hpf$ distribute IQA100(block)
      INTEGER  I1100(1-os100+1:ln100+1-os100)
!hpf$ distribute i1100(block)
      INTEGER  IFL100(len)
!hpf$ distribute IFL100(block)
      INTEGER  IQD100(len)
!hpf$ distribute IQD100(block)
      REAL  XI100(1-os100+1:ln100+1-os100)
!hpf$ distribute xi100(block)
      INTEGER  J0100(1-os+1:ln+1-os)
!hpf$ distribute j0100(block)
      REAL  D3100(len)
!hpf$ distribute D3100(block)
      REAL  WTI1100(1-os100+1:ln100+1-os100)
!hpf$ distribute wti1100(block)
      INTEGER  I0100(1-os100+1:ln100+1-os100)
!hpf$ distribute i0100(block)
      INTEGER  IQC100(len)
!hpf$ distribute IQC100(block)
      REAL  D2100(len)
!hpf$ distribute D2100(block)
      INTEGER  LA100(len)
!hpf$ distribute LA100(block)
      REAL  YJ100(1-os+1:ln+1-os)
!hpf$ distribute yj100(block)
      INTEGER  IQB100(len)
!hpf$ distribute IQB100(block)
      REAL  D1100(len)
!hpf$ distribute D1100(block)
      INTEGER  IFCOUNT100(len)
!hpf$ distribute IFCOUNT100(block)
      REAL  DFACT100(len)
!hpf$ distribute DFACT100(block)
      INTEGER  J1100(1-os+1:ln+1-os)
!hpf$ distribute j1100(block)
      REAL  D4100(len)
!hpf$ distribute D4100(block)
      REAL  FV102(len)
!hpf$ distribute FV102(block)
      REAL  FV101(len)
!hpf$ distribute FV101(block)
      REAL  FV100(len)
!hpf$ distribute FV100(block)
      REAL  D101(len)
!hpf$ distribute D101(block)
      REAL  D100(len)
!hpf$ distribute D100(block)
      REAL  C101(len)
!hpf$ distribute C101(block)
      REAL  C100(len)
!hpf$ distribute C100(block)
      REAL  B101(len)
!hpf$ distribute B101(block)
      REAL  B100(len)
!hpf$ distribute B100(block)
      REAL  A101(len)
!hpf$ distribute A101(block)
      REAL  A100(len)
!hpf$ distribute A100(block)
      LOGICAL lif103(len)
!hpf$ distribute lif103(block)
      LOGICAL lif104(len)
!hpf$ distribute lif104(block)
      LOGICAL lif105(len)
!hpf$ distribute lif105(block)
      LOGICAL lif106(len)
!hpf$ distribute lif106(block)
      REAL  WTJ1101(1-os+1:ln+1-os)
!hpf$ distribute wtj1101(block)
      INTEGER  IQA101(len)
!hpf$ distribute IQA101(block)
      INTEGER  I1101(1-os100+1:ln100+1-os100)
!hpf$ distribute i1101(block)
      INTEGER  IFL101(len)
!hpf$ distribute IFL101(block)
      INTEGER  IQD101(len)
!hpf$ distribute IQD101(block)
      REAL  XI101(1-os100+1:ln100+1-os100)
!hpf$ distribute xi101(block)
      INTEGER  J0101(1-os+1:ln+1-os)
!hpf$ distribute j0101(block)
      REAL  D3101(len)
!hpf$ distribute D3101(block)
      INTEGER  LB100(len)
!hpf$ distribute LB100(block)
      REAL  WTI1101(1-os100+1:ln100+1-os100)
!hpf$ distribute wti1101(block)
      INTEGER  I0101(1-os100+1:ln100+1-os100)
!hpf$ distribute i0101(block)
      INTEGER  IQC101(len)
!hpf$ distribute IQC101(block)
      REAL  D2101(len)
!hpf$ distribute D2101(block)
      INTEGER  LA101(len)
!hpf$ distribute LA101(block)
      REAL  YJ101(1-os+1:ln+1-os)
!hpf$ distribute yj101(block)
      INTEGER  IQB101(len)
!hpf$ distribute IQB101(block)
      REAL  D1101(len)
!hpf$ distribute D1101(block)
      INTEGER  IFCOUNT101(len)
!hpf$ distribute IFCOUNT101(block)
      REAL  DFACT101(len)
!hpf$ distribute DFACT101(block)
      INTEGER  J1101(1-os+1:ln+1-os)
!hpf$ distribute j1101(block)
      REAL  D4101(len)
!hpf$ distribute D4101(block)
      REAL  FV105(len)
!hpf$ distribute FV105(block)
      REAL  FV104(len)
!hpf$ distribute FV104(block)
      REAL  FV103(len)
!hpf$ distribute FV103(block)
      REAL  D103(len)
!hpf$ distribute D103(block)
      REAL  D102(len)
!hpf$ distribute D102(block)
      REAL  C103(len)
!hpf$ distribute C103(block)
      REAL  C102(len)
!hpf$ distribute C102(block)
      REAL  B103(len)
!hpf$ distribute B103(block)
      REAL  B102(len)
!hpf$ distribute B102(block)
      REAL  A103(len)
!hpf$ distribute A103(block)
      REAL  A102(len)
!hpf$ distribute A102(block)
      DATA fill / 1.e10 /
      amlev = mlev
      qdegdx = im / 360.0
      qdegdy = (jnp - 1) / 180.0
C  SET VERTICAL SUBSCRIPTS AND INTERPOLATION FACTORS
      FORALL (ii = 1:len) hl(ii) = pindx2(prs(ii))
      DO ii = 1 , len
        hl(ii) = min(max(hl(ii),1.0),amlev)
      ENDDO
      FORALL (ii = 1:len) la100(ii) = hl(ii) + 0.0001
      DO ii = 1 , len
        lb = min(la100(ii) + 1,mlev)
      ENDDO
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
      yj100(1:len) = (alat(1:len) + 90.0) * qdegdy + 1.0
      j0100(1:len) = min(max(int(yj100(1:len)),1),jnp - 1)
      j1100(1:len) = j0100(1:len) + 1
      wtj1100(1:len) = yj100(1:len) - j0100(1:len)
      xi100(1:len) = (alon(1:len) + 180.0) * qdegdx + 1.0
      WHERE (xi100(1:len) .GE. (im + 1))
        xi100(1:len) = xi100(1:len) - im
      ENDWHERE
      WHERE (xi100(1:len) .LT. 1)
        xi100(1:len) = xi100(1:len) + im
      ENDWHERE
      i0100(1:len) = min(max(int(xi100(1:len)),1),im)
      i1100(1:len) = i0100(1:len) + 1
      WHERE (i0100(1:len) .EQ. im)
        i1100(1:len) = 1
      ENDWHERE
      wti1100(1:len) = xi100(1:len) - i0100(1:len)
      FORALL (ii = 1:len) a100(ii) = q(i0100(ii),j0100(ii),la100(ii))
      FORALL (ii = 1:len) b100(ii) = q(i1100(ii),j0100(ii),la100(ii))
      FORALL (ii = 1:len) c100(ii) = q(i0100(ii),j1100(ii),la100(ii))
      FORALL (ii = 1:len) d100(ii) = q(i1100(ii),j1100(ii),la100(ii))
c Screen for fill values on upper level - replace fill values according
c to predetermined criteria.
C
C For brevity, the four corner points will be identified as follows:
C
C         X X   8               X X   4
C         X X                   X X
C         C  (D3)               D  (D4)
C
C
C
C
C         X X   1               X X   2
C         X X                   X X
C         A   (D1)              B   (D2)
C
C
C
C Assign corner values
C
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
      ifl100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        ifl100(1:len) = 1
      ENDWHERE
      WHERE (b100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 2
      ENDWHERE
      WHERE (d100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 4
      ENDWHERE
      WHERE (c100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 8
      ENDWHERE
      iqa100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        iqa100(1:len) = 1
      ENDWHERE
      iqb100(1:len) = 0
      WHERE (b100(1:len) .EQ. fill)
        iqb100(1:len) = 1
      ENDWHERE
      iqc100(1:len) = 0
      WHERE (c100(1:len) .EQ. fill)
        iqc100(1:len) = 1
      ENDWHERE
      iqd100(1:len) = 0
      WHERE (d100(1:len) .EQ. fill)
        iqd100(1:len) = 1
      ENDWHERE
      ifcount100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (b100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (d100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (c100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      lif(ii) = ifl100(ii) .EQ. 0
      lif100(ii) = ifl100(ii) .EQ. 1 .OR. ifl100(ii) .EQ. 4
      IF (.NOT.ifl100(ii) .EQ. 0 .AND. (ifl100(ii) .EQ. 1 .OR. ifl100(ii
     &      ) .EQ. 4)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.lif(ii) .AND. lif100(ii)) fv100(ii) = ((1
     &    -iqb100(ii)) * b100(ii) + (1 - iqc100(ii)) * c100(ii)) 
     &    / float(ifcount)
      lif101(ii) = ifl100(ii) .EQ. 2 .OR. ifl100(ii) .EQ. 8
      IF (.NOT.(lif(ii) .AND. lif100(ii)) .AND. (ifl100(ii) .EQ. 2 .OR.
     &      ifl100(ii) .EQ. 8)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.(lif(ii) .AND. lif100(ii)) 
     &    .AND. lif101(ii)) fv101(ii) = ((1 - iqa100(ii)) * a100(ii) + (
     &    1 - iqd100(ii)) * d100(ii)) / float(ifcount)
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        dfact100(1:len) = float(4 - ifcount100(1:len))
        fv102(1:len) = ((1 - iqa100(1:len)) * a100(1:len) + (1 
     &      - iqb100(1:len)) * b100(1:len) + (1 - iqc100(1:len)) 
     &      * c100(1:len) + (1 - iqd100(1:len)) * d100(1:len)) 
     &      / dfact100(1:len)
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
      ENDWHERE
      d1100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d1100(1:len) = a100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d1100(1:len) = fv100(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d1100(1:len) = fv101(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d1100(1:len) = fv102(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      DO ii = 1 , len
        lif102(ii) = d1100(ii) .EQ. fill
        IF (d1100(ii) .EQ. fill) THEN
          valup(ii) = fill
        ENDIF
      ENDDO
      d2100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d2100(1:len) = b100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d2100(1:len) = fv100(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d2100(1:len) = fv101(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d2100(1:len) = fv102(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      d3100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d3100(1:len) = c100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d3100(1:len) = fv100(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d3100(1:len) = fv101(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d3100(1:len) = fv102(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      d4100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d4100(1:len) = d100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d4100(1:len) = fv100(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d4100(1:len) = fv101(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d4100(1:len) = fv102(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv102(1:len))
C
C  UPPER LEVEL INTERPOLATION
      ENDWHERE
      WHERE (.NOT.d1100(1:len) .EQ. fill)
        a101(1:len) = d1100(1:len)
        b101(1:len) = d2100(1:len)
        c101(1:len) = d3100(1:len)
        d101(1:len) = d4100(1:len)
      ENDWHERE
      DO ii = 1 , len
        IF (.NOT.lif102(ii)) THEN
          valup(ii) = wtj1100(ii) * (wti1100(ii) 
     &        * d101(ii) + (1.0 - wti1100(ii)) * c101(ii)) + (1.0 
     &        - wtj1100(ii)) * (wti1100(ii) * b101(ii) + (1.0 
     &        - wti1100(ii)) * a101(ii))
        ENDIF
      ENDDO
C        HL(ii) = AMIN1( AMAX1( HL(ii),1.0 ), AMLEV )
      FORALL (ii = 1:len) la101(ii) = hl(ii) + 0.0001
      lb100(1:len) = min(la101(1:len) + 1,mlev)
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
      yj101(1:len) = (alat(1:len) + 90.0) * qdegdy + 1.0
      j0101(1:len) = min(max(int(yj101(1:len)),1),jnp - 1)
      j1101(1:len) = j0101(1:len) + 1
      wtj1101(1:len) = yj101(1:len) - j0101(1:len)
      xi101(1:len) = (alon(1:len) + 180.0) * qdegdx + 1.0
      WHERE (xi101(1:len) .GE. (im + 1))
        xi101(1:len) = xi101(1:len) - im
      ENDWHERE
      WHERE (xi101(1:len) .LT. 1)
        xi101(1:len) = xi101(1:len) + im
      ENDWHERE
      i0101(1:len) = min(max(int(xi101(1:len)),1),im)
      i1101(1:len) = i0101(1:len) + 1
      WHERE (i0101(1:len) .EQ. im)
        i1101(1:len) = 1
      ENDWHERE
      wti1101(1:len) = xi101(1:len) - i0101(1:len)
      FORALL (ii = 1:len) a102(ii) = q(i0101(ii),j0101(ii),lb100(ii))
      FORALL (ii = 1:len) b102(ii) = q(i1101(ii),j0101(ii),lb100(ii))
      FORALL (ii = 1:len) c102(ii) = q(i0101(ii),j1101(ii),lb100(ii))
      FORALL (ii = 1:len) d102(ii) = q(i1101(ii),j1101(ii),lb100(ii))
C Similarly, screen for fill values on lower level
C
C Assign corner values
C
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
      ifl101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        ifl101(1:len) = 1
      ENDWHERE
      WHERE (b102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 2
      ENDWHERE
      WHERE (d102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 4
      ENDWHERE
      WHERE (c102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 8
      ENDWHERE
      iqa101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        iqa101(1:len) = 1
      ENDWHERE
      iqb101(1:len) = 0
      WHERE (b102(1:len) .EQ. fill)
        iqb101(1:len) = 1
      ENDWHERE
      iqc101(1:len) = 0
      WHERE (c102(1:len) .EQ. fill)
        iqc101(1:len) = 1
      ENDWHERE
      iqd101(1:len) = 0
      WHERE (d102(1:len) .EQ. fill)
        iqd101(1:len) = 1
      ENDWHERE
      ifcount101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (b102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (d102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (c102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      lif103(ii) = ifl101(ii) .EQ. 0
      lif104(ii) = ifl101(ii) .EQ. 1 .OR. ifl101(ii) .EQ. 4
      IF (.NOT.ifl101(ii) .EQ. 0 .AND. (ifl101(ii) .EQ. 1 .OR. ifl101(ii
     &      ) .EQ. 4)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.lif103(ii) .AND. lif104(ii)) fv103(ii) =
     &    ((1 - iqb101(ii)) * b102(ii) + (1 - iqc101(ii)) * c102(ii)) 
     &    / float(ifcount)
      lif105(ii) = ifl101(ii) .EQ. 2 .OR. ifl101(ii) .EQ. 8
      IF (.NOT.(lif103(ii) .AND. lif104(ii)) .AND. (ifl101(ii) .EQ. 2 
     &      .OR. ifl101(ii) .EQ. 8)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.(lif103(ii) .AND. lif104(ii)) 
     &    .AND. lif105(ii)) fv104(ii) = ((1 - iqa101(ii)) * a102(ii) + (
     &    1 - iqd101(ii)) * d102(ii)) / float(ifcount)
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        dfact101(1:len) = float(4 - ifcount101(1:len))
        fv105(1:len) = ((1 - iqa101(1:len)) * a102(1:len) + (1 
     &      - iqb101(1:len)) * b102(1:len) + (1 - iqc101(1:len)) 
     &      * c102(1:len) + (1 - iqd101(1:len)) * d102(1:len)) 
     &      / dfact101(1:len)
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
      ENDWHERE
      d1101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d1101(1:len) = a102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d1101(1:len) = fv103(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d1101(1:len) = fv104(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d1101(1:len) = fv105(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      DO ii = 1 , len
        lif106(ii) = d1101(ii) .EQ. fill
        IF (d1101(ii) .EQ. fill) THEN
          valdn(ii) = fill
        ENDIF
      ENDDO
      d2101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d2101(1:len) = b102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d2101(1:len) = fv103(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d2101(1:len) = fv104(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d2101(1:len) = fv105(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      d3101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d3101(1:len) = c102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d3101(1:len) = fv103(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d3101(1:len) = fv104(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d3101(1:len) = fv105(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      d4101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d4101(1:len) = d102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d4101(1:len) = fv103(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d4101(1:len) = fv104(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d4101(1:len) = fv105(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv105(1:len))
c
C  LOWER LEVEL INTERPOLATION
      ENDWHERE
      WHERE (.NOT.d1101(1:len) .EQ. fill)
        a103(1:len) = d1101(1:len)
        b103(1:len) = d2101(1:len)
        c103(1:len) = d3101(1:len)
        d103(1:len) = d4101(1:len)
      ENDWHERE
      DO ii = 1 , len
        IF (.NOT.lif106(ii)) THEN
          valdn(ii) = wtj1101(ii) * (wti1101(ii) 
     &        * d103(ii) + (1.0 - wti1101(ii)) * c103(ii)) + (1.0 
     &        - wtj1101(ii)) * (wti1101(ii) * b103(ii) + (1.0 
     &        - wti1101(ii)) * a103(ii))
        ENDIF
      ENDDO
      DO 7006 ii = 1 , len
C  VERTICAL INTERPOLATION
        IF (valup(ii) .NE. fill .AND. 
     &        valdn(ii) .NE. fill) THEN
          val(ii) = valup(ii) + (
     &        valdn(ii) - valup(ii))
     &        * (hl(ii) - int(hl(ii)))
        ELSEIF (valup(ii) .EQ. fill .AND. 
     &        valdn(ii) .NE. fill) THEN
          val(ii) = valdn(ii)
        ELSEIF (valup(ii) .NE. fill .AND. 
     &        valdn(ii) .EQ. fill) THEN
          val(ii) = valup(ii)
        ELSE
          val(ii) = fill
        ENDIF
  400   CONTINUE
 7006 CONTINUE
      RETURN
      END
CMAX: ----------------------------------------------------
CMAX: Transformation of VTERPV from vterpv.f
CMAX: ----------------------------------------------------
      SUBROUTINE vterpv_v1(alat,os,ln,alon,os100,ln100,prs,os101,ln101,
     &    val,os102,ln102,len,q)
C  3-DIMENSIONAL BILINEAR INTERPOLATION OF A FIELD, Q, TO A SET OF
C  LAT/LON/PRESSURE LOCATIONS
C  ALAT(I) IS ASSUMED TO BE BETWEEN  -90.0 AND  +90.0
C  ALON(I) IS ASSUMED TO BE BETWEEN -180.0 AND +180.0
C  VERTICAL INTERPOLATION IS LINEAR IN PRESSURE
cmax: Changed argument ALAT to passed with index
      INTEGER os
      INTEGER ln
cmax: Changed argument ALON to passed with index
      INTEGER os100
      INTEGER ln100
cmax: Changed argument PRS to passed with index
      INTEGER os101
      INTEGER ln101
cmax: Changed argument VAL to passed with index
      INTEGER os102
      INTEGER ln102
      DIMENSION alat(1-os+1:ln+1-os)
      DIMENSION alon(1-os100+1:ln100+1-os100)
      REAL AMLEV
      REAL fill
      REAL HL (1)
      INTEGER II
      INTEGER I0
      INTEGER I1
      INTEGER IPRS
      INTEGER J0
      INTEGER J1
      INTEGER len
      DIMENSION prs(1-os101+1:ln101+1-os101)
      DIMENSION Q (IM, JNP, MLEV)
      REAL QDEGDX
      REAL QDEGDY
      DIMENSION val(1-os102+1:ln102+1-os102)
      REAL VALDN (1)
      REAL VALUP (1)
      REAL WTJ1
      REAL XI
      REAL YJ
C  IM AND JNP ARE NEEDED FROM COMMON BLOCK /CONTRL/
      LOGICAL STRAT, SLP, FDCOS, FEXP, SAVEAE, SIGDAT
      COMMON / CONTRL / IM, JNP, NB, NDALT, NHMS, NLAY, NLAYM1, NLAYP1, 
     &NYMD, STRAT, IDIMEN, SLP, FDCOS, FEXP, SAVEAE, SIGDAT, MAXREP
C  VERTICAL INDICES
      COMMON / MLAY / MLEV, MLEVM1, MMIX, MMIXM1, LS, LSM1
!hpf$ distribute alat(block)
!hpf$ distribute alon(block)
!hpf$ distribute hl(block)
!hpf$ distribute prs(block)
!hpf$ distribute q(block,block,block)
!hpf$ distribute val(block)
!hpf$ distribute valdn(block)
!hpf$ distribute valup(block)
      LOGICAL lif(len)
!hpf$ distribute lif(block)
      LOGICAL lif100(len)
!hpf$ distribute lif100(block)
      LOGICAL lif101(len)
!hpf$ distribute lif101(block)
      LOGICAL lif102(len)
!hpf$ distribute lif102(block)
      REAL  WTJ1100(1-os+1:ln+1-os)
!hpf$ distribute wtj1100(block)
      INTEGER  IQA100(len)
!hpf$ distribute IQA100(block)
      INTEGER  I1100(1-os100+1:ln100+1-os100)
!hpf$ distribute i1100(block)
      INTEGER  IFL100(len)
!hpf$ distribute IFL100(block)
      INTEGER  IQD100(len)
!hpf$ distribute IQD100(block)
      REAL  XI100(1-os100+1:ln100+1-os100)
!hpf$ distribute xi100(block)
      INTEGER  J0100(1-os+1:ln+1-os)
!hpf$ distribute j0100(block)
      REAL  D3100(len)
!hpf$ distribute D3100(block)
      REAL  WTI1100(1-os100+1:ln100+1-os100)
!hpf$ distribute wti1100(block)
      INTEGER  I0100(1-os100+1:ln100+1-os100)
!hpf$ distribute i0100(block)
      INTEGER  IQC100(len)
!hpf$ distribute IQC100(block)
      REAL  D2100(len)
!hpf$ distribute D2100(block)
      INTEGER  LA100(len)
!hpf$ distribute LA100(block)
      REAL  YJ100(1-os+1:ln+1-os)
!hpf$ distribute yj100(block)
      INTEGER  IQB100(len)
!hpf$ distribute IQB100(block)
      REAL  D1100(len)
!hpf$ distribute D1100(block)
      INTEGER  IFCOUNT100(len)
!hpf$ distribute IFCOUNT100(block)
      REAL  DFACT100(len)
!hpf$ distribute DFACT100(block)
      INTEGER  J1100(1-os+1:ln+1-os)
!hpf$ distribute j1100(block)
      REAL  D4100(len)
!hpf$ distribute D4100(block)
      REAL  FV102(len)
!hpf$ distribute FV102(block)
      REAL  FV101(len)
!hpf$ distribute FV101(block)
      REAL  FV100(len)
!hpf$ distribute FV100(block)
      REAL  D101(len)
!hpf$ distribute D101(block)
      REAL  D100(len)
!hpf$ distribute D100(block)
      REAL  C101(len)
!hpf$ distribute C101(block)
      REAL  C100(len)
!hpf$ distribute C100(block)
      REAL  B101(len)
!hpf$ distribute B101(block)
      REAL  B100(len)
!hpf$ distribute B100(block)
      REAL  A101(len)
!hpf$ distribute A101(block)
      REAL  A100(len)
!hpf$ distribute A100(block)
      LOGICAL lif103(len)
!hpf$ distribute lif103(block)
      LOGICAL lif104(len)
!hpf$ distribute lif104(block)
      LOGICAL lif105(len)
!hpf$ distribute lif105(block)
      LOGICAL lif106(len)
!hpf$ distribute lif106(block)
      REAL  WTJ1101(1-os+1:ln+1-os)
!hpf$ distribute wtj1101(block)
      INTEGER  IQA101(len)
!hpf$ distribute IQA101(block)
      INTEGER  I1101(1-os100+1:ln100+1-os100)
!hpf$ distribute i1101(block)
      INTEGER  IFL101(len)
!hpf$ distribute IFL101(block)
      INTEGER  IQD101(len)
!hpf$ distribute IQD101(block)
      REAL  XI101(1-os100+1:ln100+1-os100)
!hpf$ distribute xi101(block)
      INTEGER  J0101(1-os+1:ln+1-os)
!hpf$ distribute j0101(block)
      REAL  D3101(len)
!hpf$ distribute D3101(block)
      INTEGER  LB100(len)
!hpf$ distribute LB100(block)
      REAL  WTI1101(1-os100+1:ln100+1-os100)
!hpf$ distribute wti1101(block)
      INTEGER  I0101(1-os100+1:ln100+1-os100)
!hpf$ distribute i0101(block)
      INTEGER  IQC101(len)
!hpf$ distribute IQC101(block)
      REAL  D2101(len)
!hpf$ distribute D2101(block)
      INTEGER  LA101(len)
!hpf$ distribute LA101(block)
      REAL  YJ101(1-os+1:ln+1-os)
!hpf$ distribute yj101(block)
      INTEGER  IQB101(len)
!hpf$ distribute IQB101(block)
      REAL  D1101(len)
!hpf$ distribute D1101(block)
      INTEGER  IFCOUNT101(len)
!hpf$ distribute IFCOUNT101(block)
      REAL  DFACT101(len)
!hpf$ distribute DFACT101(block)
      INTEGER  J1101(1-os+1:ln+1-os)
!hpf$ distribute j1101(block)
      REAL  D4101(len)
!hpf$ distribute D4101(block)
      REAL  FV105(len)
!hpf$ distribute FV105(block)
      REAL  FV104(len)
!hpf$ distribute FV104(block)
      REAL  FV103(len)
!hpf$ distribute FV103(block)
      REAL  D103(len)
!hpf$ distribute D103(block)
      REAL  D102(len)
!hpf$ distribute D102(block)
      REAL  C103(len)
!hpf$ distribute C103(block)
      REAL  C102(len)
!hpf$ distribute C102(block)
      REAL  B103(len)
!hpf$ distribute B103(block)
      REAL  B102(len)
!hpf$ distribute B102(block)
      REAL  A103(len)
!hpf$ distribute A103(block)
      REAL  A102(len)
!hpf$ distribute A102(block)
      DATA fill / 1.e10 /
      amlev = mlev
      qdegdx = im / 360.0
      qdegdy = (jnp - 1) / 180.0
C  SET VERTICAL SUBSCRIPTS AND INTERPOLATION FACTORS
      FORALL (ii = 1:len) hl(ii) = pindx2(prs(ii))
      DO ii = 1 , len
        hl(ii) = min(max(hl(ii),1.0),
     &      amlev)
      ENDDO
      FORALL (ii = 1:len) la100(ii) = hl(ii) + 0.0001
      DO ii = 1 , len
        lb = min(la100(ii) + 1,mlev)
      ENDDO
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
      yj100(1:len) = (alat(1:len) + 90.0) * qdegdy + 1.0
      j0100(1:len) = min(max(int(yj100(1:len)),1),jnp - 1)
      j1100(1:len) = j0100(1:len) + 1
      wtj1100(1:len) = yj100(1:len) - j0100(1:len)
      xi100(1:len) = (alon(1:len) + 180.0) * qdegdx + 1.0
      WHERE (xi100(1:len) .GE. (im + 1))
        xi100(1:len) = xi100(1:len) - im
      ENDWHERE
      WHERE (xi100(1:len) .LT. 1)
        xi100(1:len) = xi100(1:len) + im
      ENDWHERE
      i0100(1:len) = min(max(int(xi100(1:len)),1),im)
      i1100(1:len) = i0100(1:len) + 1
      WHERE (i0100(1:len) .EQ. im)
        i1100(1:len) = 1
      ENDWHERE
      wti1100(1:len) = xi100(1:len) - i0100(1:len)
      FORALL (ii = 1:len) a100(ii) = q(i0100(ii),j0100(ii),la100(ii))
      FORALL (ii = 1:len) b100(ii) = q(i1100(ii),j0100(ii),la100(ii))
      FORALL (ii = 1:len) c100(ii) = q(i0100(ii),j1100(ii),la100(ii))
      FORALL (ii = 1:len) d100(ii) = q(i1100(ii),j1100(ii),la100(ii))
c Screen for fill values on upper level - replace fill values according
c to predetermined criteria.
C
C For brevity, the four corner points will be identified as follows:
C
C         X X   8               X X   4
C         X X                   X X
C         C  (D3)               D  (D4)
C
C
C
C
C         X X   1               X X   2
C         X X                   X X
C         A   (D1)              B   (D2)
C
C
C
C Assign corner values
C
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
      ifl100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        ifl100(1:len) = 1
      ENDWHERE
      WHERE (b100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 2
      ENDWHERE
      WHERE (d100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 4
      ENDWHERE
      WHERE (c100(1:len) .EQ. fill)
        ifl100(1:len) = ifl100(1:len) + 8
      ENDWHERE
      iqa100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        iqa100(1:len) = 1
      ENDWHERE
      iqb100(1:len) = 0
      WHERE (b100(1:len) .EQ. fill)
        iqb100(1:len) = 1
      ENDWHERE
      iqc100(1:len) = 0
      WHERE (c100(1:len) .EQ. fill)
        iqc100(1:len) = 1
      ENDWHERE
      iqd100(1:len) = 0
      WHERE (d100(1:len) .EQ. fill)
        iqd100(1:len) = 1
      ENDWHERE
      ifcount100(1:len) = 0
      WHERE (a100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (b100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (d100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      WHERE (c100(1:len) .EQ. fill)
        ifcount100(1:len) = ifcount100(1:len) + 1
      ENDWHERE
      lif(ii) = ifl100(ii) .EQ. 0
      lif100(ii) = ifl100(ii) .EQ. 1 .OR. ifl100(ii) .EQ. 4
      IF (.NOT.ifl100(ii) .EQ. 0 .AND. (ifl100(ii) .EQ. 1 .OR. ifl100(ii
     &      ) .EQ. 4)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.lif(ii) .AND. lif100(ii)) fv100(ii) = ((1
     &    -iqb100(ii)) * b100(ii) + (1 - iqc100(ii)) * c100(ii)) 
     &    / float(ifcount)
      lif101(ii) = ifl100(ii) .EQ. 2 .OR. ifl100(ii) .EQ. 8
      IF (.NOT.(lif(ii) .AND. lif100(ii)) .AND. (ifl100(ii) .EQ. 2 .OR.
     &      ifl100(ii) .EQ. 8)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.(lif(ii) .AND. lif100(ii)) 
     &    .AND. lif101(ii)) fv101(ii) = ((1 - iqa100(ii)) * a100(ii) + (
     &    1 - iqd100(ii)) * d100(ii)) / float(ifcount)
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        dfact100(1:len) = float(4 - ifcount100(1:len))
        fv102(1:len) = ((1 - iqa100(1:len)) * a100(1:len) + (1 
     &      - iqb100(1:len)) * b100(1:len) + (1 - iqc100(1:len)) 
     &      * c100(1:len) + (1 - iqd100(1:len)) * d100(1:len)) 
     &      / dfact100(1:len)
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
      ENDWHERE
      d1100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d1100(1:len) = a100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d1100(1:len) = fv100(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d1100(1:len) = fv101(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d1100(1:len) = fv102(1:len) + (1 - iqa100(1:len)) * (a100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      DO ii = 1 , len
        lif102(ii) = d1100(ii) .EQ. fill
        IF (d1100(ii) .EQ. fill) THEN
          valup(ii) = fill
        ENDIF
      ENDDO
      d2100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d2100(1:len) = b100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d2100(1:len) = fv100(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d2100(1:len) = fv101(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d2100(1:len) = fv102(1:len) + (1 - iqb100(1:len)) * (b100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      d3100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d3100(1:len) = c100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d3100(1:len) = fv100(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d3100(1:len) = fv101(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d3100(1:len) = fv102(1:len) + (1 - iqc100(1:len)) * (c100(1:len)
     &      -fv102(1:len))
      ENDWHERE
      d4100(1:len) = fill
      WHERE (ifl100(1:len) .EQ. 0)
        d4100(1:len) = d100(1:len)
      ENDWHERE
      WHERE (.NOT.ifl100(1:len) .EQ. 0 .AND. (ifl100(1:len) .EQ. 1 .OR.
     &      ifl100(1:len) .EQ. 4))
        d4100(1:len) = fv100(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv100(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4) .AND. (ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8))
        d4100(1:len) = fv101(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv101(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl100(1:len) .EQ. 0 .OR. ifl100(1:len) .EQ. 1 .OR. 
     &      ifl100(1:len) .EQ. 4 .OR. ifl100(1:len) .EQ. 2 .OR. 
     &      ifl100(1:len) .EQ. 8) .AND. ifl100(1:len) .NE. 15)
        d4100(1:len) = fv102(1:len) + (1 - iqd100(1:len)) * (d100(1:len)
     &      -fv102(1:len))
C
C  UPPER LEVEL INTERPOLATION
      ENDWHERE
      WHERE (.NOT.d1100(1:len) .EQ. fill)
        a101(1:len) = d1100(1:len)
        b101(1:len) = d2100(1:len)
        c101(1:len) = d3100(1:len)
        d101(1:len) = d4100(1:len)
      ENDWHERE
      DO ii = 1 , len
        IF (.NOT.lif102(ii)) THEN
          valup(ii) = wtj1100(ii) * (wti1100(ii) 
     &        * d101(ii) + (1.0 - wti1100(ii)) * c101(ii)) + (1.0 
     &        - wtj1100(ii)) * (wti1100(ii) * b101(ii) + (1.0 
     &        - wti1100(ii)) * a101(ii))
        ENDIF
      ENDDO
C        HL(ii) = AMIN1( AMAX1( HL(ii),1.0 ), AMLEV )
      FORALL (ii = 1:len) la101(ii) = hl(ii) + 0.0001
      lb100(1:len) = min(la101(1:len) + 1,mlev)
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
      yj101(1:len) = (alat(1:len) + 90.0) * qdegdy + 1.0
      j0101(1:len) = min(max(int(yj101(1:len)),1),jnp - 1)
      j1101(1:len) = j0101(1:len) + 1
      wtj1101(1:len) = yj101(1:len) - j0101(1:len)
      xi101(1:len) = (alon(1:len) + 180.0) * qdegdx + 1.0
      WHERE (xi101(1:len) .GE. (im + 1))
        xi101(1:len) = xi101(1:len) - im
      ENDWHERE
      WHERE (xi101(1:len) .LT. 1)
        xi101(1:len) = xi101(1:len) + im
      ENDWHERE
      i0101(1:len) = min(max(int(xi101(1:len)),1),im)
      i1101(1:len) = i0101(1:len) + 1
      WHERE (i0101(1:len) .EQ. im)
        i1101(1:len) = 1
      ENDWHERE
      wti1101(1:len) = xi101(1:len) - i0101(1:len)
      FORALL (ii = 1:len) a102(ii) = q(i0101(ii),j0101(ii),lb100(ii))
      FORALL (ii = 1:len) b102(ii) = q(i1101(ii),j0101(ii),lb100(ii))
      FORALL (ii = 1:len) c102(ii) = q(i0101(ii),j1101(ii),lb100(ii))
      FORALL (ii = 1:len) d102(ii) = q(i1101(ii),j1101(ii),lb100(ii))
C Similarly, screen for fill values on lower level
C
C Assign corner values
C
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
      ifl101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        ifl101(1:len) = 1
      ENDWHERE
      WHERE (b102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 2
      ENDWHERE
      WHERE (d102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 4
      ENDWHERE
      WHERE (c102(1:len) .EQ. fill)
        ifl101(1:len) = ifl101(1:len) + 8
      ENDWHERE
      iqa101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        iqa101(1:len) = 1
      ENDWHERE
      iqb101(1:len) = 0
      WHERE (b102(1:len) .EQ. fill)
        iqb101(1:len) = 1
      ENDWHERE
      iqc101(1:len) = 0
      WHERE (c102(1:len) .EQ. fill)
        iqc101(1:len) = 1
      ENDWHERE
      iqd101(1:len) = 0
      WHERE (d102(1:len) .EQ. fill)
        iqd101(1:len) = 1
      ENDWHERE
      ifcount101(1:len) = 0
      WHERE (a102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (b102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (d102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      WHERE (c102(1:len) .EQ. fill)
        ifcount101(1:len) = ifcount101(1:len) + 1
      ENDWHERE
      lif103(ii) = ifl101(ii) .EQ. 0
      lif104(ii) = ifl101(ii) .EQ. 1 .OR. ifl101(ii) .EQ. 4
      IF (.NOT.ifl101(ii) .EQ. 0 .AND. (ifl101(ii) .EQ. 1 .OR. ifl101(ii
     &      ) .EQ. 4)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.lif103(ii) .AND. lif104(ii)) fv103(ii) =
     &    ((1 - iqb101(ii)) * b102(ii) + (1 - iqc101(ii)) * c102(ii)) 
     &    / float(ifcount)
      lif105(ii) = ifl101(ii) .EQ. 2 .OR. ifl101(ii) .EQ. 8
      IF (.NOT.(lif103(ii) .AND. lif104(ii)) .AND. (ifl101(ii) .EQ. 2 
     &      .OR. ifl101(ii) .EQ. 8)) THEN
        ifcount = 2
      ENDIF
      FORALL (ii = 1:len, .NOT.(lif103(ii) .AND. lif104(ii)) 
     &    .AND. lif105(ii)) fv104(ii) = ((1 - iqa101(ii)) * a102(ii) + (
     &    1 - iqd101(ii)) * d102(ii)) / float(ifcount)
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        dfact101(1:len) = float(4 - ifcount101(1:len))
        fv105(1:len) = ((1 - iqa101(1:len)) * a102(1:len) + (1 
     &      - iqb101(1:len)) * b102(1:len) + (1 - iqc101(1:len)) 
     &      * c102(1:len) + (1 - iqd101(1:len)) * d102(1:len)) 
     &      / dfact101(1:len)
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
      ENDWHERE
      d1101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d1101(1:len) = a102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d1101(1:len) = fv103(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d1101(1:len) = fv104(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d1101(1:len) = fv105(1:len) + (1 - iqa101(1:len)) * (a102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      DO ii = 1 , len
        lif106(ii) = d1101(ii) .EQ. fill
        IF (d1101(ii) .EQ. fill) THEN
          valdn(ii) = fill
        ENDIF
      ENDDO
      d2101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d2101(1:len) = b102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d2101(1:len) = fv103(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d2101(1:len) = fv104(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d2101(1:len) = fv105(1:len) + (1 - iqb101(1:len)) * (b102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      d3101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d3101(1:len) = c102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d3101(1:len) = fv103(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d3101(1:len) = fv104(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d3101(1:len) = fv105(1:len) + (1 - iqc101(1:len)) * (c102(1:len)
     &      -fv105(1:len))
      ENDWHERE
      d4101(1:len) = fill
      WHERE (ifl101(1:len) .EQ. 0)
        d4101(1:len) = d102(1:len)
      ENDWHERE
      WHERE (.NOT.ifl101(1:len) .EQ. 0 .AND. (ifl101(1:len) .EQ. 1 .OR.
     &      ifl101(1:len) .EQ. 4))
        d4101(1:len) = fv103(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv103(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4) .AND. (ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8))
        d4101(1:len) = fv104(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv104(1:len))
      ENDWHERE
      WHERE (.NOT.(ifl101(1:len) .EQ. 0 .OR. ifl101(1:len) .EQ. 1 .OR. 
     &      ifl101(1:len) .EQ. 4 .OR. ifl101(1:len) .EQ. 2 .OR. 
     &      ifl101(1:len) .EQ. 8) .AND. ifl101(1:len) .NE. 15)
        d4101(1:len) = fv105(1:len) + (1 - iqd101(1:len)) * (d102(1:len)
     &      -fv105(1:len))
c
C  LOWER LEVEL INTERPOLATION
      ENDWHERE
      WHERE (.NOT.d1101(1:len) .EQ. fill)
        a103(1:len) = d1101(1:len)
        b103(1:len) = d2101(1:len)
        c103(1:len) = d3101(1:len)
        d103(1:len) = d4101(1:len)
      ENDWHERE
      DO ii = 1 , len
        IF (.NOT.lif106(ii)) THEN
          valdn(ii) = wtj1101(ii) * (wti1101(ii) 
     &        * d103(ii) + (1.0 - wti1101(ii)) * c103(ii)) + (1.0 
     &        - wtj1101(ii)) * (wti1101(ii) * b103(ii) + (1.0 
     &        - wti1101(ii)) * a103(ii))
        ENDIF
      ENDDO
C  VERTICAL INTERPOLATION
      DO ii = 1 , len
        IF (valup(ii) .NE. fill .AND. valdn(
     &        ii) .NE. fill) THEN
          val(ii) = valup(ii) + (
     &        valdn(ii) - valup(ii))
     &        * (hl(ii) - int(hl(ii)))
        ENDIF
      ENDDO
      FORALL (ii = 1:len, .NOT.(valup(ii) .NE. fill 
     &    .AND. valdn(ii) .NE. fill) .AND. valup(
     &    ii) .EQ. fill .AND. valdn( ii 
     &    ) .NE. fill) val(ii) = valdn(ii)
      FORALL (ii = 1:len, .NOT.(valup(ii) .NE. fill 
     &    .AND. valdn(ii) .NE. fill .OR. valup(
     &    ii) .EQ. fill .AND. valdn( ii 
     &    ) .NE. fill) .AND. valup(ii) .NE. fill 
     &    .AND. valdn(ii) .EQ. fill) val(ii) 
     &    = valup(ii)
      FORALL (ii = 1:len, .NOT.(valup(ii) .NE. fill 
     &    .AND. valdn(ii) .NE. fill .OR. valup(
     &    ii) .EQ. fill .AND. valdn( ii 
     &    ) .NE. fill .OR. valup(ii) .NE. fill 
     &    .AND. valdn(ii) .EQ. fill)) val(ii) = fill
      RETURN
      END
CMAX: ----------------------------------------------------
CMAX: Transformation of VTERPV from vterpv.f
CMAX: ----------------------------------------------------
      SUBROUTINE vterpv(alat,alon,prs,val,len,q)
C  3-DIMENSIONAL BILINEAR INTERPOLATION OF A FIELD, Q, TO A SET OF
C  LAT/LON/PRESSURE LOCATIONS
C  ALAT(I) IS ASSUMED TO BE BETWEEN  -90.0 AND  +90.0
C  ALON(I) IS ASSUMED TO BE BETWEEN -180.0 AND +180.0
C  VERTICAL INTERPOLATION IS LINEAR IN PRESSURE
      DIMENSION ALAT (len)
      DIMENSION ALON (len)
      REAL AMLEV
      REAL fill
      REAL HL (1)
      INTEGER II
      INTEGER I0
      INTEGER I1
      INTEGER IPRS
      INTEGER J0
      INTEGER J1
      INTEGER len
      DIMENSION PRS (len)
      DIMENSION Q (IM, JNP, MLEV)
      REAL QDEGDX
      REAL QDEGDY
      DIMENSION VAL (len)
      REAL VALDN (1)
      REAL VALUP (1)
      REAL WTJ1
      REAL XI
      REAL YJ
C  IM AND JNP ARE NEEDED FROM COMMON BLOCK /CONTRL/
      LOGICAL STRAT, SLP, FDCOS, FEXP, SAVEAE, SIGDAT
      COMMON / CONTRL / IM, JNP, NB, NDALT, NHMS, NLAY, NLAYM1, NLAYP1, 
     &NYMD, STRAT, IDIMEN, SLP, FDCOS, FEXP, SAVEAE, SIGDAT, MAXREP
C  VERTICAL INDICES
      COMMON / MLAY / MLEV, MLEVM1, MMIX, MMIXM1, LS, LSM1
!hpf$ distribute alat(block)
!hpf$ distribute alon(block)
!hpf$ distribute hl(block)
!hpf$ distribute prs(block)
!hpf$ distribute q(block,block,block)
!hpf$ distribute val(block)
!hpf$ distribute valdn(block)
!hpf$ distribute valup(block)
      DATA fill / 1.e10 /
      amlev = mlev
      qdegdx = im / 360.0
      qdegdy = (jnp - 1) / 180.0
C  SET VERTICAL SUBSCRIPTS AND INTERPOLATION FACTORS
      DO 7000 ii = 1 , len
        hl(ii) = pindx2(prs(ii))
  100   CONTINUE
 7000 CONTINUE
      DO 7002 ii = 1 , len
        hl(ii) = min(max(hl(ii),1.0),
     &      amlev)
        la = hl(ii) + 0.0001
        lb = min(la + 1,mlev)
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
        yj = (alat(ii) + 90.0) * qdegdy + 1.0
        j0 = min(max(int(yj),1),jnp - 1)
        j1 = j0 + 1
        wtj1 = yj - j0
        xi = (alon(ii) + 180.0) * qdegdx + 1.0
        IF (xi .GE. (im + 1)) THEN
          xi = xi - im
        ENDIF
        IF (xi .LT. 1) THEN
          xi = xi + im
        ENDIF
        i0 = min(max(int(xi),1),im)
        i1 = i0 + 1
        IF (i0 .EQ. im) THEN
          i1 = 1
        ENDIF
        wti1 = xi - i0
c Screen for fill values on upper level - replace fill values according
c to predetermined criteria.
C
C For brevity, the four corner points will be identified as follows:
C
C         X X   8               X X   4
C         X X                   X X
C         C  (D3)               D  (D4)
C
C
C
C
C         X X   1               X X   2
C         X X                   X X
C         A   (D1)              B   (D2)
C
C
C
C Assign corner values
C
        a = q(i0,j0,la)
        b = q(i1,j0,la)
        c = q(i0,j1,la)
        d = q(i1,j1,la)
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
        ifl = 0
        iqa = 0
        iqb = 0
        iqc = 0
        iqd = 0
        ifcount = 0
        IF (a .EQ. fill) THEN
          ifl = 1
          iqa = 1
          ifcount = ifcount + 1
        ENDIF
        IF (b .EQ. fill) THEN
          ifl = ifl + 2
          iqb = 1
          ifcount = ifcount + 1
        ENDIF
        IF (d .EQ. fill) THEN
          ifl = ifl + 4
          iqd = 1
          ifcount = ifcount + 1
        ENDIF
        IF (c .EQ. fill) THEN
          ifl = ifl + 8
          iqc = 1
          ifcount = ifcount + 1
        ENDIF
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
        d1 = fill
        d2 = fill
        d3 = fill
        d4 = fill
C
        IF (ifl .EQ. 0) THEN
          d1 = a
          d2 = b
          d3 = c
          d4 = d
        ELSEIF (ifl .EQ. 1 .OR. ifl .EQ. 4) THEN
          ifcount = 2
          fv = ((1 - iqb) * b + (1 - iqc) * c) / float(ifcount)
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ELSEIF (ifl .EQ. 2 .OR. ifl .EQ. 8) THEN
          ifcount = 2
          fv = ((1 - iqa) * a + (1 - iqd) * d) / float(ifcount)
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ELSEIF (ifl .NE. 15) THEN
          dfact = float(4 - ifcount)
          fv = ((1 - iqa) * a + (1 - iqb) * b + (1 - iqc) * c + (1 - iqd
     &        ) * d) / dfact
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ENDIF
C  UPPER LEVEL INTERPOLATION
        IF (d1 .EQ. fill) THEN
          valup(ii) = fill
        ELSE
          a = d1
          b = d2
          c = d3
          d = d4
          valup(ii) = wtj1 * (wti1 * d + (1.0 - wti1)
     &        * c) + (1.0 - wtj1) * (wti1 * b + (1.0 - wti1) * a)
        ENDIF
  200   CONTINUE
 7002 CONTINUE
      DO 7004 ii = 1 , len
C        HL(ii) = AMIN1( AMAX1( HL(ii),1.0 ), AMLEV )
        la = hl(ii) + 0.0001
        lb = min(la + 1,mlev)
C  SET HORIZONTAL SUBSCRIPTS AND INTERPOLATION FACTORS
        yj = (alat(ii) + 90.0) * qdegdy + 1.0
        j0 = min(max(int(yj),1),jnp - 1)
        j1 = j0 + 1
        wtj1 = yj - j0
        xi = (alon(ii) + 180.0) * qdegdx + 1.0
        IF (xi .GE. (im + 1)) THEN
          xi = xi - im
        ENDIF
        IF (xi .LT. 1) THEN
          xi = xi + im
        ENDIF
        i0 = min(max(int(xi),1),im)
        i1 = i0 + 1
        IF (i0 .EQ. im) THEN
          i1 = 1
        ENDIF
        wti1 = xi - i0
C Similarly, screen for fill values on lower level
C
C Assign corner values
C
        a = q(i0,j0,lb)
        b = q(i1,j0,lb)
        c = q(i0,j1,lb)
        d = q(i1,j1,lb)
C Identify pattern of filled points by using a 4 bit binary representati
C e.g., 2 (decimal) = 0010 (binary) = corner B only is filled.
        ifl = 0
        iqa = 0
        iqb = 0
        iqc = 0
        iqd = 0
        ifcount = 0
        IF (a .EQ. fill) THEN
          ifl = 1
          iqa = 1
          ifcount = ifcount + 1
        ENDIF
        IF (b .EQ. fill) THEN
          ifl = ifl + 2
          iqb = 1
          ifcount = ifcount + 1
        ENDIF
        IF (d .EQ. fill) THEN
          ifl = ifl + 4
          iqd = 1
          ifcount = ifcount + 1
        ENDIF
        IF (c .EQ. fill) THEN
          ifl = ifl + 8
          iqc = 1
          ifcount = ifcount + 1
        ENDIF
C
C Filled values are repalced with values obtained from the other corners
C so that the horizontal interpolation can be done.  Note that there are
C 16 special cases of filled patterns.
C
        d1 = fill
        d2 = fill
        d3 = fill
        d4 = fill
c
        IF (ifl .EQ. 0) THEN
          d1 = a
          d2 = b
          d3 = c
          d4 = d
        ELSEIF (ifl .EQ. 1 .OR. ifl .EQ. 4) THEN
          ifcount = 2
          fv = ((1 - iqb) * b + (1 - iqc) * c) / float(ifcount)
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ELSEIF (ifl .EQ. 2 .OR. ifl .EQ. 8) THEN
          ifcount = 2
          fv = ((1 - iqa) * a + (1 - iqd) * d) / float(ifcount)
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ELSEIF (ifl .NE. 15) THEN
          dfact = float(4 - ifcount)
          fv = ((1 - iqa) * a + (1 - iqb) * b + (1 - iqc) * c + (1 - iqd
     &        ) * d) / dfact
          d1 = fv + (1 - iqa) * (a - fv)
          d2 = fv + (1 - iqb) * (b - fv)
          d3 = fv + (1 - iqc) * (c - fv)
          d4 = fv + (1 - iqd) * (d - fv)
        ENDIF
C  LOWER LEVEL INTERPOLATION
        IF (d1 .EQ. fill) THEN
          valdn(ii) = fill
        ELSE
          a = d1
          b = d2
          c = d3
          d = d4
          valdn(ii) = wtj1 * (wti1 * d + (1.0 - wti1)
     &        * c) + (1.0 - wtj1) * (wti1 * b + (1.0 - wti1) * a)
        ENDIF
  300   CONTINUE
 7004 CONTINUE
      DO 7006 ii = 1 , len
C  VERTICAL INTERPOLATION
        IF (valup(ii) .NE. fill .AND. 
     &        valdn(ii) .NE. fill) THEN
          val(ii) = valup(ii) + (
     &        valdn(ii) - valup(ii))
     &        * (hl(ii) - int(hl(ii)))
        ELSEIF (valup(ii) .EQ. fill .AND. 
     &        valdn(ii) .NE. fill) THEN
          val(ii) = valdn(ii)
        ELSEIF (valup(ii) .NE. fill .AND. 
     &        valdn(ii) .EQ. fill) THEN
          val(ii) = valup(ii)
        ELSE
          val(ii) = fill
        ENDIF
  400   CONTINUE
 7006 CONTINUE
      RETURN
      END
