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