LCOV - code coverage report
Current view: | top level - physics/rrtmgp/ext/rte-frontend - mo_rte_util_array_validation.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 35 | 75 | 46.7 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 9 | 19 | 47.4 %

              Line data    Source code
           1             : ! This code is part of Radiative Transfer for Energetics (RTE)
           2             : !
           3             : ! Contacts: Robert Pincus and Eli Mlawer
           4             : ! email:  rrtmgp@aer.com
           5             : !
           6             : ! Copyright 2015-  Atmospheric and Environmental Research,
           7             : !    Regents of the University of Colorado,
           8             : !    Trustees of Columbia University in the City of New York
           9             : ! All right reserved.
          10             : !
          11             : ! Use and duplication is permitted under the terms of the
          12             : !    BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause
          13             : ! -------------------------------------------------------------------------------------------------
          14             : module mo_rte_util_array_validation
          15             : !
          16             : !> Provide utilites for sanitizing input arrays:
          17             : !    checking values and sizes
          18             : ! These are in a module so code can be written for both CPUs and GPUs
          19             : ! Used only by Fortran classes so routines don't need C bindings and can use assumed-shape
          20             : !
          21             :   use mo_rte_kind,      only: wp, wl
          22             :   implicit none
          23             :   !>
          24             :   !> Values less than a floor (including masked versions)
          25             :   !>
          26             :   interface any_vals_less_than
          27             :     module procedure any_vals_less_than_1D,        any_vals_less_than_2D,        any_vals_less_than_3D
          28             :     module procedure any_vals_less_than_1D_masked, any_vals_less_than_2D_masked, any_vals_less_than_3D_masked
          29             :   end interface
          30             :   !>
          31             :   !> Values outside a range (including masked versions)
          32             :   !>
          33             :   interface any_vals_outside
          34             :     module procedure any_vals_outside_1D,        any_vals_outside_2D,        any_vals_outside_3D
          35             :     module procedure any_vals_outside_1D_masked, any_vals_outside_2D_masked, any_vals_outside_3D_masked
          36             :   end interface
          37             :   !>
          38             :   !> Find the extents of an array
          39             :   !>
          40             :   interface extents_are
          41             :     module procedure extents_are_1D, extents_are_2D, extents_are_3D
          42             :     module procedure extents_are_4D, extents_are_5D, extents_are_6D
          43             :     module procedure extents_are_2d_int
          44             :   end interface extents_are
          45             :
          46             :   private
          47             :   public :: any_vals_less_than, any_vals_outside, extents_are
          48             : contains
          49             :   !-------------------------------------------------------------------------------------------------
          50             :   ! Values less than a floor
          51             :   !-------------------------------------------------------------------------------------------------
          52           0 :   logical function any_vals_less_than_1D(array, check_value)
          53             :     real(wp), dimension(:), intent(in) :: array
          54             :     real(wp),               intent(in) :: check_value
          55             :
          56             :     real(wp) :: minValue
          57             :
          58             :     !$acc kernels copyin(array)
          59             :     !$omp target map(to:array) map(from:minValue)
          60           0 :     minValue = minval(array)
          61             :     !$acc end kernels
          62             :     !$omp end target
          63             :
          64           0 :     any_vals_less_than_1D = (minValue < check_value)
          65             :
          66           0 :   end function any_vals_less_than_1D
          67             : !-------------------------------------------------------------------------------------------------
          68     6069330 :   logical function any_vals_less_than_2D(array, check_value)
          69             :     real(wp), dimension(:,:), intent(in) :: array
          70             :     real(wp),                 intent(in) :: check_value
          71             :
          72             :     real(wp) :: minValue
          73             :
          74             :     !$acc kernels copyin(array)
          75             :     !$omp target map(to:array) map(from:minValue)
          76  3374427337 :     minValue = minval(array)
          77             :     !$acc end kernels
          78             :     !$omp end target
          79             :
          80     6069330 :     any_vals_less_than_2D = (minValue < check_value)
          81             :
          82     6069330 :   end function any_vals_less_than_2D
          83             : !-------------------------------------------------------------------------------------------------
          84     4152333 :   logical function any_vals_less_than_3D(array, check_value)
          85             :     real(wp), dimension(:,:,:), intent(in) :: array
          86             :     real(wp),                   intent(in) :: check_value
          87             :
          88             :     real(wp) :: minValue
          89             :
          90             : #ifdef _OPENMP
          91             :     integer :: dim1, dim2, dim3, i, j, k
          92             :     dim1 = size(array,1)
          93             :     dim2 = size(array,2)
          94             :     dim3 = size(array,3)
          95             :     minValue = check_value + epsilon(check_value) ! initialize to some value
          96             :     !$omp target teams map(to:array) &
          97             :     !$omp defaultmap(tofrom:scalar) reduction(min:minValue)
          98             :     !$omp distribute parallel do simd reduction(min:minValue)
          99             :     do i = 1, dim1
         100             :        do j = 1, dim2
         101             :           do k = 1, dim3
         102             :              minValue = min(minValue,array(i,j,k))
         103             :           enddo
         104             :        enddo
         105             :     enddo
         106             :     !$omp end target teams
         107             : #else
         108             :     !$acc kernels copyin(array)
         109 >66614*10^7 :     minValue = minval(array)
         110             :     !$acc end kernels
         111             : #endif
         112             :
         113     4152333 :     any_vals_less_than_3D = (minValue < check_value)
         114             :
         115     4152333 :   end function any_vals_less_than_3D
         116             :   !-------------------------------------------------------------------------------------------------
         117             :   ! Masked versions
         118             :   !-------------------------------------------------------------------------------------------------
         119           0 :   logical function any_vals_less_than_1D_masked(array, mask, check_value)
         120             :     real   (wp), dimension(:), intent(in) :: array
         121             :     logical(wl), dimension(:), intent(in) :: mask
         122             :     real   (wp),               intent(in) :: check_value
         123             :
         124             :     real(wp) :: minValue
         125             :
         126             :     !$acc kernels copyin(array, mask)
         127             :     !$omp target map(to: array, mask) map(from:minValue)
         128           0 :     minValue = minval(array, mask=mask)
         129             :     !$acc end kernels
         130             :     !$omp end target
         131             :
         132           0 :     any_vals_less_than_1D_masked = (minValue < check_value)
         133             :
         134           0 :   end function any_vals_less_than_1D_masked
         135             :   !-------------------------------------------------------------------------------------------------
         136           0 :   logical function any_vals_less_than_2D_masked(array, mask, check_value)
         137             :     real   (wp), dimension(:,:), intent(in) :: array
         138             :     logical(wl), dimension(:,:), intent(in) :: mask
         139             :     real   (wp),                 intent(in) :: check_value
         140             :
         141             :     real(wp) :: minValue
         142             :
         143             :     !$acc kernels copyin(array, mask)
         144             :     !$omp target map(to: array, mask) map(from:minValue)
         145           0 :     minValue = minval(array, mask=mask)
         146             :     !$acc end kernels
         147             :     !$omp end target
         148             :
         149           0 :     any_vals_less_than_2D_masked = (minValue < check_value)
         150             :
         151           0 :   end function any_vals_less_than_2D_masked
         152             :   !-------------------------------------------------------------------------------------------------
         153           0 :   logical function any_vals_less_than_3D_masked(array, mask, check_value)
         154             :     real   (wp), dimension(:,:,:), intent(in) :: array
         155             :     logical(wl), dimension(:,:,:), intent(in) :: mask
         156             :     real   (wp),                   intent(in) :: check_value
         157             :
         158             :     real(wp) :: minValue
         159             :
         160             :     !$acc kernels copyin(array, mask)
         161             :     !$omp target map(to: array, mask) map(from:minValue)
         162           0 :     minValue = minval(array, mask=mask)
         163             :     !$acc end kernels
         164             :     !$omp end target
         165             :
         166           0 :     any_vals_less_than_3D_masked = (minValue < check_value)
         167             :
         168           0 :   end function any_vals_less_than_3D_masked
         169             :   !-------------------------------------------------------------------------------------------------
         170             :   ! Values outside a range
         171             :   !-------------------------------------------------------------------------------------------------
         172      746136 :   logical function any_vals_outside_1D(array, checkMin, checkMax)
         173             :     real(wp), dimension(:), intent(in) :: array
         174             :     real(wp),               intent(in) :: checkMin, checkMax
         175             :
         176             :     real(wp) :: minValue, maxValue
         177             :
         178             :     !$acc kernels copyin(array)
         179             :     !$omp target map(to:array) map(from:minValue, maxValue)
         180    13204872 :     minValue = minval(array)
         181    13204872 :     maxValue = maxval(array)
         182             :     !$acc end kernels
         183             :     !$omp end target
         184      746136 :     any_vals_outside_1D = minValue < checkMin .or. maxValue > checkMax
         185             :
         186      746136 :   end function any_vals_outside_1D
         187             : ! ----------------------------------------------------------
         188    15181840 :   logical function any_vals_outside_2D(array, checkMin, checkMax)
         189             :     real(wp), dimension(:,:), intent(in) :: array
         190             :     real(wp),                 intent(in) :: checkMin, checkMax
         191             :
         192             :     real(wp) :: minValue, maxValue
         193             :
         194             :     !$acc kernels copyin(array)
         195             :     !$omp target map(to:array) map(from:minValue, maxValue)
         196 19520995144 :     minValue = minval(array)
         197 19520995144 :     maxValue = maxval(array)
         198             :     !$acc end kernels
         199             :     !$omp end target
         200    15181840 :     any_vals_outside_2D = minValue < checkMin .or. maxValue > checkMax
         201             :
         202    15181840 :   end function any_vals_outside_2D
         203             : ! ----------------------------------------------------------
         204     2335578 :   logical function any_vals_outside_3D(array, checkMin, checkMax)
         205             :     real(wp), dimension(:,:,:), intent(in) :: array
         206             :     real(wp),                   intent(in) :: checkMin, checkMax
         207             :
         208             :       ! Compact version using intrinsics below
         209             :       ! but an explicit loop is the only current solution on GPUs
         210             :     real(wp) :: minValue, maxValue
         211             :
         212             :
         213             : #ifdef _OPENMP
         214             :     integer :: dim1, dim2, dim3, i, j, k
         215             :     dim1 = size(array,1)
         216             :     dim2 = size(array,2)
         217             :     dim3 = size(array,3)
         218             :     minValue = checkMin + epsilon(checkMin) ! initialize to some value
         219             :     maxValue = checkMax - epsilon(checkMax) ! initialize to some value
         220             :     !$omp target teams map(to:array) &
         221             :     !$omp defaultmap(tofrom:scalar) reduction(min:minValue) reduction(max:maxValue)
         222             :     !$omp distribute parallel do simd reduction(min:minValue) reduction(max:maxValue)
         223             :     do i= 1, dim1
         224             :        do j = 1, dim2
         225             :           do k = 1, dim3
         226             :              minValue = min(minValue,array(i,j,k))
         227             :              maxValue = max(maxValue,array(i,j,k))
         228             :           enddo
         229             :        enddo
         230             :     enddo
         231             :     !$omp end target teams
         232             : #else
         233             :     !$acc kernels copyin(array)
         234 >39478*10^7 :     minValue = minval(array)
         235 >39478*10^7 :     maxValue = maxval(array)
         236             :     !$acc end kernels
         237             : #endif
         238             :
         239     2335578 :     any_vals_outside_3D = minValue < checkMin .or. maxValue > checkMax
         240             :
         241     2335578 :   end function any_vals_outside_3D
         242             :   ! ----------------------------------------------------------
         243             :   ! Masked versions
         244             :   ! ----------------------------------------------------------
         245           0 :   logical function any_vals_outside_1D_masked(array, mask, checkMin, checkMax)
         246             :     real   (wp), dimension(:), intent(in) :: array
         247             :     logical(wl), dimension(:), intent(in) :: mask
         248             :     real(wp),                  intent(in) :: checkMin, checkMax
         249             :
         250             :     real(wp) :: minValue, maxValue
         251             :
         252             :     !$acc kernels copyin(array, mask)
         253             :     !$omp target map(to: array, mask) map(from:minValue, maxValue)
         254           0 :     minValue = minval(array, mask=mask)
         255           0 :     maxValue = maxval(array, mask=mask)
         256             :     !$acc end kernels
         257             :     !$omp end target
         258           0 :     any_vals_outside_1D_masked = minValue < checkMin .or. maxValue > checkMax
         259             :
         260           0 :   end function any_vals_outside_1D_masked
         261             : ! ----------------------------------------------------------
         262           0 :   logical function any_vals_outside_2D_masked(array, mask, checkMin, checkMax)
         263             :     real   (wp), dimension(:,:), intent(in) :: array
         264             :     logical(wl), dimension(:,:), intent(in) :: mask
         265             :     real(wp),                    intent(in) :: checkMin, checkMax
         266             :
         267             :     real(wp) :: minValue, maxValue
         268             :
         269             :     !$acc kernels copyin(array, mask)
         270             :     !$omp target map(to: array, mask) map(from:minValue, maxValue)
         271           0 :     minValue = minval(array, mask=mask)
         272           0 :     maxValue = maxval(array, mask=mask)
         273             :     !$acc end kernels
         274             :     !$omp end target
         275           0 :     any_vals_outside_2D_masked = minValue < checkMin .or. maxValue > checkMax
         276             :
         277           0 :   end function any_vals_outside_2D_masked
         278             : ! ----------------------------------------------------------
         279           0 :   logical function any_vals_outside_3D_masked(array, mask, checkMin, checkMax)
         280             :     real   (wp), dimension(:,:,:), intent(in) :: array
         281             :     logical(wl), dimension(:,:,:), intent(in) :: mask
         282             :     real(wp),                      intent(in) :: checkMin, checkMax
         283             :
         284             :     real(wp) :: minValue, maxValue
         285             :
         286             :     !$acc kernels copyin(array, mask)
         287             :     !$omp target map(to: array, mask) map(from:minValue, maxValue)
         288           0 :     minValue = minval(array, mask=mask)
         289           0 :     maxValue = maxval(array, mask=mask)
         290             :     !$acc end kernels
         291             :     !$omp end target
         292           0 :     any_vals_outside_3D_masked = minValue < checkMin .or. maxValue > checkMax
         293             :
         294           0 :   end function any_vals_outside_3D_masked
         295             :   !--------------------------------------------------------------------------------------------------------------------
         296             :   !
         297             :   ! Extents
         298             :   !
         299             :   ! --------------------------------------------------------------------------------------
         300      746136 :   function extents_are_1d(array, n1)
         301             :     real(wp), dimension(:          ), intent(in) :: array
         302             :     integer,                          intent(in) :: n1
         303             :     logical(wl)                                  :: extents_are_1d
         304             :
         305      746136 :     extents_are_1d = (size(array,1) == n1)
         306      746136 :   end function extents_are_1d
         307             :   ! --------------------------------------------------------------------------------------
         308    12197296 :   function extents_are_2d(array, n1, n2)
         309             :     real(wp), dimension(:,:        ), intent(in) :: array
         310             :     integer,                          intent(in) :: n1, n2
         311             :     logical(wl)                                  :: extents_are_2d
         312             :
         313             :     extents_are_2d = (size(array,1) == n1 .and. &
         314    12197296 :                       size(array,2) == n2 )
         315    12197296 :   end function extents_are_2d
         316             :   ! --------------------------------------------------------------------------------------
         317     5417292 :   function extents_are_3d(array, n1, n2, n3)
         318             :     real(wp), dimension(:,:,:      ), intent(in) :: array
         319             :     integer,                          intent(in) :: n1, n2, n3
         320             :     logical(wl)                                  :: extents_are_3d
         321             :
         322             :     extents_are_3d = (size(array,1) == n1 .and. &
         323             :                       size(array,2) == n2 .and. &
         324     5417292 :                       size(array,3) == n3)
         325     5417292 :   end function extents_are_3d
         326             :   ! --------------------------------------------------------------------------------------
         327           0 :   function extents_are_4d(array, n1, n2, n3, n4)
         328             :     real(wp), dimension(:,:,:,:    ), intent(in) :: array
         329             :     integer,                          intent(in) :: n1, n2, n3, n4
         330             :     logical(wl)                                  :: extents_are_4d
         331             :
         332             :     extents_are_4d = (size(array,1) == n1 .and. &
         333             :                       size(array,2) == n2 .and. &
         334             :                       size(array,3) == n3 .and. &
         335           0 :                       size(array,4) == n4)
         336           0 :   end function extents_are_4d
         337             :   ! --------------------------------------------------------------------------------------
         338           0 :   function extents_are_5d(array, n1, n2, n3, n4, n5)
         339             :     real(wp), dimension(:,:,:,:,:  ), intent(in) :: array
         340             :     integer,                          intent(in) :: n1, n2, n3, n4, n5
         341             :     logical(wl)                                  :: extents_are_5d
         342             :
         343             :     extents_are_5d = (size(array,1) == n1 .and. &
         344             :                       size(array,2) == n2 .and. &
         345             :                       size(array,3) == n3 .and. &
         346             :                       size(array,4) == n4 .and. &
         347           0 :                       size(array,5) == n5 )
         348           0 :   end function extents_are_5d
         349             :   ! --------------------------------------------------------------------------------------
         350           0 :   function extents_are_6d(array, n1, n2, n3, n4, n5, n6)
         351             :     real(wp), dimension(:,:,:,:,:,:), intent(in) :: array
         352             :     integer,                          intent(in) :: n1, n2, n3, n4, n5, n6
         353             :     logical(wl)                                  :: extents_are_6d
         354             :
         355             :     extents_are_6d = (size(array,1) == n1 .and. &
         356             :                       size(array,2) == n2 .and. &
         357             :                       size(array,3) == n3 .and. &
         358             :                       size(array,4) == n4 .and. &
         359             :                       size(array,5) == n5 .and. &
         360           0 :                       size(array,6) == n6 )
         361           0 :   end function extents_are_6d
         362             :   ! --------------------------------------------------------------------------------------
         363     3020006 :   function extents_are_2d_int(array, n1, n2)
         364             :     integer,  dimension(:,:        ), intent(in) :: array
         365             :     integer,                          intent(in) :: n1, n2
         366             :     logical(wl)                                  :: extents_are_2d_int
         367             :
         368             :     extents_are_2d_int = (size(array,1) == n1 .and. &
         369     3020006 :                           size(array,2) == n2 )
         370     3020006 :   end function extents_are_2d_int
         371             :
         372             : end module mo_rte_util_array_validation

Generated by: LCOV version 1.14