ipolatev.f90

Go to the documentation of this file.

 
 
module ipolatev_mod
  use ip_interpolators_mod
  use ip_grid_factory_mod
  use ip_grid_descriptor_mod
  use ip_grid_mod
 
  implicit none
 
  private
  public :: ipolatev, ipolatev_grib1, ipolatev_grib2
 
  interface ipolatev
     module procedure ipolatev_grib1
     module procedure ipolatev_grib2
  end interface ipolatev
 
contains
 
  SUBROUTINE ipolatev_grid(IP,IPOPT,grid_in,grid_out, &
       MI,MO,KM,IBI,LI,UI,VI, &
       NO,RLAT,RLON,CROT,SROT,IBO,LO,UO,VO,IRET)
    class(ip_grid), intent(in) :: grid_in, grid_out
    INTEGER,               INTENT(IN   ) :: IP, IPOPT(20), IBI(KM)
    INTEGER,               INTENT(IN   ) :: KM, MI, MO
    INTEGER,               INTENT(  OUT) :: IBO(KM), IRET, NO
    !
    LOGICAL*1,             INTENT(IN   ) :: LI(MI,KM)
    LOGICAL*1,             INTENT(  OUT) :: LO(MO,KM)
    !
    REAL,                  INTENT(IN   ) :: UI(MI,KM),VI(MI,KM)
    REAL,                  INTENT(INOUT) :: CROT(MO),SROT(MO)
    REAL,                  INTENT(INOUT) :: RLAT(MO),RLON(MO)
    REAL,                  INTENT(  OUT) :: UO(MO,KM),VO(MO,KM)
 
    select case(ip)
    case(bilinear_interp_id)
       CALL interpolate_bilinear(ipopt,grid_in,grid_out, &
            mi,mo,km,ibi,li,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case(bicubic_interp_id)
       CALL interpolate_bicubic(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case(neighbor_interp_id)
       CALL interpolate_neighbor(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case(budget_interp_id)
       CALL interpolate_budget(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case(spectral_interp_id)
       CALL interpolate_spectral(ipopt,grid_in,grid_out, &
            mi,mo,km,ibi,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case(neighbor_budget_interp_id)
       CALL interpolate_neighbor_budget(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
            no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
    case default
       print *, "unrecognized interpolation option: ", ip
       error stop
       ! IF(IGDTNUMO.GE.0) NO=0
       ! DO K=1,KM
       !    IBO(K)=1
       !    DO N=1,NO
       !       LO(N,K)=.FALSE.
       !       UO(N,K)=0.
       !       VO(N,K)=0.
       !    ENDDO
       ! ENDDO
       ! IRET=1
    end select
 
  end subroutine ipolatev_grid
 
  
  subroutine ipolatev_grib2(ip,ipopt,igdtnumi,igdtmpli,igdtleni, &
       igdtnumo,igdtmplo,igdtleno, &
       mi,mo,km,ibi,li,ui,vi, &
       no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
 
    INTEGER,               INTENT(IN   ) :: IP, IPOPT(20), IBI(KM)
    INTEGER,               INTENT(IN   ) :: KM, MI, MO
    INTEGER,               INTENT(IN   ) :: IGDTNUMI, IGDTLENI
    INTEGER,               INTENT(IN   ) :: IGDTMPLI(IGDTLENI)
    INTEGER,               INTENT(IN   ) :: IGDTNUMO, IGDTLENO
    INTEGER,               INTENT(IN   ) :: IGDTMPLO(IGDTLENO)
    INTEGER,               INTENT(  OUT) :: IBO(KM), IRET, NO
    !
    LOGICAL*1,             INTENT(IN   ) :: LI(MI,KM)
    LOGICAL*1,             INTENT(  OUT) :: LO(MO,KM)
    !
    REAL,                  INTENT(IN   ) :: UI(MI,KM),VI(MI,KM)
    REAL,                  INTENT(INOUT) :: CROT(MO),SROT(MO)
    REAL,                  INTENT(INOUT) :: RLAT(MO),RLON(MO)
    REAL,                  INTENT(  OUT) :: UO(MO,KM),VO(MO,KM)
    !
    INTEGER                              :: K, N
 
    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 ipolatev_grid(ip,ipopt,grid_in,grid_out, &
         mi,mo,km,ibi,li,ui,vi,&
         no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
 
  end subroutine ipolatev_grib2
 
  subroutine ipolatev_grib1(ip,ipopt,kgdsi,kgdso,mi,mo,km,ibi,li,ui,vi, &
       no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
    IMPLICIT NONE
    !
    INTEGER,               INTENT(IN   ):: IP, IPOPT(20), IBI(KM)
    INTEGER,               INTENT(IN   ):: KM, MI, MO
    INTEGER,               INTENT(INOUT):: KGDSI(200), KGDSO(200)
    INTEGER,               INTENT(  OUT):: IBO(KM), IRET, NO
    !
    LOGICAL*1,             INTENT(IN   ):: LI(MI,KM)
    LOGICAL*1,             INTENT(  OUT):: LO(MO,KM)
    !
    REAL,                  INTENT(IN   ):: UI(MI,KM),VI(MI,KM)
    REAL,                  INTENT(INOUT):: CROT(MO),SROT(MO)
    REAL,                  INTENT(INOUT):: RLAT(MO),RLON(MO)
    REAL,                  INTENT(  OUT):: UO(MO,KM),VO(MO,KM)
    !
    INTEGER                             :: K, N, KGDSI11, KGDSO11
 
    type(grib1_descriptor) :: desc_in, desc_out
    class(ip_grid), allocatable :: grid_in, grid_out
 
    IF(kgdsi(1).EQ.203) THEN
       kgdsi11=kgdsi(11)
       kgdsi(11)=ior(kgdsi(11),256)
    ENDIF
    IF(kgdso(1).EQ.203) THEN
       kgdso11=kgdso(11)
       kgdso(11)=ior(kgdso(11),256)
    ENDIF
 
    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 ipolatev_grid(ip,ipopt,grid_in,grid_out, &
         mi,mo,km,ibi,li,ui,vi,&
         no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
 
    IF(kgdsi(1).EQ.203) THEN
       kgdsi(11)=kgdsi11
    ENDIF
    IF(kgdso(1).EQ.203) THEN
       kgdso(11)=kgdso11
    ENDIF
 
  END SUBROUTINE ipolatev_grib1
 
 
end module ipolatev_mod