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

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

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

trunk/Sources/phylmd/Radlwsw/radlwsw.f revision 212 by guez, Thu Jan 12 12:31:31 2017 UTC trunk/phylmd/Radlwsw/radlwsw.f revision 308 by guez, Tue Sep 18 15:14:40 2018 UTC
# Line 7  contains Line 7  contains
7    SUBROUTINE radlwsw(dist, mu0, fract, paprs, play, tsol, albedo, t, q, wo, &    SUBROUTINE radlwsw(dist, mu0, fract, paprs, play, tsol, albedo, t, q, wo, &
8         cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, albpla, &         cldfra, cldemi, cldtaupd, heat, heat0, cool, cool0, radsol, albpla, &
9         topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, sollw0, &         topsw, toplw, solsw, sollw, sollwdown, topsw0, toplw0, solsw0, sollw0, &
10         lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, ok_aie, &         lwdn0, lwdn, lwup0, lwup, swdn0, swdn, swup0, swup, ok_ade, topswad, &
11         tau_ae, piz_ae, cg_ae, topswad, solswad, cldtaupi, topswai, solswai)         solswad)
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)      ! Author: Z. X. Li (LMD/CNRS)
15      ! Date: 1996/07/19      ! Date: 1996/07/19
16    
17      ! Objet : interface entre le modèle et les rayonnements solaire et      ! Objet : interface entre le modèle et les rayonnements solaire et
18      ! infrarouge      ! infrarouge
19    
20      ! ATTENTION: swai and swad have to be interpreted in the following manner:      ! ATTENTION: swad has to be interpreted in the following manner:
21        ! not ok_ade zero
22      ! not ok_ade and not ok_aie      ! ok_ade aerosol direct forcing is F_{AD} = topsw - topswad
     ! both are zero  
   
     ! ok_ade and not ok_aie  
     ! aerosol direct forcing is F_{AD} = topsw - topswad  
     ! indirect is zero  
   
     ! not ok_ade and ok_aie  
     ! aerosol indirect forcing is F_{AI} = topsw - topswai  
     ! direct is zero  
   
     ! ok_ade and ok_aie  
     ! aerosol indirect forcing is F_{AI} = topsw - topswai  
     ! aerosol direct forcing is F_{AD} = topswai - topswad  
23    
24      USE clesphys, ONLY: solaire      USE clesphys, ONLY: solaire
25      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
# Line 41  contains Line 28  contains
28      USE suphec_m, ONLY: rg      USE suphec_m, ONLY: rg
29      use sw_m, only: sw      use sw_m, only: sw
30      USE yoethf_m, ONLY: rvtmp2      USE yoethf_m, ONLY: rvtmp2
31            
32      real, intent(in):: dist ! distance astronomique terre-soleil      real, intent(in):: dist ! distance astronomique terre-soleil
33      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal
34      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee
# Line 66  contains Line 53  contains
53      real, intent(out):: heat(klon, klev)      real, intent(out):: heat(klon, klev)
54      ! échauffement atmosphérique (visible) (K/jour)      ! échauffement atmosphérique (visible) (K/jour)
55    
56      real, intent(out):: heat0(klon, klev)      real, intent(out):: heat0(klon, klev) ! chauffage solaire ciel clair
57      real, intent(out):: cool(klon, klev) ! refroidissement dans l'IR (K/jour)      real, intent(out):: cool(klon, klev) ! refroidissement dans l'IR (K/jour)
58    
59      real, intent(out):: cool0(klon, klev)      real, intent(out):: cool0(klon, klev)
60        ! refroidissement infrarouge ciel clair
61    
62      real, intent(out):: radsol(klon)      real, intent(out):: radsol(klon)
63      ! bilan radiatif net au sol (W/m**2) (+ vers le bas)      ! bilan radiatif net au sol (W/m**2), positif vers le bas
64    
65      real, intent(out):: albpla(klon) ! albedo planetaire (entre 0 et 1)      real, intent(out):: albpla(klon) ! albedo planetaire (entre 0 et 1)
66      real, intent(out):: topsw(klon) ! flux solaire net au sommet de l'atm.      real, intent(out):: topsw(klon) ! flux solaire net au sommet de l'atm.
# Line 82  contains Line 71  contains
71      real, intent(out):: solsw(klon) ! flux solaire net à la surface      real, intent(out):: solsw(klon) ! flux solaire net à la surface
72    
73      real, intent(out):: sollw(klon)      real, intent(out):: sollw(klon)
74      ! rayonnement infrarouge montant à la surface      ! rayonnement infrarouge net à la surface
75    
76      real, intent(out):: sollwdown(klon)      real, intent(out):: sollwdown(klon)
77      real, intent(out):: topsw0(klon)      real, intent(out):: topsw0(klon)
# Line 94  contains Line 83  contains
83      REAL, intent(out):: swup0(klon, klev+1), swup(klon, klev+1)      REAL, intent(out):: swup0(klon, klev+1), swup(klon, klev+1)
84    
85      logical, intent(in):: ok_ade ! apply the Aerosol Direct Effect      logical, intent(in):: ok_ade ! apply the Aerosol Direct Effect
     logical, intent(in):: ok_aie ! apply the Aerosol Indirect Effect  
   
     ! aerosol optical properties (calculated in aeropt.F):  
     real, intent(in):: tau_ae(klon, klev, 2), piz_ae(klon, klev, 2)  
     real, intent(in):: cg_ae(klon, klev, 2)  
