LCOV - code coverage report
Current view: | top level - physics/rrtmgp/ext/rte-frontend - mo_fluxes.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 31 | 41 | 75.6 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 2 | 3 | 66.7 %

              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 and
           7             : ! Regents of the University of Colorado.  All right reserved.
           8             : !
           9             : ! Use and duplication is permitted under the terms of the
          10             : !    BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause
          11             : ! -------------------------------------------------------------------------------------------------
          12             : !
          13             : !> ## Compute output quantities from spectrally-resolved flux profiles
          14             : !>
          15             : !>    This module contains an abstract class and a broadband implmentation that sums over all spectral points
          16             : !>    The abstract base class defines the routines that extenstions must implement: `reduce()` and `are_desired()`
          17             : !>    The intent is for users to extend it as required, using mo_flxues_broadband as an example
          18             : !
          19             : ! -------------------------------------------------------------------------------------------------
          20             : module mo_fluxes
          21             :   use mo_rte_kind,       only: wp
          22             :   use mo_rte_config,     only: check_extents
          23             :   use mo_rte_util_array_validation, only: extents_are
          24             :   use mo_optical_props,  only: ty_optical_props
          25             :   use mo_fluxes_broadband_kernels, &
          26             :                          only: sum_broadband, net_broadband
          27             :   implicit none
          28             :   private
          29             :   ! -----------------------------------------------------------------------------------------------
          30             :   !
          31             :   !> Abstract base class:
          32             :   !>   `reduce()` function accepts spectral flux profiles, computes desired outputs
          33             :   !>   `are_desired()` returns a logical
          34             :   !
          35             :   ! -----------------------------------------------------------------------------------------------
          36             :   type, abstract, public :: ty_fluxes
          37             :   contains
          38             :     procedure(reduce_abstract),      deferred, public :: reduce
          39             :     procedure(are_desired_abstract), deferred, public :: are_desired
          40             :   end type ty_fluxes
          41             :   ! -----------------------------------------------------------------------------------------------
          42             :   !
          43             :   !> Class implementing broadband integration for the complete flux profile.
          44             :   !>   Data components are pointers so results can be written directly into memory
          45             :   !
          46             :   ! -----------------------------------------------------------------------------------------------
          47             :   type, extends(ty_fluxes), public :: ty_fluxes_broadband
          48             :     real(wp), dimension(:,:), pointer :: flux_up => NULL(), flux_dn => NULL()
          49             :     real(wp), dimension(:,:), pointer :: flux_net => NULL()    ! Net (down - up)
          50             :     real(wp), dimension(:,:), pointer :: flux_dn_dir => NULL() ! Direct flux down
          51             :   contains
          52             :     procedure, public :: reduce      => reduce_broadband
          53             :     procedure, public :: are_desired => are_desired_broadband
          54             :   end type ty_fluxes_broadband
          55             :   ! -----------------------------------------------------------------------------------------------
          56             :
          57             :   ! -----------------------------------------------------------------------------------------------
          58             :   !
          59             :   ! Abstract interfaces: any implemntation has to provide routines with these interfaces
          60             :   !
          61             :   abstract interface
          62             :     ! -------------------
          63             :     !
          64             :     !> This routine takes the fully resolved calculation (detailed in spectral and vertical dimensions) and
          65             :     !>   computes desired outputs. Output values will normally be data components of the derived type.
          66             :     !
          67             :     function reduce_abstract(this, gpt_flux_up, gpt_flux_dn, spectral_disc, top_at_1, gpt_flux_dn_dir) result(error_msg)
          68             :       import ty_fluxes, ty_optical_props
          69             :       import wp
          70             :       class(ty_fluxes),                  intent(inout) :: this
          71             :       real(kind=wp), dimension(:,:,:),   intent(in   ) :: gpt_flux_up ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
          72             :       real(kind=wp), dimension(:,:,:),   intent(in   ) :: gpt_flux_dn ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
          73             :       class(ty_optical_props),           intent(in   ) :: spectral_disc  !< derived type with spectral information
          74             :       logical,                           intent(in   ) :: top_at_1
          75             :       real(kind=wp), dimension(:,:,:), optional, &
          76             :                                          intent(in   ) :: gpt_flux_dn_dir! Direct flux down
          77             :       character(len=128)                               :: error_msg
          78             :     end function reduce_abstract
          79             :     ! -------------------
          80             :     !
          81             :     ! This routine determines if the reduction should proceed - it's useful in ensuring
          82             :     !   that space has been allocated for the results, for example.
          83             :     !
          84             :     function are_desired_abstract(this)
          85             :       import ty_fluxes
          86             :       class(ty_fluxes), intent(in   ) :: this
          87             :       logical                         :: are_desired_abstract
          88             :     end function are_desired_abstract
          89             :     ! ----------------------
          90             :   end interface
          91             : contains
          92             :   ! --------------------------------------------------------------------------------------
          93             :   !
          94             :   !> Broadband fluxes -- simply sum over the spectral dimension and report the whole profile
          95             :   !
          96             :   ! --------------------------------------------------------------------------------------
          97     1135399 :   function reduce_broadband(this, gpt_flux_up, gpt_flux_dn, spectral_disc, top_at_1, gpt_flux_dn_dir) result(error_msg)
          98             :     class(ty_fluxes_broadband),        intent(inout) :: this
          99             :     real(kind=wp), dimension(:,:,:),   intent(in   ) :: gpt_flux_up ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
         100             :     real(kind=wp), dimension(:,:,:),   intent(in   ) :: gpt_flux_dn ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
         101             :     class(ty_optical_props),           intent(in   ) :: spectral_disc  !< derived type with spectral information
         102             :     logical,                           intent(in   ) :: top_at_1
         103             :     real(kind=wp), dimension(:,:,:), optional, &
         104             :                                        intent(in   ) :: gpt_flux_dn_dir! Direct flux down
         105             :     character(len=128)                               :: error_msg
         106             :     ! ------
         107             :     integer :: ncol, nlev, ngpt
         108             :
         109             :     ! ------
         110     1135399 :     ncol = size(gpt_flux_up, DIM=1)
         111     1135399 :     nlev = size(gpt_flux_up, DIM=2)
         112     1135399 :     ngpt = size(gpt_flux_up, DIM=3)
         113     1135399 :     error_msg = ""
         114             :
         115     1135399 :     if(check_extents) then
         116             :       !
         117             :       ! Check array sizes
         118             :       !  Input arrays
         119             :       !
         120     1135399 :       if(.not. extents_are(gpt_flux_dn, ncol, nlev, ngpt)) &
         121           0 :         error_msg = "reduce: gpt_flux_dn array incorrectly sized"
         122             :
         123     1135399 :       if(present(gpt_flux_dn_dir)) then
         124      389263 :         if(.not. extents_are(gpt_flux_dn_dir, ncol, nlev, ngpt)) &
         125           0 :           error_msg = "reduce: gpt_flux_dn_dir array incorrectly sized"
         126             :       end if
         127             :       !
         128             :       ! Output arrays
         129             :       !
         130     1135399 :       if(associated(this%flux_up)) then
         131     1135399 :         if(.not. extents_are(this%flux_up, ncol, nlev)) &
         132           0 :           error_msg = 'reduce: flux_up array incorrectly sized'
         133             :       end if
         134     1135399 :       if(associated(this%flux_dn)) then
         135     1135399 :         if(.not. extents_are(this%flux_dn, ncol, nlev)) &
         136           0 :           error_msg = 'reduce: flux_dn array incorrectly sized'
         137             :       end if
         138     1135399 :       if(associated(this%flux_net)) then
         139     1135399 :         if(.not. extents_are(this%flux_net, ncol, nlev)) &
         140           0 :           error_msg = 'reduce: flux_net array incorrectly sized'
         141             :       end if
         142     1135399 :       if(associated(this%flux_dn_dir)) then
         143      389263 :         if(.not. extents_are(this%flux_dn_dir, ncol, nlev)) &
         144           0 :           error_msg = 'reduce: flux_dn_dir array incorrectly sized'
         145             :       end if
         146             :
         147     1135399 :       if(error_msg /= "") return
         148             :     end if
         149             :     !
         150             :     ! Self-consistency -- shouldn't be asking for direct beam flux if it isn't supplied
         151             :     !
         152     1135399 :     if(associated(this%flux_dn_dir) .and. .not. present(gpt_flux_dn_dir)) then
         153           0 :       error_msg = "reduce: requesting direct downward flux but this hasn't been supplied"
         154           0 :       return
         155             :     end if
         156             :
         157             :     !
         158             :     ! Broadband fluxes - call the kernels
         159             :     !
         160     1135399 :     if(associated(this%flux_up    )) &
         161     1135399 :       call sum_broadband(ncol, nlev, ngpt, gpt_flux_up,     this%flux_up)
         162     1135399 :     if(associated(this%flux_dn    )) &
         163     1135399 :       call sum_broadband(ncol, nlev, ngpt, gpt_flux_dn,     this%flux_dn)
         164     1135399 :     if(associated(this%flux_dn_dir)) &
         165      389263 :       call sum_broadband(ncol, nlev, ngpt, gpt_flux_dn_dir, this%flux_dn_dir)
         166             :
         167     1135399 :     if(associated(this%flux_net)) then
         168             :       !
         169             :       !  Reuse down and up results if possible
         170             :       !
         171     1135399 :       if(associated(this%flux_dn) .and. associated(this%flux_up)) then
         172     1135399 :         call net_broadband(ncol, nlev,      this%flux_dn, this%flux_up, this%flux_net)
         173             :       else
         174           0 :         call net_broadband(ncol, nlev, ngpt, gpt_flux_dn,  gpt_flux_up, this%flux_net)
         175             :       end if
         176             :     end if
         177             :   end function reduce_broadband
         178             :   ! --------------------------------------------------------------------------------------
         179             :   !
         180             :   !> Are any fluxes desired from this set of g-point fluxes? We can tell because memory will
         181             :   !>   be allocated for output
         182             :   !
         183             :   ! --------------------------------------------------------------------------------------
         184     2270798 :   function are_desired_broadband(this)
         185             :     class(ty_fluxes_broadband), intent(in   ) :: this
         186             :     logical                                   :: are_desired_broadband
         187             :
         188             :     are_desired_broadband = any( [associated(this%flux_up),     &
         189             :                                   associated(this%flux_dn),     &
         190             :                                   associated(this%flux_dn_dir), &
         191     2270798 :                                   associated(this%flux_net)] )
         192     2270798 :   end function are_desired_broadband
         193             :   ! --------------------------------------------------------------------------------------
         194           0 : end module mo_fluxes

Generated by: LCOV version 1.14