/[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 213 by guez, Mon Feb 27 15:44:55 2017 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, t, q, wo, &
8         t, q, wo, cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, &         cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, albpla, &
9         albpla, topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, &         topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, sollw0, &
10         sollw0, lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, &         lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, &
11         ok_aie, tau_ae, piz_ae, cg_ae, topswad, solswad, cldtaupi, topswai, &         tau_ae, piz_ae, cg_ae, topswad, solswad, cldtaupi, topswai, solswai)
        solswai)  
12    
13      ! 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
14      ! Author: Z. X. Li (LMD/CNRS) date: 1996/07/19      ! Author: Z. X. Li (LMD/CNRS)
15      ! Objet : interface entre le modèle et les rayonnements      ! Date: 1996/07/19
     ! Rayonnements solaire et infrarouge  
16    
17        ! Objet : interface entre le modèle et les rayonnements solaire et
18        ! infrarouge
19    
20        ! ATTENTION: swai and swad have to be interpreted in the following manner:
21    
22        ! not ok_ade and not ok_aie
23        ! both are zero
24    
25        ! ok_ade and not ok_aie
26        ! aerosol direct forcing is F_{AD} = topsw - topswad
27        ! indirect is zero
28    
29        ! not ok_ade and ok_aie
30        ! aerosol indirect forcing is F_{AI} = topsw - topswai
31        ! direct is zero
32    
33        ! ok_ade and ok_aie
34        ! aerosol indirect forcing is F_{AI} = topsw - topswai
35        ! aerosol direct forcing is F_{AD} = topswai - topswad
36    
37        USE clesphys, ONLY: solaire
38      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
39      USE clesphys, ONLY: bug_ozone, solaire      use lw_m, only: lw
     USE suphec_m, ONLY: rg  
40      USE raddim, ONLY: kdlon      USE raddim, ONLY: kdlon
41      USE yoethf_m, ONLY: rvtmp2      USE suphec_m, ONLY: rg
42      use sw_m, only: sw      use sw_m, only: sw
43        USE yoethf_m, ONLY: rvtmp2
44                    
45      ! Arguments:      real, intent(in):: dist ! distance astronomique terre-soleil
46      ! dist-----input-R- distance astronomique terre-soleil      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal
47      ! rmu0-----input-R- cosinus de l'angle zenithal      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee
48      ! fract----input-R- duree d'ensoleillement normalisee      real, intent(in):: paprs(klon, klev+1) ! pression a inter-couche (Pa)
49      ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)      real, intent(in):: play(klon, klev) ! pression au milieu de couche (Pa)
50      ! solaire--input-R- constante solaire (W/m**2)      real, intent(in):: tsol(klon) ! temperature du sol (en K)
51      ! paprs----input-R- pression a inter-couche (Pa)      real, intent(in):: albedo(klon) ! albedo du sol (entre 0 et 1)
52      ! pplay----input-R- pression au milieu de couche (Pa)      real, intent(in):: t(klon, klev) ! temperature (K)
53      ! tsol-----input-R- temperature du sol (en K)      real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg/kg)
     ! albedo---input-R- albedo du sol (entre 0 et 1)  
     ! t--------input-R- temperature (K)  
     ! q--------input-R- vapeur d'eau (en kg/kg)  
     ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505  
     ! cldfra---input-R- fraction nuageuse (entre 0 et 1)  
     ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)  
     ! 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        
   
     ! 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.  
     ! toplw----output-R- ray. IR montant au sommet de l'atmosphere  
     ! 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)  
54    
     ! ATTENTION: swai and swad have to be interpreted in the following manner:  
     ! 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)  
