source: LMDZ6/trunk/libf/phylmd/ecrad/radiation_scheme.F90 @ 4553

Last change on this file since 4553 was 4543, checked in by idelkadi, 15 months ago

Configuration of the parameters for the SPARTACUS solver so that they can be modified in the namelist file:

  • addition of the module setup_config_from_lmdz.F90
  • modification of the interface with Ecrad (radiation_scheme.F90)
File size: 28.6 KB
Line 
1! AI mars 2021
2! ====================== Interface between ECRAD and LMDZ ====================
3! radiation_scheme.F90 appelee dans radlwsw_m.F90 si iflag_rttm = 2
4! revoir toutes les parties avec "AI ATTENTION"
5! Mars 2021 :
6!             - Revoir toutes les parties commentees AI ATTENTION
7!             1. Traitement des aerosols
8!             2. Verifier les parametres times issus de LMDZ (calcul issed)
9!             3. Configuration a partir de namelist
10!             4. frac_std = 0.75     
11! ============================================================================
12
13SUBROUTINE RADIATION_SCHEME &
14! Inputs
15     & (KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW, &
16     &  IDAY, TIME, &
17     &  PSOLAR_IRRADIANCE, &
18     &  PMU0, PTEMPERATURE_SKIN, &
19     &  PALBEDO_DIF, PALBEDO_DIR, &
20     &  PEMIS, PEMIS_WINDOW, &
21     &  PGELAM, PGEMU, &
22     &  PPRESSURE_H, PTEMPERATURE_H, PQ, PQSAT, &
23     &  PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, &
24     &  PCCL4, PO3, PO2, &
25     &  PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW, &
26     &  ZRE_LIQUID_UM, ZRE_ICE_UM, &
27     &  PAEROSOL_OLD, PAEROSOL, &
28! Outputs
29     &  PFLUX_SW, PFLUX_LW, PFLUX_SW_CLEAR, PFLUX_LW_CLEAR, &
30     &  PFLUX_SW_DN, PFLUX_LW_DN, PFLUX_SW_DN_CLEAR, PFLUX_LW_DN_CLEAR, &
31     &  PFLUX_SW_UP, PFLUX_LW_UP, PFLUX_SW_UP_CLEAR, PFLUX_LW_UP_CLEAR, &
32     &  PFLUX_DIR, PFLUX_DIR_CLEAR, PFLUX_DIR_INTO_SUN, &
33     &  PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, &
34     &  PEMIS_OUT, PLWDERIVATIVE, &
35     &  PSWDIFFUSEBAND, PSWDIRECTBAND)
36
37
38! RADIATION_SCHEME - Interface to modular radiation scheme
39!
40! (C) Copyright 2015- ECMWF.
41!
42! This software is licensed under the terms of the Apache Licence Version 2.0
43! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
44!
45! In applying this licence, ECMWF does not waive the privileges and immunities
46! granted to it by virtue of its status as an intergovernmental organisation
47! nor does it submit to any jurisdiction.
48!
49! PURPOSE
50! -------
51!   The modular radiation scheme is contained in a separate
52!   library. This routine puts the the IFS arrays into appropriate
53!   objects, computing the additional data that is required, and sends
54!   it to the radiation scheme.  It returns net fluxes and surface
55!   flux components needed by the rest of the model.
56!
57!   Lower case is used for variables and types taken from the
58!   radiation library
59!
60! INTERFACE
61! ---------
62!    RADIATION_SCHEME is called from RADLSWR. The
63!    SETUP_RADIATION_SCHEME routine (in the RADIATION_SETUP module)
64!    should have been run first.
65!
66! AUTHOR
67! ------
68!   Robin Hogan, ECMWF
69!   Original: 2015-09-16
70!
71! MODIFICATIONS
72! -------------
73!
74! TO DO
75! -----
76!
77!-----------------------------------------------------------------------
78
79! Modules from ifs or ifsaux libraries
80USE PARKIND1 , ONLY : JPIM, JPRB
81USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
82! AI ATTENTION module propre a ifs commentes
83!USE YOERAD   , ONLY : YRERAD
84USE RADIATION_SETUP, ONLY : SETUP_RADIATION_SCHEME, rad_config, &
85!USE RADIATION_SETUP, ONLY : &
86     &  NWEIGHT_UV,  IBAND_UV,  WEIGHT_UV, &
87     &  NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
88     &  ITYPE_TROP_BG_AER,  TROP_BG_AER_MASS_EXT, &
89     &  ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT, ISolverSpartacus
90! Commentes : jour, date de la simulation
91!USE YOMRIP0  , ONLY : NINDAT
92!USE YOMCT3   , ONLY : NSTEP
93!USE YOMRIP   , ONLY : YRRIP
94USE YOMCST   , ONLY : RSIGMA ! Stefan-Boltzmann constant
95
96! Modules from radiation library
97USE radiation_single_level,   ONLY : single_level_type
98USE radiation_thermodynamics, ONLY : thermodynamics_type
99USE radiation_gas
100USE radiation_cloud,          ONLY : cloud_type
101USE radiation_aerosol,        ONLY : aerosol_type
102USE radiation_flux,           ONLY : flux_type
103USE radiation_interface,      ONLY : radiation, set_gas_units
104USE radiation_save,           ONLY : save_inputs
105
106USE mod_phys_lmdz_para
107USE setup_config_from_lmdz,   ONLY : driver_config_type
108
109IMPLICIT NONE
110
111! INPUT ARGUMENTS
112! *** Array dimensions and ranges
113INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA    ! Start column to process
114INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA    ! End column to process
115!INTEGER, INTENT(IN) :: KIDIA, KFDIA
116INTEGER(KIND=JPIM),INTENT(IN) :: KLON     ! Number of columns
117INTEGER(KIND=JPIM),INTENT(IN) :: KLEV     ! Number of levels
118!INTEGER, INTENT(IN) :: KLON, KLEV
119!INTEGER(KIND=JPIM),INTENT(IN) :: KAEROLMDZ ! Number of aerosol types
120INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL
121INTEGER(KIND=JPIM),INTENT(IN) :: NSW ! Numbe of bands
122
123! AI ATTENTION
124!INTEGER, PARAMETER :: KAEROSOL = 12
125
126! *** Single-level fields
127REAL(KIND=JPRB),   INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2)
128REAL(KIND=JPRB),   INTENT(IN) :: PMU0(KLON) ! Cosine of solar zenith ang
129REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE_SKIN(KLON) ! (K)
130! Diffuse and direct components of surface shortwave albedo
131!REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIF(KLON,YRERAD%NSW)
132!REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIR(KLON,YRERAD%NSW)
133REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIF(KLON,NSW)
134REAL(KIND=JPRB),   INTENT(IN) :: PALBEDO_DIR(KLON,NSW)
135! Longwave emissivity outside and inside the window region
136REAL(KIND=JPRB),   INTENT(IN) :: PEMIS(KLON)
137REAL(KIND=JPRB),   INTENT(IN) :: PEMIS_WINDOW(KLON)
138! Longitude (radians), sine of latitude
139REAL(KIND=JPRB),   INTENT(IN) :: PGELAM(KLON)
140REAL(KIND=JPRB),   INTENT(IN) :: PGEMU(KLON)
141! Land-sea mask
142!REAL(KIND=JPRB),   INTENT(IN) :: PLAND_SEA_MASK(KLON)
143
144! *** Variables on full levels
145!REAL(KIND=JPRB),   INTENT(IN) :: PPRESSURE(KLON,KLEV)    ! (Pa)
146!REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
147! *** Variables on half levels
148REAL(KIND=JPRB),   INTENT(IN) :: PPRESSURE_H(KLON,KLEV+1)    ! (Pa)
149REAL(KIND=JPRB),   INTENT(IN) :: PTEMPERATURE_H(KLON,KLEV+1) ! (K)
150
151! *** Gas mass mixing ratios on full levels
152REAL(KIND=JPRB),   INTENT(IN) :: PQ(KLON,KLEV)
153! AI
154REAL(KIND=JPRB),   INTENT(IN) :: PQSAT(KLON,KLEV)
155REAL(KIND=JPRB),   INTENT(IN) :: PCO2
156REAL(KIND=JPRB),   INTENT(IN) :: PCH4
157REAL(KIND=JPRB),   INTENT(IN) :: PN2O
158REAL(KIND=JPRB),   INTENT(IN) :: PNO2
159REAL(KIND=JPRB),   INTENT(IN) :: PCFC11
160REAL(KIND=JPRB),   INTENT(IN) :: PCFC12
161REAL(KIND=JPRB),   INTENT(IN) :: PHCFC22
162REAL(KIND=JPRB),   INTENT(IN) :: PCCL4
163REAL(KIND=JPRB),   INTENT(IN) :: PO3(KLON,KLEV) ! AI (kg/kg) ATTENTION (Pa*kg/kg)
164REAL(KIND=JPRB),   INTENT(IN) :: PO2
165
166! *** Cloud fraction and hydrometeor mass mixing ratios
167REAL(KIND=JPRB),   INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
168REAL(KIND=JPRB),   INTENT(IN) :: PQ_LIQUID(KLON,KLEV)
169REAL(KIND=JPRB),   INTENT(IN) :: PQ_ICE(KLON,KLEV)
170!REAL(KIND=JPRB),   INTENT(IN) :: PQ_RAIN(KLON,KLEV)
171REAL(KIND=JPRB),   INTENT(IN) :: PQ_SNOW(KLON,KLEV)
172
173! *** Aerosol mass mixing ratios
174REAL(KIND=JPRB),   INTENT(IN) :: PAEROSOL_OLD(KLON,6,KLEV)
175REAL(KIND=JPRB),   INTENT(IN) :: PAEROSOL(KLON,KLEV,KAEROSOL)
176
177!REAL(KIND=JPRB),   INTENT(IN) :: PCCN_LAND(KLON)
178!REAL(KIND=JPRB),   INTENT(IN) :: PCCN_SEA(KLON)
179
180!AI mars 2021
181INTEGER(KIND=JPIM), INTENT(IN) :: IDAY
182REAL(KIND=JPRB), INTENT(IN)    :: TIME
183
184
185! OUTPUT ARGUMENTS
186
187! *** Net fluxes on half-levels (W m-2)
188REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW(KLON,KLEV+1)
189REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW(KLON,KLEV+1)
190REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_CLEAR(KLON,KLEV+1)
191REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_CLEAR(KLON,KLEV+1)
192
193!*** DN and UP flux on half-levels (W m-2)
194REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN(KLON,KLEV+1)
195REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN(KLON,KLEV+1)
196REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_CLEAR(KLON,KLEV+1)
197REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_CLEAR(KLON,KLEV+1)
198REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP(KLON,KLEV+1)
199REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP(KLON,KLEV+1)
200REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_CLEAR(KLON,KLEV+1)
201REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_CLEAR(KLON,KLEV+1)
202
203! *** Surface flux components (W m-2)
204! AI ATTENTION
205!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_SURF(KLON)
206!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_SURF(KLON)
207!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_CLEAR_SURF(KLON)
208!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_CLEAR_SURF(KLON)
209!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_SURF(KLON)
210!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_SURF(KLON)
211!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_CLEAR_SURF(KLON)
212!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_CLEAR_SURF(KLON)
213
214! Direct component of surface flux into horizontal plane
215REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR(KLON)
216REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR_CLEAR(KLON)
217! As PFLUX_DIR but into a plane perpendicular to the sun
218REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_DIR_INTO_SUN(KLON)
219
220! *** Ultraviolet and photosynthetically active radiation (W m-2)
221REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_UV(KLON)
222REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_PAR(KLON)
223REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_PAR_CLEAR(KLON)
224
225! *** Other single-level diagnostics
226! Top-of-atmosphere incident solar flux (W m-2)
227! AI ATTENTION
228!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_DN_TOA(KLON)
229!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_SW_UP_TOA(KLON)
230!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_DN_TOA(KLON)
231!REAL(KIND=JPRB),  INTENT(OUT) :: PFLUX_LW_UP_TOA(KLON)
232
233! Diagnosed longwave surface emissivity across the whole spectrum
234REAL(KIND=JPRB),  INTENT(OUT) :: PEMIS_OUT(KLON)   
235
236! Partial derivative of total-sky longwave upward flux at each level
237! with respect to upward flux at surface, used to correct heating
238! rates at gridpoints/timesteps between calls to the full radiation
239! scheme.  Note that this version uses the convention of level index
240! increasing downwards, unlike the local variable ZLwDerivative that
241! is returned from the LW radiation scheme.
242REAL(KIND=JPRB),  INTENT(OUT) :: PLWDERIVATIVE(KLON,KLEV+1)
243
244! Surface diffuse and direct downwelling shortwave flux in each
245! shortwave albedo band, used in RADINTG to update the surface fluxes
246! accounting for high-resolution albedo information
247REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIFFUSEBAND(KLON,NSW)
248REAL(KIND=JPRB),  INTENT(OUT) :: PSWDIRECTBAND (KLON,NSW)
249
250! LOCAL VARIABLES
251! AI ATTENTION
252!type(config_type)         :: rad_config
253TYPE(single_level_type)   :: single_level
254TYPE(thermodynamics_type) :: thermodynamics
255TYPE(gas_type)            :: gas
256TYPE(cloud_type)          :: cloud
257TYPE(aerosol_type)        :: aerosol
258TYPE(flux_type)           :: flux
259
260! Mass mixing ratio of ozone (kg/kg)
261REAL(KIND=JPRB)           :: ZO3(KLON,KLEV)
262
263! Cloud effective radii in microns
264REAL(KIND=JPRB)           :: ZRE_LIQUID_UM(KLON,KLEV)
265REAL(KIND=JPRB)           :: ZRE_ICE_UM(KLON,KLEV)
266
267! Cloud overlap decorrelation length for cloud boundaries in km
268REAL(KIND=JPRB)           :: ZDECORR_LEN_KM(KLON)
269
270! Ratio of cloud overlap decorrelation length for cloud water
271! inhomogeneities to that for cloud boundaries (typically 0.5)
272!REAL(KIND=JPRB)           :: ZDECORR_LEN_RATIO = 0.5_jprb
273
274!AI mai 2023
275! A mettre dans namelist
276!real(jprb) :: high_inv_effective_size
277!real(jprb) :: middle_inv_effective_size
278!real(jprb) :: low_inv_effective_size
279
280!real(jprb) :: cloud_inhom_separation_factor
281!real(jprb) :: cloud_separation_scale_surface
282!real(jprb) :: cloud_separation_scale_toa
283!real(jprb) :: cloud_separation_scale_power
284
285! The surface net longwave flux if the surface was a black body, used
286! to compute the effective broadband surface emissivity
287REAL(KIND=JPRB)           :: ZBLACK_BODY_NET_LW(KIDIA:KFDIA)
288
289! Layer mass in kg m-2
290REAL(KIND=JPRB)           :: ZLAYER_MASS(KIDIA:KFDIA,KLEV)
291
292! Time integers
293INTEGER :: ITIM
294
295! Loop indices
296INTEGER :: JLON, JLEV, JBAND, JB_ALBEDO, JAER
297
298REAL(KIND=JPRB) :: ZHOOK_HANDLE
299
300! AI ATTENTION traitement aerosols
301INTEGER, PARAMETER :: NAERMACC = 1
302
303! AI ATTENTION
304! A mettre dans namelist
305!real(jprb), parameter    :: frac_std = 0.75
306
307! Name of file names specified on command line
308character(len=512) :: file_name
309
310logical :: loutput=.true.
311logical :: lprint_input=.false.
312logical :: lprint_config=.false.
313logical, save :: debut_ecrad=.true.
314!$OMP THREADPRIVATE(debut_ecrad)
315
316type(driver_config_type) :: driver_config
317! Import time functions for iseed calculation
318! AI ATTENTION propre a ifs
319!#include "fcttim.func.h"
320!#include "liquid_effective_radius.intfb.h"
321!#include "ice_effective_radius.intfb.h"
322!#include "cloud_overlap_decorr_len.intfb.h"
323!#include "satur.intfb.h"
324
325! Verifier les inputs
326print*,'=============== dans radiation_scheme : ==================='
327if (lprint_input) then
328  print*,'********** Verification des entrees *************'
329  print*,'KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW =', &
330        KIDIA, KFDIA, KLON, KLEV, KAEROSOL, NSW
331  print*,'IDAY, TIME =', IDAY, TIME
332  print*,'PSOLAR_IRRADIANCE =', PSOLAR_IRRADIANCE
333  print*,'PMU0 =', PMU0
334  print*,'PTEMPERATURE_SKIN =',PTEMPERATURE_SKIN
335  print*,'PEMIS, PEMIS_WINDOW =', PEMIS, PEMIS_WINDOW
336  print*,'PGELAM, PGEMU =', PGELAM, PGEMU
337  print*,'PPRESSURE_H =', PPRESSURE_H
338  print*,'PTEMPERATURE_H =', PTEMPERATURE_H
339  print*,'PQ =', PQ
340  print*,'PQSAT=',PQSAT
341  print*,'PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4 =', &
342        PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4
343  print*,'PO3 =',PO3
344  print*,'PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW =', &
345        PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_SNOW
346  print*,'ZRE_LIQUID_UM, ZRE_ICE_UM =', &
347        ZRE_LIQUID_UM, ZRE_ICE_UM
348  print*,'PAEROSOL_OLD, PAEROSOL =', PAEROSOL_OLD, PAEROSOL
349endif
350
351IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',0,ZHOOK_HANDLE)
352print*,'Entree dans radiation_scheme'
353
354!$OMP MASTER
355if (debut_ecrad) then
356! AI appel radiation_setup
357call SETUP_RADIATION_SCHEME(loutput)
358
359 if (lprint_config) then
360  print*,'************* Parametres de configuration  ********************'
361  print*,'rad_config%iverbosesetup = ',rad_config%iverbosesetup
362  print*,'rad_config%iverbose = ',rad_config%iverbose
363  print*,'rad_config%directory_name =', rad_config%directory_name
364  print*,'rad_config%do_lw_derivatives =',rad_config%do_lw_derivatives
365  print*,'rad_config%do_surface_sw_spectral_flux =', &
366        rad_config%do_surface_sw_spectral_flux
367  print*,'rad_config%do_setup_ifsrrtm =', rad_config%do_setup_ifsrrtm
368  print*,'rad_config%i_liq_model =',rad_config%i_liq_model
369  print*,'rad_config%i_ice_model =',rad_config%i_ice_model
370  print*,'rad_config%i_overlap_scheme =', rad_config%i_overlap_scheme
371  print*,'rad_config%use_aerosols = ', rad_config%use_aerosols
372  print*,'rad_config%n_aerosol_types = ', rad_config%n_aerosol_types
373  print*,'rad_config%i_solver_lw =',rad_config%i_solver_lw
374  print*,'rad_config%i_solver_sw =',rad_config%i_solver_sw
375  print*,'rad_config%do_3d_effects =', rad_config%do_3d_effects
376  print*,'rad_config%do_sw_delta_scaling_with_gases =', &
377       rad_config%do_sw_delta_scaling_with_gases
378  print*,'rad_config%do_lw_aerosol_scattering =', &
379       rad_config%do_lw_aerosol_scattering
380  print*,'rad_config%i_albedo_from_band_sw = ', &
381       rad_config%i_albedo_from_band_sw
382  print*,'n_bands_lw =', rad_config%n_bands_lw
383  print*,'rad_config%i_emiss_from_band_lw =', rad_config%i_emiss_from_band_lw
384 endif
385 debut_ecrad=.false.
386endif
387!$OMP END MASTER
388!$OMP BARRIER
389! Fin partie initialisation et configuration
390
391! AI : allocation des tableaux pour chaque partie (thermo, ...)
392!      passage des champs LMDZ aux structures Ecrad
393!      calculs Ecrad
394! AI ATTENTION
395! Allocate memory in radiation objects
396! emissivite avec une seule bande
397CALL single_level%allocate(KLON, NSW, 1, &
398     &                     use_sw_albedo_direct=.TRUE.)
399
400print*,'************* THERMO (allocate + input) ************************************'
401! Set thermodynamic profiles: simply copy over the half-level
402! pressure and temperature
403!print*,'Appel allocate thermo'
404CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
405!print*,'Definir les champs thermo'
406! AI
407! pressure_hl > paprs
408! temperature_hl calculee dans radlsw de la meme facon que pour RRTM
409thermodynamics%pressure_hl   (KIDIA:KFDIA,:) = PPRESSURE_H   (KIDIA:KFDIA,:)
410thermodynamics%temperature_hl(KIDIA:KFDIA,:) = PTEMPERATURE_H(KIDIA:KFDIA,:)
411
412!print*,'Compute saturation specific humidity'
413! Compute saturation specific humidity, used to hydrate aerosols. The
414! "2" for the last argument indicates that the routine is not being
415! called from within the convection scheme.
416!CALL SATUR(KIDIA, KFDIA, KLON, 1, KLEV, &
417!     &  PPRESSURE, PTEMPERATURE, thermodynamics%h2o_sat_liq, 2)
418! Alternative approximate version using temperature and pressure from
419! the thermodynamics structure
420!CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
421!AI ATTENTION
422thermodynamics%h2o_sat_liq = PQSAT
423
424print*,'********** SINGLE LEVEL VARS **********************************'
425!AI ATTENTION
426! Set single-level fileds
427single_level%solar_irradiance              = PSOLAR_IRRADIANCE
428single_level%cos_sza(KIDIA:KFDIA)          = PMU0(KIDIA:KFDIA)
429single_level%skin_temperature(KIDIA:KFDIA) = PTEMPERATURE_SKIN(KIDIA:KFDIA)
430single_level%sw_albedo(KIDIA:KFDIA,:)      = PALBEDO_DIF(KIDIA:KFDIA,:)
431single_level%sw_albedo_direct(KIDIA:KFDIA,:)=PALBEDO_DIR(KIDIA:KFDIA,:)
432single_level%lw_emissivity(KIDIA:KFDIA,1)  = PEMIS(KIDIA:KFDIA)
433!single_level%lw_emissivity(KIDIA:KFDIA,2)  = PEMIS_WINDOW(KIDIA:KFDIA)
434
435! Create the relevant seed from date and time get the starting day
436! and number of minutes since start
437!IDAY = NDD(NINDAT)
438!cur_day
439!ITIM = NINT(NSTEP * YRRIP%TSTEP / 60.0_JPRB)
440ITIM = NINT(TIME / 60.0_JPRB)
441!current_time
442!allocate(single_level%iseed(KIDIA:KFDIA))
443DO JLON = KIDIA, KFDIA
444  ! This method gives a unique value for roughly every 1-km square
445  ! on the globe and every minute.  ASIN(PGEMU)*60 gives rough
446  ! latitude in degrees, which we multiply by 100 to give a unique
447  ! value for roughly every km. PGELAM*60*100 gives a unique number
448  ! for roughly every km of longitude around the equator, which we
449  ! multiply by 180*100 so there is no overlap with the latitude
450  ! values.  The result can be contained in a 32-byte integer (but
451  ! since random numbers are generated with the help of integer
452  ! overflow, it should not matter if the number did overflow).
453  single_level%iseed(JLON) = ITIM + IDAY &
454       &  +  NINT(PGELAM(JLON)*108000000.0_JPRB &
455       &          + ASIN(PGEMU(JLON))*6000.0_JPRB)
456ENDDO
457
458print*,'********** CLOUDS (allocate + input) *******************************************'
459!print*,'Appel Allocate clouds'
460CALL cloud%allocate(KLON, KLEV)
461! Set cloud fields
462cloud%q_liq(KIDIA:KFDIA,:)    = PQ_LIQUID(KIDIA:KFDIA,:)
463cloud%q_ice(KIDIA:KFDIA,:)    = PQ_ICE(KIDIA:KFDIA,:) + PQ_SNOW(KIDIA:KFDIA,:)
464cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
465
466!!! ok AI ATTENTION a voir avec JL
467! Compute effective radi and convert to metres
468! AI. : on passe directement les champs de LMDZ
469cloud%re_liq(KIDIA:KFDIA,:) = ZRE_LIQUID_UM(KIDIA:KFDIA,:)
470cloud%re_ice(KIDIA:KFDIA,:) = ZRE_ICE_UM(KIDIA:KFDIA,:)
471
472! Get the cloud overlap decorrelation length (for cloud boundaries),
473! in km, according to the parameterization specified by NDECOLAT,
474! and insert into the "cloud" object. Also get the ratio of
475! decorrelation lengths for cloud water content inhomogeneities and
476! cloud boundaries, and set it in the "rad_config" object.
477! IFS :
478!CALL CLOUD_OVERLAP_DECORR_LEN(KIDIA, KFDIA, KLON, PGEMU, YRERAD%NDECOLAT, &
479!     &    ZDECORR_LEN_KM, PDECORR_LEN_RATIO=ZDECORR_LEN_RATIO)
480! AI valeur dans namelist
481! rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
482
483!AI ATTENTION meme valeur que dans offline
484! A mettre dans namelist
485ZDECORR_LEN_KM = driver_config%overlap_decorr_length
486DO JLON = KIDIA,KFDIA
487  CALL cloud%set_overlap_param(thermodynamics, &
488       &                 ZDECORR_LEN_KM(JLON), &
489       &                 istartcol=JLON, iendcol=JLON)
490ENDDO
491
492! IFS :
493! Cloud water content fractional standard deviation is configurable
494! from namelist NAERAD but must be globally constant. Before it was
495! hard coded at 1.0.
496!CALL cloud%create_fractional_std(KLON, KLEV, YRERAD%RCLOUD_FRAC_STD)
497! AI ATTENTION frac_std=0.75 meme valeur que dans la version offline
498CALL cloud%create_fractional_std(KLON, KLEV, driver_config%frac_std)
499
500if (rad_config%i_solver_sw == ISolverSPARTACUS &
501      & .or.   rad_config%i_solver_lw == ISolverSPARTACUS) then
502! AI ! Read cloud properties needed by SPARTACUS
503!AI ATTENTION meme traitement dans le version offline
504  if (driver_config%low_inv_effective_size >= 0.0_jprb &
505     & .or. driver_config%middle_inv_effective_size >= 0.0_jprb &
506     & .or. driver_config%high_inv_effective_size >= 0.0_jprb) then
507     call cloud%create_inv_cloud_effective_size_eta(klon, klev, &
508               &  thermodynamics%pressure_hl, &
509               &  driver_config%low_inv_effective_size, &
510               &  driver_config%middle_inv_effective_size, &
511               &  driver_config%high_inv_effective_size, 0.8_jprb, 0.45_jprb)
512  else if (driver_config%cloud_separation_scale_surface > 0.0_jprb &
513         .and. driver_config%cloud_separation_scale_toa > 0.0_jprb) then
514    call cloud%param_cloud_effective_separation_eta(klon, klev, &
515               &  thermodynamics%pressure_hl, &
516               &  driver_config%cloud_separation_scale_surface, &
517               &  driver_config%cloud_separation_scale_toa, &
518               &  driver_config%cloud_separation_scale_power, &
519               &  driver_config%cloud_inhom_separation_factor)
520  endif
521endif 
522
523print*,'******** AEROSOLS (allocate + input) **************************************'
524!IF (NAERMACC > 0) THEN
525  CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
526!ELSE
527!  CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
528!ENDIF
529! Compute the dry mass of each layer neglecting humidity effects, in
530! kg m-2, needed to scale some of the aerosol inputs
531! AI commente ATTENTION
532!CALL thermodynamics%get_layer_mass(ZLAYER_MASS)
533
534! Copy over aerosol mass mixing ratio
535!IF (NAERMACC > 0) THEN
536
537  ! MACC aerosol climatology - this is already in mass mixing ratio
538  ! units with the required array orientation so we can copy it over
539  ! directly
540  aerosol%mixing_ratio(KIDIA:KFDIA,:,:) = PAEROSOL(KIDIA:KFDIA,:,:)
541
542  ! Add the tropospheric and stratospheric backgrounds contained in the
543  ! old Tegen arrays - this is very ugly!
544! AI ATTENTION
545!  IF (TROP_BG_AER_MASS_EXT > 0.0_JPRB) THEN
546!    aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
547!         &  = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
548!         &  + PAEROSOL_OLD(KIDIA:KFDIA,1,:) &
549!         &  / (ZLAYER_MASS * TROP_BG_AER_MASS_EXT)
550!  ENDIF
551!  IF (STRAT_BG_AER_MASS_EXT > 0.0_JPRB) THEN
552!    aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
553!         &  = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
554!         &  + PAEROSOL_OLD(KIDIA:KFDIA,6,:) &
555!         &  / (ZLAYER_MASS * STRAT_BG_AER_MASS_EXT)
556!  ENDIF
557
558!ELSE
559
560  ! Tegen aerosol climatology - the array PAEROSOL_OLD contains the
561  ! 550-nm optical depth in each layer. The optics data file
562  ! aerosol_ifs_rrtm_tegen.nc does not contain mass extinction
563  ! coefficient, but a scaling factor that the 550-nm optical depth
564  ! should be multiplied by to obtain the optical depth in each
565  ! spectral band.  Therefore, in order for the units to work out, we
566  ! need to divide by the layer mass (in kg m-2) to obtain the 550-nm
567  ! cross-section per unit mass of dry air (so in m2 kg-1).  We also
568  ! need to permute the array.
569!  DO JLEV = 1,KLEV
570!    DO JAER = 1,6
571!      aerosol%mixing_ratio(KIDIA:KFDIA,JLEV,JAER) &
572!         &  = PAEROSOL_OLD(KIDIA:KFDIA,JAER,JLEV) &
573!         &  / ZLAYER_MASS(KIDIA:KFDIA,JLEV)
574!    ENDDO
575!  ENDDO
576
577!ENDIF
578
579print*,'********** GAS (allocate + input) ************************************************'
580!print*,'Appel Allocate gas'
581CALL gas%allocate(KLON, KLEV)
582
583! Convert ozone Pa*kg/kg to kg/kg
584! AI ATTENTION
585!DO JLEV = 1,KLEV
586!  DO JLON = KIDIA,KFDIA
587!    ZO3(JLON,JLEV) = PO3_DP(JLON,JLEV) &
588!         &         / (PPRESSURE_H(JLON,JLEV+1)-PPRESSURE_H(JLON,JLEV))
589!  ENDDO
590!ENDDO
591
592!  Insert gas mixing ratios
593!print*,'Insert gas mixing ratios'
594CALL gas%put(IH2O,    IMassMixingRatio, PQ)
595CALL gas%put(IO3,     IMassMixingRatio, PO3)
596CALL gas%put_well_mixed(ICO2,    IMAssMixingRatio, PCO2)
597CALL gas%put_well_mixed(ICH4,    IMassMixingRatio, PCH4)
598CALL gas%put_well_mixed(IN2O,    IMassMixingRatio, PN2O)
599CALL gas%put_well_mixed(ICFC11,  IMassMixingRatio, PCFC11)
600CALL gas%put_well_mixed(ICFC12,  IMassMixingRatio, PCFC12)
601CALL gas%put_well_mixed(IHCFC22, IMassMixingRatio, PHCFC22)
602CALL gas%put_well_mixed(ICCL4,   IMassMixingRatio, PCCL4)
603CALL gas%put_well_mixed(IO2,     IMassMixingRatio, PO2)
604! Ensure the units of the gas mixing ratios are what is required by
605! the gas absorption model
606call set_gas_units(rad_config, gas)
607
608print*,'************** FLUX (allocate) ***********************'
609CALL flux%allocate(rad_config, 1, KLON, KLEV)
610
611! Call radiation scheme
612print*,'******** Appel radiation scheme **************************'
613CALL radiation(KLON, KLEV, KIDIA, KFDIA, rad_config, &
614     &  single_level, thermodynamics, gas, cloud, aerosol, flux)
615
616! Compute required output fluxes
617! DN and UP flux
618PFLUX_SW_DN(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:)
619PFLUX_SW_UP(KIDIA:KFDIA,:) = flux%sw_up(KIDIA:KFDIA,:)
620PFLUX_LW_DN(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:)
621PFLUX_LW_UP(KIDIA:KFDIA,:) = flux%lw_up(KIDIA:KFDIA,:)
622PFLUX_SW_DN_CLEAR(KIDIA:KFDIA,:) = flux%sw_dn_clear(KIDIA:KFDIA,:)
623PFLUX_SW_UP_CLEAR(KIDIA:KFDIA,:) = flux%sw_up_clear(KIDIA:KFDIA,:)
624PFLUX_LW_DN_CLEAR(KIDIA:KFDIA,:) = flux%lw_dn_clear(KIDIA:KFDIA,:)
625PFLUX_LW_UP_CLEAR(KIDIA:KFDIA,:) = flux%lw_up_clear(KIDIA:KFDIA,:)
626
627! First the net fluxes
628PFLUX_SW(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:) - flux%sw_up(KIDIA:KFDIA,:)
629PFLUX_LW(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:) - flux%lw_up(KIDIA:KFDIA,:)
630PFLUX_SW_CLEAR(KIDIA:KFDIA,:) &
631     &  = flux%sw_dn_clear(KIDIA:KFDIA,:) - flux%sw_up_clear(KIDIA:KFDIA,:)
632PFLUX_LW_CLEAR(KIDIA:KFDIA,:) &
633     &  = flux%lw_dn_clear(KIDIA:KFDIA,:) - flux%lw_up_clear(KIDIA:KFDIA,:)
634
635! Now the surface fluxes
636!PFLUX_SW_DN_SURF(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,KLEV+1)
637!PFLUX_LW_DN_SURF(KIDIA:KFDIA) = flux%lw_dn(KIDIA:KFDIA,KLEV+1)
638!PFLUX_SW_UP_SURF(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,KLEV+1)
639!PFLUX_LW_UP_SURF(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,KLEV+1)
640!PFLUX_SW_DN_CLEAR_SURF(KIDIA:KFDIA) = flux%sw_dn_clear(KIDIA:KFDIA,KLEV+1)
641!PFLUX_LW_DN_CLEAR_SURF(KIDIA:KFDIA) = flux%lw_dn_clear(KIDIA:KFDIA,KLEV+1)
642!PFLUX_SW_UP_CLEAR_SURF(KIDIA:KFDIA) = flux%sw_up_clear(KIDIA:KFDIA,KLEV+1)
643!PFLUX_LW_UP_CLEAR_SURF(KIDIA:KFDIA) = flux%lw_up_clear(KIDIA:KFDIA,KLEV+1)
644PFLUX_DIR(KIDIA:KFDIA) = flux%sw_dn_direct(KIDIA:KFDIA,KLEV+1)
645PFLUX_DIR_CLEAR(KIDIA:KFDIA) = flux%sw_dn_direct_clear(KIDIA:KFDIA,KLEV+1)
646PFLUX_DIR_INTO_SUN(KIDIA:KFDIA) = 0.0_JPRB
647WHERE (PMU0(KIDIA:KFDIA) > EPSILON(1.0_JPRB))
648  PFLUX_DIR_INTO_SUN(KIDIA:KFDIA) = PFLUX_DIR(KIDIA:KFDIA) / PMU0(KIDIA:KFDIA)
649END WHERE
650
651! Top-of-atmosphere downwelling flux
652!PFLUX_SW_DN_TOA(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,1)
653!PFLUX_SW_UP_TOA(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,1)
654!PFLUX_LW_DN_TOA(KIDIA:KFDIA) = flux%lw_dn(KIDIA:KFDIA,1)
655!PFLUX_LW_UP_TOA(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,1)
656
657! Compute UV fluxes as weighted sum of appropriate shortwave bands
658!AI ATTENTION
659if (0.eq.1) then
660PFLUX_UV       (KIDIA:KFDIA) = 0.0_JPRB
661DO JBAND = 1,NWEIGHT_UV
662  PFLUX_UV(KIDIA:KFDIA) = PFLUX_UV(KIDIA:KFDIA) + WEIGHT_UV(JBAND) &
663       &  * flux%sw_dn_surf_band(IBAND_UV(JBAND),KIDIA:KFDIA)
664ENDDO
665
666! Compute photosynthetically active radiation similarly
667PFLUX_PAR      (KIDIA:KFDIA) = 0.0_JPRB
668PFLUX_PAR_CLEAR(KIDIA:KFDIA) = 0.0_JPRB
669DO JBAND = 1,NWEIGHT_PAR
670  PFLUX_PAR(KIDIA:KFDIA) = PFLUX_PAR(KIDIA:KFDIA) + WEIGHT_PAR(JBAND) &
671       &  * flux%sw_dn_surf_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
672  PFLUX_PAR_CLEAR(KIDIA:KFDIA) = PFLUX_PAR_CLEAR(KIDIA:KFDIA) &
673       &  + WEIGHT_PAR(JBAND) &
674       &  * flux%sw_dn_surf_clear_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
675ENDDO
676endif
677! Compute effective broadband emissivity
678ZBLACK_BODY_NET_LW = flux%lw_dn(KIDIA:KFDIA,KLEV+1) &
679     &  - RSIGMA*PTEMPERATURE_SKIN(KIDIA:KFDIA)**4
680PEMIS_OUT(KIDIA:KFDIA) = PEMIS(KIDIA:KFDIA)
681WHERE (ABS(ZBLACK_BODY_NET_LW) > 1.0E-5)
682  PEMIS_OUT(KIDIA:KFDIA) = PFLUX_LW(KIDIA:KFDIA,KLEV+1) / ZBLACK_BODY_NET_LW
683END WHERE
684
685! Copy longwave derivatives
686! AI ATTENTION
687!IF (YRERAD%LAPPROXLWUPDATE) THEN
688IF (rad_config%do_lw_derivatives) THEN
689  PLWDERIVATIVE(KIDIA:KFDIA,:) = flux%lw_derivatives(KIDIA:KFDIA,:)
690END IF
691
692! Store the shortwave downwelling fluxes in each albedo band
693!AI ATTENTION
694!IF (YRERAD%LAPPROXSWUPDATE) THEN
695if (0.eq.1) then
696IF (rad_config%do_surface_sw_spectral_flux) THEN
697  PSWDIFFUSEBAND(KIDIA:KFDIA,:) = 0.0_JPRB
698  PSWDIRECTBAND (KIDIA:KFDIA,:) = 0.0_JPRB
699  DO JBAND = 1,rad_config%n_bands_sw
700    JB_ALBEDO = rad_config%i_albedo_from_band_sw(JBAND)
701    DO JLON = KIDIA,KFDIA
702      PSWDIFFUSEBAND(JLON,JB_ALBEDO) = PSWDIFFUSEBAND(JLON,JB_ALBEDO) &
703           &  + flux%sw_dn_surf_band(JBAND,JLON) &
704           &  - flux%sw_dn_direct_surf_band(JBAND,JLON)
705      PSWDIRECTBAND(JLON,JB_ALBEDO)  = PSWDIRECTBAND(JLON,JB_ALBEDO) &
706           &  + flux%sw_dn_direct_surf_band(JBAND,JLON)
707    ENDDO
708  ENDDO
709ENDIF
710endif
711CALL single_level%deallocate
712CALL thermodynamics%deallocate
713CALL gas%deallocate
714CALL cloud%deallocate
715CALL aerosol%deallocate
716CALL flux%deallocate
717
718IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',1,ZHOOK_HANDLE)
719
720END SUBROUTINE RADIATION_SCHEME
Note: See TracBrowser for help on using the repository browser.