!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MKARPSVAR                   ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mkarpsvar(nx_ext,ny_ext,nz_ext,nx,ny,nz,lvlprof,             & 13,1
           iorder,iprtopt,intropt,iloc,jloc,x_ext,y_ext,                &
           hgtext,zext,x2d,y2d,za,varext,                               &
           zsnd,varsnd,arpsbar,arpsprt,                                 &
           dxfld,dyfld,rdxfld,rdyfld,                                   &
           slopey,alphay,betay,                                         &
           tem_ext)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Take data from external file on pressure levels and interpolate in
!  the horizontal and vertical to ARPS height levels and horizontal
!  locations. Then, form the ARPS mean and perturbation quantities.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster
!  5/01/1994.
!
!  MODIFICATION HISTORY:
!
!  11/21/1994 (KB)
!  Added full documentation.
!
!  2000/08/16 (Gene Bassett)
!  Added intropt.
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    nx_ext   Number of grid points in the x-direction (east/west)
!             for the external grid
!    ny_ext   Number of grid points in the y-direction (north/south)
!             for the external grid
!    nz_ext   Number of grid points in the vertical
!             for the external grid
!
!    nx       Number of grid points in the x-direction (east/west)
!             for the ARPS grid
!    ny       Number of grid points in the y-direction (north/south)
!             for the ARPS grid
!    nz       Number of grid points in the vertical
!             for the ARPS grid
!
!    iorder   order of polynomial for interpolation (1, 2 or 3)
!    intropt  Option indicating to interpolate perturbation or total
!             variables:
!             = 1  Interpolate perturbation variables and add to base
!                  sounding (default);
!             = 2  Interploate total variables.
!    iprtopt  Flag for producing a perturbation variable
!             iprtopt = 1   Produce mean and perturbation field
!             iprtopt = 0   Produce mean and total field
!
!    iloc     x-index location of ARPS grid point in the external array
!    jloc     y-index location of ARPS grid point in the external array
!
!    x2d      x coordinate of ARPS grid point in external coordinate
!    y2d      x coordinate of ARPS grid point in external coordinate
!
!    zext     Array of heights of the external grid
!    za       Array of heights of ARPS physical heights
!    zsnd     1-D array of height representing a mean sounding
!             over domain
!    varsnd   1-D array of variable representing a mean sounding
!             over domain
!
!  OUTPUT:
!
!    arpsbar  3-D array of mean field on ARPS levels
!    arpsprt  3-D array of perturbation (iprtopt=1) or
!             total (iprtopt=0) variable at ARPS grid locations
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Input variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: nx_ext,ny_ext,nz_ext  ! external grid dimensions
  INTEGER :: nx,ny,nz              ! ARPS grid dimensions
  INTEGER :: lvlprof               ! levels in mean sounding
  INTEGER :: iorder                ! interpolating polynomial order
  INTEGER :: intropt               ! interpolation option
  INTEGER :: iprtopt               ! perturbation generation flag
  INTEGER :: iloc(nx,ny)           ! external x-index of ARPS grid point
  INTEGER :: jloc(nx,ny)           ! external y-index of ARPS grid point
  REAL :: x_ext(nx_ext)            ! external x-coord
  REAL :: y_ext(ny_ext)            ! external y-coord
  REAL :: hgtext(nx_ext,ny_ext,nz_ext)     ! heights of external levels
  REAL :: zext(nx,ny,nz_ext)       ! heights of external levels
!                                  interpolated to ARPS grid locs
  REAL :: x2d(nx,ny)
  REAL :: y2d(nx,ny)
  REAL :: za(nx,ny,nz)             ! ARPS physical heights
  REAL :: varext(nx_ext,ny_ext,nz_ext)     ! variable to convert
  REAL :: zsnd(lvlprof)            ! 1-D array of level heights
  REAL :: varsnd(lvlprof)          ! 1-D array of level-means
