source: LMDZ5/trunk/libf/phylmd/radlwsw_m.F90 @ 1786

Last change on this file since 1786 was 1764, checked in by Laurent Fairhead, 11 years ago

Inclusion d'une routine qui lit des champs d'aérosols stratosphériques
mensuels, prescrit des propriétés optiques et modifie le rayonnement en
conséquence. Pour le moment, seule l'interaction avec le rayonnement ondes
courtes est pris en compte. Les fichiers d'input doivent être au format des
fichiers de sortie. Contrôlé par la variable logique: flag_aerosol_strat
(false par défaut dans DefLists?/config.def)

  1. Boucher

A new routine has been added to the code that reads in monthly stratospheric
aerosols, prescribes optical properties and modifies radiation accordingly.
Presently, only the interaction with short wave radiation is taken into account.
Input files must be formatted as are the aerosol output fields. Control is by
the logical flag: flag_aerosol_strat (which is false by default and included
DefLists?/config.def)

  1. Boucher
File size: 18.5 KB
RevLine 
[1687]1module radlwsw_m
2
3  IMPLICIT NONE
4
5contains
6
7SUBROUTINE radlwsw( &
8   dist, rmu0, fract, &
9   paprs, pplay,tsol,alb1, alb2, &
10   t,q,wo,&
11   cldfra, cldemi, cldtaupd,&
12   ok_ade, ok_aie, flag_aerosol,&
[1764]13   flag_aerosol_strat,&
[1687]14   tau_aero, piz_aero, cg_aero,&
15   cldtaupi, new_aod, &
16   qsat, flwc, fiwc, &
17   heat,heat0,cool,cool0,radsol,albpla,&
18   topsw,toplw,solsw,sollw,&
19   sollwdown,&
20   topsw0,toplw0,solsw0,sollw0,&
21   lwdn0, lwdn, lwup0, lwup,&
22   swdn0, swdn, swup0, swup,&
23   topswad_aero, solswad_aero,&
24   topswai_aero, solswai_aero, &
25   topswad0_aero, solswad0_aero,&
26   topsw_aero, topsw0_aero,&
27   solsw_aero, solsw0_aero, &
28   topswcf_aero, solswcf_aero)
29
30
31
32  USE DIMPHY
33  USE assert_m, ONLY : assert
34  USE infotrac, ONLY : type_trac
35#ifdef REPROBUS
36  USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
37#endif
38
39  !======================================================================
40  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
41  ! Objet: interface entre le modele et les rayonnements
42  ! Arguments:
43  ! dist-----input-R- distance astronomique terre-soleil
44  ! rmu0-----input-R- cosinus de l'angle zenithal
45  ! fract----input-R- duree d'ensoleillement normalisee
46  ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
47  ! paprs----input-R- pression a inter-couche (Pa)
48  ! pplay----input-R- pression au milieu de couche (Pa)
49  ! tsol-----input-R- temperature du sol (en K)
50  ! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible
51  ! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
52  ! t--------input-R- temperature (K)
53  ! q--------input-R- vapeur d'eau (en kg/kg)
54  ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
55  ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
56  ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
57  ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
58  ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
59  ! flag_aerosol-input-I- aerosol flag from 0 to 6
[1764]60  ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)
[1687]61  ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
62  ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
63  !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
64  !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
65  !                   it is needed for the diagnostics of the aerosol indirect radiative forcing     
66  !
67  ! heat-----output-R- echauffement atmospherique (visible) (K/jour)
68  ! cool-----output-R- refroidissement dans l'IR (K/jour)
69  ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
70  ! albpla---output-R- albedo planetaire (entre 0 et 1)
71  ! topsw----output-R- flux solaire net au sommet de l'atm.
72  ! toplw----output-R- ray. IR montant au sommet de l'atmosphere
73  ! solsw----output-R- flux solaire net a la surface
74  ! sollw----output-R- ray. IR montant a la surface
75  ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
76  ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
77  ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
78  ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
79  !
80  ! ATTENTION: swai and swad have to be interpreted in the following manner:
81  ! ---------
82  ! ok_ade=F & ok_aie=F -both are zero
83  ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
84  !                        indirect is zero
85  ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
86  !                        direct is zero
87  ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
88  !                        aerosol direct forcing is F_{AD} = topswai-topswad
89  !
90 
91  !======================================================================
92 
93  ! ====================================================================
94  ! Adapte au modele de chimie INCA par Celine Deandreis & Anne Cozic -- 2009
95  ! 1 = ZERO   
96  ! 2 = AER total   
97  ! 3 = NAT   
98  ! 4 = BC   
99  ! 5 = SO4   
100  ! 6 = POM   
101  ! 7 = DUST   
102  ! 8 = SS   
103  ! 9 = NO3   
104  !
105  ! ====================================================================
106  include "YOETHF.h"
107  include "YOMCST.h"
108  include "clesphys.h"
109  include "iniprint.h"
110
111! Input arguments
112  REAL,    INTENT(in)  :: dist
113  REAL,    INTENT(in)  :: rmu0(KLON), fract(KLON)
114  REAL,    INTENT(in)  :: paprs(KLON,KLEV+1), pplay(KLON,KLEV)
115  REAL,    INTENT(in)  :: alb1(KLON), alb2(KLON), tsol(KLON)
116  REAL,    INTENT(in)  :: t(KLON,KLEV), q(KLON,KLEV)
117
118  REAL, INTENT(in):: wo(:, :, :) ! dimension(KLON,KLEV, 1 or 2)
119  ! column-density of ozone in a layer, in kilo-Dobsons
120  ! "wo(:, :, 1)" is for the average day-night field,
121  ! "wo(:, :, 2)" is for daylight time.
122
123  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
124  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
[1764]125  LOGICAL, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
[1687]126  REAL,    INTENT(in)  :: cldfra(KLON,KLEV), cldemi(KLON,KLEV), cldtaupd(KLON,KLEV)
127  REAL,    INTENT(in)  :: tau_aero(KLON,KLEV,9,2)                        ! aerosol optical properties (see aeropt.F)
128  REAL,    INTENT(in)  :: piz_aero(KLON,KLEV,9,2)                        ! aerosol optical properties (see aeropt.F)
129  REAL,    INTENT(in)  :: cg_aero(KLON,KLEV,9,2)                         ! aerosol optical properties (see aeropt.F)
130  REAL,    INTENT(in)  :: cldtaupi(KLON,KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
131  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
132  REAL,    INTENT(in)  :: qsat(klon,klev) ! Variable pour iflag_rrtm=1
133  REAL,    INTENT(in)  :: flwc(klon,klev) ! Variable pour iflag_rrtm=1
134  REAL,    INTENT(in)  :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1
135
136! Output arguments
137  REAL,    INTENT(out) :: heat(KLON,KLEV), cool(KLON,KLEV)
138  REAL,    INTENT(out) :: heat0(KLON,KLEV), cool0(KLON,KLEV)
139  REAL,    INTENT(out) :: radsol(KLON), topsw(KLON), toplw(KLON)
140  REAL,    INTENT(out) :: solsw(KLON), sollw(KLON), albpla(KLON)
141  REAL,    INTENT(out) :: topsw0(KLON), toplw0(KLON), solsw0(KLON), sollw0(KLON)
142  REAL,    INTENT(out) :: sollwdown(KLON)
143  REAL,    INTENT(out) :: swdn(KLON,kflev+1),swdn0(KLON,kflev+1)
144  REAL,    INTENT(out) :: swup(KLON,kflev+1),swup0(KLON,kflev+1)
145  REAL,    INTENT(out) :: lwdn(KLON,kflev+1),lwdn0(KLON,kflev+1)
146  REAL,    INTENT(out) :: lwup(KLON,kflev+1),lwup0(KLON,kflev+1)
147  REAL,    INTENT(out) :: topswad_aero(KLON), solswad_aero(KLON)         ! output: aerosol direct forcing at TOA and surface
148  REAL,    INTENT(out) :: topswai_aero(KLON), solswai_aero(KLON)         ! output: aerosol indirect forcing atTOA and surface
149  REAL, DIMENSION(klon), INTENT(out)    :: topswad0_aero
150  REAL, DIMENSION(klon), INTENT(out)    :: solswad0_aero
151  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw_aero
152  REAL, DIMENSION(kdlon,9), INTENT(out) :: topsw0_aero
153  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw_aero
154  REAL, DIMENSION(kdlon,9), INTENT(out) :: solsw0_aero
155  REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero
156  REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero
157
158! Local variables
159  REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
160  REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
161  REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
162  REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
163  REAL(KIND=8) ZFLUP(KDLON,KFLEV+1)
164  REAL(KIND=8) ZFLDN(KDLON,KFLEV+1)
165  REAL(KIND=8) ZFLUP0(KDLON,KFLEV+1)
166  REAL(KIND=8) ZFLDN0(KDLON,KFLEV+1)
167  REAL(KIND=8) zx_alpha1, zx_alpha2
168  INTEGER k, kk, i, j, iof, nb_gr
169  REAL(KIND=8) PSCT
170  REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2)
171  REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
172  REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV)
173  REAL(KIND=8) PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1)
174  REAL(KIND=8) PTAVE(kdlon,kflev)
175  REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
176
177  real(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
178  ! "POZON(:, :, 1)" is for the average day-night field,
179  ! "POZON(:, :, 2)" is for daylight time.
180
181  REAL(KIND=8) PAER(kdlon,kflev,5)
182  REAL(KIND=8) PCLDLD(kdlon,kflev)
183  REAL(KIND=8) PCLDLU(kdlon,kflev)
184  REAL(KIND=8) PCLDSW(kdlon,kflev)
185  REAL(KIND=8) PTAU(kdlon,2,kflev)
186  REAL(KIND=8) POMEGA(kdlon,2,kflev)
187  REAL(KIND=8) PCG(kdlon,2,kflev)
188  REAL(KIND=8) zfract(kdlon), zrmu0(kdlon), zdist
189  REAL(KIND=8) zheat(kdlon,kflev), zcool(kdlon,kflev)
190  REAL(KIND=8) zheat0(kdlon,kflev), zcool0(kdlon,kflev)
191  REAL(KIND=8) ztopsw(kdlon), ztoplw(kdlon)
192  REAL(KIND=8) zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon)
193  REAL(KIND=8) zsollwdown(kdlon)
194  REAL(KIND=8) ztopsw0(kdlon), ztoplw0(kdlon)
195  REAL(KIND=8) zsolsw0(kdlon), zsollw0(kdlon)
196  REAL(KIND=8) zznormcp
197  REAL(KIND=8) tauaero(kdlon,kflev,9,2)                     ! aer opt properties
198  REAL(KIND=8) pizaero(kdlon,kflev,9,2)
199  REAL(KIND=8) cgaero(kdlon,kflev,9,2)
200  REAL(KIND=8) PTAUA(kdlon,2,kflev)                         ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
201  REAL(KIND=8) POMEGAA(kdlon,2,kflev)                       ! dito for single scatt albedo
202  REAL(KIND=8) ztopswadaero(kdlon), zsolswadaero(kdlon)     ! Aerosol direct forcing at TOAand surface
203  REAL(KIND=8) ztopswad0aero(kdlon), zsolswad0aero(kdlon)   ! Aerosol direct forcing at TOAand surface
204  REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon)     ! dito, indirect
205  REAL(KIND=8) ztopsw_aero(kdlon,9), ztopsw0_aero(kdlon,9)
206  REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
207  REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3)     
208  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
209
210  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
211  ! initialisation
212  tauaero(:,:,:,:)=0.
213  pizaero(:,:,:,:)=0.
214  cgaero(:,:,:,:)=0.
215 
216  !
217  !-------------------------------------------
218  nb_gr = KLON / kdlon
219  IF (nb_gr*kdlon .NE. KLON) THEN
220      PRINT*, "kdlon mauvais:", KLON, kdlon, nb_gr
221      CALL abort
222  ENDIF
223  IF (kflev .NE. KLEV) THEN
224      PRINT*, "kflev differe de KLEV, kflev, KLEV"
225      CALL abort
226  ENDIF
227  !-------------------------------------------
228  DO k = 1, KLEV
229    DO i = 1, KLON
230      heat(i,k)=0.
231      cool(i,k)=0.
232      heat0(i,k)=0.
233      cool0(i,k)=0.
234    ENDDO
235  ENDDO
236  !
237  zdist = dist
238  !
239  PSCT = solaire/zdist/zdist
240
241  IF (type_trac == 'repr') THEN
242#ifdef REPROBUS
243     if(ok_SUNTIME) PSCT = solaireTIME/zdist/zdist
244     print*,'Constante solaire: ',PSCT*zdist*zdist
245#endif
246  END IF
247
248  DO j = 1, nb_gr
249    iof = kdlon*(j-1)
250    DO i = 1, kdlon
251      zfract(i) = fract(iof+i)
252      zrmu0(i) = rmu0(iof+i)
253      PALBD(i,1) = alb1(iof+i)
254      PALBD(i,2) = alb2(iof+i)
255      PALBP(i,1) = alb1(iof+i)
256      PALBP(i,2) = alb2(iof+i)
257      PEMIS(i) = 1.0
258      PVIEW(i) = 1.66
259      PPSOL(i) = paprs(iof+i,1)
260      zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2))
261      zx_alpha2 = 1.0 - zx_alpha1
262      PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2
263      PTL(i,KLEV+1) = t(iof+i,KLEV)
264      PDT0(i) = tsol(iof+i) - PTL(i,1)
265    ENDDO
266    DO k = 2, kflev
267      DO i = 1, kdlon
268        PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5
269      ENDDO
270    ENDDO
271    DO k = 1, kflev
272      DO i = 1, kdlon
273        PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1)
274        PTAVE(i,k) = t(iof+i,k)
275        PWV(i,k) = MAX (q(iof+i,k), 1.0e-12)
276        PQS(i,k) = PWV(i,k)
277        POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
278             / (paprs(iof+i, k) - paprs(iof+i, k+1))
279        PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
280        PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
281        PCLDSW(i,k) = cldfra(iof+i,k)
282        PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
283        PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
284        POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
285        POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
286        PCG(i,1,k) = 0.865
287        PCG(i,2,k) = 0.910
288        !-
289        ! Introduced for aerosol indirect forcings.
290        ! The following values use the cloud optical thickness calculated from
291        ! present-day aerosol concentrations whereas the quantities without the
292        ! "A" at the end are for pre-industial (natural-only) aerosol concentrations
293        !
294        PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
295        PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
296        POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
297        POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
298      ENDDO
299    ENDDO
300
301    IF (type_trac == 'repr') THEN
302#ifdef REPROBUS
303       ndimozon = size(wo, 3)
304       CALL RAD_INTERACTIF(POZON,iof)
305#endif
306    END IF
307
308    !
309    DO k = 1, kflev+1
310      DO i = 1, kdlon
311        PPMB(i,k) = paprs(iof+i,k)/100.0
312      ENDDO
313    ENDDO
314    !
315    DO kk = 1, 5
316      DO k = 1, kflev
317        DO i = 1, kdlon
318          PAER(i,k,kk) = 1.0E-15
319        ENDDO
320      ENDDO
321    ENDDO
322    DO k = 1, kflev
323      DO i = 1, kdlon
324        tauaero(i,k,:,1)=tau_aero(iof+i,k,:,1)
325        pizaero(i,k,:,1)=piz_aero(iof+i,k,:,1)
326        cgaero(i,k,:,1) =cg_aero(iof+i,k,:,1)
327        tauaero(i,k,:,2)=tau_aero(iof+i,k,:,2)
328        pizaero(i,k,:,2)=piz_aero(iof+i,k,:,2)
329        cgaero(i,k,:,2) =cg_aero(iof+i,k,:,2)
330      ENDDO
331    ENDDO
332
333!
334!===== iflag_rrtm ================================================
335!     
336    IF (iflag_rrtm == 0) THEN
337       ! Old radiation scheme, used for AR4 runs
338       ! average day-night ozone for longwave
339       CALL LW_LMDAR4(&
340            PPMB, PDP,&
341            PPSOL,PDT0,PEMIS,&
342            PTL, PTAVE, PWV, POZON(:, :, 1), PAER,&
343            PCLDLD,PCLDLU,&
344            PVIEW,&
345            zcool, zcool0,&
346            ztoplw,zsollw,ztoplw0,zsollw0,&
347            zsollwdown,&
348            ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
349
350       ! daylight ozone, if we have it, for short wave
351       IF (.NOT. new_aod) THEN
352          ! use old version
353          CALL SW_LMDAR4(PSCT, zrmu0, zfract,&
354               PPMB, PDP, &
355               PPSOL, PALBD, PALBP,&
356               PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
357               PCLDSW, PTAU, POMEGA, PCG,&
358               zheat, zheat0,&
359               zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
360               ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
361               tauaero(:,:,5,:), pizaero(:,:,5,:), cgaero(:,:,5,:),&
362               PTAUA, POMEGAA,&
363               ztopswadaero,zsolswadaero,&
364               ztopswaiaero,zsolswaiaero,&
[1764]365               ok_ade, ok_aie)
[1687]366         
367       ELSE ! new_aod=T         
368          CALL SW_AEROAR4(PSCT, zrmu0, zfract,&
369               PPMB, PDP,&
370               PPSOL, PALBD, PALBP,&
371               PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,&
372               PCLDSW, PTAU, POMEGA, PCG,&
373               zheat, zheat0,&
374               zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,&
375               ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
376               tauaero, pizaero, cgaero, &
377               PTAUA, POMEGAA,&
378               ztopswadaero,zsolswadaero,&
379               ztopswad0aero,zsolswad0aero,&
380               ztopswaiaero,zsolswaiaero, &
381               ztopsw_aero,ztopsw0_aero,&
382               zsolsw_aero,zsolsw0_aero,&
383               ztopswcf_aero,zsolswcf_aero, &
[1764]384               ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat)
[1687]385       ENDIF
386
387    ELSE 
388!===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
389       WRITE(lunout,*) "Option iflag_rrtm=T ne fonctionne pas encore !!!"
390       CALL abort_gcm('radlwsw','iflag_rrtm=T not valid',1)
391
392    ENDIF ! iflag_rrtm
393!======================================================================
394
395    DO i = 1, kdlon
396      radsol(iof+i) = zsolsw(i) + zsollw(i)
397      topsw(iof+i) = ztopsw(i)
398      toplw(iof+i) = ztoplw(i)
399      solsw(iof+i) = zsolsw(i)
400      sollw(iof+i) = zsollw(i)
401      sollwdown(iof+i) = zsollwdown(i)
402      DO k = 1, kflev+1
403        lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
404        lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
405        lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
406        lwup  ( iof+i,k)   = ZFLUP  ( i,k)
407      ENDDO
408      topsw0(iof+i) = ztopsw0(i)
409      toplw0(iof+i) = ztoplw0(i)
410      solsw0(iof+i) = zsolsw0(i)
411      sollw0(iof+i) = zsollw0(i)
412      albpla(iof+i) = zalbpla(i)
413
414      DO k = 1, kflev+1
415        swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
416        swdn  ( iof+i,k)   = ZFSDN  ( i,k)
417        swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
418        swup  ( iof+i,k)   = ZFSUP  ( i,k)
419      ENDDO
420    ENDDO
421    !-transform the aerosol forcings, if they have
422    ! to be calculated
423    IF (ok_ade) THEN
424        DO i = 1, kdlon
425          topswad_aero(iof+i) = ztopswadaero(i)
426          topswad0_aero(iof+i) = ztopswad0aero(i)
427          solswad_aero(iof+i) = zsolswadaero(i)
428          solswad0_aero(iof+i) = zsolswad0aero(i)
429! MS the following lines seem to be wrong, why is iof on right hand side???
430!          topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
431!          topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
432!          solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
433!          solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
434          topsw_aero(iof+i,:) = ztopsw_aero(i,:)
435          topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
436          solsw_aero(iof+i,:) = zsolsw_aero(i,:)
437          solsw0_aero(iof+i,:) = zsolsw0_aero(i,:)
438          topswcf_aero(iof+i,:) = ztopswcf_aero(i,:)
439          solswcf_aero(iof+i,:) = zsolswcf_aero(i,:)         
440        ENDDO
441    ELSE
442        DO i = 1, kdlon
443          topswad_aero(iof+i) = 0.0
444          solswad_aero(iof+i) = 0.0
445          topswad0_aero(iof+i) = 0.0
446          solswad0_aero(iof+i) = 0.0
447          topsw_aero(iof+i,:) = 0.
448          topsw0_aero(iof+i,:) =0.
449          solsw_aero(iof+i,:) = 0.
450          solsw0_aero(iof+i,:) = 0.
451        ENDDO
452    ENDIF
453    IF (ok_aie) THEN
454        DO i = 1, kdlon
455          topswai_aero(iof+i) = ztopswaiaero(i)
456          solswai_aero(iof+i) = zsolswaiaero(i)
457        ENDDO
458    ELSE
459        DO i = 1, kdlon
460          topswai_aero(iof+i) = 0.0
461          solswai_aero(iof+i) = 0.0
462        ENDDO
463    ENDIF
464    DO k = 1, kflev
465      DO i = 1, kdlon
466        !        scale factor to take into account the difference between
467        !        dry air and watter vapour scpecifi! heat capacity
468        zznormcp=1.0+RVTMP2*PWV(i,k)
469        heat(iof+i,k) = zheat(i,k)/zznormcp
470        cool(iof+i,k) = zcool(i,k)/zznormcp
471        heat0(iof+i,k) = zheat0(i,k)/zznormcp
472        cool0(iof+i,k) = zcool0(i,k)/zznormcp
473      ENDDO
474    ENDDO
475
476 ENDDO ! j = 1, nb_gr
477
478END SUBROUTINE radlwsw
479
480end module radlwsw_m
Note: See TracBrowser for help on using the repository browser.