/[lmdze]/trunk/Sources/phylmd/Radlwsw/radlwsw.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/radlwsw.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/Radlwsw/radlwsw.f90 revision 53 by guez, Fri Oct 7 13:11:58 2011 UTC trunk/Sources/phylmd/Radlwsw/radlwsw.f revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC
# Line 4  module radlwsw_m Line 4  module radlwsw_m
4    
5  contains  contains
6    
7    SUBROUTINE radlwsw(dist, rmu0, fract, paprs, pplay, tsol, albedo, alblw, &    SUBROUTINE radlwsw(dist, mu0, fract, paprs, play, tsol, albedo, &
8         t, q, wo, cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, &         t, q, wo, cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, &
9         albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, &         albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, &
10         sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, &         sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, &
# Line 12  contains Line 12  contains
12         solswai)         solswai)
13    
14      ! From LMDZ4/libf/phylmd/radlwsw.F, version 1.4 2005/06/06 13:16:33      ! From LMDZ4/libf/phylmd/radlwsw.F, version 1.4 2005/06/06 13:16:33
15      ! Author: Z. X. Li (LMD/CNRS) date: 1996/07/19      ! Author: Z. X. Li (LMD/CNRS)
16      ! Objet : interface entre le modèle et les rayonnements      ! Date: 1996/07/19
     ! Rayonnements solaire et infrarouge  
17    
18        ! Objet : interface entre le modèle et les rayonnements solaire et
19        ! infrarouge
20    
21        ! ATTENTION: swai and swad have to be interpreted in the following manner:
22    
23        ! not ok_ade and not ok_aie
24        ! both are zero
25    
26        ! ok_ade and not ok_aie
27        ! aerosol direct forcing is F_{AD} = topsw - topswad
28        ! indirect is zero
29    
30        ! not ok_ade and ok_aie
31        ! aerosol indirect forcing is F_{AI} = topsw - topswai
32        ! direct is zero
33    
34        ! ok_ade and ok_aie
35        ! aerosol indirect forcing is F_{AI} = topsw - topswai
36        ! aerosol direct forcing is F_{AD} = topswai - topswad
37    
38        USE clesphys, ONLY: solaire
39      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
40      USE clesphys, ONLY: bug_ozone, solaire      use lw_m, only: lw
     USE suphec_m, ONLY: rg  
41      USE raddim, ONLY: kdlon      USE raddim, ONLY: kdlon
42      USE yoethf_m, ONLY: rvtmp2      USE suphec_m, ONLY: rg
43      use sw_m, only: sw      use sw_m, only: sw
44        USE yoethf_m, ONLY: rvtmp2
45                    
46      ! Arguments:      ! Arguments:
47      ! dist-----input-R- distance astronomique terre-soleil  
48      ! rmu0-----input-R- cosinus de l'angle zenithal      real, intent(in):: dist ! distance astronomique terre-soleil
49      ! fract----input-R- duree d'ensoleillement normalisee      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal
50      ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee
51      ! solaire--input-R- constante solaire (W/m**2)      real, intent(in):: paprs(klon, klev+1) ! pression a inter-couche (Pa)
52      ! paprs----input-R- pression a inter-couche (Pa)      real, intent(in):: play(klon, klev) ! pression au milieu de couche (Pa)
53      ! pplay----input-R- pression au milieu de couche (Pa)      real, intent(in):: tsol(klon) ! temperature du sol (en K)
54      ! tsol-----input-R- temperature du sol (en K)      real, intent(in):: albedo(klon) ! albedo du sol (entre 0 et 1)
55      ! albedo---input-R- albedo du sol (entre 0 et 1)      real, intent(in):: t(klon, klev) ! temperature (K)
56      ! t--------input-R- temperature (K)      real q(klon, klev)
57      ! q--------input-R- vapeur d'eau (en kg/kg)      ! q--------input-R- vapeur d'eau (en kg/kg)
58      ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505  
59        real, intent(in):: wo(klon, klev)
60        ! column-density of ozone in a layer, in kilo-Dobsons
61    
62        real cldfra(klon, klev), cldemi(klon, klev)
63      ! cldfra---input-R- fraction nuageuse (entre 0 et 1)      ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
     ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)  