!
!-----------------------------------------------------------------------
!
!  Output variables
!
!-----------------------------------------------------------------------
!
  REAL :: arpsbar( nx, ny, nz)     ! 3-D array of level-means
  REAL :: arpsprt( nx, ny, nz)     ! Output array, perturnbation variable
                                   ! or total variable (see iprtopt)
!
!-----------------------------------------------------------------------
!
!  Temporary work arrays
!
!-----------------------------------------------------------------------
!
  REAL :: dxfld(nx_ext)
  REAL :: dyfld(ny_ext)
  REAL :: rdxfld(nx_ext)
  REAL :: rdyfld(ny_ext)
  REAL :: slopey(nx_ext,ny_ext,nz_ext)
  REAL :: alphay(nx_ext,ny_ext,nz_ext)
  REAL :: betay(nx_ext,ny_ext,nz_ext)
  REAL :: tem_ext(nx_ext,ny_ext,nz_ext)
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: i,j,k,ia,ja,ka,kl
  REAL :: wlow
  REAL :: topprt,botprt,arpstop,arpsbot
  REAL :: pntint2d
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!

!
!-----------------------------------------------------------------------
!
!  Subtract horizontal mean from external fields.
!
!-----------------------------------------------------------------------
!
  IF (intropt == 1) THEN
    DO j=1,ny_ext
      DO i=1,nx_ext
        DO k=1,nz_ext
          DO kl=2,lvlprof-1
            IF(zsnd(kl) > hgtext(i,j,k)) EXIT
          END DO
!          11     CONTINUE
          wlow=(zsnd(kl)-hgtext(i,j,k))/                                  &
               (zsnd(kl)-zsnd(kl-1))
          tem_ext(i,j,k)=varext(i,j,k)-                                   &
               ((1.-wlow)*varsnd(kl) + wlow*varsnd(kl-1))
        END DO
      END DO
    END DO
  ELSE
    tem_ext = varext
  ENDIF
!
!-----------------------------------------------------------------------
!
!  Compute derivative terms
!
!-----------------------------------------------------------------------
!
  CALL setdrvy(nx_ext,ny_ext,nz_ext,                                    &
               1,nx_ext,1,ny_ext,1,nz_ext,                              &
               dyfld,rdyfld,tem_ext,                                    &
               slopey,alphay,betay)
!
!-----------------------------------------------------------------------
!
!  Loop through all ARPS grid points
!
!-----------------------------------------------------------------------
!
  DO ja=1,ny
    DO ia=1,nx
!
!-----------------------------------------------------------------------
!
!  Interpolate from the mean sounding to get arpsbar
!
!-----------------------------------------------------------------------
!
      DO ka=1,nz
        DO kl=2,lvlprof-1
          IF(zsnd(kl) > za(ia,ja,ka)) EXIT
        END DO
!        51     CONTINUE
        wlow=(zsnd(kl)-za(ia,ja,ka))/                                   &
             (zsnd(kl)-zsnd(kl-1))
        arpsbar(ia,ja,ka)=                                              &
              (1.-wlow)*varsnd(kl) + wlow*varsnd(kl-1)
      END DO
!
!-----------------------------------------------------------------------
!
!    Find vertical location
!    and interpolate in vertical between two horizontal
!    interpolations on the external grid surfaces.
!
!    Extrapolation is done by assuming the perturbation
!    from mean is constant.
!
!-----------------------------------------------------------------------
!
      botprt=pntint2d(nx_ext,ny_ext,                                    &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,1),                  &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,1),alphay(1,1,1),betay(1,1,1))

      topprt=pntint2d(nx_ext,ny_ext,                                    &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,nz_ext),             &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,nz_ext),                                      &
               alphay(1,1,nz_ext),betay(1,1,nz_ext))

      DO ka=1,nz
        IF(za(ia,ja,ka) < zext(ia,ja,1)) THEN
          arpsprt(ia,ja,ka)=botprt
        ELSE IF(za(ia,ja,ka) > zext(ia,ja,nz_ext)) THEN
          arpsprt(ia,ja,ka)=topprt
        ELSE
          DO kl=2,nz_ext-1
            IF(zext(ia,ja,kl) > za(ia,ja,ka)) EXIT
          END DO