86    
87      real, intent(out):: topswad(klon), solswad(klon)      real, intent(out):: topswad(klon), solswad(klon)
88      ! aerosol direct forcing at TOA and surface      ! aerosol direct forcing at TOA and surface
89      ! ray. solaire net absorbe      ! rayonnement solaire net absorb\'e
       
     real, intent(in):: cldtaupi(klon, klev)  
     ! cloud visible optical thickness for pre-industrial 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  
   
     real, intent(out):: topswai(klon), solswai(klon)  
     ! aerosol indirect forcing at TOA and surface  
     ! ray. solaire net absorbe  
90    
91      ! Local:      ! Local:
92    
     double precision tauae(kdlon, klev, 2) ! aer opt properties  
     double precision pizae(kdlon, klev, 2)  
     double precision cgae(kdlon, klev, 2)  
   
93      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
94      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
95      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)
# Line 162  contains Line 132  contains
132      DOUBLE PRECISION zznormcp      DOUBLE PRECISION zznormcp
133    
134      !jq the following quantities are needed for the aerosol radiative forcings      !jq the following quantities are needed for the aerosol radiative forcings
   
     DOUBLE PRECISION PTAUA(kdlon, 2, klev)  
     ! present-day value of cloud opt thickness (PTAU is pre-industrial  
     ! value), local use  
   
     DOUBLE PRECISION POMEGAA(kdlon, 2, klev) ! dito for single scatt albedo  
   
135      DOUBLE PRECISION ztopswad(kdlon), zsolswad(kdlon)      DOUBLE PRECISION ztopswad(kdlon), zsolswad(kdlon)
136      ! Aerosol direct forcing at TOAand surface      ! Aerosol direct forcing at TOA and surface
137    
     DOUBLE PRECISION ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect  
138      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2      real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
139    
140      !----------------------------------------------------------------------      !----------------------------------------------------------------------
141    
     tauae = 0.  
     pizae = 0.  
     cgae = 0.  
   
142      nb_gr = klon / kdlon      nb_gr = klon / kdlon
143      IF (nb_gr * kdlon /= klon) THEN      IF (nb_gr * kdlon /= klon) THEN
144         PRINT *, "kdlon mauvais :", klon, kdlon, nb_gr         PRINT *, "kdlon mauvais :", klon, kdlon, nb_gr
145         stop 1         stop 1
146      ENDIF      ENDIF
147        
148      heat = 0.      heat = 0.
149      cool = 0.      cool = 0.
150      heat0 = 0.      heat0 = 0.
# Line 203  contains Line 161  contains
161            PALBP(i, 2) = albedo(iof+i)            PALBP(i, 2) = albedo(iof+i)
162            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre
163            ! PEMIS(i) = 0.96            ! PEMIS(i) = 0.96
164            PEMIS(i) = 1.0            PEMIS(i) = 1.
165            PVIEW(i) = 1.66            PVIEW(i) = 1.66
166            PPSOL(i) = paprs(iof+i, 1)            PPSOL(i) = paprs(iof+i, 1)
167            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &
168                 / (play(iof+i, 1)-play(iof+i, 2))                 / (play(iof+i, 1)-play(iof+i, 2))
169            zx_alpha2 = 1.0 - zx_alpha1            zx_alpha2 = 1. - zx_alpha1
170            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
171            PTL(i, klev+1) = t(iof+i, klev)            PTL(i, klev+1) = t(iof+i, klev)
172            PDT0(i) = tsol(iof+i) - PTL(i, 1)            PDT0(i) = tsol(iof+i) - PTL(i, 1)
# Line 222  contains Line 180  contains
180            DO i = 1, kdlon            DO i = 1, kdlon
181               PDP(i, k) = paprs(iof+i, k)-paprs(iof+i, k+1)               PDP(i, k) = paprs(iof+i, k)-paprs(iof+i, k+1)
182               PTAVE(i, k) = t(iof+i, k)               PTAVE(i, k) = t(iof+i, k)
183               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)               PWV(i, k) = MAX (q(iof+i, k), 1e-12)
184               PQS(i, k) = PWV(i, k)               PQS(i, k) = PWV(i, k)
185               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &
186                    / (paprs(iof+i, k) - paprs(iof+i, k+1))                    / (paprs(iof+i, k) - paprs(iof+i, k+1))
187               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
188               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
189               PCLDSW(i, k) = cldfra(iof+i, k)               PCLDSW(i, k) = cldfra(iof+i, k)
190               PTAU(i, 1, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)               PTAU(i, 1, k) = MAX(cldtaupd(iof+i, k), 1e-05)
191               ! (1e-12 serait instable)               ! (1e-12 serait instable)
192               PTAU(i, 2, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)               PTAU(i, 2, k) = MAX(cldtaupd(iof+i, k), 1e-05)
193               ! (pour 32-bit machines)               ! (pour 32-bit machines)
194               POMEGA(i, 1, k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i, 1, k))               POMEGA(i, 1, k) = 0.9999 - 5e-04 * EXP(-0.5 * PTAU(i, 1, k))
195               POMEGA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i, 2, k))               POMEGA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i, 2, k))
196               PCG(i, 1, k) = 0.865               PCG(i, 1, k) = 0.865
197               PCG(i, 2, k) = 0.910               PCG(i, 2, k) = 0.910
   
              ! Introduced for aerosol indirect forcings.  The  
              ! following values use the cloud optical thickness  
              ! calculated from present-day aerosol concentrations  
              ! whereas the quantities without the "A" at the end are  
              ! for pre-industial (natural-only) aerosol concentrations  
              PTAUA(i, 1, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)  
              ! (1e-12 serait instable)  
              PTAUA(i, 2, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)  
              ! (pour 32-bit machines)  
              POMEGAA(i, 1, k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i, 1, k))  
              POMEGAA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i, 2, k))  
              !jq-end  
