/[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 53 by guez, Fri Oct 7 13:11:58 2011 UTC trunk/phylmd/Radlwsw/radlwsw.f revision 82 by guez, Wed Mar 5 14:57:53 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, rmu0, 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
17      ! Rayonnements solaire et infrarouge  
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    
     USE dimphy, ONLY: klev, klon  
38      USE clesphys, ONLY: bug_ozone, solaire      USE clesphys, ONLY: bug_ozone, solaire
39      USE suphec_m, ONLY: rg      USE dimphy, ONLY: klev, klon
40        use lw_m, only: lw
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    
48        real dist, rmu0(klon), fract(klon)
49      ! dist-----input-R- distance astronomique terre-soleil      ! dist-----input-R- distance astronomique terre-soleil
50      ! rmu0-----input-R- cosinus de l'angle zenithal      ! rmu0-----input-R- cosinus de l'angle zenithal
51      ! fract----input-R- duree d'ensoleillement normalisee      ! fract----input-R- duree d'ensoleillement normalisee
52      ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)  
53      ! solaire--input-R- constante solaire (W/m**2)      real, intent(in):: paprs(klon, klev+1)
54      ! paprs----input-R- pression a inter-couche (Pa)      ! paprs----input-R- pression a inter-couche (Pa)
55      ! pplay----input-R- pression au milieu de couche (Pa)      real, intent(in):: play(klon, klev)
56      ! tsol-----input-R- temperature du sol (en K)      ! play----input-R- pression au milieu de couche (Pa)
57        real tsol(klon), albedo(klon), alblw(klon)
58      ! albedo---input-R- albedo du sol (entre 0 et 1)      ! albedo---input-R- albedo du sol (entre 0 et 1)
59        ! tsol-----input-R- temperature du sol (en K)
60        real, intent(in):: t(klon, klev)
61      ! t--------input-R- temperature (K)      ! t--------input-R- temperature (K)
62        real q(klon, klev)
63      ! q--------input-R- vapeur d'eau (en kg/kg)      ! q--------input-R- vapeur d'eau (en kg/kg)
64        real, intent(in):: wo(klon, klev)
65      ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505      ! wo-------input-R- contenu en ozone (en kg/kg) correction MPL 100505
66        real cldfra(klon, klev), cldemi(klon, klev)
67      ! 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)  
68      ! 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        
69    
70        real cldtaupd(klon, klev)
71        ! input-R- epaisseur optique des nuages dans le visible (present-day value)
72    
73        real, intent(out):: heat(klon, klev)
74        ! échauffement atmosphérique (visible) (K/jour)
75    
76        real heat0(klon, klev)
77        real cool(klon, klev)
78      ! cool-----output-R- refroidissement dans l'IR (K/jour)      ! cool-----output-R- refroidissement dans l'IR (K/jour)
79        real cool0(klon, klev)
80        real radsol(klon)
81      ! 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)
82        real albpla(klon)
83      ! albpla---output-R- albedo planetaire (entre 0 et 1)      ! albpla---output-R- albedo planetaire (entre 0 et 1)
84        real topsw(klon)
85      ! topsw----output-R- flux solaire net au sommet de l'atm.      ! topsw----output-R- flux solaire net au sommet de l'atm.
86      ! toplw----output-R- ray. IR montant au sommet de l'atmosphere  
87      ! solsw----output-R- flux solaire net a la surface      real, intent(out):: toplw(klon)
88      ! sollw----output-R- ray. IR montant a la surface      ! rayonnement infrarouge montant au sommet de l'atmosphère
89      ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)  
90        real, intent(out):: solsw(klon) ! flux solaire net à la surface
91    
92        real, intent(out):: sollw(klon)
93        ! rayonnement infrarouge montant à la surface
94    
95        real, intent(out):: sollwdown(klon)
96        real topsw0(klon)
97        real, intent(out):: toplw0(klon)
98        real solsw0(klon), sollw0(klon)
99        !IM output 3D: SWup, SWdn, LWup, LWdn
100        REAL lwdn0(klon, klev+1), lwdn(klon, klev+1)
101        REAL lwup0(klon, klev+1), lwup(klon, klev+1)
102        REAL swdn0(klon, klev+1), swdn(klon, klev+1)
103        REAL swup0(klon, klev+1), swup(klon, klev+1)
104    
105        logical ok_ade, ok_aie
106        ! switches whether to use aerosol direct (indirect) effects or not
107        ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
108        ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
109    
110        real tau_ae(klon, klev, 2), piz_ae(klon, klev, 2), cg_ae(klon, klev, 2)
111        ! input-R- aerosol optical properties (calculated in aeropt.F)
112    
113        real topswad(klon), solswad(klon)
114        ! output: aerosol direct forcing at TOA and surface
115      ! 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)
116      ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)      ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
     ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)  
