source: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/driver/ifs_blocking.F90 @ 5185

Last change on this file since 5185 was 5185, checked in by abarral, 2 months ago

Replace REPROBUS CPP KEY by logical using handmade wonky wrapper
File size: 24.2 KB
Line 
1! ifs_blocking.F90 - Reshuffle ecRad data into an NPROMA-blocked data structure
2
3! (C) Copyright 2022- ECMWF.
4
5! This software is licensed under the terms of the Apache Licence Version 2.0
6! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
7
8! In applying this licence, ECMWF does not waive the privileges and immunities
9! granted to it by virtue of its status as an intergovernmental organisation
10! nor does it submit to any jurisdiction.
11
12! Author:  Balthasar Reuter
13! Email:   balthasar.reuter@ecmwf.int
14!
15
16module ifs_blocking
17
18  use parkind1,                 only : jprb, jpim ! Working precision, integer type
19
20  implicit none
21
22  public
23
24  type :: ifs_config_type
25    ! Offsets in ZRGP
26    integer :: igi, imu0, iamu0, iemiss, its, islm, iccnl,    &
27        &     ibas, itop, igelam, igemu, iclon, islon, iald, ialp, iti, ipr, iqs, iwv, iclc, ilwa,    &
28        &     iiwa, iswa, irwa, irra, idp, ioz, iecpo3, ihpr, iaprs, ihti, iaero, ifrsod, icdir,      &
29        &     ifrted, ifrsodc, ifrtedc, iemit, isudu, iuvdf, iparf, iparcf, itincf, ifdir, ifdif,     &
30        &     ilwderivative, iswdirectband, iswdiffuseband, ifrso, iswfc, ifrth, ilwfc, iaer,         &
31        &     iich4, iin2o, ino2, ic11, ic12, igix, iico2, iccno, ic22, icl4
32    integer :: ire_liq, ire_ice, ioverlap
33    integer :: ifldstot
34  end type ifs_config_type
35
36contains
37
38integer(kind=jpim) function indrad(knext,kflds,lduse)
39
40  integer(kind=jpim), intent(inout) :: knext
41  integer(kind=jpim), intent(in) :: kflds
42  logical, intent(in) :: lduse
43
44  if( lduse ) then
45    indrad=knext
46    knext=knext+kflds
47  else
48    indrad=-99999999
49  endif
50
51end function indrad
52
53subroutine ifs_setup_indices (driver_config, ifs_config, yradiation, nlev)
54
55  use radiation_io,             only : nulout
56  use ecrad_driver_config,      only : driver_config_type
57  use radiation_setup,          only : tradiation
58
59  ! Configuration specific to this driver
60  type(driver_config_type), intent(in)     :: driver_config
61  type(ifs_config_type), intent(inout)     :: ifs_config
62
63  ! Configuration for the radiation scheme, IFS style
64  type(tradiation), intent(inout)          :: yradiation
65
66  integer, intent(inout) :: nlev
67
68  integer :: ifldsin, ifldsout, inext, iinbeg, iinend, ioutbeg, ioutend
69  logical :: llactaero
70  logical :: lldebug
71
72  ! Extract some config values
73  lldebug=(driver_config%iverbose>4)     ! debug
74  llactaero = .false.
75  if(yradiation%rad_config%n_aerosol_types > 0 .AND.&
76    & yradiation%rad_config%n_aerosol_types <= 21 .AND. yradiation%yrerad%naermacc == 0) then
77    llactaero = .true.
78  endif
79
80
81  ! RADINTG
82  !
83
84  !  INITIALISE INDICES FOR VARIABLE
85
86  ! INDRAD is a CONTAIN'd function (now a module function)
87
88  inext  =1
89  iinbeg =1                        ! start of input variables
90  ifs_config%igi    =indrad(inext,1,lldebug)
91  ifs_config%imu0   =indrad(inext,1,.true.)
92  ifs_config%iamu0  =indrad(inext,1,.true.)
93  ifs_config%iemiss =indrad(inext,yradiation%yrerad%nlwemiss,.true.)
94  ifs_config%its    =indrad(inext,1,.true.)
95  ifs_config%islm   =indrad(inext,1,.true.)
96  ifs_config%iccnl  =indrad(inext,1,.true.)
97  ifs_config%iccno  =indrad(inext,1,.true.)
98  ifs_config%ibas   =indrad(inext,1,.true.)
99  ifs_config%itop   =indrad(inext,1,.true.)
100  ifs_config%igelam =indrad(inext,1,.true.)
101  ifs_config%igemu  =indrad(inext,1,.true.)
102  ifs_config%iclon  =indrad(inext,1,.true.)
103  ifs_config%islon  =indrad(inext,1,.true.)
104  ifs_config%iald   =indrad(inext,yradiation%yrerad%nsw,.true.)
105  ifs_config%ialp   =indrad(inext,yradiation%yrerad%nsw,.true.)
106  ifs_config%iti    =indrad(inext,nlev,.true.)
107  ifs_config%ipr    =indrad(inext,nlev,.true.)
108  ifs_config%iqs    =indrad(inext,nlev,.true.)
109  ifs_config%iwv    =indrad(inext,nlev,.true.)
110  ifs_config%iclc   =indrad(inext,nlev,.true.)
111  ifs_config%ilwa   =indrad(inext,nlev,.true.)
112  ifs_config%iiwa   =indrad(inext,nlev,.true.)
113  ifs_config%iswa   =indrad(inext,nlev,.true.)
114  ifs_config%irwa   =indrad(inext,nlev,.true.)
115  ifs_config%irra   =indrad(inext,nlev,.true.)
116  ifs_config%idp    =indrad(inext,nlev,.true.)
117  ifs_config%ioz    =indrad(inext,nlev,.false.)
118  ifs_config%iecpo3 =indrad(inext,nlev ,.false.)
119  ifs_config%ihpr   =indrad(inext,nlev+1,.true.) ! not used in ecrad
120  ifs_config%iaprs  =indrad(inext,nlev+1,.true.)
121  ifs_config%ihti   =indrad(inext,nlev+1,.true.)
122  ifs_config%iaero  =indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,&
123                          & llactaero .AND. yradiation%yrerad%naermacc==0)
124
125  iinend =inext-1                  ! end of input variables
126
127  ioutbeg=inext                    ! start of output variables
128  if (yradiation%yrerad%naermacc == 1) then
129    ifs_config%iaero = indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,&
130                            & yradiation%yrerad%ldiagforcing)
131  endif
132  ifs_config%ifrsod =indrad(inext,1,.true.)
133  ifs_config%ifrted =indrad(inext,yradiation%yrerad%nlwout,.true.)
134  ifs_config%ifrsodc=indrad(inext,1,.true.)
135  ifs_config%ifrtedc=indrad(inext,1,.true.)
136  ifs_config%iemit  =indrad(inext,1,.true.)
137  ifs_config%isudu  =indrad(inext,1,.true.)
138  ifs_config%iuvdf  =indrad(inext,1,.true.)
139  ifs_config%iparf  =indrad(inext,1,.true.)
140  ifs_config%iparcf =indrad(inext,1,.true.)
141  ifs_config%itincf =indrad(inext,1,.true.)
142  ifs_config%ifdir  =indrad(inext,1,.true.)
143  ifs_config%ifdif  =indrad(inext,1,.true.)
144  ifs_config%icdir  =indrad(inext,1,.true.)
145  ifs_config%ilwderivative =indrad(inext,nlev+1, yradiation%yrerad%lapproxlwupdate)
146  ifs_config%iswdirectband =indrad(inext,yradiation%yrerad%nsw,yradiation%yrerad%lapproxswupdate)
147  ifs_config%iswdiffuseband=indrad(inext,yradiation%yrerad%nsw,yradiation%yrerad%lapproxswupdate)
148  ifs_config%ifrso  =indrad(inext,nlev+1,.true.)
149  ifs_config%iswfc  =indrad(inext,nlev+1,.true.)
150  ifs_config%ifrth  =indrad(inext,nlev+1,.true.)
151  ifs_config%ilwfc  =indrad(inext,nlev+1,.true.)
152  ifs_config%iaer   =indrad(inext,6*nlev,yradiation%yrerad%ldiagforcing)
153  ifs_config%ioz    =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
154  ifs_config%iico2  =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
155  ifs_config%iich4  =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
156  ifs_config%iin2o  =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
157  ifs_config%ino2   =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
158  ifs_config%ic11   =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
159  ifs_config%ic12   =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
160  ifs_config%ic22   =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
161  ifs_config%icl4   =indrad(inext,nlev,yradiation%yrerad%ldiagforcing)
162  ifs_config%igix   =indrad(inext,1,lldebug)
163
164  ioutend=inext-1                  ! end of output variables
165
166                                ! start of local variables
167  if(.not.yradiation%yrerad%ldiagforcing) then
168    if (yradiation%rad_config%n_aerosol_types == 0 .or. yradiation%yrerad%naermacc == 1) then
169      ifs_config%iaero = indrad(inext,yradiation%rad_config%n_aerosol_types*nlev,.true.)
170    endif
171    ifs_config%iaer   =indrad(inext,nlev*6,.true.)
172    ifs_config%ioz    =indrad(inext,nlev,.true.)
173    ifs_config%iico2  =indrad(inext,nlev,.true.)
174    ifs_config%iich4  =indrad(inext,nlev,.true.)
175    ifs_config%iin2o  =indrad(inext,nlev,.true.)
176    ifs_config%ino2   =indrad(inext,nlev,.true.)
177    ifs_config%ic11   =indrad(inext,nlev,.true.)
178    ifs_config%ic12   =indrad(inext,nlev,.true.)
179    ifs_config%ic22   =indrad(inext,nlev,.true.)
180    ifs_config%icl4   =indrad(inext,nlev,.true.)
181  endif
182                                ! end of local variables
183
184                                  ! start of standalone inputs workaround variables
185  ifs_config%ire_liq =indrad(inext,nlev,.true.)
186  ifs_config%ire_ice =indrad(inext,nlev,.true.)
187  ifs_config%ioverlap =indrad(inext,nlev-1,.true.)
188                                  ! end of standalone inputs workaround variables
189
190  ifldsin = iinend - iinbeg +1
191  ifldsout= ioutend-ioutbeg +1
192  ifs_config%ifldstot= inext  - 1
193
194  if( lldebug )then
195    write(nulout,'("imu0   =",i0)')ifs_config%imu0
196    write(nulout,'("iamu0  =",i0)')ifs_config%iamu0
197    write(nulout,'("iemiss =",i0)')ifs_config%iemiss
198    write(nulout,'("its    =",i0)')ifs_config%its
199    write(nulout,'("islm   =",i0)')ifs_config%islm
200    write(nulout,'("iccnl  =",i0)')ifs_config%iccnl
201    write(nulout,'("iccno  =",i0)')ifs_config%iccno
202    write(nulout,'("ibas   =",i0)')ifs_config%ibas
203    write(nulout,'("itop   =",i0)')ifs_config%itop
204    write(nulout,'("igelam =",i0)')ifs_config%igelam
205    write(nulout,'("igemu  =",i0)')ifs_config%igemu
206    write(nulout,'("iclon  =",i0)')ifs_config%iclon
207    write(nulout,'("islon  =",i0)')ifs_config%islon
208    write(nulout,'("iald   =",i0)')ifs_config%iald
209    write(nulout,'("ialp   =",i0)')ifs_config%ialp
210    write(nulout,'("iti    =",i0)')ifs_config%iti
211    write(nulout,'("ipr    =",i0)')ifs_config%ipr
212    write(nulout,'("iqs    =",i0)')ifs_config%iqs
213    write(nulout,'("iwv    =",i0)')ifs_config%iwv
214    write(nulout,'("iclc   =",i0)')ifs_config%iclc
215    write(nulout,'("ilwa   =",i0)')ifs_config%ilwa
216    write(nulout,'("iiwa   =",i0)')ifs_config%iiwa
217    write(nulout,'("iswa   =",i0)')ifs_config%iswa
218    write(nulout,'("irwa   =",i0)')ifs_config%irwa
219    write(nulout,'("irra   =",i0)')ifs_config%irra
220    write(nulout,'("idp    =",i0)')ifs_config%idp
221    write(nulout,'("ioz    =",i0)')ifs_config%ioz
222    write(nulout,'("iecpo3 =",i0)')ifs_config%iecpo3
223    write(nulout,'("ihpr   =",i0)')ifs_config%ihpr
224    write(nulout,'("iaprs  =",i0)')ifs_config%iaprs
225    write(nulout,'("ihti   =",i0)')ifs_config%ihti
226    write(nulout,'("ifrsod =",i0)')ifs_config%ifrsod
227    write(nulout,'("ifrted =",i0)')ifs_config%ifrted
228    write(nulout,'("ifrsodc=",i0)')ifs_config%ifrsodc
229    write(nulout,'("ifrtedc=",i0)')ifs_config%ifrtedc
230    write(nulout,'("iemit  =",i0)')ifs_config%iemit
231    write(nulout,'("isudu  =",i0)')ifs_config%isudu
232    write(nulout,'("iuvdf  =",i0)')ifs_config%iuvdf
233    write(nulout,'("iparf  =",i0)')ifs_config%iparf
234    write(nulout,'("iparcf =",i0)')ifs_config%iparcf
235    write(nulout,'("itincf =",i0)')ifs_config%itincf
236    write(nulout,'("ifdir  =",i0)')ifs_config%ifdir
237    write(nulout,'("ifdif  =",i0)')ifs_config%ifdif
238    write(nulout,'("icdir  =",i0)')ifs_config%icdir
239    write(nulout,'("ilwderivative  =",i0)')ifs_config%ilwderivative
240    write(nulout,'("iswdirectband  =",i0)')ifs_config%iswdirectband
241    write(nulout,'("iswdiffuseband =",i0)')ifs_config%iswdiffuseband
242    write(nulout,'("ifrso  =",i0)')ifs_config%ifrso
243    write(nulout,'("iswfc  =",i0)')ifs_config%iswfc
244    write(nulout,'("ifrth  =",i0)')ifs_config%ifrth
245    write(nulout,'("ilwfc  =",i0)')ifs_config%ilwfc
246    write(nulout,'("igi    =",i0)')ifs_config%igi
247    write(nulout,'("iaer   =",i0)')ifs_config%iaer
248    write(nulout,'("iaero  =",i0)')ifs_config%iaero
249    write(nulout,'("iico2  =",i0)')ifs_config%iico2
250    write(nulout,'("iich4  =",i0)')ifs_config%iich4
251    write(nulout,'("iin2o  =",i0)')ifs_config%iin2o
252    write(nulout,'("ino2   =",i0)')ifs_config%ino2
253    write(nulout,'("ic11   =",i0)')ifs_config%ic11
254    write(nulout,'("ic12   =",i0)')ifs_config%ic12
255    write(nulout,'("ic22   =",i0)')ifs_config%ic22
256    write(nulout,'("icl4   =",i0)')ifs_config%icl4
257    write(nulout,'("ire_liq=",i0)')ifs_config%ire_liq
258    write(nulout,'("ire_ice=",i0)')ifs_config%ire_ice
259    write(nulout,'("ioverlap=",i0)')ifs_config%ioverlap
260    write(nulout,'("ifldsin =",i0)')ifldsin
261    write(nulout,'("ifldsout=",i0)')ifldsout
262    write(nulout,'("ifldstot=",i0)')ifs_config%ifldstot
263  endif
264
265end subroutine ifs_setup_indices
266
267subroutine ifs_copy_inputs_to_blocked ( &
268  & driver_config, ifs_config, yradiation, ncol, nlev, &
269  & single_level, thermodynamics, gas, cloud, aerosol, &
270  & sin_latitude, longitude_rad, land_frac, pressure_fl, temperature_fl, &
271  & zrgp, thermodynamics_out, iseed)
272
273  use radiation_single_level,   only : single_level_type
274  use radiation_thermodynamics, only : thermodynamics_type
275  use radiation_gas,            only : gas_type, IMassMixingRatio, &
276        &   IH2O, ICO2, IO3, IN2O, ICH4, ICFC11, ICFC12, IHCFC22, ICCL4
277  use radiation_cloud,          only : cloud_type
278  use radiation_aerosol,        only : aerosol_type
279  use ecrad_driver_config,      only : driver_config_type
280  use radiation_setup,          only : tradiation
281
282  implicit none
283
284  ! Configuration specific to this driver
285  type(driver_config_type), intent(in)     :: driver_config
286
287  type(ifs_config_type), intent(in)     :: ifs_config
288
289  ! Configuration for the radiation scheme, IFS style
290  type(tradiation), intent(in)          :: yradiation
291
292  integer, intent(in) :: ncol, nlev         ! Number of columns and levels
293
294  ! Derived types for the inputs to the radiation scheme
295  type(single_level_type), intent(in)   :: single_level
296  type(thermodynamics_type), intent(in) :: thermodynamics
297  type(gas_type), intent(in)            :: gas
298  type(cloud_type), intent(in)          :: cloud
299  type(aerosol_type), intent(in)        :: aerosol
300
301  ! Additional input data, required for effective radii calculation
302  real(jprb), dimension(:), intent(in)   :: sin_latitude, longitude_rad, land_frac
303  real(jprb), dimension(:,:), intent(in) :: pressure_fl, temperature_fl
304
305  ! monolithic IFS data structure to pass to radiation scheme
306  real(kind=jprb), intent(out), allocatable :: zrgp(:,:,:)
307
308  ! Empty thermodynamics type to store pressure_hl for output at the end
309  type(thermodynamics_type), intent(inout), optional  :: thermodynamics_out
310
311  ! Seed for random number generator
312  integer, intent(out), allocatable, optional :: iseed(:,:)
313
314  ! number of column blocks, block size
315  integer :: ngpblks, nproma
316
317  integer :: jrl, ibeg, iend, il, ib, ifld, jemiss, jalb, jlev, joff, jaer
318
319  ! Extract some config values
320  nproma=driver_config%nblocksize        ! nproma size
321  ngpblks=(ncol-1)/nproma+1              ! number of column blocks
322
323  ! Allocate blocked data structure
324  allocate(zrgp(nproma,ifs_config%ifldstot,ngpblks))
325  if(present(thermodynamics_out)) allocate(thermodynamics_out%pressure_hl(ncol,nlev+1))
326  if(present(iseed)) allocate(iseed(nproma,ngpblks))
327
328  ! First touch
329  !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
330  !$OMP&PRIVATE(IB,IFLD)
331  DO ib=1,ngpblks
332    DO ifld=1,ifs_config%ifldstot
333      zrgp(:,ifld,ib) = 0._jprb
334    enddo
335    if(present(iseed)) iseed(:,ib) = 0
336  enddo
337  !$OMP END PARALLEL DO
338
339  associate(yderad=>yradiation%yrerad, rad_config=>yradiation%rad_config)
340
341    ! REPLACED ich4 with iich4 due to clash
342    ! REPLACED in2o with iin2o due to clash
343    ! REPLACED ico2 with iico2 due to clash
344
345    !  -------------------------------------------------------
346
347    !  INPUT LOOP
348
349    !  -------------------------------------------------------
350
351    !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
352    !$OMP&PRIVATE(JRL,IBEG,IEND,IL,IB,JAER,JOFF,JLEV,JALB)
353    DO jrl=1,ncol,nproma
354
355      ibeg=jrl
356      iend=min(ibeg+nproma-1,ncol)
357      il=iend-ibeg+1
358      ib=(jrl-1)/nproma+1
359
360      !* RADINTG:  3.      PREPARE INPUT ARRAYS
361
362      ! zrgp(1:il,imu0,ib)  = ???
363      zrgp(1:il,ifs_config%iamu0,ib)  =  single_level%cos_sza(ibeg:iend)   ! cosine of solar zenith ang (mu0)
364
365      DO jemiss=1,yderad%nlwemiss
366        zrgp(1:il,ifs_config%iemiss+jemiss-1,ib)  =  single_level%lw_emissivity(ibeg:iend,jemiss)
367      enddo
368
369      zrgp(1:il,ifs_config%its,ib)      = single_level%skin_temperature(ibeg:iend)  ! skin temperature
370      zrgp(1:il,ifs_config%islm,ib)     = land_frac(ibeg:iend) ! land-sea mask
371      zrgp(1:il,ifs_config%iccnl,ib)    = yderad%rccnlnd ! CCN over land
372      zrgp(1:il,ifs_config%iccno,ib)    = yderad%rccnsea ! CCN over sea
373      ! zrgp(1:il,ibas,ib)     = ???
374      ! zrgp(1:il,itop,ib)     = ???
375      zrgp(1:il,ifs_config%igelam,ib)   = longitude_rad(ibeg:iend) ! longitude
376      zrgp(1:il,ifs_config%igemu,ib)    = sin_latitude(ibeg:iend) ! sine of latitude
377      ! zrgp(1:il,iclon,ib)    = ???
378      ! zrgp(1:il,islon,ib)    = ???
379
380      DO jalb=1,yderad%nsw
381        zrgp(1:il,ifs_config%iald+jalb-1,ib)  =  single_level%sw_albedo(ibeg:iend,jalb)
382      enddo
383
384      if (allocated(single_level%sw_albedo_direct)) then
385        DO jalb=1,yderad%nsw
386          zrgp(1:il,ifs_config%ialp+jalb-1,ib)  =  single_level%sw_albedo_direct(ibeg:iend,jalb)
387        end do
388      else
389        DO jalb=1,yderad%nsw
390          zrgp(1:il,ifs_config%ialp+jalb-1,ib)  =  single_level%sw_albedo(ibeg:iend,jalb)
391        end do
392      end if
393     
394      DO jlev=1,nlev
395        zrgp(1:il,ifs_config%iti+jlev-1,ib)   = temperature_fl(ibeg:iend,jlev) ! full level temperature
396        zrgp(1:il,ifs_config%ipr+jlev-1,ib)   = pressure_fl(ibeg:iend,jlev) ! full level pressure
397        ! zrgp(1:il,iqs+jlev-1,ib)   = ???
398      enddo
399
400      DO jlev=1,nlev
401        zrgp(1:il,ifs_config%iwv+jlev-1,ib)   = gas%mixing_ratio(ibeg:iend,jlev,IH2O) ! this is already in MassMixingRatio units
402        if (rad_config%do_clouds) then
403          zrgp(1:il,ifs_config%iclc+jlev-1,ib)  = cloud%fraction(ibeg:iend,jlev)
404          zrgp(1:il,ifs_config%ilwa+jlev-1,ib)  = cloud%q_liq(ibeg:iend,jlev)
405          zrgp(1:il,ifs_config%iiwa+jlev-1,ib)  = cloud%q_ice(ibeg:iend,jlev)
406        else
407          zrgp(1:il,ifs_config%iclc+jlev-1,ib)  = 0._jprb
408          zrgp(1:il,ifs_config%ilwa+jlev-1,ib)  = 0._jprb
409          zrgp(1:il,ifs_config%iiwa+jlev-1,ib)  = 0._jprb
410        endif
411        zrgp(1:il,ifs_config%iswa+jlev-1,ib)  = 0._jprb  ! snow
412        zrgp(1:il,ifs_config%irwa+jlev-1,ib)  = 0._jprb  ! rain
413
414        ! zrgp(1:il,irra+jlev-1,ib)  = ???
415        ! zrgp(1:il,idp+jlev-1,ib)   = ???
416        ! zrgp(1:il,ifsd+jlev-1,ib)   = ???
417        ! zrgp(1:il,iecpo3+jlev-1,ib) = ???
418      enddo
419
420      zrgp(1:il,ifs_config%iaer:ifs_config%iaer+nlev,ib)  =  0._jprb ! old aerosol, not used
421      if (yderad%naermacc == 1) then
422        joff=ifs_config%iaero
423        DO jaer=1,rad_config%n_aerosol_types
424          DO jlev=1,nlev
425            zrgp(1:il,joff,ib) = aerosol%mixing_ratio(ibeg:iend,jlev,jaer)
426            joff=joff+1
427          enddo
428        enddo
429      endif
430
431      DO jlev=1,nlev+1
432        ! zrgp(1:il,ihpr+jlev-1,ib)  = ???
433        zrgp(1:il,ifs_config%iaprs+jlev-1,ib) = thermodynamics%pressure_hl(ibeg:iend,jlev)
434        zrgp(1:il,ifs_config%ihti+jlev-1,ib)  = thermodynamics%temperature_hl(ibeg:iend,jlev)
435      enddo
436
437      ! -- by default, globally averaged concentrations (mmr)
438      call gas%get(ICO2, IMassMixingRatio, zrgp(1:il,ifs_config%iico2:ifs_config%iico2+nlev-1,ib), istartcol=ibeg)
439      call gas%get(ICH4, IMassMixingRatio, zrgp(1:il,ifs_config%iich4:ifs_config%iich4+nlev-1,ib), istartcol=ibeg)
440      call gas%get(IN2O, IMassMixingRatio, zrgp(1:il,ifs_config%iin2o:ifs_config%iin2o+nlev-1,ib), istartcol=ibeg)
441      call gas%get(ICFC11, IMassMixingRatio, zrgp(1:il,ifs_config%ic11:ifs_config%ic11+nlev-1,ib), istartcol=ibeg)
442      call gas%get(ICFC12, IMassMixingRatio, zrgp(1:il,ifs_config%ic12:ifs_config%ic12+nlev-1,ib), istartcol=ibeg)
443      call gas%get(IHCFC22,IMassMixingRatio, zrgp(1:il,ifs_config%ic22:ifs_config%ic22+nlev-1,ib), istartcol=ibeg)
444      call gas%get(ICCL4,  IMassMixingRatio, zrgp(1:il,ifs_config%icl4:ifs_config%icl4+nlev-1,ib), istartcol=ibeg)
445      call gas%get(IO3, IMassMixingRatio, zrgp(1:il,ifs_config%ioz:ifs_config%ioz+nlev-1,ib), istartcol=ibeg)
446      ! convert ozone kg/kg to Pa*kg/kg
447      ! do jlev=1,nlev
448      !   zrgp(1:il,ifs_config%ioz+jlev-1,ib)  = zrgp(1:il,ifs_config%ioz+jlev-1,ib) &
449      !         &                       * (thermodynamics%pressure_hl(ibeg:iend,jlev+1) &
450      !         &                         - thermodynamics%pressure_hl(ibeg:iend,jlev))
451      ! enddo
452
453      ! local workaround variables for standalone input files
454      if (rad_config%do_clouds) then
455        DO jlev=1,nlev
456          ! missing full-level temperature and pressure as well as land-sea-mask
457          zrgp(1:il,ifs_config%ire_liq+jlev-1,ib) = cloud%re_liq(ibeg:iend,jlev)
458          zrgp(1:il,ifs_config%ire_ice+jlev-1,ib) = cloud%re_ice(ibeg:iend,jlev)
459        enddo
460        DO jlev=1,nlev-1
461          ! for the love of it, I can't figure this one out. Probably to do with
462          ! my crude approach of setting PGEMU?
463          zrgp(1:il,ifs_config%ioverlap+jlev-1,ib) = cloud%overlap_param(ibeg:iend,jlev)
464        enddo
465        if(present(iseed)) iseed(1:il,ib) = single_level%iseed(ibeg:iend)
466      else
467        DO jlev=1,nlev
468          ! missing full-level temperature and pressure as well as land-sea-mask
469          zrgp(1:il,ifs_config%ire_liq+jlev-1,ib) = 0._jprb
470          zrgp(1:il,ifs_config%ire_ice+jlev-1,ib) = 0._jprb
471        enddo
472        DO jlev=1,nlev-1
473          zrgp(1:il,ifs_config%ioverlap+jlev-1,ib) = 0._jprb
474        enddo
475        if(present(iseed)) iseed(1:il,ib) = 0
476      endif ! do_clouds
477    enddo
478    !$OMP END PARALLEL DO
479
480    ! Store pressure for output
481    if(present(thermodynamics_out)) thermodynamics_out%pressure_hl(:,:) = thermodynamics%pressure_hl(:,:)
482
483  end associate
484
485end subroutine ifs_copy_inputs_to_blocked
486
487subroutine ifs_copy_fluxes_from_blocked(&
488    & driver_config, ifs_config, yradiation, ncol, nlev,&
489    & zrgp, flux, flux_sw_direct_normal, flux_uv, flux_par, flux_par_clear,&
490    & emissivity_out, flux_diffuse_band, flux_direct_band)
491  use ecrad_driver_config,      only : driver_config_type
492  use radiation_setup,          only : tradiation
493  use radiation_flux,           only : flux_type
494
495  ! Configuration specific to this driver
496  type(driver_config_type), intent(in)     :: driver_config
497
498  type(ifs_config_type), intent(in)     :: ifs_config
499
500  ! Configuration for the radiation scheme, IFS style
501  type(tradiation), intent(in)          :: yradiation
502
503  integer, intent(in) :: ncol, nlev         ! Number of columns and levels
504
505  ! monolithic IFS data structure passed to radiation scheme
506  real(kind=jprb), intent(inout), allocatable :: zrgp(:,:,:)
507
508  ! Derived type containing outputs from the radiation scheme
509  type(flux_type), intent(inout)              :: flux
510
511  ! Additional output fluxes as arrays
512  real(jprb), dimension(:), intent(inout)     :: flux_sw_direct_normal, flux_uv, flux_par,&
513                                                 & flux_par_clear, emissivity_out
514  real(jprb), dimension(:,:), intent(inout) :: flux_diffuse_band, flux_direct_band
515
516  ! number of column blocks, block size
517  integer :: ngpblks, nproma
518
519  integer :: jrl, ibeg, iend, il, ib, jlev, jg
520
521  ! Extract some config values
522  nproma=driver_config%nblocksize        ! nproma size
523  ngpblks=(ncol-1)/nproma+1              ! number of column blocks
524
525    !  -------------------------------------------------------
526
527    !  OUTPUT LOOP
528
529    !  -------------------------------------------------------
530
531    !$OMP PARALLEL DO SCHEDULE(RUNTIME)&
532    !$OMP&PRIVATE(JRL,IBEG,IEND,IL,IB,JLEV,JG)
533    DO jrl=1,ncol,nproma
534      ibeg=jrl
535      iend=min(ibeg+nproma-1,ncol)
536      il=iend-ibeg+1
537      ib=(jrl-1)/nproma+1
538
539      DO jlev=1,nlev+1
540        flux%sw_up(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ifrso+jlev-1,ib)
541        flux%lw_up(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ifrth+jlev-1,ib)
542        flux%sw_up_clear(ibeg:iend,jlev) = zrgp(1:il,ifs_config%iswfc+jlev-1,ib)
543        flux%lw_up_clear(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ilwfc+jlev-1,ib)
544        if (yradiation%yrerad%lapproxlwupdate) then
545          flux%lw_derivatives(ibeg:iend,jlev) = zrgp(1:il,ifs_config%ilwderivative+jlev-1,ib)
546        else
547          flux%lw_derivatives(ibeg:iend,jlev) = 0.0_jprb
548        endif
549      end do
550      flux%sw_dn(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%ifrsod,ib)
551      flux%lw_dn(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%ifrted,ib)
552      flux%sw_dn_clear(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%ifrsodc,ib)
553      flux%lw_dn_clear(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%ifrtedc,ib)
554      flux%sw_dn_direct(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%ifdir,ib)
555      flux%sw_dn_direct_clear(ibeg:iend,nlev+1) = zrgp(1:il,ifs_config%icdir,ib)
556      flux_sw_direct_normal(ibeg:iend) = zrgp(1:il,ifs_config%isudu,ib)
557      flux_uv(ibeg:iend) = zrgp(1:il,ifs_config%iuvdf,ib)
558      flux_par(ibeg:iend) = zrgp(1:il,ifs_config%iparf,ib)
559      flux_par_clear(ibeg:iend) = zrgp(1:il,ifs_config%iparcf,ib)
560      flux%sw_dn(ibeg:iend,1) = zrgp(1:il,ifs_config%itincf,ib)
561      emissivity_out(ibeg:iend) = zrgp(1:il,ifs_config%iemit,ib)
562      if (yradiation%yrerad%lapproxswupdate) then
563        DO jg=1,yradiation%yrerad%nsw
564          flux_diffuse_band(ibeg:iend,jg) = zrgp(1:il,ifs_config%iswdiffuseband+jg-1,ib)
565          flux_direct_band(ibeg:iend,jg) = zrgp(1:il,ifs_config%iswdirectband+jg-1,ib)
566        end do
567      else
568        flux_diffuse_band(ibeg:iend,:) = 0.0_jprb
569        flux_direct_band(ibeg:iend,:) = 0.0_jprb
570      endif
571    end do
572
573    deallocate(zrgp)
574
575end subroutine ifs_copy_fluxes_from_blocked
576
577end module ifs_blocking
Note: See TracBrowser for help on using the repository browser.