Line data Source code
1 : ! This code is part of
2 : ! RRTM for GCM Applications - Parallel (RRTMGP)
3 : !
4 : ! Eli Mlawer and Robert Pincus
5 : ! Andre Wehe and Jennifer Delamere
6 : ! email: rrtmgp@aer.com
7 : !
8 : ! Copyright 2015, Atmospheric and Environmental Research and
9 : ! Regents of the University of Colorado. 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 : !
15 : ! This module is for packaging output quantities from RRTMGP based on spectral flux profiles
16 : ! This implementation provides band-by-band flux profiles
17 : !
18 : module mo_fluxes_byband
19 : use mo_rte_kind, only: wp
20 : use mo_rte_config, only: check_extents
21 : use mo_rte_util_array_validation, &
22 : only: extents_are
23 : use mo_fluxes, only: ty_fluxes, ty_fluxes_broadband
24 : use mo_optical_props, only: ty_optical_props
25 : implicit none
26 :
27 : ! Output from radiation calculations
28 : ! Data components are pointers so results can be written directly into memory
29 : ! reduce() function accepts spectral flux profiles
30 : type, extends(ty_fluxes_broadband) :: ty_fluxes_byband
31 : real(wp), dimension(:,:,:), pointer :: bnd_flux_up => NULL(), & ! Band-by-band fluxes
32 : bnd_flux_dn => NULL() ! (ncol, nlev, nband)
33 : real(wp), dimension(:,:,:), pointer :: bnd_flux_net => NULL() ! Net (down - up)
34 : real(wp), dimension(:,:,:), pointer :: bnd_flux_dn_dir => NULL() ! Direct flux down
35 : contains
36 : procedure :: reduce => reduce_byband
37 : procedure :: are_desired => are_desired_byband
38 : end type ty_fluxes_byband
39 :
40 : interface net_byband
41 : module procedure net_byband_full, net_byband_precalc
42 : end interface net_byband
43 :
44 : contains
45 : ! --------------------------------------------------------------------------------------
46 1135399 : function reduce_byband(this, gpt_flux_up, gpt_flux_dn, spectral_disc, top_at_1, gpt_flux_dn_dir) result(error_msg)
47 : class(ty_fluxes_byband), intent(inout) :: this
48 : real(kind=wp), dimension(:,:,:), intent(in ) :: gpt_flux_up ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
49 : real(kind=wp), dimension(:,:,:), intent(in ) :: gpt_flux_dn ! Fluxes by gpoint [W/m2](ncol, nlay+1, ngpt)
50 : class(ty_optical_props), intent(in ) :: spectral_disc !< derived type with spectral information
51 : logical, intent(in ) :: top_at_1
52 : real(kind=wp), dimension(:,:,:), optional, &
53 : intent(in ) :: gpt_flux_dn_dir! Direct flux down
54 : character(len=128) :: error_msg
55 : ! ------
56 : integer :: ncol, nlev, ngpt, nbnd
57 2270798 : integer, dimension(2, spectral_disc%get_nband()) :: band_lims
58 : ! ------
59 1135399 : ncol = size(gpt_flux_up, DIM=1)
60 1135399 : nlev = size(gpt_flux_up, DIM=2)
61 1135399 : ngpt = spectral_disc%get_ngpt()
62 1135399 : nbnd = spectral_disc%get_nband()
63 53298973 : band_lims(:,:) = spectral_disc%get_band_lims_gpoint()
64 :
65 : ! Compute broadband fluxes
66 : ! This also checks that input arrays are consistently sized
67 : !
68 1881535 : error_msg = this%ty_fluxes_broadband%reduce(gpt_flux_up, gpt_flux_dn, spectral_disc, top_at_1, gpt_flux_dn_dir)
69 1135399 : if(error_msg /= '') return
70 :
71 1135399 : if(size(gpt_flux_up, 3) /= ngpt) then
72 0 : error_msg = "reduce: spectral discretization and g-point flux arrays have differing number of g-points"
73 0 : return
74 : end if
75 :
76 : ! Check sizes of output arrays
77 1135399 : if(check_extents) then
78 1135399 : if(associated(this%bnd_flux_up)) then
79 389263 : if(.not. extents_are(this%bnd_flux_up, ncol, nlev, nbnd)) &
80 0 : error_msg = "reduce: bnd_flux_up array incorrectly sized (can't compute net flux either)"
81 : end if
82 1135399 : if(associated(this%bnd_flux_dn)) then
83 389263 : if(.not. extents_are(this%bnd_flux_dn, ncol, nlev, nbnd)) &
84 0 : error_msg = "reduce: bnd_flux_dn array incorrectly sized (can't compute net flux either)"
85 : end if
86 1135399 : if(associated(this%bnd_flux_dn_dir)) then
87 389263 : if(.not. extents_are(this%bnd_flux_dn_dir, ncol, nlev, nbnd)) &
88 0 : error_msg = "reduce: bnd_flux_dn_dir array incorrectly sized"
89 : end if
90 1135399 : if(associated(this%bnd_flux_net)) then
91 389263 : if(.not. extents_are(this%bnd_flux_net, ncol, nlev, nbnd)) &
92 0 : error_msg = "reduce: bnd_flux_net array incorrectly sized (can't compute net flux either)"
93 : end if
94 1135399 : if(error_msg /= "") return
95 : end if
96 : !
97 : ! Self-consistency -- shouldn't be asking for direct beam flux if it isn't supplied
98 1135399 : if(associated(this%bnd_flux_dn_dir) .and. .not. present(gpt_flux_dn_dir)) then
99 0 : error_msg = "reduce: requesting bnd_flux_dn_dir but direct flux hasn't been supplied"
100 0 : return
101 : end if
102 :
103 : ! -------
104 : !$acc enter data copyin(band_lims)
105 : !$omp target enter data map(to:band_lims)
106 : ! Band-by-band fluxes
107 : ! Up flux
108 1135399 : if(associated(this%bnd_flux_up)) then
109 389263 : call sum_byband(ncol, nlev, ngpt, nbnd, band_lims, gpt_flux_up, this%bnd_flux_up )
110 : end if
111 :
112 : ! -------
113 : ! Down flux
114 1135399 : if(associated(this%bnd_flux_dn)) then
115 389263 : call sum_byband(ncol, nlev, ngpt, nbnd, band_lims, gpt_flux_dn, this%bnd_flux_dn )
116 : end if
117 :
118 1135399 : if(associated(this%bnd_flux_dn_dir)) then
119 389263 : call sum_byband(ncol, nlev, ngpt, nbnd, band_lims, gpt_flux_dn_dir, this%bnd_flux_dn_dir)
120 : end if
121 :
122 : ! -------
123 : ! Net flux
124 : !
125 1135399 : if(associated(this%bnd_flux_net)) then
126 : !
127 : ! Reuse down and up results if possible
128 : !
129 389263 : if(associated(this%bnd_flux_dn) .and. associated(this%bnd_flux_up)) then
130 389263 : call net_byband(ncol, nlev, nbnd, this%bnd_flux_dn, this%bnd_flux_up, this%bnd_flux_net)
131 : else
132 0 : call net_byband(ncol, nlev, ngpt, nbnd, band_lims, gpt_flux_dn, gpt_flux_up, this%bnd_flux_net)
133 : end if
134 : end if
135 : !$acc exit data delete(band_lims)
136 : !$omp target exit data map(release:band_lims)
137 : end function reduce_byband
138 : ! --------------------------------------------------------------------------------------
139 : ! Are any fluxes desired from this set of g-point fluxes? We can tell because memory will
140 : ! be allocated for output
141 : !
142 1135399 : function are_desired_byband(this)
143 : class(ty_fluxes_byband), intent(in ) :: this
144 : logical :: are_desired_byband
145 :
146 : are_desired_byband = any([associated(this%bnd_flux_up), &
147 : associated(this%bnd_flux_dn), &
148 : associated(this%bnd_flux_dn_dir), &
149 : associated(this%bnd_flux_net), &
150 4119943 : this%ty_fluxes_broadband%are_desired()])
151 1135399 : end function are_desired_byband
152 :
153 : ! ----------------------------------------------------------------------------
154 : ! Kernels (private to this module)
155 : ! ----------------------------------------------------------------------------
156 : !
157 : ! Spectral reduction over all points
158 : !
159 1167789 : subroutine sum_byband(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux, byband_flux) bind (C)
160 : integer, intent(in ) :: ncol, nlev, ngpt, nbnd
161 : integer, dimension(2, nbnd), intent(in ) :: band_lims
162 : real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux
163 : real(wp), dimension(ncol, nlev, nbnd), intent(out) :: byband_flux
164 :
165 : integer :: icol, ilev, igpt, ibnd
166 : !$acc parallel loop collapse(3) copyin(spectral_flux, band_lims) copyout(byband_flux)
167 : !$omp target teams distribute parallel do collapse(3) map(to:spectral_flux, band_lims) map(from:byband_flux)
168 17516835 : do ibnd = 1, nbnd
169 1570676205 : do ilev = 1, nlev
170 24936145416 : do icol = 1, ncol
171 23366637000 : byband_flux(icol, ilev, ibnd) = spectral_flux(icol, ilev, band_lims(1, ibnd))
172 >18848*10^7 : do igpt = band_lims(1,ibnd)+1, band_lims(2,ibnd)
173 : byband_flux(icol, ilev, ibnd) = byband_flux(icol, ilev, ibnd) + &
174 >18693*10^7 : spectral_flux(icol, ilev, igpt)
175 : end do
176 : end do
177 : end do
178 : enddo
179 1167789 : end subroutine sum_byband
180 : ! ----------------------------------------------------------------------------
181 : !
182 : ! Net flux: Spectral reduction over all points
183 : !
184 0 : subroutine net_byband_full(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux_dn, spectral_flux_up, byband_flux_net) bind (C)
185 : integer, intent(in ) :: ncol, nlev, ngpt, nbnd
186 : integer, dimension(2, nbnd), intent(in ) :: band_lims
187 : real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux_dn, spectral_flux_up
188 : real(wp), dimension(ncol, nlev, nbnd), intent(out) :: byband_flux_net
189 :
190 : integer :: icol, ilev, igpt, ibnd
191 :
192 : !$acc parallel loop collapse(3) copyin(spectral_flux_dn, spectral_flux_up, band_lims) copyout(byband_flux_net)
193 : !$omp target teams distribute parallel do collapse(3) map(to:spectral_flux_dn, spectral_flux_up, band_lims) map(from:byband_flux_net)
194 0 : do ibnd = 1, nbnd
195 0 : do ilev = 1, nlev
196 0 : do icol = 1, ncol
197 0 : igpt = band_lims(1,ibnd)
198 0 : byband_flux_net(icol, ilev, ibnd) = spectral_flux_dn(icol, ilev, igpt) - &
199 0 : spectral_flux_up(icol, ilev, igpt)
200 0 : do igpt = band_lims(1,ibnd)+1, band_lims(2,ibnd)
201 : byband_flux_net(icol, ilev, ibnd) = byband_flux_net(icol, ilev, ibnd) + &
202 0 : spectral_flux_dn(icol, ilev, igpt) - &
203 0 : spectral_flux_up(icol, ilev, igpt)
204 : end do
205 : end do
206 : end do
207 : end do
208 0 : end subroutine net_byband_full
209 : ! ----------------------------------------------------------------------------
210 389263 : subroutine net_byband_precalc(ncol, nlev, nbnd, byband_flux_dn, byband_flux_up, byband_flux_net) bind (C)
211 : integer, intent(in ) :: ncol, nlev, nbnd
212 : real(wp), dimension(ncol, nlev, nbnd), intent(in ) :: byband_flux_dn, byband_flux_up
213 : real(wp), dimension(ncol, nlev, nbnd), intent(out) :: byband_flux_net
214 :
215 8312437735 : byband_flux_net(1:ncol,1:nlev,1:nbnd) = byband_flux_dn(1:ncol,1:nlev,1:nbnd) - byband_flux_up(1:ncol,1:nlev,1:nbnd)
216 389263 : end subroutine net_byband_precalc
217 : ! ----------------------------------------------------------------------------
218 :
219 0 : end module mo_fluxes_byband
|
