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
|
