Line data    Source code

       1             : module utils_mod
       2             :   use shr_kind_mod   ,only: r8 => shr_kind_r8, cl=>shr_kind_cl
       3             :   use cam_logfile    ,only: iulog
       4             :   use cam_abortutils ,only: endrun
       5             :   use esmf           ,only: ESMF_FIELD
       6             :   use edyn_mpi       ,only: mlon0,mlon1,mlat0,mlat1, lon0,lon1,lat0,lat1
       7             :   use edyn_params    ,only: finit
       8             : 
       9             :   implicit none
      10             :   private
      11             : 
      12             :   public :: boxcar_ave
      13             :   public :: check_ncerr
      14             :   public :: check_alloc
      15             : 
      16             : contains
      17             : 
      18             :   !-----------------------------------------------------------------------
      19           0 :   subroutine boxcar_ave(x,y,lon,lat,mtime,itime,ibox)
      20             :     !
      21             :     ! perform boxcar average
      22             :     !
      23             :     ! Args:
      24             :     integer,  intent(in)  :: lon
      25             :     integer,  intent(in)  :: lat
      26             :     integer,  intent(in)  :: mtime
      27             :     integer,  intent(in)  :: itime
      28             :     integer,  intent(in)  :: ibox
      29             :     real(r8), intent(in)  :: x(lon,lat,mtime)
      30             :     real(r8), intent(out) :: y(lon,lat)
      31             : 
      32             :     ! Local:
      33             :     integer :: i, iset, iset1
      34             : 
      35           0 :     if (ibox > mtime) then
      36           0 :        call endrun('boxcar_ave: ibox > mtime')
      37             :     endif
      38             :     !
      39           0 :     iset = itime - ibox/2
      40           0 :     if (iset < 1) iset = 1
      41           0 :     iset1 = iset + ibox
      42           0 :     if (iset1 > mtime) then
      43           0 :        iset1 = mtime
      44           0 :        iset = iset1 - ibox
      45             :     end if
      46           0 :     y(:,:) = 0._r8
      47           0 :     do i=iset,iset1
      48           0 :        y(:,:) = y(:,:) + x(:,:,i)
      49             :     end do
      50           0 :     if (ibox > 0) y(:,:) = y(:,:)/ibox
      51             :     !
      52           0 :   end subroutine boxcar_ave
      53             : 
      54             :   !-----------------------------------------------------------------------
      55           0 :   subroutine check_alloc(ierror, subname, varname, lonp1, latp1, ntimes, lw)
      56             :     use spmd_utils, only: masterproc
      57             :     integer,           intent(in) :: ierror
      58             :     character(len=*),  intent(in) :: subname
      59             :     character(len=*),  intent(in) :: varname
      60             :     integer, optional, intent(in) :: lonp1
      61             :     integer, optional, intent(in) :: latp1
      62             :     integer, optional, intent(in) :: ntimes
      63             :     integer, optional, intent(in) :: lw
      64             :     ! Local variable
      65             :     character(len=cl) :: errmsg
      66             : 
      67           0 :     if (ierror /= 0) then
      68             :        write(errmsg, '(">>> ",a,": error allocating ",a)')                   &
      69           0 :             trim(subname), trim(varname)
      70           0 :        if (present(lonp1)) then
      71           0 :           write(errmsg(len_trim(errmsg)+1:), '(", lonp1 = ",i0)') lonp1
      72             :        end if
      73           0 :        if (present(latp1)) then
      74           0 :           write(errmsg(len_trim(errmsg)+1:), '(", latp1 = ",i0)') latp1
      75             :        end if
      76           0 :        if (present(ntimes)) then
      77           0 :           write(errmsg(len_trim(errmsg)+1:), '(", ntimes = ",i0)') ntimes
      78             :        end if
      79           0 :        if (present(lw)) then
      80           0 :           write(errmsg(len_trim(errmsg)+1:), '(", lw = ",i0)') lw
      81             :        end if
      82           0 :        if (masterproc) then
      83           0 :           write(iulog, *) trim(errmsg)
      84             :        end if
      85           0 :        call endrun(trim(errmsg))
      86             :     end if
      87             : 
      88           0 :   end subroutine check_alloc
      89             : 
      90             :   !-----------------------------------------------------------------------
      91           0 :   subroutine check_ncerr(istat, subname, msg)
      92             :     use pio, only: pio_noerr
      93             :     !
      94             :     ! Handle a netcdf lib error:
      95             :     !
      96             :     integer,          intent(in) :: istat
      97             :     character(len=*), intent(in) :: subname
      98             :     character(len=*), intent(in) :: msg
      99             :     !
     100             :     ! Local variable
     101             :     character(len=cl) :: errmsg
     102             :     !
     103           0 :     if (istat /= pio_noerr) then
     104           0 :        write(iulog,"(/72('-'))")
     105           0 :        write(iulog,"('>>> Error from netcdf library:')")
     106           0 :        write(iulog,"(a,': Error getting ',a)") trim(subname), trim(msg)
     107             : 
     108           0 :        write(iulog,"('istat=',i5)") istat
     109           0 :        write(iulog,"(72('-')/)")
     110             :        write(errmsg, '("NetCDF Error in ",a,": ",2a,", istat = ",i0)')        &
     111           0 :             trim(subname), 'Error getting ', trim(msg), istat
     112           0 :        call endrun(trim(errmsg))
     113             :     end if
     114           0 :   end subroutine check_ncerr
     115             : 
     116             : end module utils_mod