64      ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)      ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
     ! ok_ade---input-L- apply the Aerosol Direct Effect or not?  
     ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?  
     ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)  
     ! cldtaupi-input-R- epaisseur optique des nuages dans le visible  
     !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller  
     !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd  
     !                   it is needed for the diagnostics of the aerosol indirect radiative forcing        
65    
66        real cldtaupd(klon, klev)
67        ! input-R- epaisseur optique des nuages dans le visible (present-day value)
68    
69        real, intent(out):: heat(klon, klev)
70        ! échauffement atmosphérique (visible) (K/jour)
71    
72        real heat0(klon, klev)
73        real cool(klon, klev)
74      ! cool-----output-R- refroidissement dans l'IR (K/jour)      ! cool-----output-R- refroidissement dans l'IR (K/jour)
75        real cool0(klon, klev)
76        real radsol(klon)
77      ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)      ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
78      ! albpla---output-R- albedo planetaire (entre 0 et 1)      real, intent(out):: albpla(klon) ! albedo planetaire (entre 0 et 1)
79        real topsw(klon)
80      ! topsw----output-R- flux solaire net au sommet de l'atm.      ! topsw----output-R- flux solaire net au sommet de l'atm.
81      ! toplw----output-R- ray. IR montant au sommet de l'atmosphere  
82      ! solsw----output-R- flux solaire net a la surface      real, intent(out):: toplw(klon)
83      ! sollw----output-R- ray. IR montant a la surface      ! rayonnement infrarouge montant au sommet de l'atmosphère
84      ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)  
85        real, intent(out):: solsw(klon) ! flux solaire net à la surface
86    
87        real, intent(out):: sollw(klon)
88        ! rayonnement infrarouge montant à la surface
89    
90        real, intent(out):: sollwdown(klon)
91        real topsw0(klon)
92        real, intent(out):: toplw0(klon)
93        real solsw0(klon), sollw0(klon)
94        !IM output 3D: SWup, SWdn, LWup, LWdn
95        REAL lwdn0(klon, klev+1), lwdn(klon, klev+1)
96        REAL lwup0(klon, klev+1), lwup(klon, klev+1)
97        REAL swdn0(klon, klev+1), swdn(klon, klev+1)
98        REAL swup0(klon, klev+1), swup(klon, klev+1)
99    
100        logical ok_ade, ok_aie
101        ! switches whether to use aerosol direct (indirect) effects or not
102        ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
103        ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
104    
105        real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)
106        ! input-R- aerosol optical properties (calculated in aeropt.F)
107    
108        real topswad(klon), solswad(klon)
109        ! output: aerosol direct forcing at TOA and surface
110      ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)      ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
111      ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)      ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
112    
113        real cldtaupi(klon, klev)
114        ! cloud optical thickness for pre-industrial aerosol concentrations
115        ! (i.e. with a smaller droplet concentration and thus larger droplet radii)
116        ! -input-R- epaisseur optique des nuages dans le visible
117        ! calculated for pre-industrial (pi) aerosol concentrations,
118        ! i.e. with smaller droplet concentration, thus larger droplets,
119        ! thus generally cdltaupi cldtaupd it is needed for the
120        ! diagnostics of the aerosol indirect radiative forcing
121    
122        real topswai(klon), solswai(klon)
123        ! output: aerosol indirect forcing atTOA and surface
124      ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)      ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
125        ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
126    
127      ! ATTENTION: swai and swad have to be interpreted in the following manner:      ! Local:
     ! ok_ade = F & ok_aie = F -both are zero  
     ! ok_ade = T & ok_aie = F -aerosol direct forcing is F_{AD} = topsw-topswad  
     !                        indirect is zero  
     ! ok_ade = F & ok_aie = T -aerosol indirect forcing is F_{AI} = topsw-topswai  
     !                        direct is zero  
     ! ok_ade = T & ok_aie = T -aerosol indirect forcing is F_{AI} = topsw-topswai  
     !                        aerosol direct forcing is F_{AD} = topswai-topswad  
   
     real rmu0(klon), fract(klon), dist  
   
     real, intent(in):: paprs(klon, klev+1)  
     real, intent(in):: pplay(klon, klev)  
     real albedo(klon), alblw(klon), tsol(klon)  
     real, intent(in):: t(klon, klev)  
     real q(klon, klev)  
     real, intent(in):: wo(klon, klev)  
     real cldfra(klon, klev), cldemi(klon, klev), cldtaupd(klon, klev)  
