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

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

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

trunk/libf/phylmd/Radlwsw/radlwsw.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/phylmd/Radlwsw/radlwsw.f revision 118 by guez, Thu Dec 18 17:30:24 2014 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, alblw, &
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)  
54      ! tsol-----input-R- temperature du sol (en K)      real tsol(klon), albedo(klon), alblw(klon)
55      ! albedo---input-R- albedo du sol (entre 0 et 1)      ! albedo---input-R- albedo du sol (entre 0 et 1)
56        ! tsol-----input-R- temperature du sol (en K)
57        real, intent(in):: t(klon, klev)
58      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
59        real q(klon, klev)
60      ! q--------input-R- vapeur d'eau (en kg/kg)      ! q--------input-R- vapeur d'eau (en kg/kg)
61      ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505  
62        real, intent(in):: wo(klon, klev)
63        ! column-density of ozone in a layer, in kilo-Dobsons
64    
65        real cldfra(klon, klev), cldemi(klon, klev)
66      ! 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)  
67      ! 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)
     ! 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        
   
     ! cool-----output-R- refroidissement dans l'IR (K/jour)  
     ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)  
     ! albpla---output-R- albedo planetaire (entre 0 et 1)  
     ! topsw----output-R- flux solaire net au sommet de l'atm.  
     ! solsw----output-R- flux solaire net a la surface  
     ! sollw----output-R- ray. IR montant a la surface  
     ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)  
     ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)  
     ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)  
     ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)  
68    
69      ! ATTENTION: swai and swad have to be interpreted in the following manner:      real cldtaupd(klon, klev)
70      ! ok_ade = F & ok_aie = F -both are zero      ! input-R- epaisseur optique des nuages dans le visible (present-day value)
     ! 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)  
71    
72      real, intent(out):: heat(klon, klev)      real, intent(out):: heat(klon, klev)
73      ! échauffement atmosphérique (visible) (K/jour)      ! échauffement atmosphérique (visible) (K/jour)
74    
75        real heat0(klon, klev)
76      real cool(klon, klev)      real cool(klon, klev)
77      real heat0(klon, klev), cool0(klon, klev)      ! cool-----output-R- refroidissement dans l'IR (K/jour)
78      real radsol(klon), topsw(klon)      real cool0(klon, klev)
79        real radsol(klon)
80        ! radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
81        real albpla(klon)
82        ! albpla---output-R- albedo planetaire (entre 0 et 1)
83        real topsw(klon)
84        ! topsw----output-R- flux solaire net au sommet de l'atm.
85    
86      real, intent(out):: toplw(klon)      real, intent(out):: toplw(klon)
87      ! rayonnement infrarouge montant au sommet de l'atmosphère      ! rayonnement infrarouge montant au sommet de l'atmosphère
88    
89      real solsw(klon), sollw(klon), albpla(klon)      real, intent(out):: solsw(klon) ! flux solaire net à la surface
90      real topsw0(klon), solsw0(klon), sollw0(klon)  
91        real, intent(out):: sollw(klon)
92        ! rayonnement infrarouge montant à la surface
93    
94        real, intent(out):: sollwdown(klon)
95        real topsw0(klon)
96      real, intent(out):: toplw0(klon)      real, intent(out):: toplw0(klon)
97      real sollwdown(klon)      real solsw0(klon), sollw0(klon)
98        !IM output 3D: SWup, SWdn, LWup, LWdn
99        REAL lwdn0(klon, klev+1), lwdn(klon, klev+1)
100        REAL lwup0(klon, klev+1), lwup(klon, klev+1)
101        REAL swdn0(klon, klev+1), swdn(klon, klev+1)
102        REAL swup0(klon, klev+1), swup(klon, klev+1)
103    
104        logical ok_ade, ok_aie
105        ! switches whether to use aerosol direct (indirect) effects or not
106        ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
107        ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
108    
109        real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)
110        ! input-R- aerosol optical properties (calculated in aeropt.F)
111    
112        real topswad(klon), solswad(klon)
113        ! output: aerosol direct forcing at TOA and surface
114        ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
115        ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
116    
117        real cldtaupi(klon, klev)
118        ! cloud optical thickness for pre-industrial aerosol concentrations
119        ! (i.e. with a smaller droplet concentration and thus larger droplet radii)
120        ! -input-R- epaisseur optique des nuages dans le visible
121        ! calculated for pre-industrial (pi) aerosol concentrations,
122        ! i.e. with smaller droplet concentration, thus larger droplets,
123        ! thus generally cdltaupi cldtaupd it is needed for the
124        ! diagnostics of the aerosol indirect radiative forcing
125    
126        real topswai(klon), solswai(klon)
127        ! output: aerosol indirect forcing atTOA and surface
128        ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
129        ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
130    
131        ! Local:
132    
133        double precision tauae(kdlon, klev, 2) ! aer opt properties
134        double precision pizae(kdlon, klev, 2)
135        double precision cgae(kdlon, klev, 2)
136    
137      !IM output 3D      !IM output 3D
138      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
139      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
# Line 101  contains Line 146  contains
146      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)
147    
148      DOUBLE PRECISION zx_alpha1, zx_alpha2      DOUBLE PRECISION zx_alpha1, zx_alpha2
   