!          351       CONTINUE
          wlow=(zext(ia,ja,kl)-   za(ia,ja,ka))/                        &
               (zext(ia,ja,kl)-zext(ia,ja,kl-1))

          arpstop=pntint2d(nx_ext,ny_ext,                               &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,kl),                 &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,kl),                                          &
               alphay(1,1,kl),betay(1,1,kl))

          arpsbot=pntint2d(nx_ext,ny_ext,                               &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,kl-1),               &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,kl-1),                                        &
               alphay(1,1,kl-1),betay(1,1,kl-1))

          arpsprt(ia,ja,ka)=(1.-wlow)*arpstop+wlow*arpsbot

        END IF
      END DO
    END DO
  END DO
!
!-----------------------------------------------------------------------
!
!  If total quantity, rather than perturbation quantity desired,
!  add the level mean to the interpolated perturbation variable
!  at each grid point.
!
!-----------------------------------------------------------------------
!
  IF(iprtopt == 0 .and. intropt == 1) THEN
    arpsprt = arpsprt + arpsbar
  ELSE IF(iprtopt == 1 .and. intropt == 2) THEN
    arpsprt = arpsprt - arpsbar
  END IF
!
  RETURN
END SUBROUTINE mkarpsvar
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MKARPSVLZ                   ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mkarpsvlz(nx_ext,ny_ext,nz_ext,nx,ny,nz,lvlprof,             & 1,1
           iorder,iprtopt,intropt,iloc,jloc,x_ext,y_ext,                &
           hgtext,zext,x2d,y2d,za,varext,                               &
           zsnd,vlnsnd,arpsbar,arpsprt,                                 &
           dxfld,dyfld,rdxfld,rdyfld,                                   &
           slopey,alphay,betay,                                         &
           tem_ext)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Take data from external file on pressure levels and interpolate in
!  the horizontal and vertical to ARPS height levels and horizontal
!  locations. Then, form the ARPS mean and perturbation quantities.
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Keith Brewster
!  5/01/1994.
!
!  MODIFICATION HISTORY:
!
!  11/21/1994 (KB)
!  Added full documentation.
!
!  2000/08/16 (Gene Bassett)
!  Added intropt.
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    nx_ext   Number of grid points in the x-direction (east/west)
!             for the external grid
!    ny_ext   Number of grid points in the y-direction (north/south)
!             for the external grid
!    nz_ext   Number of grid points in the vertical
!             for the external grid
!
!    nx       Number of grid points in the x-direction (east/west)
!             for the ARPS grid
!    ny       Number of grid points in the y-direction (north/south)
!             for the ARPS grid
!    nz       Number of grid points in the vertical
!             for the ARPS grid
!
!    iorder   order of polynomial for interpolation (1, 2 or 3)
!    intropt  Option indicating to interpolate perturbation or total
!             variables:
!             = 1  Interpolate perturbation variables and add to base
!                  sounding (default);
!             = 2  Interploate total variables.
!    iprtopt  Flag for producing a perturbation variable
!             iprtopt = 1   Produce mean and perturbation field
!             iprtopt = 0   Produce mean and total field
!
!    iloc     x-index location of ARPS grid point in the external array
!    jloc     y-index location of ARPS grid point in the external array
!
!    x2d      x coordinate of ARPS grid point in external coordinate
!    y2d      x coordinate of ARPS grid point in external coordinate
!
!    zext     Array of heights of the external grid
!    za       Array of heights of ARPS physical heights
!    zsnd     1-D array of height representing a mean sounding
!             over domain
!    vlnsnd   1-D array of variable representing the log of the
!             mean sounding of the variable.
!
!  OUTPUT:
!
!    arpsbar  3-D array of mean field on ARPS levels
!    arpsprt  3-D array of perturbation (iprtopt=1) or
!             total (iprtopt=0) variable at ARPS grid locations
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Input variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: nx_ext,ny_ext,nz_ext  ! external grid dimensions
  INTEGER :: nx,ny,nz              ! ARPS grid dimensions
  INTEGER :: lvlprof               ! levels in mean sounding
  INTEGER :: iorder                ! interpolating polynomial order
  INTEGER :: intropt               ! interpolation option
  INTEGER :: iprtopt               ! perturbation generation flag
  INTEGER :: iloc(nx,ny)           ! external x-index of ARPS grid point
  INTEGER :: jloc(nx,ny)           ! external y-index of ARPS grid point
  REAL :: x_ext(nx_ext)            ! external x-coord
  REAL :: y_ext(ny_ext)            ! external y-coord
  REAL :: hgtext(nx_ext,ny_ext,nz_ext)     ! heights of external levels
  REAL :: zext(nx,ny,nz_ext)       ! heights of external levels
