ipolates.f90

Go to the documentation of this file.

 
 
module ipolates_mod
  use ip_interpolators_mod
  use ip_grid_descriptor_mod
  use ip_grid_factory_mod, only: init_grid
  use ip_interpolators_mod
  use ip_grid_mod
  implicit none
 
  private
  public :: ipolates, ipolates_grib1, ipolates_grib2
 
  interface ipolates
     module procedure ipolates_grib1
     module procedure ipolates_grib2
  end interface ipolates
 
contains
 
  subroutine ipolates_grid(ip, ipopt, grid_in, grid_out, mi, mo, km,&
       & ibi, li, gi, no, rlat, rlon, ibo, lo, go, iret)
    class(ip_grid), intent(in) :: grid_in, grid_out
    INTEGER,    INTENT(IN   ) :: IP, IPOPT(20), KM, MI, MO
    INTEGER,    INTENT(IN   ) :: IBI(KM)
    INTEGER,    INTENT(INOUT) :: NO
    INTEGER,    INTENT(  OUT) :: IRET, IBO(KM)
    !
    LOGICAL*1,  INTENT(IN   ) :: LI(MI,KM)
    LOGICAL*1,  INTENT(  OUT) :: LO(MO,KM)
    !
    REAL,       INTENT(IN   ) :: GI(MI,KM)
    REAL,       INTENT(INOUT) :: RLAT(MO),RLON(MO)
    REAL,       INTENT(  OUT) :: GO(MO,KM)
    !
 
    select case(ip)
    case(bilinear_interp_id)
       CALL interpolate_bilinear(ipopt,grid_in,grid_out,mi,mo,km,ibi&
            &,li,gi,no,rlat,rlon,ibo,lo,go,iret)
    case(bicubic_interp_id)
       CALL interpolate_bicubic(ipopt,grid_in,grid_out,mi,mo,km,ibi&
            &,li,gi,no,rlat,rlon,ibo,lo,go,iret)
    case(neighbor_interp_id)
       CALL interpolate_neighbor(ipopt,grid_in,grid_out,mi,mo,km,ibi&
            &,li,gi,no,rlat,rlon,ibo,lo,go,iret)
    case(budget_interp_id)
       CALL interpolate_budget(ipopt,grid_in,grid_out,mi,mo,km,ibi,li&
            &,gi,no,rlat,rlon,ibo,lo,go,iret)
    case(spectral_interp_id)
       CALL interpolate_spectral(ipopt,grid_in,grid_out,mi,mo,km,ibi&
            &,gi,no,rlat,rlon,ibo,lo,go,iret)
    case(neighbor_budget_interp_id)
       CALL interpolate_neighbor_budget(ipopt,grid_in,grid_out,mi,mo&
            &,km,ibi,li,gi,no,rlat,rlon,ibo,lo,go,iret)
    case default
       ! IF(KGDSO(1).GE.0) NO=0
       ! DO K=1,KM
       !    IBO(K)=1
       !    DO N=1,NO
       !       LO(N,K)=.FALSE.
       !       GO(N,K)=0.
       !    ENDDO
       ! ENDDO
       iret=1
       print *, "Unrecognized interp option: ", ip
       error stop
    end select
 
  end subroutine ipolates_grid
 
  subroutine ipolates_grib1(ip,ipopt,kgdsi,kgdso,mi,mo,km,ibi,li,gi, &
       no,rlat,rlon,ibo,lo,go,iret) bind(c)
    !
    INTEGER,    INTENT(IN   ) :: IP, IPOPT(20), KM, MI, MO
    INTEGER,    INTENT(IN   ) :: IBI(KM), KGDSI(200), KGDSO(200)
    INTEGER,    INTENT(INOUT) :: NO
    INTEGER,    INTENT(  OUT) :: IRET, IBO(KM)
    !
    LOGICAL*1,  INTENT(IN   ) :: LI(MI,KM)
    LOGICAL*1,  INTENT(  OUT) :: LO(MO,KM)
    !
    REAL,       INTENT(IN   ) :: GI(MI,KM)
    REAL,       INTENT(INOUT) :: RLAT(MO),RLON(MO)
    REAL,       INTENT(  OUT) :: GO(MO,KM)
    !
    INTEGER                   :: K, N
 
    type(grib1_descriptor) :: desc_in, desc_out
    class(ip_grid), allocatable :: grid_in, grid_out
 
    desc_in = init_descriptor(kgdsi)
    desc_out = init_descriptor(kgdso)
 
    call init_grid(grid_in, desc_in)
    call init_grid(grid_out, desc_out)
 
    call ipolates_grid(ip, ipopt, grid_in, grid_out, mi, mo, km, ibi, li, gi, no, rlat, rlon, ibo, lo, go, iret)
 
  END SUBROUTINE ipolates_grib1
 
 
  SUBROUTINE ipolates_grib2(IP,IPOPT,IGDTNUMI,IGDTMPLI,IGDTLENI, &
       IGDTNUMO,IGDTMPLO,IGDTLENO, &
       MI,MO,KM,IBI,LI,GI, &
       NO,RLAT,RLON,IBO,LO,GO,IRET) bind(C)
    INTEGER,        INTENT(IN   )     :: IP, IPOPT(20), KM, MI, MO
    INTEGER,        INTENT(IN   )     :: IBI(KM)
    INTEGER,        INTENT(IN   )     :: IGDTNUMI, IGDTLENI
    INTEGER,        INTENT(IN   )     :: IGDTMPLI(IGDTLENI)
    INTEGER,        INTENT(IN   )     :: IGDTNUMO, IGDTLENO
    INTEGER,        INTENT(IN   )     :: IGDTMPLO(IGDTLENO)
    INTEGER,        INTENT(  OUT)     :: NO
    INTEGER,        INTENT(  OUT)     :: IRET, IBO(KM)
    !
    LOGICAL*1,      INTENT(IN   )     :: LI(MI,KM)
    LOGICAL*1,      INTENT(  OUT)     :: LO(MO,KM)
    !
    REAL,           INTENT(IN   )     :: GI(MI,KM)
    REAL,           INTENT(INOUT)     :: RLAT(MO),RLON(MO)
    REAL,           INTENT(  OUT)     :: GO(MO,KM)
 
    type(grib2_descriptor) :: desc_in, desc_out
    class(ip_grid), allocatable :: grid_in, grid_out
 
    desc_in = init_descriptor(igdtnumi, igdtleni, igdtmpli)
    desc_out = init_descriptor(igdtnumo, igdtleno, igdtmplo)
 
    call init_grid(grid_in, desc_in)
    call init_grid(grid_out, desc_out)
 
    CALL ipolates_grid(ip,ipopt,grid_in,grid_out,mi,mo,km,ibi,li,gi,no,rlat,rlon,ibo,lo,go,iret)
 
  END SUBROUTINE ipolates_grib2
 
 
 
end module ipolates_mod