149      INTEGER k, kk, i, iof, nb_gr      INTEGER k, kk, i, iof, nb_gr
     EXTERNAL lw  
   
150      DOUBLE PRECISION PSCT      DOUBLE PRECISION PSCT
151    
152      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)
# Line 112  contains Line 154  contains
154      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)
155      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)
156      DOUBLE PRECISION PTAVE(kdlon, klev)      DOUBLE PRECISION PTAVE(kdlon, klev)
157      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev), POZON(kdlon, klev)      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev)
158        DOUBLE PRECISION POZON(kdlon, klev) ! mass fraction of ozone
159      DOUBLE PRECISION PAER(kdlon, klev, 5)      DOUBLE PRECISION PAER(kdlon, klev, 5)
160      DOUBLE PRECISION PCLDLD(kdlon, klev)      DOUBLE PRECISION PCLDLD(kdlon, klev)
161      DOUBLE PRECISION PCLDLU(kdlon, klev)      DOUBLE PRECISION PCLDLU(kdlon, klev)
# Line 121  contains Line 164  contains
164      DOUBLE PRECISION POMEGA(kdlon, 2, klev)      DOUBLE PRECISION POMEGA(kdlon, 2, klev)
165      DOUBLE PRECISION PCG(kdlon, 2, klev)      DOUBLE PRECISION PCG(kdlon, 2, klev)
166    
167      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon), zdist      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon)
168    
169      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)
170      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)
# Line 132  contains Line 175  contains
175      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)
176      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)
177      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)  
178    
179      !jq the following quantities are needed for the aerosol radiative forcings      !jq the following quantities are needed for the aerosol radiative forcings
180    
     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  
     ! ok_ade---input-L- apply the Aerosol Direct Effect or not?  
     ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?  
   
     double precision tauae(kdlon, klev, 2) ! aer opt properties  
     double precision pizae(kdlon, klev, 2)  
     double precision cgae(kdlon, klev, 2)  
   
181      DOUBLE PRECISION PTAUA(kdlon, 2, klev)      DOUBLE PRECISION PTAUA(kdlon, 2, klev)
182      ! present-day value of cloud opt thickness (PTAU is pre-industrial      ! present-day value of cloud opt thickness (PTAU is pre-industrial
183      ! value), local use      ! value), local use
# Line 172  contains Line 188  contains
188      ! Aerosol direct forcing at TOAand surface      ! Aerosol direct forcing at TOAand surface
189    
190      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
191        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
192    
193      !----------------------------------------------------------------------      !----------------------------------------------------------------------
194    
# Line 189  contains Line 206  contains
206      cool = 0.      cool = 0.
207      heat0 = 0.      heat0 = 0.
208      cool0 = 0.      cool0 = 0.
209      zdist = dist      PSCT = solaire / dist**2
     PSCT = solaire / zdist / zdist  
210    
211      loop_iof: DO iof = 0, klon - kdlon, kdlon      loop_iof: DO iof = 0, klon - kdlon, kdlon
212         DO i = 1, kdlon         DO i = 1, kdlon
213            zfract(i) = fract(iof+i)            zfract(i) = fract(iof+i)
214            zrmu0(i) = rmu0(iof+i)            zrmu0(i) = mu0(iof+i)
215            PALBD(i, 1) = albedo(iof+i)            PALBD(i, 1) = albedo(iof+i)
216            PALBD(i, 2) = alblw(iof+i)            PALBD(i, 2) = alblw(iof+i)
217            PALBP(i, 1) = albedo(iof+i)            PALBP(i, 1) = albedo(iof+i)
# Line 205  contains Line 221  contains
221            PEMIS(i) = 1.0            PEMIS(i) = 1.0
222            PVIEW(i) = 1.66            PVIEW(i) = 1.66
223            PPSOL(i) = paprs(iof+i, 1)            PPSOL(i) = paprs(iof+i, 1)
224            zx_alpha1 = (paprs(iof+i, 1)-pplay(iof+i, 2))  &            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &
225                 / (pplay(iof+i, 1)-pplay(iof+i, 2))                 / (play(iof+i, 1)-play(iof+i, 2))
226            zx_alpha2 = 1.0 - zx_alpha1            zx_alpha2 = 1.0 - zx_alpha1
227            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
228            PTL(i, klev+1) = t(iof+i, klev)            PTL(i, klev+1) = t(iof+i, klev)
# Line 223  contains Line 239  contains
239               PTAVE(i, k) = t(iof+i, k)               PTAVE(i, k) = t(iof+i, k)
240               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)
241               PQS(i, k) = PWV(i, k)               PQS(i, k) = PWV(i, k)
242               ! wo:    cm.atm (epaisseur en cm dans la situation standard)               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &
243               ! 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  
244               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
245               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
246               PCLDSW(i, k) = cldfra(iof+i, k)               PCLDSW(i, k) = cldfra(iof+i, k)
Legend:
Removed from v.62  
changed lines
  Added in v.118
  ViewVC Help
Powered by ViewVC 1.1.21