!                                  interpolated to ARPS grid locs
  REAL :: x2d(nx,ny)
  REAL :: y2d(nx,ny)
  REAL :: za(nx,ny,nz)             ! ARPS physical heights
  REAL :: varext(nx_ext,ny_ext,nz_ext)     ! variable to convert
  REAL :: zsnd(lvlprof)            ! 1-D array of level heights
  REAL :: vlnsnd(lvlprof)          ! 1-D array of level-means
!
!-----------------------------------------------------------------------
!
!  Output variables
!
!-----------------------------------------------------------------------
!
  REAL :: arpsbar( nx, ny, nz)     ! 3-D array of level-means
  REAL :: arpsprt( nx, ny, nz)     ! Output array, perturnbation variable
                                   ! or total variable (see iprtopt)
!
!-----------------------------------------------------------------------
!
!  Temporary work arrays
!
!-----------------------------------------------------------------------
!
  REAL :: dxfld(nx_ext)
  REAL :: dyfld(ny_ext)
  REAL :: rdxfld(nx_ext)
  REAL :: rdyfld(ny_ext)
  REAL :: slopey(nx_ext,ny_ext,nz_ext)
  REAL :: alphay(nx_ext,ny_ext,nz_ext)
  REAL :: betay(nx_ext,ny_ext,nz_ext)
  REAL :: tem_ext(nx_ext,ny_ext,nz_ext)
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: i,j,k,ia,ja,ka,kl
  REAL :: wlow
  REAL :: topprt,botprt,arpstop,arpsbot
  REAL :: pntint2d
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!

!
!-----------------------------------------------------------------------
!
!  Subtract horizontal mean from external fields.
!
!-----------------------------------------------------------------------
!
  IF (intropt == 1) THEN
    DO j=1,ny_ext
      DO i=1,nx_ext
        DO k=1,nz_ext
          DO kl=2,lvlprof-1
            IF(zsnd(kl) > hgtext(i,j,k)) EXIT
          END DO
!          11     CONTINUE
          wlow=(zsnd(kl)-hgtext(i,j,k))/                                  &
               (zsnd(kl)-zsnd(kl-1))
          tem_ext(i,j,k)=varext(i,j,k)-EXP(                               &
               ((1.-wlow)*vlnsnd(kl) + wlow*vlnsnd(kl-1)))
        END DO
      END DO
    END DO
  ELSE ! intropt=2
    tem_ext = LOG(varext)
  ENDIF
!
!-----------------------------------------------------------------------
!
!  Compute derivative terms
!
!-----------------------------------------------------------------------
!
  CALL setdrvy(nx_ext,ny_ext,nz_ext,                                    &
               1,nx_ext,1,ny_ext,1,nz_ext,                              &
               dyfld,rdyfld,tem_ext,                                    &
               slopey,alphay,betay)
