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

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

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

revision 178 by guez, Fri Mar 11 18:47:26 2016 UTC 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, 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 39  contains Line 38  contains
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 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 132  contains Line 117  contains
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 160  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              flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
             PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
             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              flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
             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 179  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              flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
             PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
             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              flag_aer, tauae, pizae, cgae, &              POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
             ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
             ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &  
             PWV, PQS, &  
             ZFDOWN, ZFUP)  
170    
171         ! cloudy-sky:         ! cloudy-sky:
172    
# Line 208  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                 flag_aer, tauae, pizae, cgae, &                 POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
                PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
                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                 flag_aer, tauae, pizae, cgae, &                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, &
191                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &                 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 232  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, &  
                flag_aer, tauae, pizae, cgae, &  
                PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
                ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &  
                ZFD, ZFU)  
           INU = 2  
           CALL SW2S(INU, &  
                flag_aer, tauae, pizae, cgae, &  
                ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &  
                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.178  
changed lines
  Added in v.217
  ViewVC Help
Powered by ViewVC 1.1.21