/[lmdze]/trunk/Sources/phylmd/Radlwsw/sw.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/sw.f

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

trunk/libf/phylmd/Radlwsw/sw.f90 revision 72 by guez, Tue Jul 23 13:00:07 2013 UTC trunk/Sources/phylmd/Radlwsw/sw.f revision 217 by guez, Thu Mar 30 14:25:18 2017 UTC
# Line 5  module sw_m Line 5  module sw_m
5  contains  contains
6    
7    SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &    SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
8         PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, &         PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PALBPLA, &
9         PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &         PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, &
10         ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &         PTOPSWAD, PSOLSWAD, PTOPSWAI, PSOLSWAI, ok_ade)
        PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)  
11    
12      ! Purpose.      ! Purpose.
13      ! This routine computes the shortwave radiation fluxes in two      ! This routine computes the shortwave radiation fluxes in two
# Line 31  contains Line 30  contains
30      ! 95-01-01 J.-J. Morcrette direct/diffuse albedo      ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
31      ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)      ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
32    
     USE clesphys, ONLY: bug_ozone  
33      USE raddim, ONLY: kdlon, kflev      USE raddim, ONLY: kdlon, kflev
34      USE suphec_m, ONLY: rcpd, rday, rg, md, rmo3      USE suphec_m, ONLY: rcpd, rday, rg
35        use sw1s_m, only: sw1s
36        use sw2s_m, only: sw2s
37    
38      ! ARGUMENTS:      ! ARGUMENTS:
39    
40      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
   
     DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)  
     DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)  
     DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)  
   
41      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
42      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
43        DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
44        DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
45        DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
46        DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
47        DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
48      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
49      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
50      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
51      DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)      DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
     DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! AEROSOLS' OPTICAL THICKNESS  
   
     DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)  
     DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)  
   
52      DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION      DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
53      DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS      DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
     DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR  
54      DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
55        DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
56      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
57      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
58      DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO      DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
# Line 67  contains Line 60  contains
60      DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE      DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
61      DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)      DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
62      DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)      DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
63        DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
64        DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
65        DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
66        DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
67    
68        DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)
69        ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
70    
71      ! LOCAL VARIABLES:      DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)
72        ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
73    
74        DOUBLE PRECISION, intent(out):: PTOPSWAI(KDLON)
75        ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
76    
77        DOUBLE PRECISION, intent(out):: PSOLSWAI(KDLON)
78        ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
79    
80        logical, intent(in):: ok_ade ! use aerosol forcings or not?
81    
82        ! Local:
83    
84      DOUBLE PRECISION ZOZ(KDLON, KFLEV)      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
85      DOUBLE PRECISION ZAKI(KDLON, 2)      DOUBLE PRECISION ZAKI(KDLON, 2)
# Line 85  contains Line 96  contains
96      DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)      DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
97      DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)      DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
98    
     DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)  
     DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)  
     DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)  
     DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)  
   
99      INTEGER inu, jl, jk, i, k, kpl1      INTEGER inu, jl, jk, i, k, kpl1
100    
101      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
# Line 97  contains Line 103  contains
103      INTEGER:: itapsw = 0      INTEGER:: itapsw = 0
104      LOGICAL:: appel1er = .TRUE.      LOGICAL:: appel1er = .TRUE.
105      !jq-Introduced for aerosol forcings      !jq-Introduced for aerosol forcings
106      double precision, save:: flag_aer      logical, save:: flag_aer
     logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?  
     double precision tauae(kdlon, kflev, 2) ! aerosol optical properties  
     double precision pizae(kdlon, kflev, 2)  
     ! aerosol optical properties(see aeropt.F)  
       
     double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-  
     DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)  
     ! CLOUD OPTICAL THICKNESS (pre-industrial value)  
   
     DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO  
     DOUBLE PRECISION PTOPSWAD(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)  
   
     DOUBLE PRECISION PSOLSWAD(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)  
   
     DOUBLE PRECISION PTOPSWAI(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)  
   
     DOUBLE PRECISION PSOLSWAI(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)  
107    
108      !jq - Fluxes including aerosol effects      !jq - Fluxes including aerosol effects
109      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
# Line 127  contains Line 112  contains
112      DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
113    
114      logical:: initialized = .false.      logical:: initialized = .false.
115        REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
116    
117      !-------------------------------------------------------------------      !-------------------------------------------------------------------
118    
119      if(.not.initialized) then      if(.not.initialized) then
120         flag_aer=0.         flag_aer=.false.
121         initialized=.TRUE.         initialized=.TRUE.
122         ZFSUPAD = 0.         ZFSUPAD = 0.
123         ZFSDNAD = 0.         ZFSDNAD = 0.
# Line 150  contains Line 136  contains
136         DO JK = 1 , KFLEV         DO JK = 1 , KFLEV
137            DO JL = 1, KDLON            DO JL = 1, KDLON
138               ZCLDSW0(JL, JK) = 0.0               ZCLDSW0(JL, JK) = 0.0
139               IF (bug_ozone) then               ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
                 ZOZ(JL, JK) = POZON(JL, JK)*46.6968/RG &  
                      *PDP(JL, JK)*(101325.0/PPSOL(JL))  
              ELSE  
                 ! Correction MPL 100505  
                 ZOZ(JL, JK) = POZON(JL, JK)*MD/RMO3*46.6968/RG*PDP(JL, JK)  
              ENDIF  
