Line data    Source code

       1             : module mo_util
       2             : 
       3             :   use shr_kind_mod, only : r8 => shr_kind_r8
       4             : 
       5             :   implicit none
       6             : 
       7             :   private
       8             :   public :: rebin
       9             : 
      10             : contains
      11             : 
      12           0 :   subroutine rebin( nsrc, ntrg, src_x, trg_x, src, trg )
      13             :     !---------------------------------------------------------------
      14             :     !   ... rebin src to trg
      15             :     !---------------------------------------------------------------
      16             : 
      17             :     implicit none
      18             : 
      19             :     !---------------------------------------------------------------
      20             :     !   ... dummy arguments
      21             :     !---------------------------------------------------------------
      22             :     integer, intent(in)   :: nsrc                  ! dimension source array
      23             :     integer, intent(in)   :: ntrg                  ! dimension target array
      24             :     real(r8), intent(in)      :: src_x(nsrc+1)         ! source coordinates
      25             :     real(r8), intent(in)      :: trg_x(ntrg+1)         ! target coordinates
      26             :     real(r8), intent(in)      :: src(nsrc)             ! source array
      27             :     real(r8), intent(out)     :: trg(ntrg)             ! target array
      28             : 
      29             :     !---------------------------------------------------------------
      30             :     !   ... local variables
      31             :     !---------------------------------------------------------------
      32             :     integer  :: i, l
      33             :     integer  :: si, si1
      34             :     integer  :: sil, siu
      35             :     real(r8)     :: y
      36             :     real(r8)     :: sl, su
      37             :     real(r8)     :: tl, tu
      38             : 
      39             :     !---------------------------------------------------------------
      40             :     !   ... check interval overlap
      41             :     !---------------------------------------------------------------
      42             :     !     if( trg_x(1) < src_x(1) .or. trg_x(ntrg+1) > src_x(nsrc+1) ) then
      43             :     !        write(iulog,*) 'rebin: target grid is outside source grid'
      44             :     !        write(iulog,*) '       target grid from ',trg_x(1),' to ',trg_x(ntrg+1)
      45             :     !        write(iulog,*) '       source grid from ',src_x(1),' to ',src_x(nsrc+1)
      46             :     !        call endrun
      47             :     !     end if
      48             : 
      49           0 :     do i = 1,ntrg
      50           0 :        tl = trg_x(i)
      51           0 :        if( tl < src_x(nsrc+1) ) then
      52           0 :           do sil = 1,nsrc+1
      53           0 :              if( tl <= src_x(sil) ) then
      54             :                 exit
      55             :              end if
      56             :           end do
      57           0 :           tu = trg_x(i+1)
      58           0 :           do siu = 1,nsrc+1
      59           0 :              if( tu <= src_x(siu) ) then
      60             :                 exit
      61             :              end if
      62             :           end do
      63           0 :           y   = 0._r8
      64           0 :           sil = max( sil,2 )
      65           0 :           siu = min( siu,nsrc+1 )
      66           0 :           do si = sil,siu
      67           0 :              si1 = si - 1
      68           0 :              sl  = max( tl,src_x(si1) )
      69           0 :              su  = min( tu,src_x(si) )
      70           0 :              y   = y + (su - sl)*src(si1)
      71             :           end do
      72           0 :           trg(i) = y/(trg_x(i+1) - trg_x(i))
      73             :        else
      74           0 :           trg(i) = 0._r8
      75             :        end if
      76             :     end do
      77             : 
      78           0 :   end subroutine rebin
      79             : 
      80             : 
      81             : end module mo_util