55      real, intent(in):: wo(klon, klev)      real, intent(in):: wo(klon, klev)
56      real cldfra(klon, klev), cldemi(klon, klev), cldtaupd(klon, klev)      ! column-density of ozone in a layer, in kilo-Dobsons
57    
58        real, intent(in):: cldfra(klon, klev) ! fraction nuageuse (entre 0 et 1)
59    
60        real, intent(in):: cldemi(klon, klev)
61        ! emissivite des nuages dans l'IR (entre 0 et 1)
62    
63        real, intent(in):: cldtaupd(klon, klev)
64        ! epaisseur optique des nuages dans le visible (present-day value)
65    
66      real, intent(out):: heat(klon, klev)      real, intent(out):: heat(klon, klev)
67      ! échauffement atmosphérique (visible) (K/jour)      ! échauffement atmosphérique (visible) (K/jour)
68    
69      real cool(klon, klev)      real, intent(out):: heat0(klon, klev) ! chauffage solaire ciel clair
70      real heat0(klon, klev), cool0(klon, klev)      real, intent(out):: cool(klon, klev) ! refroidissement dans l'IR (K/jour)
71      real radsol(klon), topsw(klon), toplw(klon)  
72      real solsw(klon), sollw(klon), albpla(klon)      real, intent(out):: cool0(klon, klev)
73      real topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)      ! refroidissement infrarouge ciel clair
74      real sollwdown(klon)  
75      !IM output 3D      real, intent(out):: radsol(klon)
76        ! bilan radiatif net au sol (W/m**2) (+ vers le bas)
77    
78        real, intent(out):: albpla(klon) ! albedo planetaire (entre 0 et 1)
79        real, intent(out):: topsw(klon) ! flux solaire net au sommet de l'atm.
80    
81        real, intent(out):: toplw(klon)
82        ! rayonnement infrarouge montant au sommet de l'atmosphère
83    
84        real, intent(out):: solsw(klon) ! flux solaire net à la surface
85    
86        real, intent(out):: sollw(klon)
87        ! rayonnement infrarouge montant à la surface
88    
89        real, intent(out):: sollwdown(klon)
90        real, intent(out):: topsw0(klon)
91        real, intent(out):: toplw0(klon)
92        real, intent(out):: solsw0(klon), sollw0(klon)
93        REAL, intent(out):: lwdn0(klon, klev+1), lwdn(klon, klev+1)
94        REAL, intent(out):: lwup0(klon, klev+1), lwup(klon, klev+1)
95        REAL, intent(out):: swdn0(klon, klev+1), swdn(klon, klev+1)
96        REAL, intent(out):: swup0(klon, klev+1), swup(klon, klev+1)
97    
98        logical, intent(in):: ok_ade ! apply the Aerosol Direct Effect
99        logical, intent(in):: ok_aie ! apply the Aerosol Indirect Effect
100    
101        ! aerosol optical properties (calculated in aeropt.F):
102        real, intent(in):: tau_ae(klon, klev, 2), piz_ae(klon, klev, 2)
103        real, intent(in):: cg_ae(klon, klev, 2)
104    
105        real, intent(out):: topswad(klon), solswad(klon)
106        ! aerosol direct forcing at TOA and surface
107        ! ray. solaire net absorbe
108        
109        real, intent(in):: cldtaupi(klon, klev)
110        ! cloud visible optical thickness for pre-industrial aerosol concentrations
111        ! i.e. with smaller droplet concentration, thus larger droplets,
112        ! thus generally cdltaupi cldtaupd it is needed for the
113        ! diagnostics of the aerosol indirect radiative forcing
114    
115        real, intent(out):: topswai(klon), solswai(klon)
116        ! aerosol indirect forcing at TOA and surface
117        ! ray. solaire net absorbe
118    
119        ! Local:
120    
121        double precision tauae(kdlon, klev, 2) ! aer opt properties
122        double precision pizae(kdlon, klev, 2)
123        double precision cgae(kdlon, klev, 2)
124    
125      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
126      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
127      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)
# Line 99  contains Line 133  contains
133      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)
134    
135      DOUBLE PRECISION zx_alpha1, zx_alpha2      DOUBLE PRECISION zx_alpha1, zx_alpha2
136        INTEGER k, kk, i, iof, nb_gr
     INTEGER k, kk, i, j, iof, nb_gr  
     EXTERNAL lw  
   
137      DOUBLE PRECISION PSCT      DOUBLE PRECISION PSCT
138    
139      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)
# Line 110  contains Line 141  contains
141      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)      DOUBLE PRECISION PPSOL(kdlon), PDP(kdlon, klev)
142      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)      DOUBLE PRECISION PTL(kdlon, klev+1), PPMB(kdlon, klev+1)
143      DOUBLE PRECISION PTAVE(kdlon, klev)      DOUBLE PRECISION PTAVE(kdlon, klev)
144      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev), POZON(kdlon, klev)      DOUBLE PRECISION PWV(kdlon, klev), PQS(kdlon, klev)
145      DOUBLE PRECISION PAER(kdlon, klev, 5)      DOUBLE PRECISION POZON(kdlon, klev) ! mass fraction of ozone
146        DOUBLE PRECISION PAER(kdlon, klev, 5) ! AEROSOLS' OPTICAL THICKNESS
147      DOUBLE PRECISION PCLDLD(kdlon, klev)      DOUBLE PRECISION PCLDLD(kdlon, klev)
148      DOUBLE PRECISION PCLDLU(kdlon, klev)      DOUBLE PRECISION PCLDLU(kdlon, klev)
149      DOUBLE PRECISION PCLDSW(kdlon, klev)      DOUBLE PRECISION PCLDSW(kdlon, klev)
# Line 119  contains Line 151  contains
151      DOUBLE PRECISION POMEGA(kdlon, 2, klev)      DOUBLE PRECISION POMEGA(kdlon, 2, klev)
152      DOUBLE PRECISION PCG(kdlon, 2, klev)      DOUBLE PRECISION PCG(kdlon, 2, klev)
153    
154      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon), zdist      DOUBLE PRECISION zfract(kdlon), zrmu0(kdlon)
155    
156      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)      DOUBLE PRECISION zheat(kdlon, klev), zcool(kdlon, klev)
157      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)      DOUBLE PRECISION zheat0(kdlon, klev), zcool0(kdlon, klev)
# Line 130  contains Line 162  contains
162      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)      DOUBLE PRECISION ztopsw0(kdlon), ztoplw0(kdlon)
163      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)      DOUBLE PRECISION zsolsw0(kdlon), zsollw0(kdlon)
164      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)  
165    
166      !jq the following quantities are needed for the aerosol radiative forcings      !jq the following quantities are needed for the aerosol radiative forcings
167    
     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)  
   
