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