128    
129      real, intent(out):: heat(klon, klev)      double precision tauae(kdlon, klev, 2) ! aer opt properties
130      ! échauffement atmosphérique (visible) (K/jour)      double precision pizae(kdlon, klev, 2)
131        double precision cgae(kdlon, klev, 2)
132    
     real cool(klon, klev)  
     real heat0(klon, klev), cool0(klon, klev)  
     real radsol(klon), topsw(klon), toplw(klon)  
     real solsw(klon), sollw(klon), albpla(klon)  
     real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)  
     real sollwdown(klon)  
133      !IM output 3D      !IM output 3D
134      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
135      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
# Line 99  contains Line 142  contains
142      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)
143    
144      DOUBLE PRECISION zx_alpha1, zx_alpha2      DOUBLE PRECISION zx_alpha1, zx_alpha2
145        INTEGER k, kk, i, iof, nb_gr
     INTEGER k, kk, i, j, iof, nb_gr  
     EXTERNAL lw  
   
146      DOUBLE PRECISION PSCT      DOUBLE PRECISION PSCT
147    
148      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)
# Line 110  contains Line 150  contains
150      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)
151      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)
152      DOUBLE PRECISION PTAVE(kdlon, klev)      DOUBLE PRECISION PTAVE(kdlon, klev)
153      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev), POZON(kdlon, klev)      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev)
154        DOUBLE PRECISION POZON(kdlon, klev) ! mass fraction of ozone
155      DOUBLE PRECISION PAER(kdlon, klev, 5)      DOUBLE PRECISION PAER(kdlon, klev, 5)
156      DOUBLE PRECISION PCLDLD(kdlon, klev)      DOUBLE PRECISION PCLDLD(kdlon, klev)
157      DOUBLE PRECISION PCLDLU(kdlon, klev)      DOUBLE PRECISION PCLDLU(kdlon, klev)
# Line 119  contains Line 160  contains
160      DOUBLE PRECISION POMEGA(kdlon, 2, klev)      DOUBLE PRECISION POMEGA(kdlon, 2, klev)
161      DOUBLE PRECISION PCG(kdlon, 2, klev)      DOUBLE PRECISION PCG(kdlon, 2, klev)
162    
163      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon), zdist      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon)
164    
165      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)
166      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)
# Line 130  contains Line 171  contains
171      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)
172      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)
173      DOUBLE PRECISION zznormcp      DOUBLE PRECISION zznormcp
     !IM output 3D: SWup, SWdn, LWup, LWdn  
     REAL swdn(klon, klev+1), swdn0(klon, klev+1)  
     REAL swup(klon, klev+1), swup0(klon, klev+1)  
     REAL lwdn(klon, klev+1), lwdn0(klon, klev+1)  
     REAL lwup(klon, klev+1), lwup0(klon, klev+1)  
174    
175      !jq the following quantities are needed for the aerosol radiative forcings      !jq the following quantities are needed for the aerosol radiative forcings
176    
     real topswad(klon), solswad(klon)  
     ! output: aerosol direct forcing at TOA and surface  
   
     real topswai(klon), solswai(klon)  
     ! output: aerosol indirect forcing atTOA and surface  
   
     real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)  
     ! aerosol optical properties (see aeropt.F)  
   
     real cldtaupi(klon, klev)  
     ! cloud optical thickness for pre-industrial aerosol concentrations  
     ! (i.e., with a smaller droplet concentrationand thus larger droplet radii)  
   
     logical ok_ade, ok_aie  
     ! switches whether to use aerosol direct (indirect) effects or not  
   
     double precision tauae(kdlon, klev, 2) ! aer opt properties  
     double precision pizae(kdlon, klev, 2)  
     double precision cgae(kdlon, klev, 2)  
   
