/[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

revision 213 by guez, Mon Feb 27 15:44:55 2017 UTC revision 217 by guez, Thu Mar 30 14:25:18 2017 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    
# Line 19  contains Line 19  contains
19    
20      ! ATTENTION: swai and swad have to be interpreted in the following manner:      ! ATTENTION: swai and swad have to be interpreted in the following manner:
21    
22      ! not ok_ade and not ok_aie      ! not ok_ade
23      ! both are zero      ! both are zero
24    
25      ! ok_ade and not ok_aie      ! ok_ade
26      ! aerosol direct forcing is F_{AD} = topsw - topswad      ! aerosol direct forcing is F_{AD} = topsw - topswad
27      ! indirect is zero      ! indirect is zero
28    
     ! 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  
   
29      USE clesphys, ONLY: solaire      USE clesphys, ONLY: solaire
30      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
31      use lw_m, only: lw      use lw_m, only: lw
# Line 41  contains Line 33  contains
33      USE suphec_m, ONLY: rg      USE suphec_m, ONLY: rg
34      use sw_m, only: sw      use sw_m, only: sw
35      USE yoethf_m, ONLY: rvtmp2      USE yoethf_m, ONLY: rvtmp2
36            
37      real, intent(in):: dist ! distance astronomique terre-soleil      real, intent(in):: dist ! distance astronomique terre-soleil
38      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal      real, intent(in):: mu0(klon) ! cosinus de l'angle zenithal
39      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee      real, intent(in):: fract(klon) ! duree d'ensoleillement normalisee
# Line 96  contains Line 88  contains
88      REAL, intent(out):: swup0(klon, klev+1), swup(klon, klev+1)      REAL, intent(out):: swup0(klon, klev+1), swup(klon, klev+1)
89    
90      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)  
91    
92      real, intent(out):: topswad(klon), solswad(klon)      real, intent(out):: topswad(klon), solswad(klon)
93      ! aerosol direct forcing at TOA and surface      ! aerosol direct forcing at TOA and surface
94      ! 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  
95    
96      ! Local:      ! Local:
97    
     double precision tauae(kdlon, klev, 2) ! aer opt properties  
     double precision pizae(kdlon, klev, 2)  
     double precision cgae(kdlon, klev, 2)  
   
98      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP(KDLON, KLEV+1)
99      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)      DOUBLE PRECISION ZFSDN(KDLON, KLEV+1)
100      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)      DOUBLE PRECISION ZFSUP0(KDLON, KLEV+1)
# Line 179  contains Line 152  contains
152    
153      !----------------------------------------------------------------------      !----------------------------------------------------------------------
154    
     tauae = 0.  
     pizae = 0.  
     cgae = 0.  
   
