NCEPLIBS-ip 5.2.0
Loading...
Searching...
No Matches
ipolatev.F90
Go to the documentation of this file.
1
4
10module ipolatev_mod
11 use ip_interpolators_mod
12 use ip_grid_factory_mod
13 use ip_grid_descriptor_mod
14 use ip_grid_mod
15
16 implicit none
17
18 private
19 public :: ipolatev, ipolatev_grib2, ipolatev_grib1_single_field, ipolatev_grib1, ipolatev_grib2_single_field
20
21 interface ipolatev
22 module procedure ipolatev_grib1
23 module procedure ipolatev_grib1_single_field
24 module procedure ipolatev_grib2
25 module procedure ipolatev_grib2_single_field
26 end interface ipolatev
27
28contains
29
67 SUBROUTINE ipolatev_grid(IP,IPOPT,grid_in,grid_out, &
68 MI,MO,KM,IBI,LI,UI,VI, &
69 NO,RLAT,RLON,CROT,SROT,IBO,LO,UO,VO,IRET)
70 class(ip_grid), intent(in) :: grid_in, grid_out
71 INTEGER, INTENT(IN ) :: IP, IPOPT(20), IBI(KM)
72 INTEGER, INTENT(IN ) :: KM, MI, MO
73 INTEGER, INTENT( OUT) :: IBO(KM), IRET, NO
74 !
75 LOGICAL*1, INTENT(IN ) :: LI(MI,KM)
76 LOGICAL*1, INTENT( OUT) :: LO(MO,KM)
77 !
78 REAL, INTENT(IN ) :: UI(MI,KM),VI(MI,KM)
79 REAL, INTENT(INOUT) :: CROT(MO),SROT(MO)
80 REAL, INTENT(INOUT) :: RLAT(MO),RLON(MO)
81 REAL, INTENT( OUT) :: UO(MO,KM),VO(MO,KM)
82
83 select case(ip)
84 case(bilinear_interp_id)
85 CALL interpolate_bilinear(ipopt,grid_in,grid_out, &
86 mi,mo,km,ibi,li,ui,vi,&
87 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
88 case(bicubic_interp_id)
89 CALL interpolate_bicubic(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
90 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
91 case(neighbor_interp_id)
92 CALL interpolate_neighbor(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
93 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
94 case(budget_interp_id)
95 CALL interpolate_budget(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
96 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
97 case(spectral_interp_id)
98 CALL interpolate_spectral(ipopt,grid_in,grid_out, &
99 mi,mo,km,ibi,ui,vi,&
100 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
101 case(neighbor_budget_interp_id)
102 CALL interpolate_neighbor_budget(ipopt,grid_in,grid_out,mi,mo,km,ibi,li,ui,vi,&
103 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
104 case default
105 print *, "unrecognized interpolation option: ", ip
106 error stop
107 ! IF(IGDTNUMO.GE.0) NO=0
108 ! DO K=1,KM
109 ! IBO(K)=1
110 ! DO N=1,NO
111 ! LO(N,K)=.FALSE.
112 ! UO(N,K)=0.
113 ! VO(N,K)=0.
114 ! ENDDO
115 ! ENDDO
116 ! IRET=1
117 end select
118
119 end subroutine ipolatev_grid
120
382 subroutine ipolatev_grib2(ip,ipopt,igdtnumi,igdtmpli,igdtleni, &
383 igdtnumo,igdtmplo,igdtleno, &
384 mi,mo,km,ibi,li,ui,vi, &
385 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
386 USE iso_c_binding, ONLY: c_int, c_float, c_double, c_bool, c_long
387#if (LSIZE==8)
388 INTEGER(C_LONG), INTENT(IN ) :: IP, IPOPT(20), IBI(KM)
389 INTEGER(C_LONG), INTENT(IN ) :: KM, MI, MO
390 INTEGER(C_LONG), INTENT(IN ) :: IGDTNUMI, IGDTLENI
391 INTEGER(C_LONG), INTENT(IN ) :: IGDTMPLI(IGDTLENI)
392 INTEGER(C_LONG), INTENT(IN ) :: IGDTNUMO, IGDTLENO
393 INTEGER(C_LONG), INTENT(IN ) :: IGDTMPLO(IGDTLENO)
394 INTEGER(C_LONG), INTENT( OUT) :: IBO(KM), IRET, NO
395#else
396 INTEGER(C_INT), INTENT(IN ) :: IP, IPOPT(20), IBI(KM)
397 INTEGER(C_INT), INTENT(IN ) :: KM, MI, MO
398 INTEGER(C_INT), INTENT(IN ) :: IGDTNUMI, IGDTLENI
399 INTEGER(C_INT), INTENT(IN ) :: IGDTMPLI(IGDTLENI)
400 INTEGER(C_INT), INTENT(IN ) :: IGDTNUMO, IGDTLENO
401 INTEGER(C_INT), INTENT(IN ) :: IGDTMPLO(IGDTLENO)
402 INTEGER(C_INT), INTENT( OUT) :: IBO(KM), IRET, NO
403#endif
404 !
405 LOGICAL(C_BOOL), INTENT(IN ) :: LI(MI,KM)
406 LOGICAL(C_BOOL), INTENT( OUT) :: LO(MO,KM)
407 !
408#if (LSIZE==4)
409 REAL(C_FLOAT), INTENT(IN ) :: UI(MI,KM),VI(MI,KM)
410 REAL(C_FLOAT), INTENT(INOUT) :: CROT(MO),SROT(MO)
411 REAL(C_FLOAT), INTENT(INOUT) :: RLAT(MO),RLON(MO)
412 REAL(C_FLOAT), INTENT( OUT) :: UO(MO,KM),VO(MO,KM)
413#else
414 REAL(C_DOUBLE), INTENT(IN ) :: UI(MI,KM),VI(MI,KM)
415 REAL(C_DOUBLE), INTENT(INOUT) :: CROT(MO),SROT(MO)
416 REAL(C_DOUBLE), INTENT(INOUT) :: RLAT(MO),RLON(MO)
417 REAL(C_DOUBLE), INTENT( OUT) :: UO(MO,KM),VO(MO,KM)
418#endif
419 !
420
421 type(grib2_descriptor) :: desc_in, desc_out
422 class(ip_grid), allocatable :: grid_in, grid_out
423
424 desc_in = init_descriptor(igdtnumi, igdtleni, igdtmpli)
425 desc_out = init_descriptor(igdtnumo, igdtleno, igdtmplo)
426
427 call init_grid(grid_in, desc_in)
428 call init_grid(grid_out, desc_out)
429
430 CALL ipolatev_grid(ip,ipopt,grid_in,grid_out, &
431 mi,mo,km,ibi,li,ui,vi,&
432 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
433
434 end subroutine ipolatev_grib2
435
565 subroutine ipolatev_grib1(ip,ipopt,kgdsi,kgdso,mi,mo,km,ibi,li,ui,vi, &
566 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
567 USE iso_c_binding, ONLY: c_int, c_float, c_double, c_bool, c_long
568 IMPLICIT NONE
569 !
570#if (LSIZE==8)
571 INTEGER(C_LONG), INTENT(IN ):: IP, IPOPT(20), IBI(KM)
572 INTEGER(C_LONG), INTENT(IN ):: KM, MI, MO
573 INTEGER(C_LONG), INTENT(INOUT):: KGDSI(200), KGDSO(200)
574 INTEGER(C_LONG), INTENT( OUT):: IBO(KM), IRET, NO
575#else
576 INTEGER(C_INT), INTENT(IN ):: IP, IPOPT(20), IBI(KM)
577 INTEGER(C_INT), INTENT(IN ):: KM, MI, MO
578 INTEGER(C_INT), INTENT(INOUT):: KGDSI(200), KGDSO(200)
579 INTEGER(C_INT), INTENT( OUT):: IBO(KM), IRET, NO
580#endif
581 !
582 LOGICAL(C_BOOL), INTENT(IN ):: LI(MI,KM)
583 LOGICAL(C_BOOL), INTENT( OUT):: LO(MO,KM)
584 !
585#if (LSIZE==4)
586 REAL(C_FLOAT), INTENT(IN ):: UI(MI,KM),VI(MI,KM)
587 REAL(C_FLOAT), INTENT(INOUT):: CROT(MO),SROT(MO)
588 REAL(C_FLOAT), INTENT(INOUT):: RLAT(MO),RLON(MO)
589 REAL(C_FLOAT), INTENT( OUT):: UO(MO,KM),VO(MO,KM)
590#else
591 REAL(C_DOUBLE), INTENT(IN ):: UI(MI,KM),VI(MI,KM)
592 REAL(C_DOUBLE), INTENT(INOUT):: CROT(MO),SROT(MO)
593 REAL(C_DOUBLE), INTENT(INOUT):: RLAT(MO),RLON(MO)
594 REAL(C_DOUBLE), INTENT( OUT):: UO(MO,KM),VO(MO,KM)
595#endif
596 !
597 INTEGER :: KGDSI11, KGDSO11
598
599 type(grib1_descriptor) :: desc_in, desc_out
600 class(ip_grid), allocatable :: grid_in, grid_out
601
602 IF(kgdsi(1).EQ.203) THEN
603 kgdsi11=kgdsi(11)
604 kgdsi(11)=ior(kgdsi(11),256)
605 ENDIF
606 IF(kgdso(1).EQ.203) THEN
607 kgdso11=kgdso(11)
608 kgdso(11)=ior(kgdso(11),256)
609 ENDIF
610
611 desc_in = init_descriptor(kgdsi)
612 desc_out = init_descriptor(kgdso)
613
614 call init_grid(grid_in, desc_in)
615 call init_grid(grid_out, desc_out)
616
617 CALL ipolatev_grid(ip,ipopt,grid_in,grid_out, &
618 mi,mo,km,ibi,li,ui,vi,&
619 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret)
620
621 IF(kgdsi(1).EQ.203) THEN
622 kgdsi(11)=kgdsi11
623 ENDIF
624 IF(kgdso(1).EQ.203) THEN
625 kgdso(11)=kgdso11
626 ENDIF
627
628 END SUBROUTINE ipolatev_grib1
629
680 subroutine ipolatev_grib1_single_field(ip,ipopt,kgdsi,kgdso,mi,mo,km,ibi,li,ui,vi, &
681 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
682 USE iso_c_binding, ONLY: c_int, c_float, c_double, c_bool, c_long
683 IMPLICIT NONE
684 !
685#if (LSIZE==8)
686 INTEGER(C_LONG), INTENT(IN ):: IP, IPOPT(20), IBI
687 INTEGER(C_LONG), INTENT(IN ):: KM, MI, MO
688 INTEGER(C_LONG), INTENT(INOUT):: KGDSI(200), KGDSO(200)
689 INTEGER(C_LONG), INTENT( OUT):: IBO, IRET, NO
690#else
691 INTEGER(C_INT), INTENT(IN ):: IP, IPOPT(20), IBI
692 INTEGER(C_INT), INTENT(IN ):: KM, MI, MO
693 INTEGER(C_INT), INTENT(INOUT):: KGDSI(200), KGDSO(200)
694 INTEGER(C_INT), INTENT( OUT):: IBO, IRET, NO
695#endif
696 !
697 LOGICAL(C_BOOL), INTENT(IN ):: LI(MI)
698 LOGICAL(C_BOOL), INTENT( OUT):: LO(MO)
699 !
700#if (LSIZE==4)
701 REAL(C_FLOAT), INTENT(IN ):: UI(MI),VI(MI)
702 REAL(C_FLOAT), INTENT(INOUT):: CROT(MO),SROT(MO)
703 REAL(C_FLOAT), INTENT(INOUT):: RLAT(MO),RLON(MO)
704 REAL(C_FLOAT), INTENT( OUT):: UO(MO),VO(MO)
705#else
706 REAL(C_DOUBLE), INTENT(IN ):: UI(MI),VI(MI)
707 REAL(C_DOUBLE), INTENT(INOUT):: CROT(MO),SROT(MO)
708 REAL(C_DOUBLE), INTENT(INOUT):: RLAT(MO),RLON(MO)
709 REAL(C_DOUBLE), INTENT( OUT):: UO(MO),VO(MO)
710#endif
711 !
712 INTEGER :: KGDSI11, KGDSO11
713
714 type(grib1_descriptor) :: desc_in, desc_out
715 class(ip_grid), allocatable :: grid_in, grid_out
716 integer :: ibo_array(1)
717
718 ! Can't pass expression (e.g. [ibo]) to intent(out) argument.
719 ! Initialize placeholder array of size 1 to make rank match.
720 ibo_array(1) = ibo
721
722 IF(kgdsi(1).EQ.203) THEN
723 kgdsi11=kgdsi(11)
724 kgdsi(11)=ior(kgdsi(11),256)
725 ENDIF
726 IF(kgdso(1).EQ.203) THEN
727 kgdso11=kgdso(11)
728 kgdso(11)=ior(kgdso(11),256)
729 ENDIF
730
731 desc_in = init_descriptor(kgdsi)
732 desc_out = init_descriptor(kgdso)
733
734 call init_grid(grid_in, desc_in)
735 call init_grid(grid_out, desc_out)
736
737 CALL ipolatev_grid(ip,ipopt,grid_in,grid_out, &
738 mi,mo,km,[ibi],li,ui,vi,&
739 no,rlat,rlon,crot,srot,ibo_array,lo,uo,vo,iret)
740
741 ibo = ibo_array(1)
742
743 IF(kgdsi(1).EQ.203) THEN
744 kgdsi(11)=kgdsi11
745 ENDIF
746 IF(kgdso(1).EQ.203) THEN
747 kgdso(11)=kgdso11
748 ENDIF
749
750 END SUBROUTINE ipolatev_grib1_single_field
751
832 subroutine ipolatev_grib2_single_field(ip,ipopt,igdtnumi,igdtmpli,igdtleni, &
833 igdtnumo,igdtmplo,igdtleno, &
834 mi,mo,km,ibi,li,ui,vi, &
835 no,rlat,rlon,crot,srot,ibo,lo,uo,vo,iret) bind(c)
836 USE iso_c_binding, ONLY: c_int, c_float, c_double, c_bool, c_long
837#if (LSIZE==8)
838 INTEGER(C_LONG), INTENT(IN ) :: IP, IPOPT(20), IBI
839 INTEGER(C_LONG), INTENT(IN ) :: KM, MI, MO
840 INTEGER(C_LONG), INTENT(IN ) :: IGDTNUMI, IGDTLENI
841 INTEGER(C_LONG), INTENT(IN ) :: IGDTMPLI(IGDTLENI)
842 INTEGER(C_LONG), INTENT(IN ) :: IGDTNUMO, IGDTLENO
843 INTEGER(C_LONG), INTENT(IN ) :: IGDTMPLO(IGDTLENO)
844 INTEGER(C_LONG), INTENT( OUT) :: IBO, IRET, NO
845#else
846 INTEGER(C_INT), INTENT(IN ) :: IP, IPOPT(20), IBI
847 INTEGER(C_INT), INTENT(IN ) :: KM, MI, MO
848 INTEGER(C_INT), INTENT(IN ) :: IGDTNUMI, IGDTLENI
849 INTEGER(C_INT), INTENT(IN ) :: IGDTMPLI(IGDTLENI)
850 INTEGER(C_INT), INTENT(IN ) :: IGDTNUMO, IGDTLENO
851 INTEGER(C_INT), INTENT(IN ) :: IGDTMPLO(IGDTLENO)
852 INTEGER(C_INT), INTENT( OUT) :: IBO, IRET, NO
853#endif
854 !
855 LOGICAL(C_BOOL), INTENT(IN ) :: LI(MI)
856 LOGICAL(C_BOOL), INTENT( OUT) :: LO(MO)
857 !
858#if (LSIZE==4)
859 REAL(C_FLOAT), INTENT(IN ) :: UI(MI),VI(MI)
860 REAL(C_FLOAT), INTENT(INOUT) :: CROT(MO),SROT(MO)
861 REAL(C_FLOAT), INTENT(INOUT) :: RLAT(MO),RLON(MO)
862 REAL(C_FLOAT), INTENT( OUT) :: UO(MO),VO(MO)
863#else
864 REAL(C_DOUBLE), INTENT(IN ) :: UI(MI),VI(MI)
865 REAL(C_DOUBLE), INTENT(INOUT) :: CROT(MO),SROT(MO)
866 REAL(C_DOUBLE), INTENT(INOUT) :: RLAT(MO),RLON(MO)
867 REAL(C_DOUBLE), INTENT( OUT) :: UO(MO),VO(MO)
868#endif
869 !
870
871 type(grib2_descriptor) :: desc_in, desc_out
872 class(ip_grid), allocatable :: grid_in, grid_out
873 integer :: ibo_array(1)
874
875 ! Can't pass expression (e.g. [ibo]) to intent(out) argument.
876 ! Initialize placeholder array of size 1 to make rank match.
877 ibo_array(1) = ibo
878
879 desc_in = init_descriptor(igdtnumi, igdtleni, igdtmpli)
880 desc_out = init_descriptor(igdtnumo, igdtleno, igdtmplo)
881
882 call init_grid(grid_in, desc_in)
883 call init_grid(grid_out, desc_out)
884
885 CALL ipolatev_grid(ip,ipopt,grid_in,grid_out, &
886 mi,mo,km,[ibi],li,ui,vi,&
887 no,rlat,rlon,crot,srot,ibo_array,lo,uo,vo,iret)
888
889 ibo = ibo_array(1)
890
891 end subroutine ipolatev_grib2_single_field
892
893end module ipolatev_mod
894
ip_grid_descriptor_mod::init_descriptor
Definition ip_grid_descriptor_mod.F90:63
ip_grid_factory_mod::init_grid
Definition ip_grid_factory_mod.F90:20
ipolatev_mod::ipolatev
Definition ipolatev.F90:21
ip_grid_descriptor_mod
Users derived type grid descriptor objects to abstract away the raw GRIB1 and GRIB2 grid definitions.
Definition ip_grid_descriptor_mod.F90:15
ip_grid_factory_mod
Routines for creating an ip_grid given a Grib descriptor.
Definition ip_grid_factory_mod.F90:11
ip_grid_mod
Abstract ip_grid type.
Definition ip_grid_mod.F90:10
ip_interpolators_mod
Top-level module to export interpolation routines and constants.
Definition ip_interpolators_mod.F90:7
ip_interpolators_mod::neighbor_interp_id
integer, parameter, public neighbor_interp_id
Definition ip_interpolators_mod.F90:21
ip_interpolators_mod::bilinear_interp_id
integer, parameter, public bilinear_interp_id
Definition ip_interpolators_mod.F90:17
ip_interpolators_mod::budget_interp_id
integer, parameter, public budget_interp_id
Definition ip_interpolators_mod.F90:23
ip_interpolators_mod::spectral_interp_id
integer, parameter, public spectral_interp_id
Definition ip_interpolators_mod.F90:25
ip_interpolators_mod::bicubic_interp_id
integer, parameter, public bicubic_interp_id
Definition ip_interpolators_mod.F90:19
ip_interpolators_mod::neighbor_budget_interp_id
integer, parameter, public neighbor_budget_interp_id
Definition ip_interpolators_mod.F90:27
ipolatev_mod
Top-level driver for vector interpolation interpolation routine ipolatev().
Definition ipolatev.F90:10
ipolatev_mod::ipolatev_grib2
subroutine, public 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)
This subprogram interpolates vector fields from any grid to any grid given a grib2 descriptor.
Definition ipolatev.F90:386
ipolatev_mod::ipolatev_grid
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)
Interpolates vector fields between grids given ip_grid objects.
Definition ipolatev.F90:70
ipolatev_mod::ipolatev_grib2_single_field
subroutine, public ipolatev_grib2_single_field(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)
This subprogram interpolates vector fields from any grid to any grid given a grib2 descriptor.
Definition ipolatev.F90:836
ipolatev_mod::ipolatev_grib1
subroutine, public ipolatev_grib1(ip, ipopt, kgdsi, kgdso, mi, mo, km, ibi, li, ui, vi, no, rlat, rlon, crot, srot, ibo, lo, uo, vo, iret)
This subprogram interpolates vector field from any grid to any grid given a grib1 Grid Descriptor Sec...
Definition ipolatev.F90:567
ipolatev_mod::ipolatev_grib1_single_field
subroutine, public ipolatev_grib1_single_field(ip, ipopt, kgdsi, kgdso, mi, mo, km, ibi, li, ui, vi, no, rlat, rlon, crot, srot, ibo, lo, uo, vo, iret)
Special case of ipolatev_grib1 when interpolating a single field.
Definition ipolatev.F90:682
ip_grid_descriptor_mod::grib1_descriptor
Descriptor representing a grib1 grib descriptor section (GDS) with an integer array.
Definition ip_grid_descriptor_mod.F90:39
ip_grid_descriptor_mod::grib2_descriptor
Grib-2 descriptor containing a grib2 GDT represented by an integer array.
Definition ip_grid_descriptor_mod.F90:49
ip_grid_mod::ip_grid
Abstract grid that holds fields and methods common to all grids.
Definition ip_grid_mod.F90:58