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