ecearth3/sources/tm5mp/base/grid_tools.F90

!
! Grid tools.
!
! may 2002, Arjo Segers
!

module grid_tools


  use Binas, only : deg2rad, pi, ae
  
  implicit none
  
  
  ! --- in/out --------------------------------------
  
  private
  
  public  ::  deg2rad, pi, ae
  
  public  ::  ll_area
  public  ::  ll_area_frac
  
  

contains


  ! ===================================================================
    
  
  ! given rectangle [west,east]x[south,north] in radians,
  ! compute area in rad^2
  
  real function ll_area( west, east, south, north )
  
    ! --- in/out -------------------------------------
    
    real, intent(in)  ::  west, east, south, north    ! rad
    
    ! --- begin ------------------------------------

    ll_area = ( sin(max(north,south)) - sin(min(north,south)) ) * abs(east-west)
    
  end function ll_area
  
  
  ! ===
  
  
  ! Compute fraction of rectangle 1 that covers rectangle 2,
  ! both defined in radians.
  ! Fraction is equal to ratio of shaded area and area 1.
  !
  !   +-----------------+         |
  !   |           +-----+---------+--
  !   |    1      |/////|         |
  !   +-----------------+   2     |
  !               |               |
  !             --+---------------+--
  !               |               |
  !
  
  real function ll_area_frac( west1, east1, south1, north1, &
                               west2, east2, south2, north2 )
    
    ! --- in/out ----------------------------
    
    real, intent(in)      ::  west1, east1, south1, north1   ! rad
    real, intent(in)      ::  west2, east2, south2, north2   ! rad

    ! --- local ---------------------------

    real        ::  xwest2, xeast2
    
    ! --- begin -----------------------------

    ! check ..    
    if ( east1 < west1 .or. east2 < west2 .or. &
         north1 < south1 .or. north2 < south2 ) then
      print *, 'found strange area:'
      print *, '  1:', west1, east1, south1, north1
      print *, '  2:', west2, east2, south2, north2
      stop 'FATAL ERROR IN ll_area_frac'
    end if
    
    ! shift rect 2 over 360 deg if it does not cover rect 1 at all;
    ! if they still not cover, the fraction will be set to zero later on:
    if ( west2 > east1 ) then
      ! cell 2 is east of cell 1; try to shift 360.0 westwards
      xwest2 = west2 - 2*pi
      xeast2 = east2 - 2*pi
    else if ( east2 < west1 ) then
      ! cell 2 is west of cell 1; try to shift 360.0 eastwards
      xwest2 = west2 + 2*pi
      xeast2 = east2 + 2*pi
    else
      ! just copy ...
      xwest2 = west2
      xeast2 = east2
    end if

    ! compute fraction; zero if rectangles do not cover:
    if ( (xeast2 <= west1 ) .or. (xwest2 >= east1 ) .or. &
         (north2 <= south1) .or. (south2 >= north1) ) then
      ll_area_frac = 0.0
    else
      ll_area_frac = &
         ll_area( max(west1 ,xwest2), min(east1 ,xeast2), &
                  max(south1,south2), min(north1,north2) ) &
          / ll_area( west1, east1, south1, north1 )
    end if

  end function ll_area_frac
  

end module grid_tools