source: LMDZ6/trunk/libf/phylmd/radlwsw_m.F90 @ 3435

Last change on this file since 3435 was 3435, checked in by Laurent Fairhead, 5 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

  • as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

  • due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Author Date Id Revi
File size: 46.0 KB
Line 
1!
2! $Id: radlwsw_m.F90 3435 2019-01-22 15:21:59Z fairhead $
3!
4module radlwsw_m
5
6  IMPLICIT NONE
7
8contains
9
10SUBROUTINE radlwsw( &
11   dist, rmu0, fract, &
12!albedo SB >>>
13!  paprs, pplay,tsol,alb1, alb2, &
14   paprs, pplay,tsol,SFRWL,alb_dir, alb_dif, &
15!albedo SB <<<
16   t,q,wo,&
17   cldfra, cldemi, cldtaupd,&
18   ok_ade, ok_aie, flag_aerosol,&
19   flag_aerosol_strat, flag_aer_feedback, &
20   tau_aero, piz_aero, cg_aero,&
21   tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM
22   tau_aero_lw_rrtm, &                                   ! rajoute par C. Kleinschmitt pour RRTM
23   cldtaupi, new_aod, &
24   qsat, flwc, fiwc, &
25   ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
26   heat,heat0,cool,cool0,albpla,&
27   topsw,toplw,solsw,sollw,&
28   sollwdown,&
29   topsw0,toplw0,solsw0,sollw0,&
30   lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,&
31   swdnc0, swdn0, swdn, swupc0, swup0, swup,&
32   topswad_aero, solswad_aero,&
33   topswai_aero, solswai_aero, &
34   topswad0_aero, solswad0_aero,&
35   topsw_aero, topsw0_aero,&
36   solsw_aero, solsw0_aero, &
37   topswcf_aero, solswcf_aero,&
38!-C. Kleinschmitt for LW diagnostics
39   toplwad_aero, sollwad_aero,&
40   toplwai_aero, sollwai_aero, &
41   toplwad0_aero, sollwad0_aero,&
42!-end
43   ZLWFT0_i, ZFLDN0, ZFLUP0,&
44   ZSWFT0_i, ZFSDN0, ZFSUP0)
45
46
47
48  USE DIMPHY
49  USE assert_m, ONLY : assert
50  USE infotrac_phy, ONLY : type_trac
51  USE write_field_phy
52#ifdef REPROBUS
53  USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
54#endif
55#ifdef CPP_RRTM
56!    modules necessaires au rayonnement
57!    -----------------------------------------
58!     USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
59!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LINHOM   , LCCNL,LCCNO,
60!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO ,&
61! NSW mis dans .def MPL 20140211
62! NLW ajoute par OB
63      USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO ,&
64          NRADIP   , NRADLP , NICEOPT, NLIQOPT ,RCCNLND  , RCCNSEA
65      USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
66      USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD,&   
67          RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC,&   
68          REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ,& 
69          REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0,& 
70          RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3,& 
71          RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0,& 
72          RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RASWCA,&
73          RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF
74!    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
75      USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
76!      USE YOETHF   , ONLY : RTICE
77      USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK     
78      USE YOMPHY3  , ONLY : RII0
79#endif
80      USE aero_mod
81
82  !======================================================================
83  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
84  ! Objet: interface entre le modele et les rayonnements
85  ! Arguments:
86  ! dist-----input-R- distance astronomique terre-soleil
87  ! rmu0-----input-R- cosinus de l'angle zenithal
88  ! fract----input-R- duree d'ensoleillement normalisee
89  ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
90  ! paprs----input-R- pression a inter-couche (Pa)
91  ! pplay----input-R- pression au milieu de couche (Pa)
92  ! tsol-----input-R- temperature du sol (en K)
93  ! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible
94  ! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
95  ! t--------input-R- temperature (K)
96  ! q--------input-R- vapeur d'eau (en kg/kg)
97  ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
98  ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
99  ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
100  ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
101  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
102  ! flag_aerosol-input-I- aerosol flag from 0 to 6
103  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (0, 1, 2)
104  ! flag_aer_feedback-input-I- activate aerosol radiative feedback (T, F)
105  ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
106  ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
107  !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
108  !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
109  !                   it is needed for the diagnostics of the aerosol indirect radiative forcing     
110  !
111  ! heat-----output-R- echauffement atmospherique (visible) (K/jour)
112  ! cool-----output-R- refroidissement dans l'IR (K/jour)
113  ! albpla---output-R- albedo planetaire (entre 0 et 1)
114  ! topsw----output-R- flux solaire net au sommet de l'atm.
115  ! toplw----output-R- ray. IR montant au sommet de l'atmosphere
116  ! solsw----output-R- flux solaire net a la surface
117  ! sollw----output-R- ray. IR montant a la surface
118  ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
119  ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
120  ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
121  ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
122  !
123  ! ATTENTION: swai and swad have to be interpreted in the following manner:
124  ! ---------
125  ! ok_ade=F & ok_aie=F -both are zero
126  ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
127  !                        indirect is zero
128  ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
129  !                        direct is zero
130  ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
131  !                        aerosol direct forcing is F_{AD} = topswai-topswad
132  !
133  ! --------- RRTM: output RECMWFL
134  ! ZEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
135  ! ZEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
136  ! ZTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
137  ! ZTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
138  ! ZCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
139  ! ZCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
140  ! ZTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
141  ! ZLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
142  ! ZLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
143  ! ZLWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY LONGWAVE FLUXES      ! added by MPL 090109
144  ! ZSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
145  ! ZSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES
146  ! ZSWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY SHORTWAVE FLUXES     ! added by MPL 090109
147  ! ZFLUX (KLON,2,KLEV+1)         ; TOTAL LW FLUXES  1=up, 2=DWN   ! added by MPL 080411
148  ! ZFLUC (KLON,2,KLEV+1)         ; CLEAR SKY LW FLUXES            ! added by MPL 080411
149  ! ZFSDWN(klon,KLEV+1)           ; TOTAL SW  DWN FLUXES           ! added by MPL 080411
150  ! ZFCDWN(klon,KLEV+1)           ; CLEAR SKY SW  DWN FLUXES       ! added by MPL 080411
151  ! ZFCCDWN(klon,KLEV+1)          ; CLEAR SKY CLEAN (NO AEROSOL) SW  DWN FLUXES      ! added by OB 211117
152  ! ZFSUP (klon,KLEV+1)           ; TOTAL SW  UP  FLUXES           ! added by MPL 080411
153  ! ZFCUP (klon,KLEV+1)           ; CLEAR SKY SW  UP  FLUXES       ! added by MPL 080411
154  ! ZFCCUP (klon,KLEV+1)          ; CLEAR SKY CLEAN (NO AEROSOL) SW  UP  FLUXES      ! added by OB 211117
155  ! ZFLCCDWN(klon,KLEV+1)         ; CLEAR SKY CLEAN (NO AEROSOL) LW  DWN FLUXES      ! added by OB 211117
156  ! ZFLCCUP (klon,KLEV+1)         ; CLEAR SKY CLEAN (NO AEROSOL) LW  UP  FLUXES      ! added by OB 211117
157 
158  !======================================================================
159 
160  ! ====================================================================
161  ! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
162  ! 1 = ZERO   
163  ! 2 = AER total   
164  ! 3 = NAT   
165  ! 4 = BC   
166  ! 5 = SO4   
167  ! 6 = POM   
168  ! 7 = DUST   
169  ! 8 = SS   
170  ! 9 = NO3   
171  !
172  ! ====================================================================
173  include "YOETHF.h"
174  include "YOMCST.h"
175  include "clesphys.h"
176
177! Input arguments
178  REAL,    INTENT(in)  :: dist
179  REAL,    INTENT(in)  :: rmu0(KLON), fract(KLON)
180  REAL,    INTENT(in)  :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
181!albedo SB >>>
182! REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
183  REAL,    INTENT(in)  :: tsol(KLON)
184  REAL,    INTENT(in) :: alb_dir(KLON,NSW),alb_dif(KLON,NSW)
185  real, intent(in) :: SFRWL(6)
186!albedo SB <<<
187  REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
188
189  REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2)
190  ! column-density of ozone in a layer, in kilo-Dobsons
191  ! "wo(:, :, 1)" is for the average day-night field,
192  ! "wo(:, :, 2)" is for daylight time.
193
194  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
195  LOGICAL              :: lldebug
196  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
197  INTEGER, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
198  LOGICAL, INTENT(in)  :: flag_aer_feedback                              ! activate aerosol radiative feedback
199  REAL,    INTENT(in)  :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
200  REAL,    INTENT(in)  :: tau_aero(KLON,KLEV,naero_grp,2)                        ! aerosol optical properties (see aeropt.F)
201  REAL,    INTENT(in)  :: piz_aero(KLON,KLEV,naero_grp,2)                        ! aerosol optical properties (see aeropt.F)
202  REAL,    INTENT(in)  :: cg_aero(KLON,KLEV,naero_grp,2)                         ! aerosol optical properties (see aeropt.F)
203!--OB
204  REAL,    INTENT(in)  :: tau_aero_sw_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
205  REAL,    INTENT(in)  :: piz_aero_sw_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
206  REAL,    INTENT(in)  :: cg_aero_sw_rrtm(KLON,KLEV,2,NSW)                  ! aerosol optical properties RRTM
207!--OB fin
208
209!--C. Kleinschmitt
210#ifdef CPP_RRTM
211  REAL,    INTENT(in)  :: tau_aero_lw_rrtm(KLON,KLEV,2,NLW)                 ! LW aerosol optical properties RRTM
212#else
213  REAL,    INTENT(in)  :: tau_aero_lw_rrtm(KLON,KLEV,2,nbands_lw_rrtm)
214#endif
215!--C. Kleinschmitt end
216
217  REAL,    INTENT(in)  :: cldtaupi(KLON,KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
218  LOGICAL, INTENT(in)  :: new_aod                                        ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
219  REAL,    INTENT(in)  :: qsat(klon,klev) ! Variable pour iflag_rrtm=1
220  REAL,    INTENT(in)  :: flwc(klon,klev) ! Variable pour iflag_rrtm=1
221  REAL,    INTENT(in)  :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1
222  REAL,    INTENT(in)  :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro
223  REAL,    INTENT(in)  :: ref_ice(klon,klev) ! ice crystal radius   present-day from newmicro
224  REAL,    INTENT(in)  :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro
225  REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
226
227! Output arguments
228  REAL,    INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
229  REAL,    INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
230  REAL,    INTENT(out) :: topsw(KLON), toplw(KLON)
231  REAL,    INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
232  REAL,    INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
233  REAL,    INTENT(out) :: sollwdown(KLON)
234  REAL,    INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1), swdnc0(KLON,kflev+1)
235  REAL,    INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1), swupc0(KLON,kflev+1)
236  REAL,    INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1), lwdnc0(KLON,kflev+1)
237  REAL,    INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1), lwupc0(KLON,kflev+1)
238  REAL,    INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON)         ! output: aerosol direct forcing at TOA and surface
239  REAL,    INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON)         ! output: aerosol indirect forcing atTOA and surface
240  REAL,    INTENT(out) :: toplwad_aero(KLON), sollwad_aero(KLON)         ! output: LW aerosol direct forcing at TOA and surface
241  REAL,    INTENT(out) :: toplwai_aero(KLON), sollwai_aero(KLON)         ! output: LW aerosol indirect forcing atTOA and surface
242  REAL, DIMENSION(klon), INTENT(out)    :: topswad0_aero
243  REAL, DIMENSION(klon), INTENT(out)    :: solswad0_aero
244  REAL, DIMENSION(klon), INTENT(out)    :: toplwad0_aero
245  REAL, DIMENSION(klon), INTENT(out)    :: sollwad0_aero
246  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
247  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
248  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
249  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
250  REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero
251  REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero
252  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i
253  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i
254
255! Local variables
256  REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
257  REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
258  REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
259  REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
260  REAL(KIND=8) ZFSUPC0(KDLON,KFLEV+1)
261  REAL(KIND=8) ZFSDNC0(KDLON,KFLEV+1)
262  REAL(KIND=8) ZFLUP(KDLON,KFLEV+1)
263  REAL(KIND=8) ZFLDN(KDLON,KFLEV+1)
264  REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1)
265  REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1)
266  REAL(KIND=8) ZFLUPC0(KDLON,KFLEV+1)
267  REAL(KIND=8) ZFLDNC0(KDLON,KFLEV+1)
268  REAL(KIND=8) zx_alpha1, zx_alpha2
269  INTEGER k, kk, i, j, iof, nb_gr
270  INTEGER ist,iend,ktdia,kmode
271  REAL(KIND=8) PSCT
272  REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2)
273!  MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW
274! avec NSW en deuxieme dimension       
275  REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW)
276  REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
277  REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV)
278  REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
279  REAL(KIND=8) PTAVE(kdlon,kflev)
280  REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
281
282  real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
283  ! "POZON(:, :, 1)" is for the average day-night field,
284  ! "POZON(:, :, 2)" is for daylight time.
285!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 
286  REAL(KIND=8) PAER(kdlon,kflev,6)
287  REAL(KIND=8) PCLDLD(kdlon,kflev)
288  REAL(KIND=8) PCLDLU(kdlon,kflev)
289  REAL(KIND=8) PCLDSW(kdlon,kflev)
290  REAL(KIND=8) PTAU(kdlon,2,kflev)
291  REAL(KIND=8) POMEGA(kdlon,2,kflev)
292  REAL(KIND=8) PCG(kdlon,2,kflev)
293  REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist
294  REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev)
295  REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev)
296  REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon)
297  REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
298  REAL(KIND=8) zsollwdown(kdlon)
299  REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon)
300  REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon)
301  REAL(KIND=8) zznormcp
302  REAL(KIND=8) tauaero(kdlon,kflev,naero_grp,2)                     ! aer opt properties
303  REAL(KIND=8) pizaero(kdlon,kflev,naero_grp,2)
304  REAL(KIND=8) cgaero(kdlon,kflev,naero_grp,2)
305  REAL(KIND=8) PTAUA(kdlon,2,kflev)                         ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
306  REAL(KIND=8) POMEGAA(kdlon,2,kflev)                       ! dito for single scatt albedo
307  REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon)     ! Aerosol direct forcing at TOAand surface
308  REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon)   ! Aerosol direct forcing at TOAand surface
309  REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon)     ! dito, indirect
310!-LW by CK
311  REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon)     ! LW Aerosol direct forcing at TOAand surface
312  REAL(KIND=8) ztoplwad0aero(kdlon), zsollwad0aero(kdlon)   ! LW Aerosol direct forcing at TOAand surface
313  REAL(KIND=8) ztoplwaiaero(kdlon), zsollwaiaero(kdlon)     ! dito, indirect
314!-end
315  REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
316  REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
317  REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3)     
318! real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618
319!MPL input supplementaires pour RECMWFL
320! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
321      REAL(KIND=8) GEMU(klon)
322!MPL input RECMWFL:
323! Tableaux aux niveaux inverses pour respecter convention Arpege
324      REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
325      REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
326!--OB
327      REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
328      REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
329!--end OB
330      REAL(KIND=8) paprs_i(klon,klev+1)
331      REAL(KIND=8) pplay_i(klon,klev)
332      REAL(KIND=8) cldfra_i(klon,klev)
333      REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone
334  ! "POZON(:, :, 1)" is for the average day-night field,
335  ! "POZON(:, :, 2)" is for daylight time.
336!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6     
337      REAL(KIND=8) PAER_i(kdlon,kflev,6)
338      REAL(KIND=8) PDP_i(klon,klev)
339      REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
340      REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev)
341!MPL output RECMWFL:
342      REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)       
343      REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)     
344      REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)   
345      REAL(KIND=8) ZTH   (klon,klev+1),ZTH_i   (klon,klev+1)   
346      REAL(KIND=8) ZCTRSO(klon,2)       
347      REAL(KIND=8) ZCEMTR(klon,2)     
348      REAL(KIND=8) ZTRSOD(klon)       
349      REAL(KIND=8) ZLWFC (klon,2)     
350      REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)   
351      REAL(KIND=8) ZSWFC (klon,2)     
352      REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
353      REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
354      REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
355      REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
356      REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
357      REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
358      REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
359      REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
360#ifdef CPP_RRTM
361      REAL(KIND=8) PTAU_LW_TOT(klon,klev,NLW)
362      REAL(KIND=8) PTAU_LW_NAT(klon,klev,NLW)
363#endif
364      REAL(KIND=8) PSFSWDIR(klon,NSW)
365      REAL(KIND=8) PSFSWDIF(klon,NSW)
366      REAL(KIND=8) PFSDNN(klon)
367      REAL(KIND=8) PFSDNV(klon)
368!MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC,
369!MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja
370!MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0,
371!MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0
372      REAL(KIND=8) ZFLUX_i (klon,2,klev+1)
373      REAL(KIND=8) ZFLUC_i (klon,2,klev+1)
374      REAL(KIND=8) ZFSDWN_i (klon,klev+1)
375      REAL(KIND=8) ZFCDWN_i (klon,klev+1)
376      REAL(KIND=8) ZFCCDWN_i (klon,klev+1)
377      REAL(KIND=8) ZFSUP_i (klon,klev+1)
378      REAL(KIND=8) ZFCUP_i (klon,klev+1)
379      REAL(KIND=8) ZFCCUP_i (klon,klev+1)
380      REAL(KIND=8) ZFLCCDWN_i (klon,klev+1)
381      REAL(KIND=8) ZFLCCUP_i (klon,klev+1)
382! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412)
383!      REAL(KIND=8) RSUN(3,2)
384!      REAL(KIND=8) SUN(3)
385!      REAL(KIND=8) SUN_FRACT(2)
386  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
387  CHARACTER (LEN=80) :: abort_message
388  CHARACTER (LEN=80) :: modname='radlwsw_m'
389
390  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
391  ! initialisation
392  ist=1
393  iend=klon
394  ktdia=1
395  kmode=ist
396  tauaero(:,:,:,:)=0.
397  pizaero(:,:,:,:)=0.
398  cgaero(:,:,:,:)=0.
399  lldebug=.FALSE.
400
401  ztopsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
402  ztopsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
403  zsolsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
404  zsolsw0_aero(:,:) = 0. !ym missing init : warning : not initialized in SW_AEROAR4
405 
406  !
407  !-------------------------------------------
408  nb_gr = KLON / kdlon
409  IF (nb_gr*kdlon .NE. KLON) THEN
410      PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
411      call abort_physic("radlwsw", "", 1)
412  ENDIF
413  IF (kflev .NE. KLEV) THEN
414      PRINT*, "kflev differe de KLEV, kflev, KLEV"
415      call abort_physic("radlwsw", "", 1)
416  ENDIF
417  !-------------------------------------------
418  DO k = 1, KLEV
419    DO i = 1, KLON
420      heat(i,k)=0.
421      cool(i,k)=0.
422      heat0(i,k)=0.
423      cool0(i,k)=0.
424    ENDDO
425  ENDDO
426  !
427  zdist = dist
428  !
429  PSCT = solaire/zdist/zdist
430
431  IF (type_trac == 'repr') THEN
432#ifdef REPROBUS
433     if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
434     print*,'Constante solaire: ',PSCT*zdist*zdist
435#endif
436  END IF
437
438  DO j = 1, nb_gr
439    iof = kdlon*(j-1)
440    DO i = 1, kdlon
441      zfract(i) = fract(iof+i)
442!     zfract(i) = 1.     !!!!!!  essai MPL 19052010
443      zrmu0(i) = rmu0(iof+i)
444
445
446!albedo SB >>>
447!
448      IF (iflag_rrtm==0) THEN
449!
450        PALBD(i,1)=alb_dif(iof+i,1)
451        PALBD(i,2)=alb_dif(iof+i,2)
452        PALBP(i,1)=alb_dir(iof+i,1)
453        PALBP(i,2)=alb_dir(iof+i,2)
454!
455      ELSEIF (iflag_rrtm==1) THEn
456!
457        DO kk=1,NSW
458          PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
459          PALBP_NEW(i,kk)=alb_dir(iof+i,kk)
460        ENDDO
461!
462      ENDIF
463!albedo SB <<<
464
465
466      PEMIS(i) = 1.0    !!!!! A REVOIR (MPL)
467      PVIEW(i) = 1.66
468      PPSOL(i) = paprs(iof+i,1)
469      zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
470      zx_alpha2 = 1.0 - zx_alpha1
471      PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
472      PTL(i,KLEV+1) = t(iof+i,KLEV)
473      PDT0(i) = tsol(iof+i) - PTL(i,1)
474    ENDDO
475    DO k = 2, kflev
476      DO i = 1, kdlon
477        PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
478      ENDDO
479    ENDDO
480    DO k = 1, kflev
481      DO i = 1, kdlon
482        PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
483        PTAVE(i,k) = t(iof+i,k)
484        PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
485        PQS(i,k) = PWV(i,k)
486!       Confert from  column density of ozone in a cell, in kDU, to a mass fraction
487        POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
488             / (paprs(iof+i, k) - paprs(iof+i, k+1))
489!       A activer pour CCMVAL on prend l'ozone impose (MPL 07042010)
490!       POZON(i,k,:) = wo(i,k,:) 
491!       print *,'RADLWSW: POZON',k, POZON(i,k,1)
492        PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
493        PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
494        PCLDSW(i,k) = cldfra(iof+i,k)
495        PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
496        PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
497        POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
498        POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
499        PCG(i,1,k) = 0.865
500        PCG(i,2,k) = 0.910
501        !-
502        ! Introduced for aerosol indirect forcings.
503        ! The following values use the cloud optical thickness calculated from
504        ! present-day aerosol concentrations whereas the quantities without the
505        ! "A" at the end are for pre-industial (natural-only) aerosol concentrations
506        !
507        PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
508        PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
509        POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
510        POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
511      ENDDO
512    ENDDO
513
514    IF (type_trac == 'repr') THEN
515#ifdef REPROBUS
516       ndimozon = size(wo, 3)
517       CALL RAD_INTERACTIF(POZON,iof)
518#endif
519    END IF
520
521    !
522    DO k = 1, kflev+1
523      DO i = 1, kdlon
524        PPMB(i,k) = paprs(iof+i,k)/100.0
525      ENDDO
526    ENDDO
527    !
528!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
529    DO kk = 1, 6
530      DO k = 1, kflev
531        DO i = 1, kdlon
532          PAER(i,k,kk) = 1.0E-15   !!!!! A REVOIR (MPL)
533        ENDDO
534      ENDDO
535    ENDDO
536    DO k = 1, kflev
537      DO i = 1, kdlon
538        tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
539        pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
540        cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
541        tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
542        pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
543        cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
544      ENDDO
545    ENDDO
546
547!
548!===== iflag_rrtm ================================================
549!     
550    IF (iflag_rrtm == 0) THEN       !!!! remettre 0 juste pour tester l'ancien rayt via rrtm
551!--- Mise a zero des tableaux output du rayonnement LW-AR4 ----------             
552      DO k = 1, kflev+1
553      DO i = 1, kdlon
554!     print *,'RADLWSW: boucle mise a zero i k',i,k
555      ZFLUP(i,k)=0.
556      ZFLDN(i,k)=0.
557      ZFLUP0(i,k)=0.
558      ZFLDN0(i,k)=0.
559      ZLWFT0_i(i,k)=0.
560      ZFLUCUP_i(i,k)=0.
561      ZFLUCDWN_i(i,k)=0.
562      ENDDO
563      ENDDO
564      DO k = 1, kflev
565      DO i = 1, kdlon
566      zcool(i,k)=0.
567      zcool0(i,k)=0.
568      ENDDO
569      ENDDO
570      DO i = 1, kdlon
571      ztoplw(i)=0.
572      zsollw(i)=0.
573      ztoplw0(i)=0.
574      zsollw0(i)=0.
575      zsollwdown(i)=0.
576      ENDDO
577       ! Old radiation scheme, used for AR4 runs
578       ! average day-night ozone for longwave
579       CALL LW_LMDAR4(&
580            PPMB, PDP,&
581            PPSOL,PDT0,PEMIS,&
582            PTL, PTAVE, PWV, POZON(:, :, 1), PAER,&
583            PCLDLD,PCLDLU,&
584            PVIEW,&
585            zcool, zcool0,&
586            ztoplw,zsollw,ztoplw0,zsollw0,&
587            zsollwdown,&
588            ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
589!----- Mise a zero des tableaux output du rayonnement SW-AR4
590      DO k = 1, kflev+1
591      DO i = 1, kdlon
592      ZFSUP(i,k)=0.
593      ZFSDN(i,k)=0.
594      ZFSUP0(i,k)=0.
595      ZFSDN0(i,k)=0.
596      ZFSUPC0(i,k)=0.
597      ZFSDNC0(i,k)=0.
598      ZFLUPC0(i,k)=0.
599      ZFLDNC0(i,k)=0.
600      ZSWFT0_i(i,k)=0.
601      ZFCUP_i(i,k)=0.
602      ZFCDWN_i(i,k)=0.
603      ZFCCUP_i(i,k)=0.
604      ZFCCDWN_i(i,k)=0.
605      ZFLCCUP_i(i,k)=0.
606      ZFLCCDWN_i(i,k)=0.
607      ENDDO
608      ENDDO
609      DO k = 1, kflev
610      DO i = 1, kdlon
611      zheat(i,k)=0.
612      zheat0(i,k)=0.
613      ENDDO
614      ENDDO
615      DO i = 1, kdlon
616      zalbpla(i)=0.
617      ztopsw(i)=0.
618      zsolsw(i)=0.
619      ztopsw0(i)=0.
620      zsolsw0(i)=0.
621      ztopswadaero(i)=0.
622      zsolswadaero(i)=0.
623      ztopswaiaero(i)=0.
624      zsolswaiaero(i)=0.
625      ENDDO
626!     print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract
627       ! daylight ozone, if we have it, for short wave
628       IF (.NOT. new_aod) THEN
629          ! use old version
630          CALL SW_LMDAR4(PSCT, zrmu0, zfract,&
631               PPMB, PDP, &
632               PPSOL, PALBD, PALBP,&
633               PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
634               PCLDSW, PTAU, POMEGA, PCG,&
635               zheat, zheat0,&
636               zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
637               ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
638               tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
639               PTAUA, POMEGAA,&
640               ztopswadaero,zsolswadaero,&
641               ztopswaiaero,zsolswaiaero,&
642               ok_ade, ok_aie)
643         
644       ELSE ! new_aod=T         
645          CALL SW_AEROAR4(PSCT, zrmu0, zfract,&
646               PPMB, PDP,&
647               PPSOL, PALBD, PALBP,&
648               PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
649               PCLDSW, PTAU, POMEGA, PCG,&
650               zheat, zheat0,&
651               zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
652               ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
653               tauaero, pizaero, cgaero, &
654               PTAUA, POMEGAA,&
655               ztopswadaero,zsolswadaero,&
656               ztopswad0aero,zsolswad0aero,&
657               ztopswaiaero,zsolswaiaero, &
658               ztopsw_aero,ztopsw0_aero,&
659               zsolsw_aero,zsolsw0_aero,&
660               ztopswcf_aero,zsolswcf_aero, &
661               ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat)
662       ENDIF
663
664       ZSWFT0_i(:,:) = ZFSDN0(:,:)-ZFSUP0(:,:)
665       ZLWFT0_i(:,:) =-ZFLDN0(:,:)-ZFLUP0(:,:)
666
667       DO i=1,kdlon
668       DO k=1,kflev+1
669!        print *,'iof i k klon klev=',iof,i,k,klon,klev
670         lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
671         lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
672         lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
673         lwup  ( iof+i,k)   = ZFLUP  ( i,k)
674         swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
675         swdn  ( iof+i,k)   = ZFSDN  ( i,k)
676         swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
677         swup  ( iof+i,k)   = ZFSUP  ( i,k)
678       ENDDO 
679       ENDDO 
680!          print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
681!          print*,'SW_AR4 swdn0  1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev)
682!          print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
683!          print*,'SW_AR4 swup0  1 , klev:',swup0(1:klon,1),swup0(1:klon,klev)
684!          print*,'SW_AR4 ZFSDN  1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev)
685!          print*,'SW_AR4 ZFSUP  1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev)
686    ELSE 
687#ifdef CPP_RRTM
688!      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.'
689!===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
690
691      DO k = 1, kflev+1
692      DO i = 1, kdlon
693      ZEMTD_i(i,k)=0.
694      ZEMTU_i(i,k)=0.
695      ZTRSO_i(i,k)=0.
696      ZTH_i(i,k)=0.
697      ZLWFT_i(i,k)=0.
698      ZSWFT_i(i,k)=0.
699      ZFLUX_i(i,1,k)=0.
700      ZFLUX_i(i,2,k)=0.
701      ZFLUC_i(i,1,k)=0.
702      ZFLUC_i(i,2,k)=0.
703      ZFSDWN_i(i,k)=0.
704      ZFCDWN_i(i,k)=0.
705      ZFCCDWN_i(i,k)=0.
706      ZFSUP_i(i,k)=0.
707      ZFCUP_i(i,k)=0.
708      ZFCCUP_i(i,k)=0.
709      ZFLCCDWN_i(i,k)=0.
710      ZFLCCUP_i(i,k)=0.
711      ENDDO
712      ENDDO
713!
714!--OB
715!--aerosol TOT  - anthropogenic+natural
716!--aerosol NAT  - natural only
717!
718      DO i = 1, kdlon
719      DO k = 1, kflev
720      DO kk=1, NSW
721!
722      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk)
723      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk)
724      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk)
725!
726      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk)
727      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk)
728      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk)
729!
730      ENDDO
731      ENDDO
732      ENDDO
733!-end OB
734!
735!--C. Kleinschmitt
736!--aerosol TOT  - anthropogenic+natural
737!--aerosol NAT  - natural only
738!
739      DO i = 1, kdlon
740      DO k = 1, kflev
741      DO kk=1, NLW
742!
743      PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk)
744      PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk)
745!
746      ENDDO
747      ENDDO
748      ENDDO
749!-end C. Kleinschmitt
750!     
751      DO i = 1, kdlon
752      ZCTRSO(i,1)=0.
753      ZCTRSO(i,2)=0.
754      ZCEMTR(i,1)=0.
755      ZCEMTR(i,2)=0.
756      ZTRSOD(i)=0.
757      ZLWFC(i,1)=0.
758      ZLWFC(i,2)=0.
759      ZSWFC(i,1)=0.
760      ZSWFC(i,2)=0.
761      PFSDNN(i)=0.
762      PFSDNV(i)=0.
763      DO kk = 1, NSW
764      PSFSWDIR(i,kk)=0.
765      PSFSWDIF(i,kk)=0.
766      ENDDO
767      ENDDO
768!----- Fin des mises a zero des tableaux output de RECMWF -------------------             
769!        GEMU(1:klon)=sin(rlatd(1:klon))
770! On met les donnees dans l'ordre des niveaux arpege
771         paprs_i(:,1)=paprs(:,klev+1)
772         do k=1,klev
773            paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
774            pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
775            cldfra_i(1:klon,k)  =cldfra(1:klon,klev+1-k)
776            PDP_i(1:klon,k)     =PDP(1:klon,klev+1-k)
777            t_i(1:klon,k)       =t(1:klon,klev+1-k)
778            q_i(1:klon,k)       =q(1:klon,klev+1-k)
779            qsat_i(1:klon,k)    =qsat(1:klon,klev+1-k)
780            flwc_i(1:klon,k)    =flwc(1:klon,klev+1-k)
781            fiwc_i(1:klon,k)    =fiwc(1:klon,klev+1-k)
782            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
783            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
784!-OB
785            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
786            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
787         enddo
788         do k=1,kflev
789           POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
790!!!            POZON_i(1:klon,k)=POZON(1:klon,k)            !!! on laisse 1=sol et klev=top
791!          print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
792!!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6     
793            do i=1,6
794            PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
795            enddo
796         enddo
797!       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
798
799!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
800! La version ARPEGE1D utilise differentes valeurs de la constante
801! solaire suivant le rayonnement utilise.
802! A controler ...
803! SOLAR FLUX AT THE TOP (/YOMPHY3/)
804! introduce season correction
805!--------------------------------------
806! RII0 = RIP0
807! IF(LRAYFM)
808! RII0 = RIP0M   ! =rip0m if Morcrette non-each time step call.
809! IF(LRAYFM15)
810! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call.
811         RII0=solaire/zdist/zdist
812!print*,'+++ radlwsw: solaire ,RII0',solaire,RII0
813!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
814! Ancien appel a RECMWF (celui du cy25)
815!        CALL RECMWF (ist , iend, klon , ktdia , klev   , kmode ,
816!    s   PALBD    , PALBP   , paprs_i , pplay_i , RCO2   , cldfra_i,
817!    s   POZON_i  , PAER_i  , PDP_i   , PEMIS   , GEMU   , rmu0,
818!    s    q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,
819!    s   ZEMTD_i  , ZEMTU_i , ZTRSO_i ,
820!    s   ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,
821!    s   ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,
822!    s   ZFLUX_i  , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i)
823!    s   'RECMWF ')
824!
825      if(lldebug) then
826        CALL writefield_phy('paprs_i',paprs_i,klev+1)
827        CALL writefield_phy('pplay_i',pplay_i,klev)
828        CALL writefield_phy('cldfra_i',cldfra_i,klev)
829        CALL writefield_phy('pozon_i',POZON_i,klev)
830        CALL writefield_phy('paer_i',PAER_i,klev)
831        CALL writefield_phy('pdp_i',PDP_i,klev)
832        CALL writefield_phy('q_i',q_i,klev)
833        CALL writefield_phy('qsat_i',qsat_i,klev)
834        CALL writefield_phy('fiwc_i',fiwc_i,klev)
835        CALL writefield_phy('flwc_i',flwc_i,klev)
836        CALL writefield_phy('t_i',t_i,klev)
837        CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
838        CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
839      endif
840
841! Nouvel appel a RECMWF (celui du cy32t0)
842         CALL RECMWF_AERO (ist , iend, klon , ktdia  , klev   , kmode ,&
843         PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
844         POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
845          q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
846         ref_liq_i, ref_ice_i, &
847         ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
848         ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
849         ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
850         ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
851         PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
852         PPIZA_TOT, PCGA_TOT,PTAU_TOT,&
853         PPIZA_NAT, PCGA_NAT,PTAU_NAT,           &  ! rajoute par OB pour diagnostiquer effet direct
854         PTAU_LW_TOT, PTAU_LW_NAT,               &  ! rajoute par C. Kleinschmitt
855         ZFLUX_i  , ZFLUC_i ,&
856         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i, ZFCCDWN_i, ZFCCUP_i, ZFLCCDWN_i, ZFLCCUP_i, &
857         ZTOPSWADAERO,ZSOLSWADAERO,&  ! rajoute par OB pour diagnostics
858         ZTOPSWAD0AERO,ZSOLSWAD0AERO,&
859         ZTOPSWAIAERO,ZSOLSWAIAERO, &
860         ZTOPSWCF_AERO,ZSOLSWCF_AERO, &
861         ZTOPLWADAERO,ZSOLLWADAERO,&  ! rajoute par C. Kleinscmitt pour LW diagnostics
862         ZTOPLWAD0AERO,ZSOLLWAD0AERO,&
863         ZTOPLWAIAERO,ZSOLLWAIAERO, &
864         ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols
865           
866!        print *,'RADLWSW: apres RECMWF'
867      if(lldebug) then
868        CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1)
869        CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1)
870        CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1)
871        CALL writefield_phy('zth_i',ZTH_i,klev+1)
872        CALL writefield_phy('zctrso',ZCTRSO,2)
873        CALL writefield_phy('zcemtr',ZCEMTR,2)
874        CALL writefield_phy('ztrsod',ZTRSOD,1)
875        CALL writefield_phy('zlwfc',ZLWFC,2)
876        CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1)
877        CALL writefield_phy('zswfc',ZSWFC,2)
878        CALL writefield_phy('zswft_i',ZSWFT_i,klev+1)
879        CALL writefield_phy('psfswdir',PSFSWDIR,6)
880        CALL writefield_phy('psfswdif',PSFSWDIF,6)
881        CALL writefield_phy('pfsdnn',PFSDNN,1)
882        CALL writefield_phy('pfsdnv',PFSDNV,1)
883        CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev)
884        CALL writefield_phy('pcga_dst',PCGA_TOT,klev)
885        CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev)
886        CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
887        CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
888        CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
889        CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1)
890        CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
891        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
892      endif
893! --------- output RECMWFL
894!  ZEMTD        (KPROMA,KLEV+1)  ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
895!  ZEMTU        (KPROMA,KLEV+1)  ; TOTAL UPWARD   LONGWAVE EMISSIVITY
896!  ZTRSO        (KPROMA,KLEV+1)  ; TOTAL SHORTWAVE TRANSMISSIVITY
897!  ZTH          (KPROMA,KLEV+1)  ; HALF LEVEL TEMPERATURE
898!  ZCTRSO       (KPROMA,2)       ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
899!  ZCEMTR       (KPROMA,2)       ; CLEAR-SKY NET LONGWAVE EMISSIVITY
900!  ZTRSOD       (KPROMA)         ; TOTAL-SKY SURFACE SW TRANSMISSITY
901!  ZLWFC        (KPROMA,2)       ; CLEAR-SKY LONGWAVE FLUXES
902!  ZLWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY LONGWAVE FLUXES
903!  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
904!  ZSWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY SHORTWAVE FLUXES
905!  PPIZA_TOT    (KPROMA,KLEV,NSW); Single scattering albedo of total aerosols
906!  PCGA_TOT     (KPROMA,KLEV,NSW); Assymetry factor for total aerosols
907!  PTAU_TOT     (KPROMA,KLEV,NSW); Optical depth of total aerosols
908!  PPIZA_NAT    (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols
909!  PCGA_NAT     (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols
910!  PTAU_NAT     (KPROMA,KLEV,NSW); Optical depth of natiral aerosols
911!  PTAU_LW_TOT  (KPROMA,KLEV,NLW); LW Optical depth of total aerosols 
912!  PTAU_LW_NAT  (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 
913!  PSFSWDIR     (KPROMA,NSW)     ;
914!  PSFSWDIF     (KPROMA,NSW)     ;
915!  PFSDNN       (KPROMA)         ;
916!  PFSDNV       (KPROMA)         ;
917! ---------
918! ---------
919! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
920! D autre part, on multiplie les resultats SW par fract pour etre coherent
921! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de
922! rayonnement SW. (MPL 260609)
923      DO k=0,klev
924         DO i=1,klon
925         ZEMTD(i,k+1)  = ZEMTD_i(i,k+1)
926         ZEMTU(i,k+1)  = ZEMTU_i(i,k+1)
927         ZTRSO(i,k+1)  = ZTRSO_i(i,k+1)
928         ZTH(i,k+1)    = ZTH_i(i,k+1)
929!        ZLWFT(i,k+1)  = ZLWFT_i(i,klev+1-k)
930!        ZSWFT(i,k+1)  = ZSWFT_i(i,klev+1-k)
931         ZFLUP(i,k+1)  = ZFLUX_i(i,1,k+1)
932         ZFLDN(i,k+1)  = ZFLUX_i(i,2,k+1)
933         ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1)
934         ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1)
935         ZFSDN(i,k+1)  = ZFSDWN_i(i,k+1)*fract(i)
936         ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i)
937         ZFSDNC0(i,k+1)= ZFCCDWN_i(i,k+1)*fract(i)
938         ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i)
939         ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i)
940         ZFSUPC0(i,k+1)= ZFCCUP_i(i,k+1)*fract(i)
941         ZFLDNC0(i,k+1)= ZFLCCDWN_i(i,k+1)
942         ZFLUPC0(i,k+1)= ZFLCCUP_i(i,k+1)
943!   Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
944!   en sortie de radlsw.F90 - MPL 7.01.09
945         ZSWFT(i,k+1)  = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i)
946         ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i)
947!        WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),&
948!        ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1)
949         ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1)
950         ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1)
951!        print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),&
952!    & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1)
953         ENDDO
954      ENDDO
955
956!--ajout OB
957      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
958      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
959      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
960      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
961      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
962      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
963      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:)
964      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:)
965      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:)
966      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
967      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
968      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
969
970!     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
971!     print*,'SW_RRTM ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
972!     print*,'SW_RRTM ZFSDN  1 , klev:',ZFSDN(1:klon,1),ZFSDN(1:klon,klev)
973!     print*,'SW_RRTM ZFSUP  1 , klev:',ZFSUP(1:klon,1),ZFSUP(1:klon,klev)     
974!     print*,'OK1'
975! ---------
976! ---------
977! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
978! LW_LMDAR4 et SW_LMDAR4
979      DO i = 1, kdlon
980         zsolsw(i)    = ZSWFT(i,1)
981         zsolsw0(i)   = ZSWFT0_i(i,1)
982!        zsolsw0(i)   = ZFSDN0(i,1)     -ZFSUP0(i,1)
983         ztopsw(i)    = ZSWFT(i,klev+1)
984         ztopsw0(i)   = ZSWFT0_i(i,klev+1)
985!        ztopsw0(i)   = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1)
986!         
987!        zsollw(i)    = ZFLDN(i,1)      -ZFLUP(i,1)
988!        zsollw0(i)   = ZFLDN0(i,1)     -ZFLUP0(i,1)
989!        ztoplw(i)    = ZFLDN(i,klev+1) -ZFLUP(i,klev+1)
990!        ztoplw0(i)   = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1)
991         zsollw(i)    = ZLWFT(i,1)
992         zsollw0(i)   = ZLWFT0_i(i,1)
993         ztoplw(i)    = ZLWFT(i,klev+1)*(-1)
994         ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
995!         
996           IF (fract(i) == 0.) THEN
997!!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0
998! pas plus que dans le sw_AR4
999          zalbpla(i)   = 1.0e+39
1000         ELSE
1001          zalbpla(i)   = ZFSUP(i,klev+1)/ZFSDN(i,klev+1)
1002         ENDIF
1003!!! 5 juin 2015
1004!!! Correction MP bug RRTM
1005         zsollwdown(i)= -1.*ZFLDN(i,1)
1006      ENDDO
1007!     print*,'OK2'
1008
1009! extrait de SW_AR4
1010!     DO k = 1, KFLEV
1011!        kpl1 = k+1
1012!        DO i = 1, KDLON
1013!           PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) -(ZFSDN(i,k)-ZFSDN(i,kpl1))
1014!           PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
1015! ZLWFT(klon,k),ZSWFT
1016
1017      do k=1,kflev
1018         do i=1,kdlon
1019           zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
1020           zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
1021           zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
1022           zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
1023!          print *,'heat cool heat0 cool0 ',zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k)
1024!          ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
1025!          ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)         
1026         enddo
1027      enddo
1028#else
1029    abort_message="You should compile with -rrtm if running with iflag_rrtm=1"
1030    call abort_physic(modname, abort_message, 1)
1031#endif
1032    ENDIF ! iflag_rrtm
1033!======================================================================
1034
1035    DO i = 1, kdlon
1036      topsw(iof+i) = ztopsw(i)
1037      toplw(iof+i) = ztoplw(i)
1038      solsw(iof+i) = zsolsw(i)
1039      sollw(iof+i) = zsollw(i)
1040      sollwdown(iof+i) = zsollwdown(i)
1041      DO k = 1, kflev+1
1042        lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
1043        lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
1044        lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
1045        lwup  ( iof+i,k)   = ZFLUP  ( i,k)
1046      ENDDO
1047      topsw0(iof+i) = ztopsw0(i)
1048      toplw0(iof+i) = ztoplw0(i)
1049      solsw0(iof+i) = zsolsw0(i)
1050      sollw0(iof+i) = zsollw0(i)
1051      albpla(iof+i) = zalbpla(i)
1052
1053      DO k = 1, kflev+1
1054        swdnc0( iof+i,k)   = ZFSDNC0( i,k)
1055        swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
1056        swdn  ( iof+i,k)   = ZFSDN  ( i,k)
1057        swupc0( iof+i,k)   = ZFSUPC0( i,k)
1058        swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
1059        swup  ( iof+i,k)   = ZFSUP  ( i,k)
1060        lwdnc0( iof+i,k)   = ZFLDNC0( i,k)
1061        lwupc0( iof+i,k)   = ZFLUPC0( i,k)
1062      ENDDO
1063    ENDDO
1064    !-transform the aerosol forcings, if they have
1065    ! to be calculated
1066    IF (ok_ade) THEN
1067        DO i = 1, kdlon
1068          topswad_aero(iof+i) = ztopswadaero(i)
1069          topswad0_aero(iof+i) = ztopswad0aero(i)
1070          solswad_aero(iof+i) = zsolswadaero(i)
1071          solswad0_aero(iof+i) = zsolswad0aero(i)
1072! MS the following lines seem to be wrong, why is iof on right hand side???
1073!          topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
1074!          topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
1075!          solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
1076!          solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
1077          topsw_aero(iof+i,:) = ztopsw_aero(i,:)
1078          topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
1079          solsw_aero(iof+i,:) = zsolsw_aero(i,:)
1080          solsw0_aero(iof+i,:) = zsolsw0_aero(i,:)
1081          topswcf_aero(iof+i,:) = ztopswcf_aero(i,:)
1082          solswcf_aero(iof+i,:) = zsolswcf_aero(i,:)   
1083          !-LW
1084          toplwad_aero(iof+i) = ztoplwadaero(i)
1085          toplwad0_aero(iof+i) = ztoplwad0aero(i)
1086          sollwad_aero(iof+i) = zsollwadaero(i)
1087          sollwad0_aero(iof+i) = zsollwad0aero(i)   
1088        ENDDO
1089    ELSE
1090        DO i = 1, kdlon
1091          topswad_aero(iof+i) = 0.0
1092          solswad_aero(iof+i) = 0.0
1093          topswad0_aero(iof+i) = 0.0
1094          solswad0_aero(iof+i) = 0.0
1095          topsw_aero(iof+i,:) = 0.
1096          topsw0_aero(iof+i,:) =0.
1097          solsw_aero(iof+i,:) = 0.
1098          solsw0_aero(iof+i,:) = 0.
1099          !-LW
1100          toplwad_aero(iof+i) = 0.0
1101          sollwad_aero(iof+i) = 0.0
1102          toplwad0_aero(iof+i) = 0.0
1103          sollwad0_aero(iof+i) = 0.0
1104        ENDDO
1105    ENDIF
1106    IF (ok_aie) THEN
1107        DO i = 1, kdlon
1108          topswai_aero(iof+i) = ztopswaiaero(i)
1109          solswai_aero(iof+i) = zsolswaiaero(i)
1110          !-LW
1111          toplwai_aero(iof+i) = ztoplwaiaero(i)
1112          sollwai_aero(iof+i) = zsollwaiaero(i)
1113        ENDDO
1114    ELSE
1115        DO i = 1, kdlon
1116          topswai_aero(iof+i) = 0.0
1117          solswai_aero(iof+i) = 0.0
1118          !-LW
1119          toplwai_aero(iof+i) = 0.0
1120          sollwai_aero(iof+i) = 0.0
1121        ENDDO
1122    ENDIF
1123    DO k = 1, kflev
1124      DO i = 1, kdlon
1125        !        scale factor to take into account the difference between
1126        !        dry air and watter vapour scpecifi! heat capacity
1127        zznormcp=1.0+RVTMP2*PWV(i,k)
1128        heat(iof+i,k) = zheat(i,k)/zznormcp
1129        cool(iof+i,k) = zcool(i,k)/zznormcp
1130        heat0(iof+i,k) = zheat0(i,k)/zznormcp
1131        cool0(iof+i,k) = zcool0(i,k)/zznormcp
1132      ENDDO
1133    ENDDO
1134
1135 ENDDO ! j = 1, nb_gr
1136
1137END SUBROUTINE radlwsw
1138
1139end module radlwsw_m
Note: See TracBrowser for help on using the repository browser.