!
!-----------------------------------------------------------------------
!
!  Loop through all ARPS grid points
!
!-----------------------------------------------------------------------
!
  DO ja=1,ny
    DO ia=1,nx
!
!-----------------------------------------------------------------------
!
!  Interpolate from the mean sounding to get arpsbar
!
!-----------------------------------------------------------------------
!
      DO ka=1,nz
        DO kl=2,lvlprof-1
          IF(zsnd(kl) > za(ia,ja,ka)) EXIT
        END DO
!        51     CONTINUE
        wlow=(zsnd(kl)-za(ia,ja,ka))/                                   &
             (zsnd(kl)-zsnd(kl-1))
        arpsbar(ia,ja,ka)=EXP(                                          &
              (1.-wlow)*vlnsnd(kl) + wlow*vlnsnd(kl-1))
      END DO
!
!-----------------------------------------------------------------------
!
!    Find vertical location
!    and interpolate in vertical between two horizontal
!    interpolations on the external grid surfaces.
!
!    Extrapolation is done by assuming the perturbation
!    from mean is constant.
!
!-----------------------------------------------------------------------
!
      botprt=pntint2d(nx_ext,ny_ext,                                    &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,1),                  &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,1),alphay(1,1,1),betay(1,1,1))

      topprt=pntint2d(nx_ext,ny_ext,                                    &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,nz_ext),             &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,nz_ext),                                      &
               alphay(1,1,nz_ext),betay(1,1,nz_ext))

      DO ka=1,nz
        IF(za(ia,ja,ka) < zext(ia,ja,1)) THEN
          arpsprt(ia,ja,ka)=botprt
        ELSE IF(za(ia,ja,ka) > zext(ia,ja,nz_ext)) THEN
          arpsprt(ia,ja,ka)=topprt
        ELSE
          DO kl=2,nz_ext-1
            IF(zext(ia,ja,kl) > za(ia,ja,ka)) EXIT
          END DO
!          351       CONTINUE
          wlow=(zext(ia,ja,kl)-   za(ia,ja,ka))/                        &
               (zext(ia,ja,kl)-zext(ia,ja,kl-1))

          arpstop=pntint2d(nx_ext,ny_ext,                               &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,kl),                 &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,kl),                                          &
               alphay(1,1,kl),betay(1,1,kl))

          arpsbot=pntint2d(nx_ext,ny_ext,                               &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),tem_ext(1,1,kl-1),               &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey(1,1,kl-1),                                        &
               alphay(1,1,kl-1),betay(1,1,kl-1))

          arpsprt(ia,ja,ka)=(1.-wlow)*arpstop+wlow*arpsbot
        END IF
      END DO
    END DO
  END DO

  IF(intropt == 2) THEN 
    arpsprt = EXP(arpsprt)
  ENDIF
!
!-----------------------------------------------------------------------
!
!  If total quantity, rather than perturbation quantity desired,
!  add the level mean to the interpolated perturbation variable
!  at each grid point.
!
!-----------------------------------------------------------------------
!
  IF(iprtopt == 0 .and. intropt == 1) THEN
    arpsprt = arpsprt + arpsbar
  ELSE IF(iprtopt == 1 .and. intropt == 2) THEN
    arpsprt = arpsprt - arpsbar
  END IF
!
  RETURN