168      DOUBLE PRECISION PTAUA(kdlon, 2, klev)      DOUBLE PRECISION PTAUA(kdlon, 2, klev)
169      ! present-day value of cloud opt thickness (PTAU is pre-industrial      ! present-day value of cloud opt thickness (PTAU is pre-industrial
170      ! value), local use      ! value), local use
# Line 168  contains Line 175  contains
175      ! Aerosol direct forcing at TOAand surface      ! Aerosol direct forcing at TOAand surface
176    
177      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect      DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
178        real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
179    
180      !----------------------------------------------------------------------      !----------------------------------------------------------------------
181    
# Line 185  contains Line 193  contains
193      cool = 0.      cool = 0.
194      heat0 = 0.      heat0 = 0.
195      cool0 = 0.      cool0 = 0.
196      zdist = dist      PSCT = solaire / dist**2
     PSCT = solaire / zdist / zdist  
   
     loop_nbgr: DO j = 1, nb_gr  
        iof = kdlon * (j - 1)  
197    
198        loop_iof: DO iof = 0, klon - kdlon, kdlon
199         DO i = 1, kdlon         DO i = 1, kdlon
200            zfract(i) = fract(iof+i)            zfract(i) = fract(iof+i)
201            zrmu0(i) = rmu0(iof+i)            zrmu0(i) = mu0(iof+i)
202            PALBD(i, 1) = albedo(iof+i)            PALBD(i, 1) = albedo(iof+i)
203            PALBD(i, 2) = alblw(iof+i)            PALBD(i, 2) = albedo(iof+i)
204            PALBP(i, 1) = albedo(iof+i)            PALBP(i, 1) = albedo(iof+i)
205            PALBP(i, 2) = alblw(iof+i)            PALBP(i, 2) = albedo(iof+i)
206            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre
207            ! PEMIS(i) = 0.96            ! PEMIS(i) = 0.96
208            PEMIS(i) = 1.0            PEMIS(i) = 1.0
209            PVIEW(i) = 1.66            PVIEW(i) = 1.66
210            PPSOL(i) = paprs(iof+i, 1)            PPSOL(i) = paprs(iof+i, 1)
211            zx_alpha1 = (paprs(iof+i, 1)-pplay(iof+i, 2))  &            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &
212                 / (pplay(iof+i, 1)-pplay(iof+i, 2))                 / (play(iof+i, 1)-play(iof+i, 2))
213            zx_alpha2 = 1.0 - zx_alpha1            zx_alpha2 = 1.0 - zx_alpha1
214            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
215            PTL(i, klev+1) = t(iof+i, klev)            PTL(i, klev+1) = t(iof+i, klev)
# Line 221  contains Line 226  contains
226               PTAVE(i, k) = t(iof+i, k)               PTAVE(i, k) = t(iof+i, k)
227               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)
228               PQS(i, k) = PWV(i, k)               PQS(i, k) = PWV(i, k)
229               ! wo:    cm.atm (epaisseur en cm dans la situation standard)               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &
230               ! 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  
231               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
232               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
233               PCLDSW(i, k) = cldfra(iof+i, k)               PCLDSW(i, k) = cldfra(iof+i, k)
# Line 283  contains Line 280  contains
280            ENDDO            ENDDO
281         ENDDO         ENDDO
282    
283         CALL LW(PPMB, PDP, PPSOL, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, &         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
284              PCLDLD, PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, &              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &
285              zsollw0, zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)
286         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
287              PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &              PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &
288              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &
289              ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, ztopswad, zsolswad, &              ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, ztopswad, zsolswad, &
290              ztopswai, zsolswai, ok_ade, ok_aie)              ztopswai, zsolswai, ok_ade, ok_aie)
# Line 355  contains Line 352  contains
352               cool0(iof+i, k) = zcool0(i, k)/zznormcp               cool0(iof+i, k) = zcool0(i, k)/zznormcp
353            ENDDO            ENDDO
354         ENDDO         ENDDO
355      end DO loop_nbgr      end DO loop_iof
356    
357    END SUBROUTINE radlwsw    END SUBROUTINE radlwsw
358    
Legend:
Removed from v.53  
changed lines
  Added in v.213
  ViewVC Help
Powered by ViewVC 1.1.21