155      nb_gr = klon / kdlon      nb_gr = klon / kdlon
156      IF (nb_gr * kdlon /= klon) THEN      IF (nb_gr * kdlon /= klon) THEN
157         PRINT *, "kdlon mauvais :", klon, kdlon, nb_gr         PRINT *, "kdlon mauvais :", klon, kdlon, nb_gr
158         stop 1         stop 1
159      ENDIF      ENDIF
160        
161      heat = 0.      heat = 0.
162      cool = 0.      cool = 0.
163      heat0 = 0.      heat0 = 0.
# Line 205  contains Line 174  contains
174            PALBP(i, 2) = albedo(iof+i)            PALBP(i, 2) = albedo(iof+i)
175            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre            ! cf. JLD pour etre en accord avec ORCHIDEE il faut mettre
176            ! PEMIS(i) = 0.96            ! PEMIS(i) = 0.96
177            PEMIS(i) = 1.0            PEMIS(i) = 1.
178            PVIEW(i) = 1.66            PVIEW(i) = 1.66
179            PPSOL(i) = paprs(iof+i, 1)            PPSOL(i) = paprs(iof+i, 1)
180            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &            zx_alpha1 = (paprs(iof+i, 1)-play(iof+i, 2))  &
181                 / (play(iof+i, 1)-play(iof+i, 2))                 / (play(iof+i, 1)-play(iof+i, 2))
182            zx_alpha2 = 1.0 - zx_alpha1            zx_alpha2 = 1. - zx_alpha1
183            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
184            PTL(i, klev+1) = t(iof+i, klev)            PTL(i, klev+1) = t(iof+i, klev)
185            PDT0(i) = tsol(iof+i) - PTL(i, 1)            PDT0(i) = tsol(iof+i) - PTL(i, 1)
# Line 224  contains Line 193  contains
193            DO i = 1, kdlon            DO i = 1, kdlon
194               PDP(i, k) = paprs(iof+i, k)-paprs(iof+i, k+1)               PDP(i, k) = paprs(iof+i, k)-paprs(iof+i, k+1)
195               PTAVE(i, k) = t(iof+i, k)               PTAVE(i, k) = t(iof+i, k)
196               PWV(i, k) = MAX (q(iof+i, k), 1.0e-12)               PWV(i, k) = MAX (q(iof+i, k), 1e-12)
197               PQS(i, k) = PWV(i, k)               PQS(i, k) = PWV(i, k)
198               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &               POZON(i, k) = wo(iof+i, k) * RG * dobson_u * 1e3 &
199                    / (paprs(iof+i, k) - paprs(iof+i, k+1))                    / (paprs(iof+i, k) - paprs(iof+i, k+1))
200               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLD(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
201               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)               PCLDLU(i, k) = cldfra(iof+i, k)*cldemi(iof+i, k)
202               PCLDSW(i, k) = cldfra(iof+i, k)               PCLDSW(i, k) = cldfra(iof+i, k)
203               PTAU(i, 1, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)               PTAU(i, 1, k) = MAX(cldtaupd(iof+i, k), 1e-05)
204               ! (1e-12 serait instable)               ! (1e-12 serait instable)
205               PTAU(i, 2, k) = MAX(cldtaupi(iof+i, k), 1.0e-05)               PTAU(i, 2, k) = MAX(cldtaupd(iof+i, k), 1e-05)
206               ! (pour 32-bit machines)               ! (pour 32-bit machines)
207               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))
208               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))
209               PCG(i, 1, k) = 0.865               PCG(i, 1, k) = 0.865
210               PCG(i, 2, k) = 0.910               PCG(i, 2, k) = 0.910
# Line 245  contains Line 214  contains
214               ! calculated from present-day aerosol concentrations               ! calculated from present-day aerosol concentrations
215               ! whereas the quantities without the "A" at the end are               ! whereas the quantities without the "A" at the end are
216               ! for pre-industial (natural-only) aerosol concentrations               ! for pre-industial (natural-only) aerosol concentrations
217               PTAUA(i, 1, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)               PTAUA(i, 1, k) = MAX(cldtaupd(iof+i, k), 1e-05)
218               ! (1e-12 serait instable)               ! (1e-12 serait instable)
219               PTAUA(i, 2, k) = MAX(cldtaupd(iof+i, k), 1.0e-05)               PTAUA(i, 2, k) = MAX(cldtaupd(iof+i, k), 1e-05)
220               ! (pour 32-bit machines)               ! (pour 32-bit machines)
221               POMEGAA(i, 1, k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i, 1, k))               POMEGAA(i, 1, k) = 0.9999 - 5e-04 * EXP(-0.5 * PTAUA(i, 1, k))
222               POMEGAA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i, 2, k))               POMEGAA(i, 2, k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i, 2, k))
223               !jq-end               !jq-end
224            ENDDO            ENDDO
# Line 257  contains Line 226  contains
226    
227         DO k = 1, klev+1         DO k = 1, klev+1
228            DO i = 1, kdlon            DO i = 1, kdlon
229               PPMB(i, k) = paprs(iof+i, k)/100.0               PPMB(i, k) = paprs(iof+i, k)/100.
230            ENDDO            ENDDO
231         ENDDO         ENDDO
232    
233         DO kk = 1, 5         DO kk = 1, 5
234            DO k = 1, klev            DO k = 1, klev
235               DO i = 1, kdlon               DO i = 1, kdlon
236                  PAER(i, k, kk) = 1.0E-15                  PAER(i, k, kk) = 1E-15
237               ENDDO               ENDDO
238            ENDDO            ENDDO
239         ENDDO         ENDDO
240    
        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  
   
241         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &         CALL LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
242              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &              PCLDLU, PVIEW, zcool, zcool0, ztoplw, zsollw, ztoplw0, zsollw0, &
243              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)              zsollwdown, ZFLUP, ZFLDN, ZFLUP0, ZFLDN0)
244         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &         CALL SW(PSCT, zrmu0, zfract, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
245              PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &              PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, zheat, zheat0, &
246              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &              zalbpla, ztopsw, zsolsw, ztopsw0, zsolsw0, ZFSUP, ZFSDN, ZFSUP0, &
247              ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, ztopswad, zsolswad, &              ZFSDN0, ztopswad, zsolswad, ztopswai, zsolswai, ok_ade)
             ztopswai, zsolswai, ok_ade, ok_aie)  
248    
249         DO i = 1, kdlon         DO i = 1, kdlon
250            radsol(iof+i) = zsolsw(i) + zsollw(i)            radsol(iof+i) = zsolsw(i) + zsollw(i)
# Line 325  contains Line 282  contains
282            ENDDO            ENDDO
283         ELSE         ELSE
284            DO i = 1, kdlon            DO i = 1, kdlon
285               topswad(iof+i) = 0.0               topswad(iof+i) = 0.
286               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  
287            ENDDO            ENDDO
288         ENDIF         ENDIF
289    
Legend:
Removed from v.213  
changed lines
  Added in v.217
  ViewVC Help
Powered by ViewVC 1.1.21