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

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

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

trunk/libf/phylmd/Radlwsw/sw.f revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/phylmd/Radlwsw/sw.f revision 118 by guez, Thu Dec 18 17:30:24 2014 UTC
# Line 1  Line 1 
1  cIM ctes ds clesphys.h   SUBROUTINE SW(PSCT, RCO2, PRMU0, PFRAC,  module sw_m
2        SUBROUTINE SW(PSCT, PRMU0, PFRAC,  
3       S              PPMB, PDP,    IMPLICIT none
4       S              PPSOL, PALBD, PALBP,  
5       S              PTAVE, PWV, PQS, POZON, PAER,  contains
6       S              PCLDSW, PTAU, POMEGA, PCG,  
7       S              PHEAT, PHEAT0,    SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
8       S              PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,         PWV, PQS, POZON, PAER, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, &
9       S              ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,         PALBPLA, PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, &
10       S              tauae, pizae, cgae,         ZFSDN0, tauae, pizae, cgae, PTAUA, POMEGAA, PTOPSWAD, PSOLSWAD, &
11       s              PTAUA, POMEGAA,         PTOPSWAI, PSOLSWAI, ok_ade, ok_aie)
12       S              PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI,  
13       J              ok_ade, ok_aie )      ! Purpose.
14              ! This routine computes the shortwave radiation fluxes in two
15        use dimens_m      ! spectral intervals following Fouquart and Bonnel (1980).
16        use dimphy  
17        use clesphys      ! Method.
18        use SUPHEC_M      ! 1. Computes absorber amounts (swu)
19        use raddim      ! 2. Computes fluxes in 1st spectral interval (SW1S)
20        IMPLICIT none      ! 3. Computes fluxes in 2nd spectral interval (SW2S)
21    
22  C      ! Reference.
23  C     ------------------------------------------------------------------      ! See radiation part of the ECMWF research department
24  C      ! documentation, and Fouquart and Bonnel (1980)
25  C     PURPOSE.  
26  C     --------      ! Author.
27  C      ! Jean-Jacques Morcrette *ecmwf*
28  C          THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO  
29  C     SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).      ! Modifications.
30  C      ! Original: 89-07-14
31  C     METHOD.      ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
32  C     -------      ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)
33  C  
34  C          1. COMPUTES ABSORBER AMOUNTS                 (SWU)      USE raddim, ONLY: kdlon, kflev
35  C          2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL  (SW1S)      USE suphec_m, ONLY: rcpd, rday, rg
36  C          3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL  (SW2S)  
37  C      ! ARGUMENTS:
38  C     REFERENCE.  
39  C     ----------      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
40  C  
41  C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT      DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
42  C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)      DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
43  C      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
44  C     AUTHOR.  
45  C     -------      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
46  C        JEAN-JACQUES MORCRETTE  *ECMWF*      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
47  C  
48  C     MODIFICATIONS.      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
49  C     --------------      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
50  C        ORIGINAL : 89-07-14      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
51  C        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo      DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
52  c        03-11-27   J. QUAAS Introduce aerosol forcings (based on BOUCHER)      DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! AEROSOLS' OPTICAL THICKNESS
53  C     ------------------------------------------------------------------  
54  C      DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
55  C* ARGUMENTS:      DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
56  C  
57        REAL*8 PSCT  ! constante solaire (valeur conseillee: 1370)      DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
58  cIM ctes ds clesphys.h   REAL*8 RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)      DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
59  C      DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
60        REAL*8 PPSOL(KDLON)        ! SURFACE PRESSURE (PA)      DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
61        REAL*8 PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)  
62        REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
63  C      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
64        REAL*8 PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE      DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
65        REAL*8 PFRAC(KDLON)  ! fraction de la journee      DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
66  C      DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
67        REAL*8 PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)      DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
68        REAL*8 PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)      DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
69        REAL*8 PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)  
70        REAL*8 POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)      ! LOCAL VARIABLES:
71        REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS  
72  C      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
73        REAL*8 PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)      DOUBLE PRECISION ZAKI(KDLON, 2)
74        REAL*8 PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)      DOUBLE PRECISION ZCLD(KDLON, KFLEV)
75  C      DOUBLE PRECISION ZCLEAR(KDLON)
76        REAL*8 PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION      DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
77        REAL*8 PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS      DOUBLE PRECISION ZFACT(KDLON)
78        REAL*8 PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR      DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
79        REAL*8 POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
80  C      DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
81        REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)      DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
82        REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky      DOUBLE PRECISION ZRMU(KDLON)
83        REAL*8 PALBPLA(KDLON)     ! PLANETARY ALBEDO      DOUBLE PRECISION ZSEC(KDLON)
84        REAL*8 PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.      DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
85        REAL*8 PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE      DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
86        REAL*8 PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)  
87        REAL*8 PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)      DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
88  C      DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
89  C* LOCAL VARIABLES:      DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
90  C      DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
91        REAL*8 ZOZ(KDLON,KFLEV)  
92        REAL*8 ZAKI(KDLON,2)          INTEGER inu, jl, jk, i, k, kpl1
93        REAL*8 ZCLD(KDLON,KFLEV)  
94        REAL*8 ZCLEAR(KDLON)      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
95        REAL*8 ZDSIG(KDLON,KFLEV)  
96        REAL*8 ZFACT(KDLON)      INTEGER:: itapsw = 0
97        REAL*8 ZFD(KDLON,KFLEV+1)      LOGICAL:: appel1er = .TRUE.
98        REAL*8 ZFDOWN(KDLON,KFLEV+1)      !jq-Introduced for aerosol forcings
99        REAL*8 ZFU(KDLON,KFLEV+1)      double precision, save:: flag_aer
100        REAL*8 ZFUP(KDLON,KFLEV+1)      logical, intent(in):: ok_ade, ok_aie ! use aerosol forcings or not?
101        REAL*8 ZRMU(KDLON)      double precision tauae(kdlon, kflev, 2) ! aerosol optical properties
102        REAL*8 ZSEC(KDLON)      double precision pizae(kdlon, kflev, 2)
103        REAL*8 ZUD(KDLON,5,KFLEV+1)      ! aerosol optical properties(see aeropt.F)
104        REAL*8 ZCLDSW0(KDLON,KFLEV)      
105  c      double precision cgae(kdlon, kflev, 2) !aerosol optical properties -"-
106        REAL*8 ZFSUP(KDLON,KFLEV+1)      DOUBLE PRECISION PTAUA(KDLON, 2, KFLEV)
107        REAL*8 ZFSDN(KDLON,KFLEV+1)      ! CLOUD OPTICAL THICKNESS (pre-industrial value)
108        REAL*8 ZFSUP0(KDLON,KFLEV+1)  
109        REAL*8 ZFSDN0(KDLON,KFLEV+1)      DOUBLE PRECISION POMEGAA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
110  C      DOUBLE PRECISION PTOPSWAD(KDLON)
111        INTEGER inu, jl, jk, i, k, kpl1      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
112  c  
113        INTEGER swpas  ! Every swpas steps, sw is calculated      DOUBLE PRECISION PSOLSWAD(KDLON)
114        PARAMETER(swpas=1)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
115  c  
116        INTEGER itapsw      DOUBLE PRECISION PTOPSWAI(KDLON)
117        LOGICAL appel1er      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
118        DATA itapsw /0/  
119        DATA appel1er /.TRUE./      DOUBLE PRECISION PSOLSWAI(KDLON)
120  cjq-Introduced for aerosol forcings      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
121        real*8 flag_aer  
122        logical ok_ade, ok_aie    ! use aerosol forcings or not?      !jq - Fluxes including aerosol effects
123        real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
124        real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
125        real*8 cgae(kdlon,kflev,2)   ! -"-      DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
126        REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)      DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)
127        REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO  
128        REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)      logical:: initialized = .false.
129        REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)      REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
130        REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)  
131        REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)      !-------------------------------------------------------------------
132  cjq - Fluxes including aerosol effects  
133        REAL*8 ZFSUPAD(KDLON,KFLEV+1)      if(.not.initialized) then
134        REAL*8 ZFSDNAD(KDLON,KFLEV+1)         flag_aer=0.
135        REAL*8 ZFSUPAI(KDLON,KFLEV+1)         initialized=.TRUE.
136        REAL*8 ZFSDNAI(KDLON,KFLEV+1)         ZFSUPAD = 0.
137        logical initialized         ZFSDNAD = 0.
138        SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes         ZFSUPAI = 0.
139  !rv         ZFSDNAI = 0.
140        save flag_aer      endif
141        data initialized/.false./      !rv
142  cjq-end  
143        if(.not.initialized) then      IF (appel1er) THEN
144          flag_aer=0.         PRINT*, 'SW calling frequency: ', swpas
145          initialized=.TRUE.         PRINT*, " In general, it should be 1"
146        endif         appel1er = .FALSE.
147  !rv      ENDIF
148          
149  c      IF (MOD(itapsw, swpas).EQ.0) THEN
150        IF (appel1er) THEN         DO JK = 1 , KFLEV
151           PRINT*, 'SW calling frequency : ', swpas            DO JL = 1, KDLON
152           PRINT*, "   In general, it should be 1"               ZCLDSW0(JL, JK) = 0.0
153           appel1er = .FALSE.               ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
154        ENDIF            ENDDO
155  C     ------------------------------------------------------------------         ENDDO
156        IF (MOD(itapsw,swpas).EQ.0) THEN  
157  c         ! clear-sky:
158        DO JK = 1 , KFLEV         CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
159        DO JL = 1, KDLON              PRMU0, PFRAC, PTAVE, PWV, &
160           ZCLDSW0(JL,JK) = 0.0              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
161           IF (bug_ozone) then         INU = 1
162             ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG         CALL SW1S(INU, &
163       .               *PDP(JL,JK)*(101325.0/PPSOL(JL))              PAER, flag_aer, tauae, pizae, cgae, &
164           ELSE              PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
165  c        Correction MPL 100505              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
166             ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK)              ZFD, ZFU)
167           ENDIF                   INU = 2
168        ENDDO         CALL SW2S(INU, &
169        ENDDO              PAER, flag_aer, tauae, pizae, cgae, &
170  C              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0, &
171  C              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
172  c clear-sky:              PWV, PQS, &
173  cIM ctes ds clesphys.h  CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,              ZFDOWN, ZFUP)
174        CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL,         DO JK = 1 , KFLEV+1
175       S         PRMU0,PFRAC,PTAVE,PWV,            DO JL = 1, KDLON
176       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
177        INU = 1               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
178        CALL SW1S(INU,            ENDDO
179       S     PAER, flag_aer, tauae, pizae, cgae,         ENDDO
180       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,  
181       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,         flag_aer=0.
182       S     ZFD, ZFU)         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
183        INU = 2              PRMU0, PFRAC, PTAVE, PWV, &
184        CALL SW2S(INU,              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
185       S     PAER, flag_aer, tauae, pizae, cgae,         INU = 1
186       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,         CALL SW1S(INU, &
187       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,              PAER, flag_aer, tauae, pizae, cgae, &
188       S     PWV, PQS,              PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
189       S     ZFDOWN, ZFUP)              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
190        DO JK = 1 , KFLEV+1              ZFD, ZFU)
191        DO JL = 1, KDLON         INU = 2
192           ZFSUP0(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)         CALL SW2S(INU, &
193           ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)              PAER, flag_aer, tauae, pizae, cgae, &
194        ENDDO              ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
195        ENDDO              ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
196                      PWV, PQS, &
197        flag_aer=0.0              ZFDOWN, ZFUP)
198        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,  
199       S         PRMU0,PFRAC,PTAVE,PWV,         ! cloudy-sky:
200       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)  
201        INU = 1         DO JK = 1 , KFLEV+1
202        CALL SW1S(INU,            DO JL = 1, KDLON
203       S     PAER, flag_aer, tauae, pizae, cgae,               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
204       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
205       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,            ENDDO
206       S     ZFD, ZFU)         ENDDO
207        INU = 2  
208        CALL SW2S(INU,         IF (ok_ade) THEN
209       S     PAER, flag_aer, tauae, pizae, cgae,            ! cloudy-sky + aerosol dir OB
210       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,            flag_aer=1.
211       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
212       S     PWV, PQS,                 PRMU0, PFRAC, PTAVE, PWV, &
213       S    ZFDOWN, ZFUP)                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
214              INU = 1
215  c cloudy-sky:            CALL SW1S(INU, &
216                         PAER, flag_aer, tauae, pizae, cgae, &
217        DO JK = 1 , KFLEV+1                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
218        DO JL = 1, KDLON                 ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
219           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)                 ZFD, ZFU)
220           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            INU = 2
221        ENDDO            CALL SW2S(INU, &
222        ENDDO                 PAER, flag_aer, tauae, pizae, cgae, &
223                         ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
224  c                       ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, &
225        IF (ok_ade) THEN                 PWV, PQS, &
226  c                 ZFDOWN, ZFUP)
227  c cloudy-sky + aerosol dir OB            DO JK = 1 , KFLEV+1
228        flag_aer=1.0               DO JL = 1, KDLON
229        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
230       S         PRMU0,PFRAC,PTAVE,PWV,                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
231       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
232        INU = 1                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
233        CALL SW1S(INU,               ENDDO
234       S     PAER, flag_aer, tauae, pizae, cgae,            ENDDO
235       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         ENDIF
236       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,  
237       S     ZFD, ZFU)         IF (ok_aie) THEN
238        INU = 2            !jq cloudy-sky + aerosol direct + aerosol indirect
239        CALL SW2S(INU,            flag_aer=1.0
240       S     PAER, flag_aer, tauae, pizae, cgae,            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
241       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,                 PRMU0, PFRAC, PTAVE, PWV, &
242       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,                 ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
243       S     PWV, PQS,            INU = 1
244       S    ZFDOWN, ZFUP)            CALL SW1S(INU, &
245        DO JK = 1 , KFLEV+1                 PAER, flag_aer, tauae, pizae, cgae, &
246        DO JL = 1, KDLON                 PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
247           ZFSUPAD(JL,JK) = ZFSUP(JL,JK)                 ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
248           ZFSDNAD(JL,JK) = ZFSDN(JL,JK)                 ZFD, ZFU)
249           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)            INU = 2
250           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)            CALL SW2S(INU, &
251        ENDDO                 PAER, flag_aer, tauae, pizae, cgae, &
252        ENDDO                 ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW, &
253                         ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD, &
254        ENDIF ! ok_ade                 PWV, PQS, &
255                         ZFDOWN, ZFUP)
256        IF (ok_aie) THEN            DO JK = 1 , KFLEV+1
257                         DO JL = 1, KDLON
258  cjq   cloudy-sky + aerosol direct + aerosol indirect                  ZFSUPAI(JL, JK) = ZFSUP(JL, JK)
259        flag_aer=1.0                  ZFSDNAI(JL, JK) = ZFSDN(JL, JK)
260        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
261       S         PRMU0,PFRAC,PTAVE,PWV,                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
262       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)               ENDDO
263        INU = 1            ENDDO
264        CALL SW1S(INU,         ENDIF
265       S     PAER, flag_aer, tauae, pizae, cgae,  
266       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         itapsw = 0
267       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,      ENDIF
268       S     ZFD, ZFU)      itapsw = itapsw + 1
269        INU = 2  
270        CALL SW2S(INU,      DO k = 1, KFLEV
271       S     PAER, flag_aer, tauae, pizae, cgae,         kpl1 = k+1
272       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         DO i = 1, KDLON
273       S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,            PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
274       S     PWV, PQS,                 -(ZFSDN(i, k)-ZFSDN(i, kpl1))
275       S    ZFDOWN, ZFUP)            PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
276        DO JK = 1 , KFLEV+1            PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
277        DO JL = 1, KDLON                 -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
278           ZFSUPAI(JL,JK) = ZFSUP(JL,JK)            PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
279           ZFSDNAI(JL,JK) = ZFSDN(JL,JK)                   ENDDO
280           ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)      ENDDO
281           ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)      DO i = 1, KDLON
282        ENDDO         PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
283        ENDDO  
284        ENDIF ! ok_aie               PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
285  cjq -end         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
286          
287        itapsw = 0         PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
288        ENDIF         PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
289        itapsw = itapsw + 1  
290  C         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
291        DO k = 1, KFLEV         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
292           kpl1 = k+1  
293           DO i = 1, KDLON         PSOLSWAI(i) = ZFSDNAI(i, 1) - ZFSUPAI(i, 1)
294              PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))         PTOPSWAI(i) = ZFSDNAI(i, KFLEV+1) - ZFSUPAI(i, KFLEV+1)
295       .                     -(ZFSDN(i,k)-ZFSDN(i,kpl1))      ENDDO
296              PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)  
297              PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))    END SUBROUTINE SW
298       .                     -(ZFSDN0(i,k)-ZFSDN0(i,kpl1))  
299              PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)  end module sw_m
          ENDDO  
       ENDDO  
       DO i = 1, KDLON  
          PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)  
 c  
          PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)  
          PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)  
 c  
          PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)  
          PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)  
 c-OB  
          PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1)  
          PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1)  
 c  
          PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1)  
          PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1)  
 c-fin  
       ENDDO  
 C  
       RETURN  
       END  
Legend:
Removed from v.38  
changed lines
  Added in v.118
  ViewVC Help
Powered by ViewVC 1.1.21