140            ENDDO            ENDDO
141         ENDDO         ENDDO
142    
# Line 165  contains Line 145  contains
145              PRMU0, PFRAC, PTAVE, PWV, &              PRMU0, PFRAC, PTAVE, PWV, &
146              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
147         INU = 1         INU = 1
148         CALL SW1S(INU, &         CALL SW1S(INU, flag_aer, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
149              PAER, flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
             PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &  
             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
             ZFD, ZFU)  
150         INU = 2         INU = 2
151         CALL SW2S(INU, &         CALL SW2S(INU, flag_aer, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
152              PAER, flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &  
             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
             PWV, PQS, &  
             ZFDOWN, ZFUP)  
153         DO JK = 1 , KFLEV+1         DO JK = 1 , KFLEV+1
154            DO JL = 1, KDLON            DO JL = 1, KDLON
155               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
# Line 184  contains Line 157  contains
157            ENDDO            ENDDO
158         ENDDO         ENDDO
159    
160         flag_aer=0.         flag_aer= .false.
161         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
162              PRMU0, PFRAC, PTAVE, PWV, &              PRMU0, PFRAC, PTAVE, PWV, &
163              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
164         INU = 1         INU = 1
165         CALL SW1S(INU, &         CALL SW1S(INU, .false., PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
166              PAER, flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
             PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &  
             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
             ZFD, ZFU)  
167         INU = 2         INU = 2
168         CALL SW2S(INU, &         CALL SW2S(INU, .false., ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
169              PAER, flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &  
             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
             PWV, PQS, &  
             ZFDOWN, ZFUP)  
170    
171         ! cloudy-sky:         ! cloudy-sky:
172    
# Line 213  contains Line 179  contains
179    
180         IF (ok_ade) THEN         IF (ok_ade) THEN
181            ! cloudy-sky + aerosol dir OB            ! cloudy-sky + aerosol dir OB
182            flag_aer=1.            flag_aer= .true.
183            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, PRMU0, PFRAC, PTAVE, PWV, ZAKI, &
184                 PRMU0, PFRAC, PTAVE, PWV, &                 ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
                ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)  
185            INU = 1            INU = 1
186            CALL SW1S(INU, &            CALL SW1S(INU, .true., PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
187                 PAER, flag_aer, tauae, pizae, cgae, &                 POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
                PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &  
                ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
                ZFD, ZFU)  
188            INU = 2            INU = 2
189            CALL SW2S(INU, &            CALL SW2S(INU, .true., ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
190                 PAER, flag_aer, tauae, pizae, cgae, &                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, &
191                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &                 ZFUP)
                ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
                PWV, PQS, &  
                ZFDOWN, ZFUP)  
192            DO JK = 1 , KFLEV+1            DO JK = 1 , KFLEV+1
193               DO JL = 1, KDLON               DO JL = 1, KDLON
194                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
# Line 237  contains Line 196  contains
196                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
197                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
198               ENDDO               ENDDO
           ENDDO  
        ENDIF  
   
        IF (ok_aie) THEN  
           !jq cloudy-sky + aerosol direct + aerosol indirect  
           flag_aer=1.0  
           CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &  
                PRMU0, PFRAC, PTAVE, PWV, &  
                ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)  
           INU = 1  
           CALL SW1S(INU, &  
                PAER, flag_aer, tauae, pizae, cgae, &  
                PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &  
                ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &  
                ZFD, ZFU)  
           INU = 2  
           CALL SW2S(INU, &  
                PAER, flag_aer, tauae, pizae, cgae, &  
                ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &  
                ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &  
                PWV, PQS, &  
                ZFDOWN, ZFUP)  
           DO JK = 1 , KFLEV+1  
              DO JL = 1, KDLON  
                 ZFSUPAI(JL, JK) = ZFSUP(JL, JK)  
                 ZFSDNAI(JL, JK) = ZFSDN(JL, JK)  
                 ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)  
                 ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)  
              ENDDO  
199            ENDDO            ENDDO
200         ENDIF         ENDIF
201    
Legend:
Removed from v.72  
changed lines
  Added in v.217
  ViewVC Help
Powered by ViewVC 1.1.21