END SUBROUTINE mkarpsvlz
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MKARPS2D                    ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mkarps2d (nx_ext,ny_ext,nx,ny,                               & 1,1
           iorder,iloc,jloc,x_ext,y_ext,                                &
           x2d,y2d,varext,arpsvar,                                      &
           dxfld,dyfld,rdxfld,rdyfld,                                   &
           slopey,alphay,betay,                                         &
           tem_ext)
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Take 2D surface data from external file and interpolate in
!  the horizontal to form the ARPS 2D data set
!
!-----------------------------------------------------------------------
!
!  AUTHOR: Fanyou Kong
!  6/10/1997.
!
!  MODIFICATION HISTORY:
!
!
!-----------------------------------------------------------------------
!
!  INPUT:
!
!    nx_ext   Number of grid points in the x-direction (east/west)
!             for the external grid
!    ny_ext   Number of grid points in the y-direction (north/south)
!             for the external grid
!
!    nx       Number of grid points in the x-direction (east/west)
!             for the ARPS grid
!    ny       Number of grid points in the y-direction (north/south)
!             for the ARPS grid
!
!    iorder   order of polynomial for interpolation (1, 2 or 3)
!
!    iloc     x-index location of ARPS grid point in the external array
!    jloc     y-index location of ARPS grid point in the external array
!
!    x2d      x coordinate of ARPS grid point in external coordinate
!    y2d      x coordinate of ARPS grid point in external coordinate
!
!    varext   external 2D data
!
!  OUTPUT:
!
!    arpsvar  2D array of variable at ARPS grid locations
!
!-----------------------------------------------------------------------
!
  IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
!  Input variables
!
!-----------------------------------------------------------------------
!
  INTEGER :: nx_ext,ny_ext         ! external grid dimensions
  INTEGER :: nx,ny                 ! ARPS grid dimensions
  INTEGER :: iorder                ! interpolating polynomial order
  INTEGER :: iloc(nx,ny)           ! external x-index of ARPS grid point
  INTEGER :: jloc(nx,ny)           ! external y-index of ARPS grid point
  REAL :: x_ext(nx_ext)            ! external x-coord
  REAL :: y_ext(ny_ext)            ! external y-coord
!                                  interpolated to ARPS grid locs
  REAL :: x2d(nx,ny)
  REAL :: y2d(nx,ny)
  REAL :: varext(nx_ext,ny_ext)    ! 2D variable to convert
!
!-----------------------------------------------------------------------
!
!  Output variables
!
!-----------------------------------------------------------------------
!
  REAL :: arpsvar( nx, ny)         ! 2-D array of ARPS grid data
!
!-----------------------------------------------------------------------
!
!  Temporary work arrays
!
!-----------------------------------------------------------------------
!
  REAL :: dxfld(nx_ext)
  REAL :: dyfld(ny_ext)
  REAL :: rdxfld(nx_ext)
  REAL :: rdyfld(ny_ext)
  REAL :: slopey(nx_ext,ny_ext)
  REAL :: alphay(nx_ext,ny_ext)
  REAL :: betay(nx_ext,ny_ext)
  REAL :: tem_ext(nx_ext,ny_ext)
!
!-----------------------------------------------------------------------
!
!  Misc. local variables:
!
!-----------------------------------------------------------------------
!
  INTEGER :: ia,ja
  REAL :: arpsdata
  REAL :: pntint2d
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!
!-----------------------------------------------------------------------
!
!  Compute derivative terms
!
!-----------------------------------------------------------------------
!
  CALL setdrvy(nx_ext,ny_ext,1,                                         &
               1,nx_ext,1,ny_ext,1,1,                                   &
               dyfld,rdyfld,varext,                                     &
               slopey,alphay,betay)
!
!-----------------------------------------------------------------------
!
!  Loop through all ARPS grid points
!
!-----------------------------------------------------------------------
!
  DO ja=1,ny
    DO ia=1,nx
!
!-----------------------------------------------------------------------
!
!    Horizontal interpolation
!
!-----------------------------------------------------------------------
!
      arpsdata=pntint2d(nx_ext,ny_ext,                                  &
               2,nx_ext-1,2,ny_ext-1,                                   &
               iorder,x_ext,y_ext,x2d(ia,ja),y2d(ia,ja),                &
               iloc(ia,ja),jloc(ia,ja),varext,                          &
               dxfld,dyfld,rdxfld,rdyfld,                               &
               slopey,alphay,betay)

      arpsvar(ia,ja)=arpsdata

    END DO
  END DO

  RETURN
END SUBROUTINE mkarps2d