198            ENDDO            ENDDO
199         ENDDO         ENDDO
200    
201         DO k = 1, klev+1         DO k = 1, klev+1
202            DO i = 1, kdlon            DO i = 1, kdlon
203               PPMB(i, k) = paprs(iof+i, k)/100.0               PPMB(i, k) = paprs(iof+i, k)/100.
204            ENDDO            ENDDO
205         ENDDO         ENDDO
206    
207         DO kk = 1, 5         DO kk = 1, 5
208            DO k = 1, klev            DO k = 1, klev
209               DO i = 1, kdlon               DO i = 1, kdlon
210                  PAER(i, k, kk) = 1.0E-15                  PAER(i, k, kk) = 1E-15
211               ENDDO               ENDDO
212            ENDDO            ENDDO
213         ENDDO         ENDDO
214    
        DO k = 1, klev  
           DO i = 1, kdlon  
              tauae(i, k, 1) = tau_ae(iof+i, k, 1)  
              pizae(i, k, 1) = piz_ae(iof+i, k, 1)  
              cgae(i, k, 1) =cg_ae(iof+i, k, 1)  
              tauae(i, k, 2) = tau_ae(iof+i, k, 2)  
              pizae(i, k, 2) = piz_ae(iof+i, k, 2)  
              cgae(i, k, 2) =cg_ae(iof+i, k, 2)  
           ENDDO  
        ENDDO  
   
215         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
216              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &
217              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)
218         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
219              PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &              PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &
220              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &
221              ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, ztopswad, zsolswad, &              ZFSDN0, ztopswad, zsolswad, ok_ade)
             ztopswai, zsolswai, ok_ade, ok_aie)  
222    
223         DO i = 1, kdlon         DO i = 1, kdlon
224            radsol(iof+i) = zsolsw(i) + zsollw(i)            radsol(iof+i) = zsolsw(i) + zsollw(i)
# Line 323  contains Line 256  contains
256            ENDDO            ENDDO
257         ELSE         ELSE
258            DO i = 1, kdlon            DO i = 1, kdlon
259               topswad(iof+i) = 0.0               topswad(iof+i) = 0.
260               solswad(iof+i) = 0.0               solswad(iof+i) = 0.
           ENDDO  
        ENDIF  
        IF (ok_aie) THEN  
           DO i = 1, kdlon  
              topswai(iof+i) = ztopswai(i)  
              solswai(iof+i) = zsolswai(i)  
           ENDDO  
        ELSE  
           DO i = 1, kdlon  
              topswai(iof+i) = 0.0  
              solswai(iof+i) = 0.0  
261            ENDDO            ENDDO
262         ENDIF         ENDIF
263    
Legend:
Removed from v.212  
changed lines
  Added in v.308
  ViewVC Help
Powered by ViewVC 1.1.21