C.Lac 11/2015 : Correction on aerosols for radiation (and remove LRAD_DUST)
[MNH-git_open_source-lfs.git] / src / MNH / radiations.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !-----------------------------------------------------------------
6 !--------------- special set of characters for RCS information
7 !-----------------------------------------------------------------
8 ! $Source$ $Revision$
9 ! masdev4_7 BUG1 2007/06/15 17:47:18
10 !-----------------------------------------------------------------
11 !    ########################
12      MODULE MODI_RADIATIONS   
13 !    ########################
14 !
15 INTERFACE 
16 !
17     SUBROUTINE RADIATIONS (OCLOSE_OUT,HFMFILE,HLUOUT,OCLEAR_SKY,OCLOUD_ONLY,&
18                KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW,   &
19                PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB,KSTATM, &
20                KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL,                         &
21                PDIR_ALB, PSCA_ALB, PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM,  &
22                PTHT, PRT, PPABST, POZON, PAER,PDST_WL, PAER_CLIM, PSVT,   &
23                PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF,PRHODREF, PZZ,   &
24                PRADEFF, PSWU, PSWD, PLWU, PLWD, PDTHRADSW, PDTHRADLW      )
25 !
26 LOGICAL, INTENT(IN)                  :: OCLOSE_OUT! flag indicating that a FM
27                                                   ! file is opened during this 
28                                                   ! time-step
29 CHARACTER(LEN=*), INTENT(IN)         :: HFMFILE   ! Name of the output
30                                                   ! FM-file
31 CHARACTER(LEN=*), INTENT(IN)         :: HLUOUT    ! Output-listing name for
32                                                   ! model n
33 LOGICAL, INTENT(IN)                  :: OCLOUD_ONLY! flag for the cloud column
34                                                    !    computations only
35 LOGICAL, INTENT(IN)                  :: OCLEAR_SKY ! 
36 INTEGER, INTENT(IN)                  :: KDLON   ! number of columns where the
37                                                 ! radiation calculations are
38                                                 !         performed
39 INTEGER, INTENT(IN)                  :: KFLEV   ! number of vertical levels
40                                                 !    where the radiation
41                                                 ! calculations are performed
42 INTEGER, INTENT(IN)                  :: KRAD_DIAG   ! index for the number of
43                                                     !  fields in the output
44 INTEGER, INTENT(IN)                  :: KFLUX   ! number of top and ground 
45                                                 ! fluxes for the ZFLUX array
46 INTEGER, INTENT(IN)                  :: KRAD    ! number of satellite radiances
47                                                 ! for the ZRAD and ZRADCS arrays
48 INTEGER, INTENT(IN)                  :: KAER    ! number of AERosol classes
49
50 INTEGER, INTENT(IN)                  :: KSWB    ! number of SW band  
51 INTEGER, INTENT(IN)                  :: KSTATM  ! index of the standard 
52                                                 ! atmosphere level just above
53                                                 !      the model top
54 INTEGER, INTENT(IN)                  :: KRAD_COLNBR ! factor by which the memory
55                                                     ! is splitted
56 !
57                                                !Choice of :             
58 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADL!cloud liquid effective radius calculation
59 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADI!cloud ice effective radius calculation
60 CHARACTER (LEN=*), INTENT (IN)       :: HOPWSW !cloud water SW optical properties   
61 CHARACTER (LEN=*), INTENT (IN)       :: HOPISW !ice water SW optical properties 
62 CHARACTER (LEN=*), INTENT (IN)       :: HOPWLW !cloud water LW optical properties
63 CHARACTER (LEN=*), INTENT (IN)       :: HOPILW !ice water  LW optical properties
64 REAL,              INTENT(IN)        :: PFUDG  ! subgrid cloud inhomogenity factor
65 !
66 REAL, DIMENSION(:,:),     INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
67 REAL,                     INTENT(IN) :: PCORSOL ! SOLar constant CORrection
68 REAL, DIMENSION(:,:),     INTENT(IN) :: PSEA    ! Land-sea mask
69 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
70 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
71 REAL, DIMENSION(:,:),     INTENT(IN) :: PEMIS   ! Surface IR EMISsivity
72 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PCLDFR  ! CLouD FRaction
73 REAL,                     INTENT(IN) :: PCCO2   ! CO2 content
74 REAL, DIMENSION(:,:),     INTENT(IN) :: PTSRAD  ! RADiative Surface Temperature
75 REAL, DIMENSION(:,:),     INTENT(IN) :: PSTATM  ! selected standard atmosphere
76 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PTHT    ! THeta at t
77 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT     ! moist variables at t
78 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PPABST  ! pressure at t
79 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT    ! scalar variable ( C2R2 and C1R3  particle) 
80 !
81 REAL, DIMENSION(:,:,:),   POINTER    :: POZON   ! OZON field from clim.
82 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER    ! AERosols optical thickness from clim. 
83 REAL, DIMENSION(:,:,:,:), POINTER    :: PDST_WL ! AERosols Extinction.by wavelength 
84 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER_CLIM    ! AERosols optical thickness from clim.                                                 ! note : the vertical dimension of 
85                                                 ! these fields include the "radiation levels"
86                                                 ! above domain top 
87 !
88 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PRHODREF ![kg/m3] air density
89 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PZZ      ![m] height of layers
90 !
91 INTEGER, DIMENSION(:,:), INTENT(INOUT)  :: KCLEARCOL_TM1 ! trace of cloud/clear col
92                                                          ! at the previous radiation step
93 !                                                 
94 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
95 REAL, DIMENSION(:,:),     INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
96 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect 
97 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse 
98 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWU ! upward SW Flux 
99 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWD ! downward SW Flux 
100 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWU ! upward LW Flux 
101 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWD ! downward LW Flux 
102 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADSW ! dthrad sw 
103 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADLW !  dthradsw
104 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PRADEFF ! effective radius
105 !
106 !
107 END SUBROUTINE RADIATIONS
108 !
109 END INTERFACE
110 !
111 END MODULE MODI_RADIATIONS  
112 !
113 !   #######################################################################
114     SUBROUTINE RADIATIONS (OCLOSE_OUT,HFMFILE,HLUOUT,OCLEAR_SKY,OCLOUD_ONLY,&
115                KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW,   &
116                PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB,KSTATM, &
117                KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL,                         &
118                PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM,   &
119                PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT,  &
120                PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ,  &
121                PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW       )
122 !   #######################################################################
123 !
124 !!****  *RADIATIONS * - routine to call the SW and LW radiation calculations
125 !!
126 !!    PURPOSE
127 !!    -------
128 !!      The purpose of this routine is to prepare the temperature, water vapor
129 !!    liquid water, cloud fraction, ozone profiles for the ECMWF radiation
130 !!    calculations. There is a great number of available radiative fluxes in
131 !!    the output, but only the potential temperature radiative tendency and the
132 !!    SW and LW surface fluxes are provided in the output of the routine.
133 !!    Two simplified computations are available (switches OCLEAR_SKY and
134 !!    OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
135 !!    for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
136 !!    the clear sky columns are averaged and the computations are made for
137 !!    the cloudy columns plus a single ensemble-mean clear sky column.
138 !!
139 !!**  METHOD
140 !!    ------
141 !!      First the temperature, water vapor, liquid water, cloud fraction
142 !!    and  profile arrays are built using the current model fields and
143 !!    the standard atmosphere for the upper layer filling.
144 !!    The standard atmosphere is used between the levels IKUP and
145 !!    KFLEV where KFLEV is the number of vertical levels for the radiation 
146 !!    computations.    
147 !!    The aerosols optical thickness and the ozone fields come directly
148 !!    from ini_radiation step (climatlogies used) and are already defined for KFLEV. 
149 !!    Surface parameter ( albedo, emiss ) are also defined from current surface fields.
150 !!    In the case of clear-sky or cloud-only approximations, the cloudy
151 !!    columns are selected by testing the vertically integrated cloud fraction
152 !!    and the radiation computations are performed for these columns plus the
153 !!    mean clear-sky one. In addition, columns where cloud have disapeared are determined
154 !!    by saving cloud trace between radiation step and they are also recalculated
155 !!    in cloud only step. In all case, the sun position correponds to  the centered
156 !!    time between 2 full radiation steps (determined in physparam).
157 !!      Then the ECMWF radiation package is called and the radiative
158 !!    heating/cooling tendancies are reformatted in case of partial
159 !!    computations.  In case of "cloud-only approximation" the only cloudy
160 !!    column radiative fields are updated.
161 !!
162 !!    EXTERNAL
163 !!    --------
164 !!      Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
165 !!
166 !!    IMPLICIT ARGUMENTS
167 !!    ------------------
168 !!      Module MODD_TIME : structure of TDTCUR
169 !!      Module MODD_CST  : constants
170 !!        XP00 : reference pressure
171 !!        XCPD : calorific capacity of dry air at constant pressure
172 !!        XRD  : gas constant for dry air
173 !!      Module MODD_PARAMETERS : parameters
174 !!        JPHEXT : Extra columns on the horizontal boundaries
175 !!        JPVEXT : Extra levels on the vertical boundaries
176 !!
177 !!    REFERENCE
178 !!    ---------
179 !!      Book2 of documentation ( routine RADIATIONS )
180 !!
181 !!    AUTHOR
182 !!    ------
183 !!      J.-P. Pinty      * Laboratoire d'Aerologie*
184 !!
185 !!    MODIFICATIONS
186 !!    -------------
187 !!      Original    26/02/95 
188 !!      J.Stein     20/12/95 add the array splitting in order to save memory
189 !!      J.-P. Pinty 19/11/96 change the splitted arrays, specific humidity
190 !!                           and add the ice phase
191 !!      J.Stein     22/06/97 use of the absolute pressure
192 !!      P.Jabouille 31/07/97 impose a zero humidity for dry simulation
193 !!      V.Masson    22/09/97 case of clear-sky approx. with no clear-sky column
194 !!      V.Masson    07/11/97 half level pressure defined from averaged Exner
195 !!                           function
196 !!      V.Masson    07/11/97 modification of junction between standard atm
197 !!                           and model for half level variables (top model
198 !!                           pressure and temperatures are used preferentially
199 !!                           to atm standard profile for the first point).
200 !!      P.Jabouille 24/08/98 impose positivity for ZQLAVE
201 !!      J.-P. Pinty 29/01/98 add storage for diagnostics
202 !!      J. Stein    18/07/99 add the ORAD_DIAG switch and keep inside the
203 !!                           subroutine the partial tendencies 
204 !!
205 !!      F.Solmon    04/03/01  MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
206 !!      P.Jabouille 05/05/03 bug in humidity conversion
207 !!      Y.Seity     25/08/03  KSWB=6 for SW direct and scattered surface 
208 !!                            downward fluxes used in surface scheme. 
209 !!      P. Tulet    01/20/05  climatologic SSA
210 !!      A. Grini    05/20/05  dust direct effect (optical properties)
211 !!      V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
212 !!      B.Aouizerats 2010     Explicit aerosol optical properties
213 !!      C.Lac       11/2015   Correction on aerosols
214 !-------------------------------------------------------------------------------
215 !
216 !*       0.    DECLARATIONS
217 !              ------------
218 !
219 USE MODE_FMWRIT
220 USE MODE_FM
221 USE MODE_ll
222 USE MODI_ECMWF_RADIATION_VERS2
223 USE YOESW    , ONLY : RTAUA    ,RPIZA    ,RCGA
224
225 !
226 USE MODD_TIME
227 USE MODD_CST
228 USE MODD_PARAMETERS
229 USE MODD_RAIN_ICE_DESCR
230 USE MODD_NSV, ONLY : NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
231                      NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
232                      NSV_DSTBEG, NSV_DSTEND, &
233                      NSV_AERBEG, NSV_AEREND, &
234                      NSV_SLTBEG, NSV_SLTEND
235 !
236 USE MODE_THERMO
237
238 USE MODD_DUST, ONLY: LDUST
239 USE MODD_SALT, ONLY: LSALT
240 USE MODD_CH_AEROSOL, ONLY: LORILAM
241 USE MODD_PARAM_RAD_n, ONLY: CAOP
242 USE MODE_DUSTOPT
243 USE MODE_SALTOPT
244 USE MODI_AEROOPT_GET
245 !
246 #ifdef MNH_PGI
247 USE MODE_PACK_PGI
248 #endif
249 !  
250 IMPLICIT NONE
251 !
252 !*       0.1   DECLARATIONS OF DUMMY ARGUMENTS :
253 !
254 LOGICAL, INTENT(IN)                  :: OCLOSE_OUT! flag indicating that a FM
255                                                   ! file is opened during this 
256                                                   ! time-step
257 CHARACTER(LEN=*), INTENT(IN)         :: HFMFILE   ! Name of the output
258                                                   ! FM-file
259 CHARACTER(LEN=*), INTENT(IN)         :: HLUOUT    ! Output-listing name for
260                                                   ! model n
261 LOGICAL, INTENT(IN)                  :: OCLOUD_ONLY! flag for the cloud column
262                                                    !    computations only
263 LOGICAL, INTENT(IN)                  :: OCLEAR_SKY ! 
264 INTEGER, INTENT(IN)                  :: KDLON   ! number of columns where the
265                                                 ! radiation calculations are
266                                                 !       performed
267 INTEGER, INTENT(IN)                  :: KFLEV   ! number of vertical levels
268                                                 !    where the radiation
269                                                 ! calculations are performed
270 INTEGER, INTENT(IN)                  :: KRAD_DIAG  ! index for the number of
271                                                    !  fields in the output
272 INTEGER, INTENT(IN)                  :: KFLUX   ! number of top and ground 
273                                                 ! fluxes for the ZFLUX array
274 INTEGER, INTENT(IN)                  :: KRAD    ! number of satellite radiances
275                                                 ! for the ZRAD and ZRADCS arrays
276 INTEGER, INTENT(IN)                  :: KAER    ! number of AERosol classes
277
278 INTEGER, INTENT(IN)                  :: KSWB    ! number of SW band  
279 INTEGER, INTENT(IN)                  :: KSTATM  ! index of the standard 
280                                                 ! atmosphere level just above
281                                                 !      the model top
282 INTEGER, INTENT(IN)                  :: KRAD_COLNBR ! factor by which the memory
283                                                     ! is splitted
284                                                     !
285                                                !Choice of :             
286 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADL ! 
287 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADI ! 
288 CHARACTER (LEN=*), INTENT (IN)       :: HOPWSW !cloud water SW optical properties   
289 CHARACTER (LEN=*), INTENT (IN)       :: HOPISW !ice water SW optical properties 
290 CHARACTER (LEN=*), INTENT (IN)       :: HOPWLW !cloud water LW optical properties
291 CHARACTER (LEN=*), INTENT (IN)       :: HOPILW !ice water  LW optical properties
292 REAL,               INTENT(IN)       :: PFUDG  ! subgrid cloud inhomogenity factor
293 REAL, DIMENSION(:,:),     INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
294 REAL,                     INTENT(IN) :: PCORSOL ! SOLar constant CORrection
295 REAL, DIMENSION(:,:),     INTENT(IN) :: PSEA    ! Land-sea mask
296 !
297 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
298 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
299 REAL, DIMENSION(:,:),     INTENT(IN) :: PEMIS   ! Surface IR EMISsivity
300 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PCLDFR  ! CLouD FRaction
301 REAL,                     INTENT(IN) :: PCCO2   ! CO2 content
302 REAL, DIMENSION(:,:),     INTENT(IN) :: PTSRAD  ! RADiative Surface Temperature
303 REAL, DIMENSION(:,:),     INTENT(IN) :: PSTATM  ! selected standard atmosphere
304 !
305 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PTHT    ! THeta at t
306 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT     ! moist variables at t
307 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PPABST  ! pressure at t
308 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT    ! scalar variable ( C2R2 and C1R3  particle)
309 !
310 REAL, DIMENSION(:,:,:),   POINTER    :: POZON   ! OZONE field from clim.
311 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER    ! AERosols optical thickness from clim. 
312 REAL, DIMENSION(:,:,:,:), POINTER    :: PDST_WL    ! AERosols Extinction by wavelength . 
313 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER_CLIM    ! AERosols optical thickness from clim.                                                 ! note : the vertical dimension of 
314                                                 ! these fields iclude the "radiation levels"
315                                                 !  above domain top.
316                                                 ! 
317                                                  
318 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PRHODREF ![kg/m3] air density
319 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PZZ      ![m] height of layers
320
321 INTEGER, DIMENSION(:,:), INTENT(INOUT)  :: KCLEARCOL_TM1 ! trace of cloud/clear col
322                                                          ! at the previous radiation step
323 !                                                 
324 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
325 REAL, DIMENSION(:,:),     INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
326 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect 
327 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse 
328 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWU ! upward SW Flux 
329 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWD ! downward SW Flux 
330 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWU ! upward LW Flux 
331 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWD ! downward LW Flux 
332 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADSW ! dthrad sw 
333 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADLW !  dthradsw
334 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PRADEFF ! effective radius
335 !
336 !
337 !*       0.2   DECLARATIONS OF LOCAL VARIABLES
338 !
339 LOGICAL                         :: GNOCL     ! .TRUE. when no cloud is present
340                                              !     with OCLEAR_SKY .TRUE.
341 LOGICAL                         :: GAOP      ! .TRUE. when CAOP='EXPL'
342 LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD    ! .TRUE. for the cloudy columns
343 LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT   ! transpose of the GCLOUD array
344 LOGICAL, DIMENSION(KDLON)       :: GCLEAR_2D ! .TRUE. for the clear-sky columns
345 LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR    ! .TRUE. for all the levels of the 
346                                              !                clear-sky columns
347 LOGICAL, DIMENSION(KDLON,KSWB)  :: GCLEAR_SWB! .TRUE. for all the bands of the  
348                                              !                clear-sky columns
349 INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
350 !
351 INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
352 !
353 INTEGER :: IIB           ! I index value of the first inner mass point
354 INTEGER :: IJB           ! J index value of the first inner mass point
355 INTEGER :: IKB           ! K index value of the first inner mass point
356 INTEGER :: IIE           ! I index value of the last inner mass point
357 INTEGER :: IJE           ! J index value of the last inner mass point
358 INTEGER :: IKE           ! K index value of the last inner mass point
359 INTEGER :: IKU           ! array size for the third  index
360 INTEGER :: IIJ           ! reformatted array index
361 INTEGER :: IKSTAE        ! level number of the STAndard atmosphere array
362 INTEGER :: IKUP          ! vertical level above which STAndard atmosphere data
363                          ! are filled in
364 !
365 INTEGER :: ICLEAR_COL    ! number of    clear-sky columns
366 INTEGER :: ICLOUD_COL    ! number of    cloudy    columns
367 INTEGER :: ICLOUD        ! number of levels corresponding of the cloudy columns
368 INTEGER :: IDIM          ! effective number of columns for which the radiation
369                          ! code is run
370 INTEGER :: INIR          ! index corresponding to NIR fisrt band (in SW)
371 !
372 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZTAVE    ! mean-layer temperature
373 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZPAVE    ! mean-layer pressure
374 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQSAVE   ! saturation specific humidity
375 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQVAVE   ! mean-layer specific humidity
376 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQLAVE   ! Liquid water KG/KG
377 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQRAVE   ! Rain water  KG/KG
378 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQIAVE   ! Ice water Kg/KG
379 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQLWC   ! liquid water content kg/m3
380 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQRWC   ! Rain water  content kg/m3
381 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQIWC   ! ice water content  kg/m3
382 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCFAVE   ! mean-layer cloud fraction
383 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZO3AVE   ! mean-layer ozone content 
384 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZPRES_HL ! half-level pressure
385 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZT_HL    ! half-level temperature
386 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZDPRES   ! layer pressure thickness
387 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
388 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCRT_C2R2! Rain water Concentarion (C2R2)
389 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCIT_C1R3! Ice water Concentarion (C2R2)
390 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAER     ! aerosol optical thickness
391 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZALBP    ! spectral surface albedo for direct radiations
392 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZALBD    ! spectral surface albedo for diffuse radiations 
393 REAL, DIMENSION (:),  ALLOCATABLE   :: ZEMIS    ! surface LW  emissivity 
394 REAL, DIMENSION (:), ALLOCATABLE    :: ZEMIW    ! surface LW  WINDOW emissivity
395 REAL, DIMENSION(:), ALLOCATABLE     :: ZTS      ! reformatted surface PTSRAD array 
396 REAL, DIMENSION(:), ALLOCATABLE     :: ZLSM     ! reformatted land sea mask
397 REAL, DIMENSION(:),   ALLOCATABLE   :: ZRMU0    ! Reformatted ZMU0 array
398 REAL                                :: ZRII0    ! corrected solar constant
399 !
400 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW    ! LW temperature tendency
401 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW    ! SW temperature tendency
402 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
403 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW    ! TOTAL LW NET FLUXES
404 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
405 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW    ! TOTAL SW NET FLUXES
406 REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and 
407                                                             ! Ground radiative FLUXes
408 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
409 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP   ! UPward   SW Flux profiles
410 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW      !          LW Flux profiles
411 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
412 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
413 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
414                                                   !  Ground Clear-Sky radiative FLUXes
415 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZSFSWDIR !surface SW direct flux
416 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZSFSWDIF !surface SW diffuse flux
417
418 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
419                         ! PLANetary ALBedo in VISible, Near-InfraRed regions
420 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
421                         ! PLANetary TRANsmission in VISible, Near-InfraRed regions
422 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
423                         ! PLANetary ABSorption in VISible, Near-InfraRed regions
424 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
425                         ! EFective  DOWNward and UPward LW nebulosity (equivalent emissivities)
426                         ! undefined if RRTM is used for LW
427 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLWP, ZFIWP
428                         ! Liquid and Ice Water Path
429 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADLP, ZRADIP
430                         ! Cloud liquid water and ice effective radius
431 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
432                         ! effective LW nebulosity ( RRTM case) 
433                         ! and SW CLoud fraction for mixed phase clouds
434 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
435                         ! effective optical thickness, single scattering albedo
436                         ! and asymetry factor for mixed phase clouds
437 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
438                         ! Clear-Sky  DowNward and UPward   SW Flux profiles
439 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
440                         ! Thicknes of the mesh
441 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDZ
442 !
443 REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
444 REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
445 REAL, DIMENSION(KDLON)       :: ZZTGVIS! SW surface flux in the VIS band
446 REAL, DIMENSION(KDLON)       :: ZZTGNIR! SW surface flux in the NIR band
447 REAL, DIMENSION(KDLON)       :: ZZTGIR ! LW surface flux in the IR bands
448 REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
449 !                                      ! SW direct surface flux   
450 REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
451 !                                      ! SW diffuse surface flux   
452 !
453 REAL, DIMENSION(KDLON)       :: ZCLOUD ! vertically integrated cloud fraction
454 !
455 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
456 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2))    :: ZLWD    ! surface Downward LW flux
457 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
458 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
459 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZPIZAZ ! Aerosols SSA
460 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZTAUAZ ! Aerosols Optical Detph
461 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZCGAZ  ! Aerosols Asymetric factor
462 REAL :: ZZTGVISC    ! downward surface SW flux (VIS band) for clear_sky
463 REAL :: ZZTGNIRC    ! downward surface SW flux (NIR band) for clear_sky
464 REAL :: ZZTGIRC     ! downward surface LW flux for clear_sky
465 REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
466 !                   ! downward surface SW direct flux for clear sky
467 REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
468 !                   ! downward surface SW diffuse flux for clear sky
469 REAL, DIMENSION(KFLEV) :: ZT_CLEAR  ! ensemble mean clear-sky temperature
470 REAL, DIMENSION(KFLEV) :: ZP_CLEAR  ! ensemble mean clear-sky temperature
471 REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
472 REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
473 REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
474 REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
475 REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
476 REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR  ! ensemble mean clear-sky aerosols optical thickness
477 REAL, DIMENSION(KSWB)       :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
478 REAL, DIMENSION(KSWB)       :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
479 REAL                        :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
480 REAL                        :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
481 REAL                        :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
482 REAL                        :: ZTS_CLEAR   ! ensemble mean clear-sky surface temperature.
483 REAL                        :: ZLSM_CLEAR  !  ensemble mean clear-sky land sea-mask  
484 !
485 !work arrays
486 REAL, DIMENSION(:),   ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
487 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
488 LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
489 !
490 !  splitted arrays used to split the memory required by the ECMWF_radiation 
491 !  subroutine, the fields have the same meaning as their complete counterpart
492 !
493 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
494 REAL, DIMENSION(:),     ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
495 REAL, DIMENSION(:),     ALLOCATABLE :: ZRMU0_SPLIT
496 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZCFAVE_SPLIT
497 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZO3AVE_SPLIT
498 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZT_HL_SPLIT
499 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZPRES_HL_SPLIT
500 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZTAVE_SPLIT
501 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZPAVE_SPLIT
502 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
503 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDPRES_SPLIT
504 REAL, DIMENSION(:),     ALLOCATABLE :: ZLSM_SPLIT
505 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQVAVE_SPLIT
506 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQSAVE_SPLIT
507 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQLAVE_SPLIT
508 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQIAVE_SPLIT
509 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQRAVE_SPLIT
510 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQRWC_SPLIT
511 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQLWC_SPLIT
512 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQIWC_SPLIT
513 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDZ_SPLIT
514 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCCT_C2R2_SPLIT
515 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCRT_C2R2_SPLIT
516 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCIT_C1R3_SPLIT
517 REAL, DIMENSION(:),     ALLOCATABLE :: ZTS_SPLIT
518 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZSFSWDIR_SPLIT
519 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZSFSWDIF_SPLIT
520 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFLW_CS_SPLIT
521 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFLW_SPLIT
522 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFSW_CS_SPLIT
523 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFSW_SPLIT
524 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_SPLIT
525 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_SPLIT
526 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
527 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
528 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
529 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
530 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_CS_SPLIT
531 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_CS_SPLIT
532 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
533 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
534 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
535 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
536 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
537 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
538 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
539 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWD_SPLIT
540 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWU_SPLIT
541 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLWP_SPLIT
542 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFIWP_SPLIT
543 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADLP_SPLIT
544 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADIP_SPLIT
545 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_RRTM_SPLIT
546 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
547 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
548 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
549 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
550 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
551 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
552 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
553 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP        !Single scattering albedo of aerosols (lon,lat,lev,wvl)
554 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR        !Real part of the aerosol refractive index(lon,lat,lev,wvl)
555 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII        !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
556 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP         !Assymetry factor aerosols            (lon,lat,lev,wvl)
557 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP      !tau/tau_{550} aerosols               (lon,lat,lev,wvl)
558 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP        !Single scattering albedo of dust (lon,lat,lev,wvl)
559 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP         !Assymetry factor dust            (lon,lat,lev,wvl)
560 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP      !tau/tau_{550} dust               (lon,lat,lev,wvl)
561 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP        !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
562 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP         !Assymetry factor aerosol from ORILAM            (lon,lat,lev,wvl)
563 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP      !tau/tau_{550} aerosol from ORILAM               (lon,lat,lev,wvl)
564 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP        !Single scattering albedo of sea salt (lon,lat,lev,wvl)
565 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP         !Assymetry factor of sea salt            (lon,lat,lev,wvl)
566 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP      !tau/tau_{550} of sea salt               (lon,lat,lev,wvl)
567 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER      !tau/tau_{550} aerosol from ORILAM               (lon,lat,lev,wvl)
568 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT      !tau/tau_{550} sea salt               (lon,lat,lev,wvl)
569 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST     !tau/tau_{550} dust               (lon,lat,lev,wvl)
570 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP      !tau/tau_{550} aerosols               (lon,lat,lev,wvl)
571 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZPIZA_EQ            !Single scattering albedo of aerosols (points,lev,wvl)
572 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZCGA_EQ             !Assymetry factor aerosols            (points,lev,wvl)
573 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZTAUREL_EQ          !tau/tau_{550} aerosols               (points,lev,wvl)
574 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZPIZA_EQ_SPLIT      !Single scattering albedo of aerosols (points,lev,wvl)
575 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZCGA_EQ_SPLIT       !Assymetry factor aerosols            (points,lev,wvl)
576 REAL, DIMENSION(:,:,:), ALLOCATABLE   :: ZTAUREL_EQ_SPLIT    !tau/tau_{550} aerosols               (points,lev,wvl)
577 REAL, DIMENSION(KFLEV,KSWB)           :: ZPIZA_EQ_CLEAR      !Single scattering albedo of aerosols (lev,wvl)
578 REAL, DIMENSION(KFLEV,KSWB)           :: ZCGA_EQ_CLEAR       !Assymetry factor aerosols            (lev,wvl)
579 REAL, DIMENSION(KFLEV,KSWB)           :: ZTAUREL_EQ_CLEAR    !tau/tau_{550} aerosols               (lev,wvl)
580 INTEGER                               :: WVL_IDX              !Counter for wavelength
581
582 !
583 INTEGER  :: JI_SPLIT          ! loop on the splitted array
584 INTEGER  :: INUM_CALL         ! number of CALL of the radiation scheme
585 INTEGER  :: IDIM_EFF          ! effective number of air-columns to compute
586 INTEGER  :: IDIM_RESIDUE      ! number of remaining air-columns to compute
587 INTEGER  :: IBEG, IEND        ! auxiliary indices
588 !
589 !
590 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
591      :: ZDTRAD_LW! LW temperature tendency
592 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
593      :: ZDTRAD_SW! SW temperature tendency
594 INTEGER             :: ILUOUT       ! Logical unit number for output-listing
595 INTEGER             :: IRESP        ! Return code of FM routines
596 INTEGER             :: IGRID        ! C-grid indicator in LFIFM file
597 INTEGER             :: ILENCH       ! Length of comment string in LFIFM file
598 CHARACTER (LEN=100) :: YCOMMENT     ! comment string in LFIFM file
599 CHARACTER (LEN=16)  :: YRECFM       ! Name of the desired field in LFIFM file
600 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
601      :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
602 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
603      :: ZSTORE_2D   ! 2D work array for storage!
604 INTEGER                         :: JBAND       ! Solar band index
605 CHARACTER (LEN=4), DIMENSION(KSWB) :: YBAND_NAME  ! Solar band name
606 CHARACTER (LEN=2)               :: YDIR        ! Type of the data field
607 !
608 INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
609 INTEGER :: JSWB ! loop on SW spectral bands
610 INTEGER :: JAE  ! loop on aerosol class
611 !
612 !-------------------------------------------------------------------------
613 !-------------------------------------------------------------------------
614 !-------------------------------------------------------------------------
615 !
616 !*       1.    COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
617 !              ----------------------------------------------
618 !
619 CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)  ! this definition must be coherent with
620                                       ! the one used in ini_radiations routine
621 IKU = SIZE(PTHT,3)
622 IKB = 1 + JPVEXT
623 IKE = IKU - JPVEXT
624 !
625 IKSTAE = SIZE(PSTATM,1)
626 IKUP   = IKE-JPVEXT+1
627
628 ISWB   = SIZE(PSRFSWD_DIR,3)
629 !
630 !-------------------------------------------------------------------------------
631 !
632 !*       2.    INITIALIZES THE MEAN-LAYER VARIABLES
633 !              ------------------------------------
634 !
635 ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
636
637 ALLOCATE(ZTAVE(KDLON,KFLEV))
638 ALLOCATE(ZQVAVE(KDLON,KFLEV))
639 ALLOCATE(ZQLAVE(KDLON,KFLEV))
640 ALLOCATE(ZQIAVE(KDLON,KFLEV))
641 ALLOCATE(ZCFAVE(KDLON,KFLEV))
642 ALLOCATE(ZQRAVE(KDLON,KFLEV))
643 ALLOCATE(ZQLWC(KDLON,KFLEV))
644 ALLOCATE(ZQIWC(KDLON,KFLEV))
645 ALLOCATE(ZQRWC(KDLON,KFLEV))
646 ALLOCATE(ZDZ(KDLON,KFLEV))
647 !
648 ZQVAVE(:,:) = 0.0
649 ZQLAVE(:,:) = 0.0
650 ZQIAVE(:,:) = 0.0
651 ZQRAVE(:,:) = 0.0
652 ZCFAVE(:,:) = 0.0
653 ZQLWC(:,:) = 0.0
654 ZQIWC(:,:) = 0.0
655 ZQRWC(:,:) = 0.0
656 ZDZ(:,:)=0.0
657 !
658 !COMPUTE THE MESH SIZE
659 DO JK=IKB,IKE
660   JKRAD = JK-JPVEXT
661   DO JJ=IJB,IJE
662     DO JI=IIB,IIE
663       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
664       ZDZ(IIJ,JKRAD)  =  PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
665       ZTAVE(IIJ,JKRAD)  = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK)
666     END DO
667   END DO
668 END DO
669 !
670 !  Check if the humidity mixing ratio is available
671 !
672 IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
673   DO JK=IKB,IKE
674     JKRAD = JK-JPVEXT
675     DO JJ=IJB,IJE
676       DO JI=IIB,IIE
677         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
678         ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
679       END DO
680     END DO
681   END DO
682 END IF
683 !
684 !  Check if the cloudwater mixing ratio is available
685 !
686 IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
687   DO JK=IKB,IKE
688     JKRAD = JK-JPVEXT
689     DO JJ=IJB,IJE
690       DO JI=IIB,IIE
691         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
692         ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
693         ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
694         ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
695       END DO
696     END DO
697   END DO
698 END IF
699 !
700 !  Check if the rainwater mixing ratio is available
701 !
702 IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
703   DO JK=IKB,IKE
704     JKRAD = JK-JPVEXT
705     DO JJ=IJB,IJE
706       DO JI=IIB,IIE
707         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
708         ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
709         ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
710       END DO
711     END DO
712   END DO
713 END IF
714 !
715 !  Check if the cloudice mixing ratio is available
716 !
717 IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
718   DO JK=IKB,IKE
719     JKRAD = JK-JPVEXT
720     DO JJ=IJB,IJE
721       DO JI=IIB,IIE
722         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
723         ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
724         ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
725       END DO
726     END DO
727   END DO
728 END IF
729 !
730 !  Standard atmosphere extension
731 !
732 DO JK=IKUP,KFLEV
733   JK1 = (KSTATM-1)+(JK-IKUP)
734   JK2 = JK1+1
735   ZTAVE(:,JK)  = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
736   ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+   &
737                  PSTATM(JK2,5)/PSTATM(JK2,4)    )
738 END DO
739 !
740 !        2.1 pronostic water concentation fields (C2R2 coupling) 
741 !
742 IF( NSV_C2R2 /= 0 ) THEN
743   ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
744   ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
745   ZCCT_C2R2(:, :) = 0.
746   ZCRT_C2R2 (:,:) = 0.
747   DO JK=IKB,IKE
748     JKRAD = JK-JPVEXT
749     DO JJ=IJB,IJE
750       DO JI=IIB,IIE
751         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
752         ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
753         ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
754       END DO
755     END DO
756   END DO
757 ELSE 
758   ALLOCATE (ZCCT_C2R2(0,0))
759   ALLOCATE (ZCRT_C2R2(0,0))
760 END IF
761 !
762 IF( NSV_C1R3 /= 0 ) THEN
763   ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
764   ZCIT_C1R3 (:,:) = 0.
765   DO JK=IKB,IKE
766     JKRAD = JK-JPVEXT
767     DO JJ=IJB,IJE
768       DO JI=IIB,IIE
769         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
770         ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
771       END DO
772     END DO
773   END DO
774 ELSE 
775   ALLOCATE (ZCIT_C1R3(0,0))
776 END IF
777 !
778 !-------------------------------------------------------------------------------
779 !
780 !*       3.    INITIALIZES THE HALF-LEVEL VARIABLES
781 !                  ------------------------------------
782 !
783 ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
784 ALLOCATE(ZT_HL(KDLON,KFLEV+1))
785 !
786 DO JK=IKB,IKE+1
787   JKRAD = JK-JPVEXT
788   DO JJ=IJB,IJE
789     DO JI=IIB,IIE
790       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
791       ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
792     END DO
793   END DO
794 END DO
795 !
796 !  Standard atmosphere extension
797 !
798 !* begining at ikup+1 level allows to use a model domain higher than 50km
799 !
800 DO JK=IKUP+1,KFLEV+1
801   JK1 = (KSTATM-1)+(JK-IKUP)
802   ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0
803 END DO
804 !
805 !  Surface temperature at the first level
806 !  and surface radiative temperature
807 ALLOCATE(ZTS(KDLON))
808 !
809 DO JJ=IJB,IJE
810   DO JI=IIB,IIE
811     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
812     ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
813     ZTS(IIJ) = PTSRAD(JI,JJ)
814   END DO
815 END DO
816 !
817 !  Temperature at half levels
818 !
819 ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
820 !
821 DO JJ=IJB,IJE
822   DO JI=IIB,IIE
823     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
824     ZT_HL(IIJ,IKE-JPVEXT+1)  =  0.5*PTHT(JI,JJ,IKE  )*ZEXNT(JI,JJ,IKE  ) &
825          + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
826   END DO
827 END DO
828 !
829 !  Standard atmosphere extension
830 !
831 !* begining at ikup+1 level allows to use a model domain higher than 50km
832 !
833 DO JK=IKUP+1,KFLEV+1
834   JK1 = (KSTATM-1)+(JK-IKUP)
835   ZT_HL(:,JK) = PSTATM(JK1,3)
836 END DO
837 !
838 !mean layer pressure and layer differential pressure (from half level variables)
839 !
840 ALLOCATE(ZPAVE(KDLON,KFLEV))
841 ALLOCATE(ZDPRES(KDLON,KFLEV))
842 DO JKRAD=1,KFLEV
843   ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
844   ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
845 END DO
846 !-----------------------------------------------------------------------
847 !*       4.    INITIALIZES THE AEROSOLS and OZONE PROFILES from climatlogy
848 !                  -------------------------------------------
849 !
850 !        4.1    AEROSOL optical thickness
851 !
852 IF (CAOP=='EXPL') THEN
853    GAOP = .TRUE.
854 ELSE
855    GAOP = .FALSE.
856 ENDIF
857 !
858 IF (CAOP=='EXPL') THEN
859    ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
860    ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
861    ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
862
863    ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
864    ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
865    ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB)) 
866    ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
867
868    ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
869    ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
870    ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
871    ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
872
873    ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
874    ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
875    ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
876    ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
877    
878
879    ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB))
880    ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB))
881
882   ZPIZA_EQ_TMP = 0.
883   ZCGA_EQ_TMP = 0.
884   ZTAUREL_EQ_TMP = 0.
885
886   ZPIZA_DST_TMP = 0.
887   ZCGA_DST_TMP = 0.
888   ZTAUREL_DST_TMP = 0
889
890   ZPIZA_SLT_TMP = 0.
891   ZCGA_SLT_TMP = 0.
892   ZTAUREL_SLT_TMP = 0
893
894   ZPIZA_AER_TMP = 0.
895   ZCGA_AER_TMP = 0.
896   ZTAUREL_AER_TMP = 0
897
898   PAER_DST=0.
899   PAER_SLT=0.
900   PAER_AER=0.
901   
902  IF (LORILAM) THEN
903    CALL AEROOPT_GET(                             &
904         PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND)        &  !I [ppp]  aerosols concentration
905         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
906         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
907         ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of aerosols
908         ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for aerosols
909         ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
910         ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of aerosols at wvl=550nm
911         ,KSWB                                    &  !I |nbr] number of shortwave bands
912         ,ZIR(IIB:IIE,IJB:IJE,:,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
913         ,ZII(IIB:IIE,IJB:IJE,:,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
914         )
915  ENDIF
916  IF(LDUST) THEN
917    CALL DUSTOPT_GET(                             &
918         PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND)        &  !I [ppp] Dust scalar concentration
919         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
920         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
921         ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of dust
922         ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for dust
923         ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
924         ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of dust at wvl=550nm
925         ,KSWB                                    &  !I |nbr] number of shortwave bands
926         )
927    DO WVL_IDX=1,KSWB
928      PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)             
929    ENDDO
930  ENDIF
931  IF(LSALT) THEN
932    CALL SALTOPT_GET(                             &
933         PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND)        &  !I [ppp] sea salt scalar concentration
934         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
935         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
936         ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of sea salt
937         ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for sea salt
938         ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
939         ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of sea salt at wvl=550nm
940         ,KSWB                                    &  !I |nbr] number of shortwave bands
941         )
942
943  ENDIF
944
945
946  ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
947  
948 !PAER(:,:,:,3)=PAER_AER(:,:,:)+PAER_SLT(:,:,:)+PAER_DST(:,:,:)
949  PAER(:,:,:,2)=PAER_SLT(:,:,:)
950  PAER(:,:,:,3)=PAER_DST(:,:,:)
951  PAER(:,:,:,4)=PAER_AER(:,:,:)
952
953
954  WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
955   ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
956                     ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
957                     ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
958                     ZTAUREL_EQ_TMP(:,:,:,:) 
959  END WHERE
960  WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
961   ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
962                    ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
963                    ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
964                    (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
965  END WHERE
966
967  ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
968  ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
969  ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
970  PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
971  ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
972
973
974 ENDIF      
975 !
976 ! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
977 ZTAUAZ(:,:,:,:) = 0.
978 ZPIZAZ(:,:,:,:) = 0.
979 ZCGAZ(:,:,:,:)  = 0.
980 DO WVL_IDX=1,KSWB
981  DO JAE=1,KAER
982       !Special optical properties for dust
983       IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
984       !Ponderation of aerosol optical in case of explicit optical factor
985       !ti
986         ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
987                                                  PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
988                                        ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) 
989       !wi*ti
990         ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
991                                   PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)                * &
992                                   ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
993                                   ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
994       !wi*ti*gi
995         ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
996                                  PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)                * &
997                                  ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
998                                  ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)   * &
999                                  ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
1000       ELSE
1001
1002       !Ponderation of aerosol optical properties 
1003       !ti
1004         ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
1005              PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
1006       !wi*ti
1007         ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
1008                                                PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
1009                                         RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
1010       !wi*ti*gi
1011         ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) =  ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
1012                                                PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)   *&
1013                         RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
1014            ENDIF
1015  ENDDO
1016 ! assymetry factor:
1017
1018 ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)  / &
1019                                    ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
1020 ! SSA:
1021 ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
1022                                     ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
1023 ENDDO
1024 !
1025
1026 !
1027 ALLOCATE(ZAER(KDLON,KFLEV,KAER))
1028 ! Aerosol classes
1029 ! 1=Continental   2=Maritime   3=Desert     4=Urban     5=Volcanic 6=Stratos.Bckgnd
1030 DO JJ=IJB,IJE
1031    DO JI=IIB,IIE
1032       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1033       ZAER (IIJ,:,:) = PAER_CLIM  (JI,JJ,:,:)
1034    END DO
1035 END DO
1036 IF ((CAOP=='EXPL') .AND. LDUST ) THEN
1037   DO JJ=IJB,IJE
1038     DO JI=IIB,IIE
1039       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1040       ZAER (IIJ,:,3) = PAER  (JI,JJ,:,3)
1041     END DO
1042   END DO
1043 END IF
1044 IF ((CAOP=='EXPL') .AND. LSALT ) THEN
1045   DO JJ=IJB,IJE
1046     DO JI=IIB,IIE
1047       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1048       ZAER (IIJ,:,2) = PAER  (JI,JJ,:,2)
1049     END DO
1050   END DO
1051 END IF
1052 IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
1053   DO JJ=IJB,IJE
1054     DO JI=IIB,IIE
1055       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1056       ZAER (IIJ,:,4) = PAER  (JI,JJ,:,4)
1057     END DO
1058   END DO
1059 END IF
1060 !
1061 ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB))
1062 ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB))
1063 ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB))
1064 IF(CAOP=='EXPL')THEN
1065     !Transform from vector of type #lon #lat #lev #wvl
1066     !to vectors of type #points, #levs, #wavelengths
1067   DO JJ=IJB,IJE
1068   DO JI=IIB,IIE
1069     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1070     ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
1071     ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
1072     ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
1073   END DO
1074   END DO
1075   DEALLOCATE(ZPIZA_EQ_TMP)
1076   DEALLOCATE(ZCGA_EQ_TMP)
1077   DEALLOCATE(ZTAUREL_EQ_TMP)
1078   DEALLOCATE(ZPIZA_DST_TMP)
1079   DEALLOCATE(ZCGA_DST_TMP)
1080   DEALLOCATE(ZTAUREL_DST_TMP)  
1081   DEALLOCATE(ZPIZA_AER_TMP)
1082   DEALLOCATE(ZCGA_AER_TMP)
1083   DEALLOCATE(ZTAUREL_AER_TMP)
1084   DEALLOCATE(ZPIZA_SLT_TMP)
1085   DEALLOCATE(ZCGA_SLT_TMP)
1086   DEALLOCATE(ZTAUREL_SLT_TMP)
1087   DEALLOCATE(PAER_DST)
1088   DEALLOCATE(PAER_AER)
1089   DEALLOCATE(PAER_SLT)
1090   DEALLOCATE(ZIR)
1091   DEALLOCATE(ZII)
1092 END IF
1093
1094
1095 !
1096 !      4.2   OZONE content 
1097 !
1098 ALLOCATE(ZO3AVE(KDLON,KFLEV))
1099 !
1100 DO JJ=IJB,IJE
1101   DO JI=IIB,IIE
1102     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1103     ZO3AVE(IIJ,:)  = POZON (JI,JJ,:)           
1104   END DO
1105 END DO
1106 !
1107 !-------------------------------------------------------------------------------
1108 !
1109 !*       5.    CALLS THE E.C.M.W.F. RADIATION CODE
1110 !                  -----------------------------------
1111 !
1112 !
1113 !*       5.1   INITIALIZES 2D AND SURFACE FIELDS
1114 !
1115 ALLOCATE(ZRMU0(KDLON))
1116 ALLOCATE(ZLSM(KDLON))
1117
1118 ALLOCATE(ZALBP(KDLON,KSWB))
1119 ALLOCATE(ZALBD(KDLON,KSWB))
1120 !
1121 ALLOCATE(ZEMIS(KDLON))
1122 ALLOCATE(ZEMIW(KDLON))
1123 !
1124 DO JJ=IJB,IJE
1125   DO JI=IIB,IIE
1126     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1127     ZEMIS(IIJ)   = PEMIS(JI,JJ)
1128     ZRMU0(IIJ)    = PCOSZEN(JI,JJ)
1129     ZLSM(IIJ)     = 1.0 - PSEA(JI,JJ)  
1130   END DO
1131 END DO  
1132 !
1133 ! spectral albedo
1134 !
1135 IF ( SIZE(PDIR_ALB,3)==1 ) THEN
1136   DO JJ=IJB,IJE
1137     DO JI=IIB,IIE
1138       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1139       !  sw direct and diffuse albedos
1140       ZALBP(IIJ,:)  = PDIR_ALB(JI,JJ,1)
1141       ZALBD(IIJ,:)  = PSCA_ALB(JI,JJ,1)
1142       !
1143     END DO
1144   END DO
1145 ELSE  
1146   DO JK=1, SIZE(PDIR_ALB,3)
1147     DO JJ=IJB,IJE
1148       DO JI=IIB,IIE
1149          IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1150          !  sw direct and diffuse albedos
1151          ZALBP(IIJ,JK)  = PDIR_ALB(JI,JJ,JK)
1152          ZALBD(IIJ,JK)  = PSCA_ALB(JI,JJ,JK)
1153        ENDDO
1154      END DO
1155    ENDDO  
1156 END IF
1157 !
1158 !
1159 ! LW emissivity
1160 ZEMIW(:)= ZEMIS(:)
1161 !
1162 !solar constant
1163 ZRII0= PCORSOL*XI0
1164 !
1165 !
1166 !
1167 !*       5.2   ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
1168 !
1169 !  Performs the horizontal average of the fields when no cloud
1170 !
1171 ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 )
1172 !
1173 ! MODIF option CLLY      
1174 ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
1175 !
1176 DO JJ=IJB,IJE
1177   DO JI=IIB,IIE
1178     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1179     ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
1180   END DO
1181 END DO
1182 !
1183 IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
1184   !
1185   GCLEAR_2D(:) = .TRUE.
1186   WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) )
1187     GCLEAR_2D(:) = .FALSE.
1188   END WHERE
1189   !
1190   !
1191   ICLEAR_COL = COUNT( GCLEAR_2D(:) )  ! number of clear sky columns
1192   !
1193
1194   IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
1195     GCLEAR_2D(1) = .FALSE.       !           column is selected
1196     ICLEAR_COL = KDLON-1
1197     GNOCL = .TRUE.
1198   ELSE
1199     GNOCL = .FALSE.
1200   END IF
1201
1202   GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV )
1203   ICLOUD_COL = KDLON - ICLEAR_COL     ! number of  cloudy   columns
1204 !
1205   IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists
1206     ZT_CLEAR(:)  = SUM( ZTAVE(:,:) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1207     ZP_CLEAR(:)  = SUM( ZPAVE(:,:) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1208     ZQV_CLEAR(:) = SUM( ZQVAVE(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1209     ZOZ_CLEAR(:) = SUM( ZO3AVE(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1210     ZDP_CLEAR(:) = SUM( ZDPRES(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1211     DO JK1=1,KAER
1212       ZAER_CLEAR(:,JK1) = SUM( ZAER(:,:,JK1),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1213     END DO
1214     !Get an average value for the clear column
1215     IF(CAOP=='EXPL')THEN
1216        DO WVL_IDX=1,KSWB
1217           ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM( ZPIZA_EQ(:,:,WVL_IDX), DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1218           ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM( ZCGA_EQ(:,:,WVL_IDX),DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1219           ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM( ZTAUREL_EQ(:,:,WVL_IDX),DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1220        ENDDO
1221     ENDIF
1222     
1223     !
1224     ZHP_CLEAR(1:KFLEV) =SUM( ZPRES_HL(:,1:KFLEV),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1225     ZHT_CLEAR(1:KFLEV)  = SUM( ZT_HL(:,1:KFLEV) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1226     ! 
1227     GCLEAR_SWB(:,:) = SPREAD(GCLEAR_2D(:),DIM=2,NCOPIES=KSWB)
1228     ZALBP_CLEAR(:) = SUM( ZALBP(:,:),DIM=1,MASK=GCLEAR_SWB(:,:) ) &
1229          / FLOAT(ICLEAR_COL)
1230     ZALBD_CLEAR(:) = SUM( ZALBD(:,:),DIM=1,MASK=GCLEAR_SWB(:,:) ) &
1231          / FLOAT(ICLEAR_COL)
1232     !
1233     ZEMIS_CLEAR  = SUM( ZEMIS(:),DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1234     ZEMIW_CLEAR  = SUM( ZEMIW(:),DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1235     ZRMU0_CLEAR  = SUM( ZRMU0(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1236     ZTS_CLEAR    = SUM( ZTS(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1237     ZLSM_CLEAR   = SUM( ZLSM(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)  
1238 !
1239   ELSE ! the first column is chosen, without physical meaning: it will not be
1240     ! unpacked after the call to the radiation ecmwf routine
1241     ZT_CLEAR(:)  = ZTAVE(1,:)
1242     ZP_CLEAR(:)  = ZPAVE(1,:)
1243     ZQV_CLEAR(:) = ZQVAVE(1,:)
1244     ZOZ_CLEAR(:) = ZO3AVE(1,:)
1245     ZDP_CLEAR(:) = ZDPRES(1,:)
1246     ZAER_CLEAR(:,:) = ZAER(1,:,:)
1247     IF(CAOP=='EXPL')THEN
1248        ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
1249        ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
1250        ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
1251     ENDIF
1252 !
1253     ZHP_CLEAR(1:KFLEV)  = ZPRES_HL(1,1:KFLEV)
1254     ZHT_CLEAR(1:KFLEV)  = ZT_HL(1,1:KFLEV)
1255     ZALBP_CLEAR(:) = ZALBP(1,:)
1256     ZALBD_CLEAR(:) = ZALBD(1,:)
1257 !
1258     ZEMIS_CLEAR  = ZEMIS(1)
1259     ZEMIW_CLEAR  = ZEMIW(1) 
1260     ZRMU0_CLEAR  = ZRMU0(1)
1261     ZTS_CLEAR    = ZTS(1) 
1262     ZLSM_CLEAR   = ZLSM(1)  
1263   END IF
1264   !
1265   GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
1266   GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
1267   ICLOUD = ICLOUD_COL*KFLEV
1268   ALLOCATE(ZWORK1(ICLOUD))
1269   ALLOCATE(ZWORK2(ICLOUD+KFLEV)) !  allocation for the KFLEV levels of 
1270                                  !  the ICLOUD cloudy columns
1271                                  !  and of the single clear_sky one
1272   !
1273   ! temperature profiles
1274   !
1275   ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
1276   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1277   ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:)      !   and the single clear_sky one
1278   DEALLOCATE(ZTAVE)
1279   ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
1280   ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1281   !
1282   ! vapor mixing ratio profiles
1283   !
1284   ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
1285   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1286   ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:)      !   and the single clear_sky one
1287   DEALLOCATE(ZQVAVE)
1288   ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
1289   ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1290   !
1291   ! mesh size 
1292   !
1293   ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
1294   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1295   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1296   DEALLOCATE(ZDZ)
1297   ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
1298   ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1299   !
1300   !
1301   ! liquid water mixing ratio profiles
1302   !
1303   ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
1304   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1305   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1306   DEALLOCATE(ZQLAVE)
1307   ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
1308   ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1309   !
1310   !rain 
1311   !
1312   ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
1313   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1314   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1315   DEALLOCATE(ZQRAVE)
1316   ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
1317   ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1318   ! 
1319   ! ice water mixing ratio profiles
1320   !
1321   ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
1322   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1323   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1324   DEALLOCATE(ZQIAVE)
1325   ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
1326   ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1327   !
1328   !
1329   ! liquid water mixing ratio profiles
1330   !
1331   ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
1332   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1333   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1334   DEALLOCATE(ZQLWC)
1335   ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
1336   ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1337   !
1338   !rain 
1339   !
1340   ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
1341   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1342   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1343   DEALLOCATE(ZQRWC)
1344   ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
1345   ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1346   ! 
1347   ! ice water mixing ratio profiles
1348   !
1349   ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
1350   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1351   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1352   DEALLOCATE(ZQIWC)
1353   ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
1354   ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1355   !
1356   !
1357   ! cloud fraction profiles
1358   !
1359   ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
1360   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1361   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1362   DEALLOCATE(ZCFAVE)
1363   ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
1364   ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1365   !
1366   ! C2R2 water particle concentration
1367   !
1368   IF ( SIZE(ZCCT_C2R2) > 0 )  THEN
1369     ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
1370     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1371     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1372     DEALLOCATE(ZCCT_C2R2)
1373     ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
1374     ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1375   ENDIF
1376   IF ( SIZE (ZCRT_C2R2) > 0 )  THEN
1377     ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
1378     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1379     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1380     DEALLOCATE(ZCRT_C2R2)
1381     ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
1382     ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1383   ENDIF
1384   IF ( SIZE (ZCIT_C1R3) > 0)  THEN
1385     ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
1386     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1387     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1388     DEALLOCATE(ZCIT_C1R3)
1389     ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
1390     ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1391   ENDIF
1392   !
1393   ! ozone content profiles
1394   !
1395   ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
1396   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1397   ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:)    !   and the single clear_sky one
1398   DEALLOCATE(ZO3AVE)
1399   ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
1400   ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1401   !
1402   ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
1403   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1404   ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:)     !   and the single clear_sky one
1405   DEALLOCATE(ZPAVE)
1406   ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
1407   ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1408   !
1409   !pressure thickness
1410   !
1411   ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
1412   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1413   ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:)    !   and the single clear_sky one
1414   DEALLOCATE(ZDPRES)
1415   ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
1416   ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1417   !
1418   !aerosols
1419   !
1420   ALLOCATE(ZWORK1AER(ICLOUD,KAER))
1421   ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
1422   DO JK=1,KAER
1423     ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
1424     ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
1425     ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
1426   END DO
1427   DEALLOCATE(ZAER)
1428   ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
1429   DO JK=1,KAER
1430     ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
1431   END DO
1432   DEALLOCATE (ZWORK1AER)
1433   DEALLOCATE (ZWORK2AER)
1434   !
1435   IF(CAOP=='EXPL')THEN
1436      ALLOCATE(ZWORK1AER(ICLOUD,KSWB))        !New vector with value for all cld. points
1437      ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB))  !New vector with value for all cld.points + 1 clr column
1438      !Single scattering albedo
1439      DO WVL_IDX=1,KSWB
1440         ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
1441         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1442         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
1443      ENDDO
1444      DEALLOCATE(ZPIZA_EQ)
1445      ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1446      DO WVL_IDX=1,KSWB
1447         ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
1448      ENDDO
1449      !Assymetry factor
1450      DO WVL_IDX=1,KSWB
1451         ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
1452         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1453         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
1454      ENDDO
1455      DEALLOCATE(ZCGA_EQ)
1456      ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1457      DO WVL_IDX=1,KSWB
1458         ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
1459      ENDDO
1460      !Relative wavelength-distributed optical depth
1461      DO WVL_IDX=1,KSWB
1462         ZWORK1AER(:,WVL_IDX) =  PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
1463         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1464         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
1465      ENDDO
1466      DEALLOCATE(ZTAUREL_EQ)
1467      ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1468      DO WVL_IDX=1,KSWB
1469         ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
1470      ENDDO
1471      DEALLOCATE(ZWORK1AER)
1472      DEALLOCATE(ZWORK2AER)
1473   ELSE
1474      DEALLOCATE(ZPIZA_EQ)
1475      ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1476      DEALLOCATE(ZCGA_EQ)
1477      ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1478      DEALLOCATE(ZTAUREL_EQ)
1479      ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1480   ENDIF !Check on LDUST
1481   
1482   ! half-level variables
1483   !
1484   ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
1485   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD)  ! fills the ICLOUD_COL cloudy columns
1486   ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:)     !   and the single clear_sky one
1487   DEALLOCATE(ZPRES_HL)
1488   ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
1489   ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1490   ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
1491   !
1492   ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
1493   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD)  ! fills the ICLOUD_COL cloudy columns
1494   ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:)     !   and the single clear_sky one
1495   DEALLOCATE(ZT_HL)
1496   ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
1497   ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1498   ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
1499   !
1500   ! surface fields
1501   !
1502   ALLOCATE(ZWORK3(ICLOUD_COL))
1503   ALLOCATE(ZWORK4(ICLOUD_COL,KSWB))
1504   ALLOCATE(ZWORK(KDLON))
1505   DO JALBS=1,KSWB
1506     ZWORK(:)  = ZALBP(:,JALBS)
1507     ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
1508     ZWORK4(:,JALBS) = ZWORK3(:)
1509   END DO
1510   DEALLOCATE(ZALBP)
1511   ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB))
1512   ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
1513   ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
1514   !
1515   DO JALBS=1,KSWB
1516     ZWORK(:)  = ZALBD(:,JALBS)
1517     ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
1518     ZWORK4(:,JALBS) = ZWORK3(:)
1519   END DO
1520   DEALLOCATE(ZALBD)
1521   ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB))
1522   ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)  
1523   ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)  
1524   !
1525   DEALLOCATE(ZWORK4)
1526   !
1527   ZWORK3(:) = PACK( ZEMIS(:),MASK=.NOT.GCLEAR_2D(:) )
1528   DEALLOCATE(ZEMIS)
1529   ALLOCATE(ZEMIS(ICLOUD_COL+1))
1530   ZEMIS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1531   ZEMIS(ICLOUD_COL+1) = ZEMIS_CLEAR
1532   !
1533   !
1534   ZWORK3(:) = PACK( ZEMIW(:),MASK=.NOT.GCLEAR_2D(:) )
1535   DEALLOCATE(ZEMIW)
1536   ALLOCATE(ZEMIW(ICLOUD_COL+1))
1537   ZEMIW(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1538   ZEMIW(ICLOUD_COL+1) = ZEMIW_CLEAR
1539   ! 
1540   !
1541   ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
1542   DEALLOCATE(ZRMU0)
1543   ALLOCATE(ZRMU0(ICLOUD_COL+1))
1544   ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1545   ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
1546   !
1547   ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
1548   DEALLOCATE(ZLSM)
1549   ALLOCATE(ZLSM(ICLOUD_COL+1))
1550   ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1551   ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
1552   ! 
1553   ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
1554   DEALLOCATE(ZTS)
1555   ALLOCATE(ZTS(ICLOUD_COL+1))
1556   ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1557   ZTS(ICLOUD_COL+1) = ZTS_CLEAR
1558   !
1559   DEALLOCATE(ZWORK1)
1560   DEALLOCATE(ZWORK2)
1561   DEALLOCATE(ZWORK3)
1562   DEALLOCATE(ZWORK)
1563   !  
1564   IDIM = ICLOUD_COL +1
1565 !
1566 ELSE
1567   !
1568   !*       5.3   RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
1569   !
1570   IDIM = KDLON
1571 END IF
1572 !
1573 ! initialisation of cloud trace for the next radiation time step
1574 WHERE ( ZCLOUD(:) <= 0.0 )
1575   ICLEAR_2D_TM1(:) = 1
1576 ELSEWHERE
1577   ICLEAR_2D_TM1(:) = 0
1578 END WHERE
1579 !
1580 DO JJ=IJB,IJE
1581   DO JI=IIB,IIE
1582     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1583     KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ)
1584   END DO
1585 END DO
1586
1587 !
1588 !*       5.4  VERTICAL grid modification(up-down) for compatibility with ECMWF 
1589 !             radiation vertical grid. ALLOCATION of the outputs.  
1590 !            
1591 !             
1592 ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
1593 !
1594 !half level pressure
1595 ZWORK_GRID(:,:)=ZPRES_HL(:,:)
1596 DO JKRAD=1, KFLEV+1
1597   JK1=(KFLEV+1)+1-JKRAD
1598   ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
1599 END DO
1600 !
1601 !half level temperature
1602 ZWORK_GRID(:,:)=ZT_HL(:,:)
1603 DO  JKRAD=1, KFLEV+1
1604   JK1=(KFLEV+1)+1-JKRAD
1605   ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
1606 END DO
1607 !
1608 DEALLOCATE(ZWORK_GRID)
1609 !
1610 !mean layer variables
1611 !-------------------------------------
1612 ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
1613 !
1614 !mean layer temperature
1615 ZWORK_GRID(:,:)=ZTAVE(:,:)
1616 DO JKRAD=1, KFLEV
1617   JK1=KFLEV+1-JKRAD
1618   ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1619 END DO
1620 !
1621 !mean layer pressure
1622 ZWORK_GRID(:,:)=ZPAVE(:,:)
1623 DO JKRAD=1, KFLEV
1624   JK1=KFLEV+1-JKRAD
1625   ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1626 END DO
1627 !
1628 !mean layer pressure thickness
1629 ZWORK_GRID(:,:)=ZDPRES(:,:)
1630 DO JKRAD=1, KFLEV
1631   JK1=KFLEV+1-JKRAD
1632   ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
1633 END DO
1634 !
1635 !mesh size
1636 ZWORK_GRID(:,:)=ZDZ(:,:)
1637 DO JKRAD=1, KFLEV
1638   JK1=KFLEV+1-JKRAD
1639   ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
1640 END DO
1641
1642 !mean layer cloud fraction
1643 ZWORK_GRID(:,:)=ZCFAVE(:,:)
1644 DO JKRAD=1, KFLEV
1645   JK1=KFLEV+1-JKRAD
1646   ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1647 END DO
1648 !
1649 !mean layer water vapor mixing ratio
1650 ZWORK_GRID(:,:)=ZQVAVE(:,:)
1651 DO JKRAD=1, KFLEV
1652   JK1=KFLEV+1-JKRAD
1653   ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1654 END DO
1655 !
1656 !ice
1657 ZWORK_GRID(:,:)=ZQIAVE(:,:)
1658 DO JKRAD=1, KFLEV
1659   JK1=KFLEV+1-JKRAD
1660   ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1661 END DO
1662 !
1663 !liquid water
1664 ZWORK_GRID(:,:)=ZQLAVE(:,:)
1665 DO JKRAD=1, KFLEV
1666   JK1=KFLEV+1-JKRAD
1667   ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1668 END DO
1669
1670
1671 !rain water
1672 ZWORK_GRID(:,:)=ZQRAVE(:,:)
1673 DO JKRAD=1, KFLEV
1674   JK1=KFLEV+1-JKRAD
1675   ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1676 END DO
1677 !
1678 !ice water content
1679 ZWORK_GRID(:,:)=ZQIWC(:,:)
1680 DO JKRAD=1, KFLEV
1681   JK1=KFLEV+1-JKRAD
1682   ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1683 END DO
1684 !
1685 !liquid water content
1686 ZWORK_GRID(:,:)=ZQLWC(:,:)
1687 DO JKRAD=1, KFLEV
1688   JK1=KFLEV+1-JKRAD
1689   ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1690 END DO
1691
1692
1693 !rain water content
1694 ZWORK_GRID(:,:)=ZQRWC(:,:)
1695 DO JKRAD=1, KFLEV
1696   JK1=KFLEV+1-JKRAD
1697   ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1698 END DO
1699
1700
1701 !C2R2 water particle concentration
1702 !
1703 IF (SIZE(ZCCT_C2R2) > 0) THEN
1704   ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
1705   DO JKRAD=1, KFLEV
1706     JK1=KFLEV+1-JKRAD
1707     ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
1708   END DO
1709 END IF
1710 IF (SIZE(ZCRT_C2R2) > 0) THEN
1711   ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
1712   DO JKRAD=1, KFLEV
1713     JK1=KFLEV+1-JKRAD
1714     ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
1715   END DO
1716 END IF
1717 IF (SIZE(ZCIT_C1R3) > 0) THEN
1718   ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
1719   DO JKRAD=1, KFLEV
1720     JK1=KFLEV+1-JKRAD
1721     ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
1722   END DO
1723 END IF
1724 !
1725 !ozone content 
1726 ZWORK_GRID(:,:)=ZO3AVE(:,:)
1727 DO JKRAD=1, KFLEV
1728   JK1=KFLEV+1-JKRAD
1729   ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1730 END DO
1731 !
1732 !aerosol optical depth 
1733 DO JI=1,KAER
1734   ZWORK_GRID(:,:)=ZAER(:,:,JI)
1735   DO JKRAD=1, KFLEV
1736     JK1=KFLEV+1-JKRAD
1737     ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1738   END DO
1739 END DO
1740 IF (CAOP=='EXPL') THEN
1741 !TURN MORE FIELDS UPSIDE DOWN...
1742 !Dust single scattering albedo
1743 DO JI=1,KSWB
1744    ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
1745    DO JKRAD=1,KFLEV
1746       JK1=KFLEV+1-JKRAD
1747       ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1748    ENDDO
1749 ENDDO
1750 !Dust asymmetry factor
1751 DO JI=1,KSWB
1752    ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
1753    DO JKRAD=1,KFLEV
1754       JK1=KFLEV+1-JKRAD
1755       ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1756    ENDDO
1757 ENDDO
1758 DO JI=1,KSWB
1759    ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
1760    DO JKRAD=1,KFLEV
1761       JK1=KFLEV+1-JKRAD
1762       ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1763    ENDDO
1764 ENDDO 
1765
1766 END IF
1767
1768 !
1769 DEALLOCATE(ZWORK_GRID)
1770 !
1771 !mean layer saturation specific humidity
1772 !
1773 ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
1774 !
1775 WHERE (ZTAVE(:,:) > XTT)
1776   ZQSAVE(:,:) = QSATW_2D(ZTAVE, ZPAVE)
1777 ELSEWHERE
1778   ZQSAVE(:,:) = QSATI_2D(ZTAVE, ZPAVE)
1779 END WHERE
1780 !
1781 ! allocations for the radiation code outputs
1782 !
1783 ALLOCATE(ZDTLW(IDIM,KFLEV))
1784 ALLOCATE(ZDTSW(IDIM,KFLEV))
1785 ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
1786 ALLOCATE(ZSFSWDIR(IDIM,ISWB))
1787 ALLOCATE(ZSFSWDIF(IDIM,ISWB))
1788 ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
1789 ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
1790 ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
1791 !
1792 !
1793 ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
1794 ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
1795 ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
1796 ALLOCATE(ZRADLP(IDIM,KFLEV))
1797 IF( KRAD_DIAG >= 1) THEN
1798   ALLOCATE(ZNFLW(IDIM,KFLEV+1))
1799   ALLOCATE(ZNFSW(IDIM,KFLEV+1))
1800 ELSE
1801   ALLOCATE(ZNFLW(0,0))
1802   ALLOCATE(ZNFSW(0,0))
1803 END IF
1804
1805 IF( KRAD_DIAG >= 2) THEN
1806   ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
1807   ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
1808   ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
1809   ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
1810   ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
1811 ELSE
1812   ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
1813   ALLOCATE(ZFLUX_SW_UP_CS(0,0))
1814   ALLOCATE(ZFLUX_LW_CS(0,0,0))
1815   ALLOCATE(ZNFSW_CS(0,0))
1816   ALLOCATE(ZNFLW_CS(0,0))
1817 END IF
1818 !
1819 IF( KRAD_DIAG >= 3) THEN
1820   ALLOCATE(ZPLAN_ALB_VIS(IDIM))
1821   ALLOCATE(ZPLAN_ALB_NIR(IDIM))
1822   ALLOCATE(ZPLAN_TRA_VIS(IDIM))
1823   ALLOCATE(ZPLAN_TRA_NIR(IDIM))
1824   ALLOCATE(ZPLAN_ABS_VIS(IDIM))
1825   ALLOCATE(ZPLAN_ABS_NIR(IDIM))
1826 ELSE
1827   ALLOCATE(ZPLAN_ALB_VIS(0))
1828   ALLOCATE(ZPLAN_ALB_NIR(0))
1829   ALLOCATE(ZPLAN_TRA_VIS(0))
1830   ALLOCATE(ZPLAN_TRA_NIR(0))
1831   ALLOCATE(ZPLAN_ABS_VIS(0))
1832   ALLOCATE(ZPLAN_ABS_NIR(0))
1833 END IF
1834 !
1835 IF( KRAD_DIAG >= 4) THEN
1836   ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
1837   ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
1838   ALLOCATE(ZTAU_TOTAL(IDIM,KSWB,KFLEV))
1839   ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB,KFLEV))
1840   ALLOCATE(ZCG_TOTAL(IDIM,KSWB,KFLEV))
1841   ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
1842   ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
1843   ALLOCATE(ZFLWP(IDIM,KFLEV))
1844   ALLOCATE(ZFIWP(IDIM,KFLEV))  
1845   ALLOCATE(ZRADIP(IDIM,KFLEV)) 
1846 ELSE
1847   ALLOCATE(ZEFCL_RRTM(0,0))
1848   ALLOCATE(ZCLSW_TOTAL(0,0))
1849   ALLOCATE(ZTAU_TOTAL(0,0,0))
1850   ALLOCATE(ZOMEGA_TOTAL(0,0,0))
1851   ALLOCATE(ZCG_TOTAL(0,0,0))
1852   ALLOCATE(ZEFCL_LWD(0,0))
1853   ALLOCATE(ZEFCL_LWU(0,0))
1854   ALLOCATE(ZFLWP(0,0))
1855   ALLOCATE(ZFIWP(0,0))
1856   ALLOCATE(ZRADIP(0,0))
1857 END IF
1858 !
1859 !*       5.6   CALLS THE ECMWF_RADIATION ROUTINES
1860 !
1861 !  mixing ratio -> specific humidity conversion
1862 !
1863
1864 ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:))
1865 !
1866 IF( IDIM <= KRAD_COLNBR ) THEN 
1867 !
1868 ! there is less than KRAD_COLNBR verticals to be considered therefore
1869 ! no split of the arrays is performed
1870 !
1871    CALL ECMWF_RADIATION_VERS2  ( IDIM ,KFLEV, KRAD_DIAG, KAER,     &      
1872        ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG,      &
1873        ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE,               &
1874        PCCO2, ZCFAVE, ZDPRES, ZEMIS, ZEMIW, ZLSM, ZRMU0,          &
1875        ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE,  ZQRWC,  &
1876        ZT_HL,ZTAVE, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3,         &
1877        ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW,                           &
1878        ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR,                      &
1879        ZSFSWDIR, ZSFSWDIF,                                        &
1880        ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW ,                     &
1881        ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS,             &
1882        ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS,             &           
1883        ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
1884        ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU,         &
1885        ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM,  ZCLSW_TOTAL,  ZTAU_TOTAL,  &
1886        ZOMEGA_TOTAL,ZCG_TOTAL,                                    &
1887        GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ                       )
1888
1889 ELSE
1890 !
1891 ! the splitting of the arrays will be performed
1892 !
1893   INUM_CALL = CEILING( FLOAT( IDIM ) / FLOAT( KRAD_COLNBR ) )
1894   IDIM_RESIDUE = IDIM
1895 !
1896   DO JI_SPLIT = 1 , INUM_CALL
1897     IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
1898     !
1899     IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN       
1900       ALLOCATE(  ZALBP_SPLIT(IDIM_EFF,KSWB))
1901       ALLOCATE(  ZALBD_SPLIT(IDIM_EFF,KSWB))  
1902       ALLOCATE(  ZEMIS_SPLIT(IDIM_EFF))
1903       ALLOCATE(  ZEMIW_SPLIT(IDIM_EFF))
1904       ALLOCATE(  ZRMU0_SPLIT(IDIM_EFF))
1905       ALLOCATE(  ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
1906       ALLOCATE(  ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
1907       ALLOCATE(  ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
1908       ALLOCATE(  ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
1909       ALLOCATE(  ZDZ_SPLIT(IDIM_EFF,KFLEV))
1910       ALLOCATE(  ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
1911       ALLOCATE(  ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
1912       ALLOCATE(  ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
1913       ALLOCATE(  ZQLWC_SPLIT(IDIM_EFF,KFLEV))
1914       ALLOCATE(  ZQIWC_SPLIT(IDIM_EFF,KFLEV))
1915       ALLOCATE(  ZQRWC_SPLIT(IDIM_EFF,KFLEV))
1916       ALLOCATE(  ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
1917       ALLOCATE(  ZTAVE_SPLIT(IDIM_EFF,KFLEV))
1918       ALLOCATE(  ZPAVE_SPLIT(IDIM_EFF,KFLEV))
1919       ALLOCATE(  ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
1920       ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1921       ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1922       ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1923       ALLOCATE(  ZDPRES_SPLIT(IDIM_EFF,KFLEV))
1924       ALLOCATE(  ZLSM_SPLIT(IDIM_EFF))
1925       ALLOCATE(  ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
1926       ALLOCATE(  ZTS_SPLIT(IDIM_EFF))
1927       ! output pronostic       
1928       ALLOCATE(  ZDTLW_SPLIT(IDIM_EFF,KFLEV))
1929       ALLOCATE(  ZDTSW_SPLIT(IDIM_EFF,KFLEV))
1930       ALLOCATE(  ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
1931       ALLOCATE(  ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
1932       ALLOCATE(  ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
1933       ALLOCATE(  ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
1934       ALLOCATE(  ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
1935       ALLOCATE(  ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
1936 !
1937       ALLOCATE(  ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
1938       ALLOCATE(  ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
1939       ALLOCATE(  ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
1940       ALLOCATE(  ZRADLP_SPLIT(IDIM_EFF,KFLEV))
1941       IF(KRAD_DIAG >=1) THEN
1942         ALLOCATE(  ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
1943         ALLOCATE(  ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
1944       ELSE
1945         ALLOCATE(  ZNFSW_SPLIT(0,0))
1946         ALLOCATE(  ZNFLW_SPLIT(0,0))
1947       END IF
1948 !
1949       IF( KRAD_DIAG >= 2) THEN      
1950         ALLOCATE(  ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
1951         ALLOCATE(  ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
1952         ALLOCATE(  ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
1953         ALLOCATE(   ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
1954         ALLOCATE(   ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
1955       ELSE
1956         ALLOCATE(  ZFLUX_SW_DOWN_CS_SPLIT(0,0))
1957         ALLOCATE(  ZFLUX_SW_UP_CS_SPLIT(0,0))
1958         ALLOCATE(  ZFLUX_LW_CS_SPLIT(0,0,0))
1959         ALLOCATE(  ZNFSW_CS_SPLIT(0,0))
1960         ALLOCATE(  ZNFLW_CS_SPLIT(0,0))
1961       END IF
1962 !
1963       IF( KRAD_DIAG >= 3) THEN
1964         ALLOCATE(  ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
1965         ALLOCATE(  ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
1966         ALLOCATE(  ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
1967         ALLOCATE(  ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
1968         ALLOCATE(  ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
1969         ALLOCATE(  ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
1970       ELSE
1971         ALLOCATE(  ZPLAN_ALB_VIS_SPLIT(0))
1972         ALLOCATE(  ZPLAN_ALB_NIR_SPLIT(0))
1973         ALLOCATE(  ZPLAN_TRA_VIS_SPLIT(0))
1974         ALLOCATE(  ZPLAN_TRA_NIR_SPLIT(0))
1975         ALLOCATE(  ZPLAN_ABS_VIS_SPLIT(0))
1976         ALLOCATE(  ZPLAN_ABS_NIR_SPLIT(0))
1977       END IF
1978 !
1979       IF( KRAD_DIAG >= 4) THEN
1980         ALLOCATE(  ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
1981         ALLOCATE(  ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
1982         ALLOCATE(  ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
1983         ALLOCATE(  ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
1984         ALLOCATE(  ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
1985         ALLOCATE(  ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
1986         ALLOCATE(  ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
1987         ALLOCATE(  ZFLWP_SPLIT(IDIM_EFF,KFLEV))
1988         ALLOCATE(  ZFIWP_SPLIT(IDIM_EFF,KFLEV))
1989         ALLOCATE(  ZRADIP_SPLIT(IDIM_EFF,KFLEV))
1990       ELSE
1991         ALLOCATE(  ZEFCL_RRTM_SPLIT(0,0))
1992         ALLOCATE(  ZCLSW_TOTAL_SPLIT(0,0))
1993         ALLOCATE(  ZTAU_TOTAL_SPLIT(0,0,0))
1994         ALLOCATE(  ZOMEGA_TOTAL_SPLIT(0,0,0))
1995         ALLOCATE(  ZCG_TOTAL_SPLIT(0,0,0))
1996         ALLOCATE(  ZEFCL_LWD_SPLIT(0,0))
1997         ALLOCATE(  ZEFCL_LWU_SPLIT(0,0))
1998         ALLOCATE(  ZFLWP_SPLIT(0,0))
1999         ALLOCATE(  ZFIWP_SPLIT(0,0))
2000         ALLOCATE(  ZRADIP_SPLIT(0,0))
2001       END IF
2002 !
2003 ! C2R2 coupling
2004 !
2005       IF (SIZE (ZCCT_C2R2) > 0)  THEN
2006         ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
2007       ELSE
2008         ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
2009       END IF
2010 !
2011       IF (SIZE (ZCRT_C2R2) > 0)  THEN
2012         ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
2013       ELSE
2014         ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
2015       END IF
2016 !
2017       IF (SIZE (ZCIT_C1R3) > 0)  THEN
2018         ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
2019       ELSE
2020         ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
2021       END IF
2022     END IF
2023
2024 ! fill the splitted arrays with their values taken from the full arrays 
2025 !
2026     IBEG = IDIM-IDIM_RESIDUE+1
2027     IEND = IBEG+IDIM_EFF-1
2028 !
2029     ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
2030     ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
2031     ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND )
2032     ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND )
2033     ZRMU0_SPLIT(:)    = ZRMU0 ( IBEG:IEND )
2034     ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
2035     ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
2036     ZT_HL_SPLIT(:,:)    = ZT_HL( IBEG:IEND ,:)
2037     ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
2038     ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
2039     ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
2040     ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
2041     ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
2042     ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
2043     ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
2044     ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
2045     ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
2046     ZTAVE_SPLIT(:,:)  = ZTAVE ( IBEG:IEND ,:)
2047     ZPAVE_SPLIT(:,:)  = ZPAVE ( IBEG:IEND ,:)
2048     ZAER_SPLIT (:,:,:)  = ZAER  ( IBEG:IEND ,:,:)
2049     IF(CAOP=='EXPL')THEN
2050        ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
2051        ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
2052        ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
2053     ENDIF
2054     ZDPRES_SPLIT(:,:)  = ZDPRES (IBEG:IEND ,:)
2055     ZLSM_SPLIT (:)    = ZLSM (IBEG:IEND)
2056     ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
2057     ZTS_SPLIT (:) = ZTS (IBEG:IEND)
2058 !
2059 ! C2R2 concentrations
2060     IF (SIZE (ZCCT_C2R2) > 0)  ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
2061     IF (SIZE (ZCRT_C2R2) > 0)  ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)  
2062     IF (SIZE (ZCIT_C1R3) > 0)  ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
2063 !
2064 !  CALL the ECMWF radiation with the splitted array
2065 !
2066    CALL ECMWF_RADIATION_VERS2  ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER,              &    
2067          ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG,                    &
2068          ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT,            &
2069          ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
2070          ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,      & 
2071          ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT,  ZT_HL_SPLIT,      &
2072          ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, & 
2073          ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT,                 &          
2074          ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT,                  &
2075          ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT,                                          &
2076          ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT ,                 &
2077          ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT,         &
2078          ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT,         & 
2079          ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT,            &
2080          ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,           &
2081          ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT,               &
2082          ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT,           &
2083          ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT,                    &
2084          GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT  )
2085
2086 !
2087 ! fill the full output arrays with the splitted arrays
2088 !
2089     ZDTLW( IBEG:IEND ,:)  =  ZDTLW_SPLIT(:,:)  
2090     ZDTSW( IBEG:IEND ,:)  =  ZDTSW_SPLIT(:,:) 
2091     ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)=  ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:) 
2092     ZSFSWDIR (IBEG:IEND,:)  = ZSFSWDIR_SPLIT(:,:)
2093     ZSFSWDIF (IBEG:IEND,:)  = ZSFSWDIF_SPLIT(:,:)
2094 !
2095     ZDTLW_CS( IBEG:IEND ,:) =  ZDTLW_CS_SPLIT(:,:)
2096     ZDTSW_CS( IBEG:IEND ,:) =  ZDTSW_CS_SPLIT(:,:)
2097     ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) =                     &
2098          ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
2099     ZFLUX_LW( IBEG:IEND ,:,:)    =  ZFLUX_LW_SPLIT(:,:,:) 
2100     ZFLUX_SW_DOWN( IBEG:IEND ,:) =  ZFLUX_SW_DOWN_SPLIT(:,:)
2101     ZFLUX_SW_UP( IBEG:IEND ,:)   =  ZFLUX_SW_UP_SPLIT(:,:)
2102     ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
2103     IF( OCLOSE_OUT ) THEN
2104       IF( KRAD_DIAG >= 1) THEN
2105         ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
2106         ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
2107         IF( KRAD_DIAG >= 2) THEN
2108           ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
2109           ZFLUX_SW_UP_CS( IBEG:IEND ,:)   = ZFLUX_SW_UP_CS_SPLIT(:,:)
2110           ZFLUX_LW_CS( IBEG:IEND ,:,:)    = ZFLUX_LW_CS_SPLIT(:,:,:)
2111           ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
2112           ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
2113           IF( KRAD_DIAG >= 3) THEN
2114             ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
2115             ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
2116             ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
2117             ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
2118             ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
2119             ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)          
2120             IF( KRAD_DIAG >= 4) THEN
2121               ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
2122               ZEFCL_LWU( IBEG:IEND ,:)   = ZEFCL_LWU_SPLIT(:,:)
2123               ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
2124               ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
2125               ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
2126               ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
2127               ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
2128               ZTAU_TOTAL( IBEG:IEND ,:,:)  = ZTAU_TOTAL_SPLIT(:,:,:)
2129               ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
2130               ZCG_TOTAL( IBEG:IEND ,:,:)   = ZCG_TOTAL_SPLIT(:,:,:)                
2131             END IF
2132           END IF
2133         END IF
2134       END IF
2135     END IF
2136 !
2137     IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
2138 !
2139 ! desallocation of the splitted arrays
2140 !
2141     IF( JI_SPLIT >= INUM_CALL-1 ) THEN
2142       DEALLOCATE(  ZALBP_SPLIT )
2143       DEALLOCATE(  ZALBD_SPLIT )  
2144       DEALLOCATE(  ZEMIS_SPLIT  )
2145       DEALLOCATE(  ZEMIW_SPLIT  )
2146       DEALLOCATE(  ZRMU0_SPLIT      )
2147       DEALLOCATE(  ZCFAVE_SPLIT     )
2148       DEALLOCATE(  ZO3AVE_SPLIT     )
2149       DEALLOCATE(  ZT_HL_SPLIT      )
2150       DEALLOCATE(  ZPRES_HL_SPLIT   )
2151       DEALLOCATE(  ZDZ_SPLIT     )
2152       DEALLOCATE(  ZQLAVE_SPLIT     )
2153       DEALLOCATE(  ZQIAVE_SPLIT     )
2154       DEALLOCATE(  ZQVAVE_SPLIT     )
2155       DEALLOCATE(  ZTAVE_SPLIT      )
2156       DEALLOCATE(  ZPAVE_SPLIT      )
2157       DEALLOCATE(  ZAER_SPLIT       )
2158       DEALLOCATE(  ZDPRES_SPLIT     )
2159       DEALLOCATE(  ZLSM_SPLIT       )
2160       DEALLOCATE(  ZQSAVE_SPLIT     )
2161       DEALLOCATE(  ZQRAVE_SPLIT  )
2162       DEALLOCATE(  ZQLWC_SPLIT     )
2163       DEALLOCATE(  ZQRWC_SPLIT     )
2164       DEALLOCATE(  ZQIWC_SPLIT     )
2165       DEALLOCATE(   ZCCT_C2R2_SPLIT  )
2166       DEALLOCATE(   ZCRT_C2R2_SPLIT  )
2167       DEALLOCATE(   ZCIT_C1R3_SPLIT  )
2168       DEALLOCATE(  ZTS_SPLIT    )
2169       DEALLOCATE(   ZNFLW_CS_SPLIT)
2170       DEALLOCATE(   ZNFLW_SPLIT)
2171       DEALLOCATE(   ZNFSW_CS_SPLIT)
2172       DEALLOCATE(   ZNFSW_SPLIT)
2173       DEALLOCATE(ZDTLW_SPLIT)
2174       DEALLOCATE(ZDTSW_SPLIT)
2175       DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
2176       DEALLOCATE(ZSFSWDIR_SPLIT)
2177       DEALLOCATE(ZSFSWDIF_SPLIT)
2178       DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
2179       DEALLOCATE(ZFLUX_SW_UP_SPLIT)
2180       DEALLOCATE(ZFLUX_LW_SPLIT)
2181       DEALLOCATE(ZDTLW_CS_SPLIT)
2182       DEALLOCATE(ZDTSW_CS_SPLIT)
2183       DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
2184       DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
2185       DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
2186       DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
2187       DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
2188       DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
2189       DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
2190       DEALLOCATE(ZEFCL_LWD_SPLIT)
2191       DEALLOCATE(ZEFCL_LWU_SPLIT)
2192       DEALLOCATE(ZFLWP_SPLIT)
2193       DEALLOCATE(ZRADLP_SPLIT)
2194       DEALLOCATE(ZRADIP_SPLIT)
2195       DEALLOCATE(ZFIWP_SPLIT)
2196       DEALLOCATE(ZEFCL_RRTM_SPLIT)
2197       DEALLOCATE(ZCLSW_TOTAL_SPLIT)
2198       DEALLOCATE(ZTAU_TOTAL_SPLIT)
2199       DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
2200       DEALLOCATE(ZCG_TOTAL_SPLIT)
2201       DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
2202       DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
2203       DEALLOCATE(ZFLUX_LW_CS_SPLIT)
2204       DEALLOCATE(ZPIZA_EQ_SPLIT)
2205       DEALLOCATE(ZCGA_EQ_SPLIT)
2206       DEALLOCATE(ZTAUREL_EQ_SPLIT)
2207     END IF
2208   END DO
2209 END IF
2210
2211 !
2212 DEALLOCATE(ZTAVE)
2213 DEALLOCATE(ZPAVE)
2214 DEALLOCATE(ZQVAVE)
2215 DEALLOCATE(ZQLAVE)
2216 DEALLOCATE(ZDZ)
2217 DEALLOCATE(ZQIAVE)
2218 DEALLOCATE(ZCFAVE)
2219 DEALLOCATE(ZPRES_HL)
2220 DEALLOCATE(ZT_HL)
2221 DEALLOCATE(ZRMU0) 
2222 DEALLOCATE(ZLSM)
2223 DEALLOCATE(ZQSAVE)
2224 DEALLOCATE(ZAER)
2225 DEALLOCATE(ZPIZA_EQ)
2226 DEALLOCATE(ZCGA_EQ)
2227 DEALLOCATE(ZTAUREL_EQ)
2228 DEALLOCATE(ZDPRES)
2229 DEALLOCATE(ZCCT_C2R2)
2230 DEALLOCATE(ZCRT_C2R2)
2231 DEALLOCATE(ZCIT_C1R3)
2232 !
2233 DEALLOCATE(ZTS)
2234 DEALLOCATE(ZALBP)
2235 DEALLOCATE(ZALBD)
2236 DEALLOCATE(ZEMIS)
2237 DEALLOCATE(ZEMIW)
2238 DEALLOCATE(ZQRAVE)
2239 DEALLOCATE(ZQLWC)
2240 DEALLOCATE(ZQIWC)
2241 DEALLOCATE(ZQRWC)
2242 DEALLOCATE(ICLEAR_2D_TM1)
2243 !
2244 !*       5.6   UNCOMPRESSES THE OUTPUT FIELD IN CASE OF 
2245 !                      CLEAR-SKY APPROXIMATION
2246 !
2247 IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
2248   ALLOCATE(ZWORK1(ICLOUD))
2249   ALLOCATE(ZWORK2(ICLOUD+KFLEV)) !       allocation for the KFLEV levels of 
2250   ALLOCATE(ZWORK4(KFLEV,KDLON))
2251   ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
2252 !
2253   DO JK=1,KFLEV
2254     ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
2255   END DO
2256   ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
2257   ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:)   &
2258        ,FIELD=ZWORK4(:,:) ) )
2259   !
2260   ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
2261   DO JK=1,KFLEV
2262     ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
2263   END DO
2264   ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
2265   ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:)   &
2266        ,FIELD=ZWORK4(:,:) ) )
2267   !
2268   DEALLOCATE(ZWORK1)
2269   DEALLOCATE(ZWORK2)
2270   DEALLOCATE(ZWORK4)
2271   !
2272   ZZTGVISC   = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
2273   !
2274   ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
2275        FIELD=ZZTGVISC  )
2276   ZZTGNIRC   = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
2277   !
2278   ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
2279        FIELD=ZZTGNIRC )
2280   ZZTGIRC    = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
2281   !
2282   ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
2283        FIELD=ZZTGIRC  )
2284   !
2285   DO JSWB=1,ISWB
2286     ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
2287     !
2288     ZZSFSWDIR(:,JSWB) =  UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
2289          FIELD= ZZSFSWDIRC(JSWB)  ) 
2290     !
2291     ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
2292     !
2293     ZZSFSWDIF(:,JSWB) =  UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
2294          FIELD= ZZSFSWDIFC(JSWB)  )
2295   END DO
2296 !
2297 !  No cloud case
2298 !
2299   IF( GNOCL ) THEN
2300           IF (SIZE(ZZDTLW,1)>1) THEN
2301              ZZDTLW(1,:)= ZZDTLW(2,:)
2302           ENDIF
2303           IF (SIZE(ZZDTSW,1)>1) THEN
2304              ZZDTSW(1,:)= ZZDTSW(2,:)
2305           ENDIF
2306     ZZTGVIS(1) = ZZTGVISC
2307     ZZTGNIR(1) = ZZTGNIRC
2308     ZZTGIR(1)  = ZZTGIRC
2309     ZZSFSWDIR(1,:) =  ZZSFSWDIRC(:)
2310     ZZSFSWDIF(1,:) =  ZZSFSWDIFC(:)
2311   END IF
2312 ELSE
2313   ZZDTLW(:,:) = ZDTLW(:,:)
2314   ZZDTSW(:,:) = ZDTSW(:,:)
2315   ZZTGVIS(:)  = ZFLUX_TOP_GND_IRVISNIR(:,5)
2316   ZZTGNIR(:)  = ZFLUX_TOP_GND_IRVISNIR(:,6)
2317   ZZTGIR(:)   = ZFLUX_TOP_GND_IRVISNIR(:,4)
2318   ZZSFSWDIR(:,:) =  ZSFSWDIR(:,:)
2319   ZZSFSWDIF(:,:) =  ZSFSWDIF(:,:) 
2320 END IF
2321 !
2322 DEALLOCATE(ZDTLW)
2323 DEALLOCATE(ZDTSW)
2324 DEALLOCATE(ZSFSWDIR)
2325 DEALLOCATE(ZSFSWDIF)
2326 !
2327 !-------------------------------------------------------------------------------
2328 !
2329 !*       6.    COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES
2330 !              --------------------------------------------------------------
2331 !
2332 !  Computes the SW and LW radiative tendencies
2333 !  note : tendencies in K/s for MNH   
2334 !
2335 ZDTRAD_LW(:,:,:)=0.0
2336 ZDTRAD_SW(:,:,:)=0.0
2337 DO JK=IKB,IKE
2338   JKRAD= JK-JPVEXT
2339   DO JJ=IJB,IJE
2340     DO JI=IIB,IIE
2341       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2342       ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY
2343       ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY      
2344     END DO
2345   END DO
2346 END DO
2347 !
2348 !  Computes the downward SW and LW surface fluxes + diffuse and direct contribution
2349 !
2350 ZLWD(:,:)=0.
2351 ZSWDDIR(:,:,:)=0.
2352 ZSWDDIF(:,:,:)=0.
2353 !
2354 DO JJ=IJB,IJE
2355   DO JI=IIB,IIE
2356     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2357     ZLWD(JI,JJ) = ZZTGIR(IIJ)
2358     ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
2359     ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
2360   END DO
2361 END DO
2362 !
2363 !final  THETA_radiative tendency and surface fluxes 
2364 !
2365 IF(OCLOUD_ONLY) THEN
2366   !
2367   ZWORKL(:,:) = SUM(PCLDFR(:,:,:),DIM=3) > 0.0
2368   DO JK = IKB,IKE
2369     WHERE( ZWORKL(:,:) )
2370       PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
2371     ENDWHERE
2372   END DO
2373   !
2374   WHERE( ZWORKL(:,:) )
2375     PSRFLWD(:,:) = ZLWD(:,:)
2376   ENDWHERE
2377   DO JSWB=1,ISWB
2378     WHERE( ZWORKL(:,:) )
2379       PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
2380       PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
2381     END WHERE
2382   END DO
2383 ELSE
2384   PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:)
2385   PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
2386   PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
2387   PSRFLWD(:,:) = ZLWD(:,:)
2388   DO JSWB=1,ISWB
2389     PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
2390     PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
2391   END DO
2392 !
2393 !sw and lw fluxes 
2394 !
2395   DO JK=IKB,IKE
2396    JKRAD = JK - JPVEXT
2397    DO JJ=IJB,IJE
2398     DO JI=IIB,IIE
2399           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2400           PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
2401           PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
2402           PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
2403           PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
2404     END DO
2405    END DO
2406   END DO
2407 !!!effective radius
2408   DO JK=IKB,IKE
2409    JKRAD = JK - JPVEXT
2410    DO JJ=IJB,IJE
2411     DO JI=IIB,IIE
2412           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2413           PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
2414     END DO
2415    END DO
2416   END DO
2417 END IF
2418 !
2419 !
2420 !-------------------------------------------------------------------------------
2421 !
2422 !*       7.    STORE SOME ADDITIONNAL RADIATIVE FIELDS
2423 !              ---------------------------------------
2424 !
2425 IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
2426   ZSTORE_3D(:,:,:) = 0.0
2427   ZSTORE_3D2(:,:,:) = 0.0
2428   ZSTORE_2D(:,:)   = 0.0
2429   !
2430   IF( KRAD_DIAG >= 1) THEN
2431     !
2432     CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
2433     WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
2434          & " KRAD_DIAG=",I1,/)') KRAD_DIAG
2435     DO JK=IKB,IKE
2436       JKRAD = JK - JPVEXT
2437       DO JJ=IJB,IJE
2438         DO JI=IIB,IIE
2439           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2440           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
2441         END DO
2442       END DO
2443     END DO
2444     YDIR='XY'
2445     YRECFM   = 'SWF_DOWN'
2446     YCOMMENT = 'X_Y_Z_SWF_DOWN (W/M2)'
2447     IGRID    = 1
2448     ILENCH   = LEN(YCOMMENT)
2449     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2450 !
2451     DO JK=IKB,IKE
2452       JKRAD = JK - JPVEXT
2453       DO JJ=IJB,IJE
2454         DO JI=IIB,IIE
2455           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2456           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
2457         END DO
2458       END DO
2459     END DO
2460     YRECFM   = 'SWF_UP'
2461     YCOMMENT = 'X_Y_Z_SWF_UP (W/M2)'
2462     IGRID    = 1
2463     ILENCH   = LEN(YCOMMENT)
2464     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2465 !
2466     DO JK=IKB,IKE
2467       JKRAD = JK - JPVEXT
2468       DO JJ=IJB,IJE
2469         DO JI=IIB,IIE
2470           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2471           ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
2472         END DO
2473       END DO
2474     END DO
2475     YRECFM   = 'LWF_DOWN'
2476     YCOMMENT = 'X_Y_Z_LWF_DOWN (W/M2)'
2477     IGRID    = 1
2478     ILENCH   = LEN(YCOMMENT)
2479     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2480 !
2481     DO JK=IKB,IKE
2482       JKRAD = JK - JPVEXT
2483       DO JJ=IJB,IJE
2484         DO JI=IIB,IIE
2485           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2486           ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
2487         END DO
2488       END DO
2489     END DO
2490     YRECFM   = 'LWF_UP'
2491     YCOMMENT = 'X_Y_Z_LWF_UP (W/M2)'
2492     IGRID    = 1
2493     ILENCH   = LEN(YCOMMENT)
2494     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2495 !
2496     DO JK=IKB,IKE
2497       JKRAD = JK - JPVEXT
2498       DO JJ=IJB,IJE
2499         DO JI=IIB,IIE
2500           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2501           ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
2502         END DO
2503       END DO
2504     END DO
2505     YRECFM   = 'LWF_NET'
2506     YCOMMENT = 'X_Y_Z_LWF_NET (W/M2)'
2507     IGRID    = 1
2508     ILENCH   = LEN(YCOMMENT)
2509     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2510 !
2511     DO JK=IKB,IKE
2512       JKRAD = JK - JPVEXT
2513       DO JJ=IJB,IJE
2514         DO JI=IIB,IIE
2515           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2516           ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
2517         END DO
2518       END DO
2519     END DO
2520     YRECFM   = 'SWF_NET'
2521     YCOMMENT = 'X_Y_Z_SWF_NET (W/M2)'
2522     IGRID    = 1
2523     ILENCH   = LEN(YCOMMENT)
2524     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2525 !
2526     DO JK=IKB,IKE
2527       DO JJ=IJB,IJE
2528         DO JI=IIB,IIE
2529           ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
2530         END DO
2531       END DO
2532     END DO
2533     YRECFM   = 'DTRAD_LW'
2534     YCOMMENT = 'X_Y_Z_DTRAD_LW (K/DAY)'
2535     IGRID    = 1
2536     ILENCH   = LEN(YCOMMENT)
2537     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2538 !
2539     DO JK=IKB,IKE
2540       DO JJ=IJB,IJE
2541         DO JI=IIB,IIE
2542           ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
2543         END DO
2544       END DO
2545     END DO
2546     YRECFM   = 'DTRAD_SW'
2547     YCOMMENT = 'X_Y_Z_DTRAD_SW (K/DAY)'
2548     IGRID    = 1
2549     ILENCH   = LEN(YCOMMENT)
2550     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2551 !
2552     DO JJ=IJB,IJE
2553       DO JI=IIB,IIE
2554         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2555         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
2556       END DO
2557     END DO
2558     YRECFM   = 'RADSWD_VIS'
2559     YCOMMENT = 'X_Y_RADSWD_VIS'
2560     IGRID    = 1
2561     ILENCH   = LEN(YCOMMENT)
2562     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2563 !
2564     DO JJ=IJB,IJE
2565       DO JI=IIB,IIE
2566         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2567         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
2568       END DO
2569     END DO
2570     YRECFM   = 'RADSWD_NIR'
2571     YCOMMENT = 'X_Y_Z_RADSWD_NIR'
2572     IGRID    = 1
2573     ILENCH   = LEN(YCOMMENT)
2574     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2575     !
2576     DO JJ=IJB,IJE
2577       DO JI=IIB,IIE
2578         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2579         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
2580       END DO
2581     END DO
2582     YRECFM   = 'RADLWD'
2583     YCOMMENT = 'X_Y_RADLWD'
2584     IGRID    = 1
2585     ILENCH   = LEN(YCOMMENT)
2586     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2587   END IF
2588   !
2589   !
2590   IF( KRAD_DIAG >= 2) THEN
2591     DO JK=IKB,IKE
2592       JKRAD = JK - JPVEXT
2593       DO JJ=IJB,IJE
2594         DO JI=IIB,IIE
2595           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2596           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
2597         END DO
2598       END DO
2599     END DO
2600     YDIR='XY'
2601     YRECFM   = 'SWF_DOWN_CS'
2602     YCOMMENT = 'X_Y_Z_SWF_DOWN_CS (W/M2)'
2603     IGRID    = 1
2604     ILENCH   = LEN(YCOMMENT)
2605     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2606     !
2607     DO JK=IKB,IKE
2608       JKRAD = JK - JPVEXT
2609       DO JJ=IJB,IJE
2610         DO JI=IIB,IIE
2611           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2612           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
2613         END DO
2614       END DO
2615     END DO
2616     YRECFM   = 'SWF_UP_CS'
2617     YCOMMENT = 'X_Y_Z_SWF_UP_CS (W/M2)'
2618     IGRID    = 1
2619     ILENCH   = LEN(YCOMMENT)
2620     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2621     !
2622     DO JK=IKB,IKE
2623       JKRAD = JK - JPVEXT
2624       DO JJ=IJB,IJE
2625         DO JI=IIB,IIE
2626           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2627           ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
2628         END DO
2629       END DO
2630     END DO
2631     YRECFM   = 'LWF_DOWN_CS'
2632     YCOMMENT = 'X_Y_Z_LWF_DOWN (W/M2)'
2633     IGRID    = 1
2634     ILENCH   = LEN(YCOMMENT)
2635     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2636     !
2637     DO JK=IKB,IKE
2638       JKRAD = JK - JPVEXT
2639       DO JJ=IJB,IJE
2640         DO JI=IIB,IIE
2641           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2642           ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
2643         END DO
2644       END DO
2645     END DO
2646     YRECFM   = 'LWF_UP_CS'
2647     YCOMMENT = 'X_Y_Z_LWF_UP_CS (W/M2)'
2648     IGRID    = 1
2649     ILENCH   = LEN(YCOMMENT)
2650     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2651     !
2652     DO JK=IKB,IKE
2653       JKRAD = JK - JPVEXT
2654       DO JJ=IJB,IJE
2655         DO JI=IIB,IIE
2656           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2657           ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
2658         END DO
2659       END DO
2660     END DO
2661     YRECFM   = 'LWF_NET_CS'
2662     YCOMMENT = 'X_Y_Z_SWF_NET_CS (W/M2)'
2663     IGRID    = 1
2664     ILENCH   = LEN(YCOMMENT)
2665     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2666     !
2667     DO JK=IKB,IKE
2668       JKRAD = JK - JPVEXT
2669       DO JJ=IJB,IJE
2670         DO JI=IIB,IIE
2671           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2672           ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
2673         END DO
2674       END DO
2675     END DO
2676     YRECFM   = 'SWF_NET_CS'
2677     YCOMMENT = 'X_Y_Z_SWF_NET_CS (W/M2)'
2678     IGRID    = 1
2679     ILENCH   = LEN(YCOMMENT)
2680     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2681     !
2682     DO JK=IKB,IKE
2683       JKRAD = JK-JPVEXT
2684       DO JJ=IJB,IJE
2685         DO JI=IIB,IIE
2686           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2687           ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD) 
2688         END DO
2689       END DO
2690     END DO
2691     YRECFM   = 'DTRAD_SW_CS'
2692     YCOMMENT = 'X_Y_Z_DTRAD_SW_CS (K/DAY)'
2693     IGRID    = 1
2694     ILENCH   = LEN(YCOMMENT)
2695     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2696     !
2697     DO JK=IKB,IKE
2698       JKRAD = JK-JPVEXT
2699       DO JJ=IJB,IJE
2700         DO JI=IIB,IIE
2701           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2702           ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD) 
2703         END DO
2704       END DO
2705     END DO
2706     YRECFM   = 'DTRAD_LW_CS'
2707     YCOMMENT = 'X_Y_Z_DTRAD_LW_CS (K/DAY)'
2708     IGRID    = 1
2709     ILENCH   = LEN(YCOMMENT)
2710     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2711     !
2712     DO JJ=IJB,IJE
2713       DO JI=IIB,IIE
2714         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2715         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
2716       END DO
2717     END DO
2718     YRECFM   = 'RADSWD_VIS_CS'
2719     YCOMMENT = 'X_Y_RADSWD_VIS_CS'
2720     IGRID    = 1
2721     ILENCH   = LEN(YCOMMENT)
2722     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2723     !
2724     DO JJ=IJB,IJE
2725       DO JI=IIB,IIE
2726         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2727         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
2728       END DO
2729     END DO
2730     YRECFM   = 'RADSWD_NIR_CS'
2731     YCOMMENT = 'X_Y_RADSWD_NIR_CS'
2732     IGRID    = 1
2733     ILENCH   = LEN(YCOMMENT)
2734     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2735     !
2736     DO JJ=IJB,IJE
2737       DO JI=IIB,IIE
2738         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2739         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
2740       END DO
2741     END DO
2742     YRECFM   = 'RADLWD_CS'
2743     YCOMMENT = 'X_Y_RADLWD_CS'
2744     IGRID    = 1
2745     ILENCH   = LEN(YCOMMENT)
2746     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2747   END IF
2748   !
2749   !
2750   IF( KRAD_DIAG >= 3) THEN
2751     DO JJ=IJB,IJE
2752       DO JI=IIB,IIE
2753         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2754         ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
2755       END DO
2756     END DO
2757     YRECFM   = 'PLAN_ALB_VIS'
2758     YCOMMENT = 'X_Y_PLAN_ALB_VIS'
2759     IGRID    = 1
2760     ILENCH   = LEN(YCOMMENT)
2761     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2762     !
2763     DO JJ=IJB,IJE
2764       DO JI=IIB,IIE
2765         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2766         ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
2767       END DO
2768     END DO
2769     YRECFM   = 'PLAN_ALB_NIR'
2770     YCOMMENT = 'X_Y_PLAN_ALB_NIR'
2771     IGRID    = 1
2772     ILENCH   = LEN(YCOMMENT)
2773     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2774     !
2775     DO JJ=IJB,IJE
2776       DO JI=IIB,IIE
2777         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2778         ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
2779       END DO
2780     END DO
2781     YRECFM   = 'PLAN_TRA_VIS'
2782     YCOMMENT = 'X_Y_PLAN_TRA_VIS'
2783     IGRID    = 1
2784     ILENCH   = LEN(YCOMMENT)
2785     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2786     !
2787     DO JJ=IJB,IJE
2788       DO JI=IIB,IIE
2789         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2790         ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
2791       END DO
2792     END DO
2793     YRECFM   = 'PLAN_TRA_NIR'
2794     YCOMMENT = 'X_Y_PLAN_TRA_NIR'
2795     IGRID    = 1
2796     ILENCH   = LEN(YCOMMENT)
2797     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2798     !
2799     DO JJ=IJB,IJE
2800       DO JI=IIB,IIE
2801         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2802         ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
2803       END DO
2804     END DO
2805     YRECFM   = 'PLAN_ABS_VIS'
2806     YCOMMENT = 'X_Y_PLAN_ABS_VIS'
2807     IGRID    = 1
2808     ILENCH   = LEN(YCOMMENT)
2809     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2810     !
2811     DO JJ=IJB,IJE
2812       DO JI=IIB,IIE
2813         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2814         ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
2815       END DO
2816     END DO
2817     YRECFM   = 'PLAN_ABS_NIR'
2818     YCOMMENT = 'X_Y_PLAN_ABS_NIR'
2819     IGRID    = 1
2820     ILENCH   = LEN(YCOMMENT)
2821     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2822     !
2823     !
2824   END IF
2825 !
2826 !
2827   IF( KRAD_DIAG >= 4) THEN
2828     DO JK=IKB,IKE
2829       JKRAD = JK - JPVEXT
2830       DO JJ=IJB,IJE
2831         DO JI=IIB,IIE
2832           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2833           ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
2834         END DO
2835       END DO
2836     END DO
2837     YRECFM   = 'EFNEB_DOWN'
2838     YCOMMENT = 'X_Y_Z_EFNEB_DOWN'
2839     IGRID    = 1
2840     ILENCH   = LEN(YCOMMENT)
2841     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2842     !
2843     DO JK=IKB,IKE
2844       JKRAD = JK - JPVEXT
2845       DO JJ=IJB,IJE
2846         DO JI=IIB,IIE
2847           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2848           ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
2849         END DO
2850       END DO
2851     END DO
2852     YRECFM   = 'EFNEB_UP'
2853     YCOMMENT = 'X_Y_Z_EFNEB_UP'
2854     IGRID    = 1
2855     ILENCH   = LEN(YCOMMENT)
2856     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2857     !
2858     DO JK=IKB,IKE
2859       JKRAD = JK - JPVEXT
2860       DO JJ=IJB,IJE
2861         DO JI=IIB,IIE
2862           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2863           ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
2864         END DO
2865       END DO
2866     END DO
2867     YRECFM   = 'FLWP'
2868     YCOMMENT = 'X_Y_Z_FLWP'
2869     IGRID    = 1
2870     ILENCH   = LEN(YCOMMENT)
2871     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2872     !
2873     DO JK=IKB,IKE
2874       JKRAD = JK - JPVEXT
2875       DO JJ=IJB,IJE
2876         DO JI=IIB,IIE
2877           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2878           ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
2879         END DO
2880       END DO
2881     END DO
2882     YRECFM   = 'FIWP'
2883     YCOMMENT = 'X_Y_Z_FIWP'
2884     IGRID    = 1
2885     ILENCH   = LEN(YCOMMENT)
2886     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2887   !
2888     DO JK=IKB,IKE
2889       JKRAD = JK - JPVEXT
2890       DO JJ=IJB,IJE
2891         DO JI=IIB,IIE
2892           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2893           ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
2894         END DO
2895       END DO
2896     END DO
2897     YRECFM   = 'EFRADL'
2898     YCOMMENT = 'X_Y_Z_RAD_microm'
2899     IGRID    = 1
2900     ILENCH   = LEN(YCOMMENT)
2901     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2902  
2903     DO JK=IKB,IKE
2904       JKRAD = JK - JPVEXT
2905       DO JJ=IJB,IJE
2906         DO JI=IIB,IIE
2907           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2908           ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
2909         END DO
2910       END DO
2911     END DO
2912     YRECFM   = 'EFRADI'
2913     YCOMMENT = 'X_Y_Z_RAD_microm'
2914     IGRID    = 1
2915     ILENCH   = LEN(YCOMMENT)
2916     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2917  !
2918     DO JK=IKB,IKE
2919       JKRAD = JK - JPVEXT
2920       DO JJ=IJB,IJE
2921         DO JI=IIB,IIE
2922           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2923           ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
2924         END DO
2925       END DO
2926     END DO
2927     YRECFM   = 'SW_NEB'
2928     YCOMMENT = 'X_Y_Z_SW_NEB'
2929     IGRID    = 1
2930     ILENCH   = LEN(YCOMMENT)
2931     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2932     !
2933     DO JK=IKB,IKE
2934       JKRAD = JK - JPVEXT
2935       DO JJ=IJB,IJE
2936         DO JI=IIB,IIE
2937           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2938           ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
2939         END DO
2940       END DO
2941     END DO
2942     YRECFM   = 'RRTM_LW_NEB'
2943     YCOMMENT = 'X_Y_Z_LW_NEB'
2944     IGRID    = 1
2945     ILENCH   = LEN(YCOMMENT)
2946     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2947     !
2948     ! spectral bands
2949     IF (KSWB==6) THEN
2950       INIR = 4
2951     ELSE
2952       INIR = 2
2953     END IF
2954
2955     DO JBAND=1,INIR-1
2956       WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
2957     END DO
2958     DO JBAND= INIR, KSWB
2959       WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
2960     END DO
2961 !
2962     DO JBAND=1,KSWB
2963       YRECFM   = 'ODAER_'//YBAND_NAME(JBAND)
2964       YCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
2965       IGRID    = 1
2966       ILENCH   = LEN(YCOMMENT)
2967       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZTAUAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
2968       YRECFM   = 'SSAAER_'//YBAND_NAME(JBAND)
2969       YCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
2970       IGRID    = 1
2971       ILENCH   = LEN(YCOMMENT)
2972       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZPIZAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
2973       YRECFM   = 'GAER_'//YBAND_NAME(JBAND)
2974       YCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
2975       IGRID    = 1
2976       ILENCH   = LEN(YCOMMENT)
2977       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZCGAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
2978     ENDDO
2979
2980     DO JBAND=1,KSWB
2981       DO JK=IKB,IKE
2982         JKRAD = JK - JPVEXT
2983         DO JJ=IJB,IJE
2984           DO JI=IIB,IIE
2985             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2986             ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
2987           END DO
2988         END DO
2989       END DO
2990       YRECFM   = 'OTH_'//YBAND_NAME(JBAND)
2991       YCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
2992       IGRID    = 1
2993       ILENCH   = LEN(YCOMMENT)
2994       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2995       !
2996       DO JK=IKB,IKE
2997         JKRAD = JK - JPVEXT
2998         DO JJ=IJB,IJE
2999           DO JI=IIB,IIE
3000             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3001             ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
3002           END DO
3003         END DO
3004       END DO
3005       YRECFM   = 'SSA_'//YBAND_NAME(JBAND)
3006       YCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
3007       IGRID    = 1
3008       ILENCH   = LEN(YCOMMENT)
3009       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3010       !
3011       DO JK=IKB,IKE
3012         JKRAD = JK - JPVEXT
3013         DO JJ=IJB,IJE
3014           DO JI=IIB,IIE
3015             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3016             ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
3017           END DO
3018         END DO
3019       END DO
3020       YRECFM   = 'ASF_'//YBAND_NAME(JBAND)
3021       YCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
3022       IGRID    = 1
3023       ILENCH   = LEN(YCOMMENT)
3024       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3025     END DO
3026   END IF
3027   !
3028   !
3029   IF (KRAD_DIAG >= 5)   THEN
3030 !
3031 ! OZONE and AER optical thickness climato  entering the ecmwf_radiation_vers2
3032 ! note the vertical grid is re-inversed for graphic !   
3033     DO JK=IKB,IKE
3034       JKRAD = KFLEV+1 - JK + JPVEXT               
3035       DO JJ=IJB,IJE
3036         DO JI=IIB,IIE 
3037           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3038           ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
3039         END DO
3040       END DO
3041     END DO
3042     YDIR='XY'
3043     YRECFM   = 'O3CLIM'
3044     YCOMMENT = 'X_Y_Z_O3 Pa/Pa'
3045     IGRID    = 1
3046     ILENCH   = LEN(YCOMMENT)
3047     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3048
3049 !cumulated optical thickness of aerosols
3050 !cumul begin from the top of the domain, not from the TOA !      
3051 !
3052 !land 
3053     DO JK=IKB,IKE
3054       JKRAD = JK - JPVEXT
3055       DO JJ=IJB,IJE
3056         DO JI=IIB,IIE
3057           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
3058         END DO
3059       END DO
3060     END DO
3061 !
3062     ZSTORE_2D (:,:) = 0.
3063     DO JK=IKB,IKE
3064       JK1=IKE-JK+IKB 
3065       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3066       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3067     END DO
3068     YDIR='XY'
3069     YRECFM   = 'CUM_AER_LAND'
3070     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3071     IGRID    = 1
3072     ILENCH   = LEN(YCOMMENT)
3073     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3074 !
3075 ! sea
3076     DO JK=IKB,IKE
3077       JKRAD = JK - JPVEXT
3078       DO JJ=IJB,IJE
3079         DO JI=IIB,IIE
3080           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
3081         END DO
3082       END DO
3083     END DO
3084 !sum
3085     ZSTORE_2D (:,:) = 0.
3086     DO JK=IKB,IKE
3087       JK1=IKE-JK+IKB 
3088       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3089       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3090     END DO
3091 !
3092     YDIR='XY'
3093     YRECFM   = 'CUM_AER_SEA'
3094     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3095     IGRID    = 1
3096     ILENCH   = LEN(YCOMMENT)
3097     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3098 !
3099 ! desert
3100     DO JK=IKB,IKE
3101       JKRAD = JK - JPVEXT
3102       DO JJ=IJB,IJE
3103         DO JI=IIB,IIE
3104           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
3105         END DO
3106       END DO
3107     END DO
3108 !sum     
3109     ZSTORE_2D (:,:) = 0.
3110     DO JK=IKB,IKE
3111       JK1=IKE-JK+IKB 
3112       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3113       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3114     END DO
3115 !    
3116     YDIR='XY'
3117     YRECFM   = 'CUM_AER_DES'
3118     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3119     IGRID    = 1
3120     ILENCH   = LEN(YCOMMENT)
3121     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3122 !
3123 ! urban
3124     DO JK=IKB,IKE
3125       JKRAD = JK - JPVEXT
3126       DO JJ=IJB,IJE
3127         DO JI=IIB,IIE
3128           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
3129         END DO
3130       END DO
3131     END DO
3132 !sum      
3133     ZSTORE_2D (:,:) = 0.
3134     DO JK=IKB,IKE
3135       JK1=IKE-JK+IKB 
3136       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3137       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3138     END DO
3139 !
3140     YDIR='XY'
3141     YRECFM   = 'CUM_AER_URB'
3142     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3143     IGRID    = 1
3144     ILENCH   = LEN(YCOMMENT)
3145     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3146 !
3147 ! Volcanoes
3148     DO JK=IKB,IKE
3149       JKRAD = JK - JPVEXT
3150       DO JJ=IJB,IJE
3151         DO JI=IIB,IIE
3152           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
3153         END DO
3154       END DO
3155     END DO
3156 !sum         
3157     ZSTORE_2D (:,:) = 0.
3158     DO JK=IKB,IKE
3159       JK1=IKE-JK+IKB 
3160       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3161       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3162     END DO
3163 !
3164     YDIR='XY'
3165     YRECFM   = 'CUM_AER_VOL'
3166     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3167     IGRID    = 1
3168     ILENCH   = LEN(YCOMMENT)
3169     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3170 !
3171 ! stratospheric background
3172     DO JK=IKB,IKE
3173       JKRAD = JK - JPVEXT
3174       DO JJ=IJB,IJE
3175         DO JI=IIB,IIE
3176           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
3177         END DO
3178       END DO
3179     END DO
3180 !sum      
3181     ZSTORE_2D (:,:) = 0.
3182     DO JK=IKB,IKE
3183       JK1=IKE-JK+IKB 
3184       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3185       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3186     END DO
3187 !
3188     YDIR='XY'
3189     YRECFM   = 'CUM_AER_STRB'
3190     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3191     IGRID    = 1
3192     ILENCH   = LEN(YCOMMENT)
3193     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3194   ENDIF
3195 END IF
3196 !
3197
3198 DEALLOCATE(ZNFLW_CS)
3199 DEALLOCATE(ZNFLW)
3200 DEALLOCATE(ZNFSW_CS)
3201 DEALLOCATE(ZNFSW)
3202 DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
3203 DEALLOCATE(ZFLUX_SW_DOWN)
3204 DEALLOCATE(ZFLUX_SW_UP)
3205 DEALLOCATE(ZFLUX_LW)
3206 DEALLOCATE(ZDTLW_CS)
3207 DEALLOCATE(ZDTSW_CS)
3208 DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
3209 DEALLOCATE(ZPLAN_ALB_VIS)
3210 DEALLOCATE(ZPLAN_ALB_NIR)
3211 DEALLOCATE(ZPLAN_TRA_VIS)
3212 DEALLOCATE(ZPLAN_TRA_NIR)
3213 DEALLOCATE(ZPLAN_ABS_VIS)
3214 DEALLOCATE(ZPLAN_ABS_NIR)
3215 DEALLOCATE(ZEFCL_LWD)
3216 DEALLOCATE(ZEFCL_LWU)
3217 DEALLOCATE(ZFLWP)
3218 DEALLOCATE(ZFIWP)
3219 DEALLOCATE(ZRADLP)
3220 DEALLOCATE(ZRADIP)
3221 DEALLOCATE(ZEFCL_RRTM)
3222 DEALLOCATE(ZCLSW_TOTAL)
3223 DEALLOCATE(ZTAU_TOTAL)
3224 DEALLOCATE(ZOMEGA_TOTAL)
3225 DEALLOCATE(ZCG_TOTAL)
3226 DEALLOCATE(ZFLUX_SW_DOWN_CS)
3227 DEALLOCATE(ZFLUX_SW_UP_CS)
3228 DEALLOCATE(ZFLUX_LW_CS)
3229 DEALLOCATE(ZO3AVE)
3230 !
3231 !-------------------------------------------------------------------------------
3232 !
3233 END SUBROUTINE RADIATIONS
3234