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

trunk/Sources/phylmd/Radlwsw/sw.f revision 219 by guez, Thu Mar 30 15:59:45 2017 UTC trunk/phylmd/Radlwsw/sw.f90 revision 346 by guez, Mon Dec 9 20:15:29 2019 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, PALBPLA, &         PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PTOPSW, &
9         PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, &         PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, PTOPSWAD, &
10         PTOPSWAD, PSOLSWAD, PTOPSWAI, PSOLSWAI, ok_ade)         PSOLSWAD, ok_ade)
11    
12      ! Purpose.      ! Purpose.
13      ! This routine computes the shortwave radiation fluxes in two      ! This routine computes the shortwave radiation fluxes in two
# Line 34  contains Line 34  contains
34      USE suphec_m, ONLY: rcpd, rday, rg      USE suphec_m, ONLY: rcpd, rday, rg
35      use sw1s_m, only: sw1s      use sw1s_m, only: sw1s
36      use sw2s_m, only: sw2s      use sw2s_m, only: sw2s
37        use swu_m, only: swu
38    
39      ! ARGUMENTS:      ! ARGUMENTS:
40    
41      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)      DOUBLE PRECISION PSCT ! constante solaire
42      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
43      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
44      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
# Line 55  contains Line 56  contains
56      DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR      DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
57      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
58      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
     DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO  
59      DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.      DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
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)
# Line 65  contains Line 65  contains
65      DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)      DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
66      DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)      DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
67    
68      DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)      DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)
69      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
70    
71      DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)      DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)
72      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
73    
     DOUBLE PRECISION, intent(out):: PTOPSWAI(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)  
   
     DOUBLE PRECISION, intent(out):: PSOLSWAI(KDLON)  
     ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)  
   
74      logical, intent(in):: ok_ade ! use aerosol forcings or not?      logical, intent(in):: ok_ade ! use aerosol forcings or not?
75    
76      ! Local:      ! Local:
77    
78      DOUBLE PRECISION ZOZ(KDLON, KFLEV)      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
79      DOUBLE PRECISION ZAKI(KDLON, 2)      DOUBLE PRECISION ZAKI(KDLON, 2)
80      DOUBLE PRECISION ZCLD(KDLON, KFLEV)      DOUBLE PRECISION ZCLD(KDLON, KFLEV)
81      DOUBLE PRECISION ZCLEAR(KDLON)      DOUBLE PRECISION ZCLEAR(KDLON)
82      DOUBLE PRECISION ZDSIG(KDLON, KFLEV)      DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
83      DOUBLE PRECISION ZFACT(KDLON)      DOUBLE PRECISION ZFACT(KDLON)
84      DOUBLE PRECISION ZFD(KDLON, KFLEV+1)      DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
# Line 107  contains Line 101  contains
101      !jq - Fluxes including aerosol effects      !jq - Fluxes including aerosol effects
102      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
103      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
     DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)  
     DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)  
104    
105      logical:: initialized = .false.      logical:: initialized = .false.
106      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
# Line 119  contains Line 111  contains
111         initialized=.TRUE.         initialized=.TRUE.
112         ZFSUPAD = 0.         ZFSUPAD = 0.
113         ZFSDNAD = 0.         ZFSDNAD = 0.
        ZFSUPAI = 0.  
        ZFSDNAI = 0.  
114      endif      endif
115      !rv      !rv
116    
# Line 130  contains Line 120  contains
120         appel1er = .FALSE.         appel1er = .FALSE.
121      ENDIF      ENDIF
122    
123      IF (MOD(itapsw, swpas).EQ.0) THEN      IF (MOD(itapsw, swpas) == 0) THEN
124         DO JK = 1 , KFLEV         DO JK = 1, KFLEV
125            DO JL = 1, KDLON            DO JL = 1, KDLON
126               ZCLDSW0(JL, JK) = 0.0               ZCLDSW0(JL, JK) = 0.0
127               ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)               ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
# Line 148  contains Line 138  contains
138         INU = 2         INU = 2
139         CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &         CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
140              ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)              ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
141         DO JK = 1 , KFLEV+1         DO JK = 1, KFLEV+1
142            DO JL = 1, KDLON            DO JL = 1, KDLON
143               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
144               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
# Line 167  contains Line 157  contains
157    
158         ! cloudy-sky:         ! cloudy-sky:
159    
160         DO JK = 1 , KFLEV+1         DO JK = 1, KFLEV+1
161            DO JL = 1, KDLON            DO JL = 1, KDLON
162               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
163               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
# Line 184  contains Line 174  contains
174            INU = 2            INU = 2
175            CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &            CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
176                 POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)                 POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
177            DO JK = 1 , KFLEV+1            DO JK = 1, KFLEV+1
178               DO JL = 1, KDLON               DO JL = 1, KDLON
179                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
180                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
181                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
182                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
183               ENDDO               ENDDO
# Line 210  contains Line 200  contains
200         ENDDO         ENDDO
201      ENDDO      ENDDO
202      DO i = 1, KDLON      DO i = 1, KDLON
        PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)  
   
203         PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)         PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
204         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
205    
# Line 220  contains Line 208  contains
208    
209         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
210         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
   
        PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)  
        PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)  
211      ENDDO      ENDDO
212    
213    END SUBROUTINE SW    END SUBROUTINE SW
Legend:
Removed from v.219  
changed lines
  Added in v.346
  ViewVC Help
Powered by ViewVC 1.1.21