/[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 62 by guez, Thu Jul 26 14:37:37 2012 UTC trunk/Sources/phylmd/Radlwsw/sw.f revision 178 by guez, Fri Mar 11 18:47:26 2016 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, &
9         PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &         PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &
10         ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &         ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &
11         PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)         PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)
12    
13      ! PURPOSE.      ! Purpose.
14      ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO      ! This routine computes the shortwave radiation fluxes in two
15      ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).      ! spectral intervals following Fouquart and Bonnel (1980).
16    
17      ! METHOD.      ! Method.
18      ! 1. COMPUTES ABSORBER AMOUNTS (SWU)      ! 1. Computes absorber amounts (swu)
19      ! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)      ! 2. Computes fluxes in 1st spectral interval (SW1S)
20      ! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)      ! 3. Computes fluxes in 2nd spectral interval (SW2S)
21    
22      ! REFERENCE.      ! Reference.
23      ! SEE RADIATION PART OF THE ECMWF RESEARCH DEPARTMENT      ! See radiation part of the ECMWF research department
24      ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)      ! documentation, and Fouquart and Bonnel (1980)
25    
26      ! AUTHOR.      ! Author.
27      ! JEAN-JACQUES MORCRETTE *ECMWF*      ! Jean-Jacques Morcrette *ecmwf*
28    
29      ! MODIFICATIONS.      ! Modifications.
30      ! ORIGINAL: 89-07-14      ! Original: 89-07-14
31      ! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo      ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
32      ! 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)      ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
33    
     USE clesphys, ONLY: bug_ozone  
     USE suphec_m, ONLY: rcpd, rday, rg, rmd, rmo3  
34      USE raddim, ONLY: kdlon, kflev      USE raddim, ONLY: kdlon, kflev
35        USE suphec_m, ONLY: rcpd, rday, rg
36        use sw1s_m, only: sw1s
37        use sw2s_m, only: sw2s
38    
39      ! ARGUMENTS:      ! ARGUMENTS:
40    
# Line 50  contains Line 51  contains
51      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
52      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
53      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  
54    
55      DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)      DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
56      DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)      DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
# Line 92  contains Line 92  contains
92    
93      INTEGER inu, jl, jk, i, k, kpl1      INTEGER inu, jl, jk, i, k, kpl1
94    
95      INTEGER swpas ! Every swpas steps, sw is calculated      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
     PARAMETER(swpas=1)  
96    
97      INTEGER itapsw      INTEGER:: itapsw = 0
98      LOGICAL appel1er      LOGICAL:: appel1er = .TRUE.
     DATA itapsw /0/  
     DATA appel1er /.TRUE./  
99      !jq-Introduced for aerosol forcings      !jq-Introduced for aerosol forcings
100      double precision flag_aer      double precision, save:: flag_aer
101      logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?      logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
102      double precision tauae(kdlon, kflev, 2) ! aerosol optical properties      double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
103      double precision pizae(kdlon, kflev, 2)      double precision pizae(kdlon, kflev, 2)
# Line 124  contains Line 121  contains
121      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
122    
123      !jq - Fluxes including aerosol effects      !jq - Fluxes including aerosol effects
124      DOUBLE PRECISION ZFSUPAD(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
125      DOUBLE PRECISION ZFSDNAD(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
126      DOUBLE PRECISION ZFSUPAI(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
127      DOUBLE PRECISION ZFSDNAI(KDLON, KFLEV+1)      DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
128      logical initialized  
129      SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes      logical:: initialized = .false.
130      !rv      REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
     save flag_aer  
     data initialized/.false./  
131    
132      !-------------------------------------------------------------------      !-------------------------------------------------------------------
133    
134      if(.not.initialized) then      if(.not.initialized) then
135         flag_aer=0.         flag_aer=0.
136         initialized=.TRUE.         initialized=.TRUE.
137           ZFSUPAD = 0.
138           ZFSDNAD = 0.
139           ZFSUPAI = 0.
140           ZFSDNAI = 0.
141      endif      endif
142      !rv      !rv
143    
# Line 152  contains Line 151  contains
151         DO JK = 1 , KFLEV         DO JK = 1 , KFLEV
152            DO JL = 1, KDLON            DO JL = 1, KDLON
153               ZCLDSW0(JL, JK) = 0.0               ZCLDSW0(JL, JK) = 0.0
154               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)*RMD/RMO3*46.6968/RG*PDP(JL, JK)  
              ENDIF  
155            ENDDO            ENDDO
156         ENDDO         ENDDO
157    
# Line 168  contains Line 161  contains
161              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
162         INU = 1         INU = 1
163         CALL SW1S(INU, &         CALL SW1S(INU, &
164              PAER, flag_aer, tauae, pizae, cgae, &              flag_aer, tauae, pizae, cgae, &
165              PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &              PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
166              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
167              ZFD, ZFU)              ZFD, ZFU)
168         INU = 2         INU = 2
169         CALL SW2S(INU, &         CALL SW2S(INU, &
170              PAER, flag_aer, tauae, pizae, cgae, &              flag_aer, tauae, pizae, cgae, &
171              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
172              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
173              PWV, PQS, &              PWV, PQS, &
174              ZFDOWN, ZFUP)              ZFDOWN, ZFUP)
# Line 192  contains Line 185  contains
185              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
186         INU = 1         INU = 1
187         CALL SW1S(INU, &         CALL SW1S(INU, &
188              PAER, flag_aer, tauae, pizae, cgae, &              flag_aer, tauae, pizae, cgae, &
189              PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &              PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
190              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
191              ZFD, ZFU)              ZFD, ZFU)
192         INU = 2         INU = 2
193         CALL SW2S(INU, &         CALL SW2S(INU, &
194              PAER, flag_aer, tauae, pizae, cgae, &              flag_aer, tauae, pizae, cgae, &
195              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
196              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
197              PWV, PQS, &              PWV, PQS, &
198              ZFDOWN, ZFUP)              ZFDOWN, ZFUP)
# Line 221  contains Line 214  contains
214                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
215            INU = 1            INU = 1
216            CALL SW1S(INU, &            CALL SW1S(INU, &
217                 PAER, flag_aer, tauae, pizae, cgae, &                 flag_aer, tauae, pizae, cgae, &
218                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
219                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
220                 ZFD, ZFU)                 ZFD, ZFU)
221            INU = 2            INU = 2
222            CALL SW2S(INU, &            CALL SW2S(INU, &
223                 PAER, flag_aer, tauae, pizae, cgae, &                 flag_aer, tauae, pizae, cgae, &
224                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
225                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
226                 PWV, PQS, &                 PWV, PQS, &
227                 ZFDOWN, ZFUP)                 ZFDOWN, ZFUP)
# Line 250  contains Line 243  contains
243                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
244            INU = 1            INU = 1
245            CALL SW1S(INU, &            CALL SW1S(INU, &
246                 PAER, flag_aer, tauae, pizae, cgae, &                 flag_aer, tauae, pizae, cgae, &
247                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
248                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
249                 ZFD, ZFU)                 ZFD, ZFU)
250            INU = 2            INU = 2
251            CALL SW2S(INU, &            CALL SW2S(INU, &
252                 PAER, flag_aer, tauae, pizae, cgae, &                 flag_aer, tauae, pizae, cgae, &
253                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, &
254                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
255                 PWV, PQS, &                 PWV, PQS, &
256                 ZFDOWN, ZFUP)                 ZFDOWN, ZFUP)
Legend:
Removed from v.62  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21