177      DOUBLE PRECISION PTAUA(kdlon, 2, klev)      DOUBLE PRECISION PTAUA(kdlon, 2, klev)
178      ! present-day value of cloud opt thickness (PTAU is pre-industrial      ! present-day value of cloud opt thickness (PTAU is pre-industrial
179      ! value), local use      ! value), local use
# Line 168  contains Line 184  contains
184      ! Aerosol direct forcing at TOAand surface      ! Aerosol direct forcing at TOAand surface
185    
186      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
187        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
188    
189      !----------------------------------------------------------------------      !----------------------------------------------------------------------
190    
# Line 185  contains Line 202  contains
202      cool = 0.      cool = 0.
203      heat0 = 0.      heat0 = 0.
204      cool0 = 0.      cool0 = 0.
205      zdist = dist      PSCT = solaire / dist**2
     PSCT = solaire / zdist / zdist  
   
     loop_nbgr: DO j = 1, nb_gr  
        iof = kdlon * (j - 1)  
206    
207        loop_iof: DO iof = 0, klon - kdlon, kdlon
208         DO i = 1, kdlon         DO i = 1, kdlon
209            zfract(i) = fract(iof+i)            zfract(i) = fract(iof+i)
210            zrmu0(i) = rmu0(iof+i)            zrmu0(i) = mu0(iof+i)
211            PALBD(i, 1) = albedo(iof+i)            PALBD(i, 1) = albedo(iof+i)
212            PALBD(i, 2) = alblw(iof+i)            PALBD(i, 2) = albedo(iof+i)
213            PALBP(i, 1) = albedo(iof+i)            PALBP(i, 1) = albedo(iof+i)
214            PALBP(i, 2) = alblw(iof+i)            PALBP(i, 2) = albedo(iof+i)
215            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre
216            ! PEMIS(i) = 0.96            ! PEMIS(i) = 0.96
217            PEMIS(i) = 1.0            PEMIS(i) = 1.0
218            PVIEW(i) = 1.66            PVIEW(i) = 1.66
219            PPSOL(i) = paprs(iof+i, 1)            PPSOL(i) = paprs(iof+i, 1)
220            zx_alpha1 = (paprs(iof+i, 1)-pplay(iof+i, 2))  &            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &
221                 / (pplay(iof+i, 1)-pplay(iof+i, 2))                 / (play(iof+i, 1)-play(iof+i, 2))
222            zx_alpha2 = 1.0 - zx_alpha1            zx_alpha2 = 1.0 - zx_alpha1
223            PTL(i, 1) = t(iof+i, 1) * zx_alpha1 + t(iof+i, 2) * zx_alpha2            PTL(i, 1) = t(iof+i, 1) * zx_alpha1 + t(iof+i, 2) * zx_alpha2
224            PTL(i, klev+1) = t(iof+i, klev)            PTL(i, klev+1) = t(iof+i, klev)
# Line 221  contains Line 235  contains
235               PTAVE(i, k) = t(iof+i, k)               PTAVE(i, k) = t(iof+i, k)
236               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)
237               PQS(i, k) = PWV(i, k)               PQS(i, k) = PWV(i, k)
238               ! wo:    cm.atm (epaisseur en cm dans la situation standard)               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &
239               ! POZON: kg/kg                    / (paprs(iof+i, k) - paprs(iof+i, k+1))
              IF (bug_ozone) then  
                 POZON(i, k) = MAX(wo(iof+i, k), 1.0e-12)*RG/46.6968 &  
                      /(paprs(iof+i, k)-paprs(iof+i, k+1)) &  
                      *(paprs(iof+i, 1)/101325.0)  
              ELSE  
                 ! le calcul qui suit est maintenant fait dans ozonecm (MPL)  
                 POZON(i, k) = wo(i, k)  
              ENDIF  
240               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
241               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
242               PCLDSW(i, k) = cldfra(iof+i, k)               PCLDSW(i, k) = cldfra(iof+i, k)
# Line 283  contains Line 289  contains
289            ENDDO            ENDDO
290         ENDDO         ENDDO
291    
292         CALL LW(PPMB, PDP, PPSOL, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, &         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
293              PCLDLD, PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, &              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &
294              zsollw0, zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)
295         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
296              PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &              PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &
297              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &
# Line 355  contains Line 361  contains
361               cool0(iof+i, k) = zcool0(i, k)/zznormcp               cool0(iof+i, k) = zcool0(i, k)/zznormcp
362            ENDDO            ENDDO
363         ENDDO         ENDDO
364      end DO loop_nbgr      end DO loop_iof
365    
366    END SUBROUTINE radlwsw    END SUBROUTINE radlwsw
367    
Legend:
Removed from v.53  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21