117    
118      ! ATTENTION: swai and swad have to be interpreted in the following manner:      real cldtaupi(klon, klev)
119      ! ok_ade = F & ok_aie = F -both are zero      ! cloud optical thickness for pre-industrial aerosol concentrations
120      ! ok_ade = T & ok_aie = F -aerosol direct forcing is F_{AD} = topsw-topswad      ! (i.e. with a smaller droplet concentration and thus larger droplet radii)
121      !                        indirect is zero      ! -input-R- epaisseur optique des nuages dans le visible
122      ! ok_ade = F & ok_aie = T -aerosol indirect forcing is F_{AI} = topsw-topswai      ! calculated for pre-industrial (pi) aerosol concentrations,
123      !                        direct is zero      ! i.e. with smaller droplet concentration, thus larger droplets,
124      ! ok_ade = T & ok_aie = T -aerosol indirect forcing is F_{AI} = topsw-topswai      ! thus generally cdltaupi cldtaupd it is needed for the
125      !                        aerosol direct forcing is F_{AD} = topswai-topswad      ! diagnostics of the aerosol indirect radiative forcing
126    
127      real rmu0(klon), fract(klon), dist      real topswai(klon), solswai(klon)
128        ! output: aerosol indirect forcing atTOA and surface
129        ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
130        ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
131    
132      real, intent(in):: paprs(klon, klev+1)      ! Local:
     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)  
133    
134      real, intent(out):: heat(klon, klev)      double precision tauae(kdlon, klev, 2) ! aer opt properties
135      ! échauffement atmosphérique (visible) (K/jour)      double precision pizae(kdlon, klev, 2)
136        double precision cgae(kdlon, klev, 2)
137    
     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)  
138      !IM output 3D      !IM output 3D
139      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
140      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
# Line 99  contains Line 147  contains
147      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)      DOUBLE PRECISION ZFLDN0(KDLON, KLEV+1)
148    
149      DOUBLE PRECISION zx_alpha1, zx_alpha2      DOUBLE PRECISION zx_alpha1, zx_alpha2
150        INTEGER k, kk, i, iof, nb_gr
     INTEGER k, kk, i, j, iof, nb_gr  
     EXTERNAL lw  
   
151      DOUBLE PRECISION PSCT      DOUBLE PRECISION PSCT
152    
153      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)      DOUBLE PRECISION PALBD(kdlon, 2), PALBP(kdlon, 2)
# Line 130  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  
   
     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 188  contains Line 208  contains
208      zdist = dist      zdist = dist
209      PSCT = solaire / zdist / zdist      PSCT = solaire / zdist / zdist
210    
211      loop_nbgr: DO j = 1, nb_gr      loop_iof: DO iof = 0, klon - kdlon, kdlon
        iof = kdlon * (j - 1)  
   
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) = rmu0(iof+i)
# Line 203  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 355  contains Line 373  contains
373               cool0(iof+i, k) = zcool0(i, k)/zznormcp               cool0(iof+i, k) = zcool0(i, k)/zznormcp
374            ENDDO            ENDDO
375         ENDDO         ENDDO
376      end DO loop_nbgr      end DO loop_iof
377    
378    END SUBROUTINE radlwsw    END SUBROUTINE radlwsw
379    
Legend:
Removed from v.53  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21