/[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 220 by guez, Tue Apr 4 14:52:21 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, 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      use swu_m, only: swu
38  C     REFERENCE.  
39  C     ----------      ! ARGUMENTS:
40  C  
41  C        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT      DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
42  C        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)      DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
43  C      DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
44  C     AUTHOR.      DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
45  C     -------      DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
46  C        JEAN-JACQUES MORCRETTE  *ECMWF*      DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
47  C      DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
48  C     MODIFICATIONS.      DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
49  C     --------------      DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
50  C        ORIGINAL : 89-07-14      DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
51  C        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo      DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
52  c        03-11-27   J. QUAAS Introduce aerosol forcings (based on BOUCHER)      DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
53  C     ------------------------------------------------------------------      DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
54  C      DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
55  C* ARGUMENTS:      DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
56  C      DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
57        REAL*8 PSCT  ! constante solaire (valeur conseillee: 1370)      DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
58  cIM ctes ds clesphys.h   REAL*8 RCO2  ! concentration CO2 (IPCC: 353.E-06*44.011/28.97)      DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
59  C      DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
60        REAL*8 PPSOL(KDLON)        ! SURFACE PRESSURE (PA)      DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
61        REAL*8 PDP(KDLON,KFLEV)    ! LAYER THICKNESS (PA)      DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
62        REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)      DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
63  C      DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
64        REAL*8 PRMU0(KDLON)  ! COSINE OF ZENITHAL ANGLE      DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
65        REAL*8 PFRAC(KDLON)  ! fraction de la journee      DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
66  C      DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
67        REAL*8 PTAVE(KDLON,KFLEV)  ! LAYER TEMPERATURE (K)      DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)
68        REAL*8 PWV(KDLON,KFLEV)    ! SPECIFIC HUMIDITY (KG/KG)  
69        REAL*8 PQS(KDLON,KFLEV)    ! SATURATED WATER VAPOUR (KG/KG)      DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON)
70        REAL*8 POZON(KDLON,KFLEV)  ! OZONE CONCENTRATION (KG/KG)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
71        REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS  
72  C      DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON)
73        REAL*8 PALBD(KDLON,2)  ! albedo du sol (lumiere diffuse)      ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
74        REAL*8 PALBP(KDLON,2)  ! albedo du sol (lumiere parallele)  
75  C      logical, intent(in):: ok_ade ! use aerosol forcings or not?
76        REAL*8 PCLDSW(KDLON,KFLEV)    ! CLOUD FRACTION  
77        REAL*8 PTAU(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS      ! Local:
78        REAL*8 PCG(KDLON,2,KFLEV)     ! ASYMETRY FACTOR  
79        REAL*8 POMEGA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO      DOUBLE PRECISION ZOZ(KDLON, KFLEV)
80  C      DOUBLE PRECISION ZAKI(KDLON, 2)
81        REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)      DOUBLE PRECISION ZCLD(KDLON, KFLEV)
82        REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky      DOUBLE PRECISION ZCLEAR(KDLON)
83        REAL*8 PALBPLA(KDLON)     ! PLANETARY ALBEDO      DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
84        REAL*8 PTOPSW(KDLON)      ! SHORTWAVE FLUX AT T.O.A.      DOUBLE PRECISION ZFACT(KDLON)
85        REAL*8 PSOLSW(KDLON)      ! SHORTWAVE FLUX AT SURFACE      DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
86        REAL*8 PTOPSW0(KDLON)     ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)      DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
87        REAL*8 PSOLSW0(KDLON)     ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)      DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
88  C      DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
89  C* LOCAL VARIABLES:      DOUBLE PRECISION ZRMU(KDLON)
90  C      DOUBLE PRECISION ZSEC(KDLON)
91        REAL*8 ZOZ(KDLON,KFLEV)      DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
92        REAL*8 ZAKI(KDLON,2)          DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)
93        REAL*8 ZCLD(KDLON,KFLEV)  
94        REAL*8 ZCLEAR(KDLON)      INTEGER inu, jl, jk, i, k, kpl1
95        REAL*8 ZDSIG(KDLON,KFLEV)  
96        REAL*8 ZFACT(KDLON)      INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated
97        REAL*8 ZFD(KDLON,KFLEV+1)  
98        REAL*8 ZFDOWN(KDLON,KFLEV+1)      INTEGER:: itapsw = 0
99        REAL*8 ZFU(KDLON,KFLEV+1)      LOGICAL:: appel1er = .TRUE.
100        REAL*8 ZFUP(KDLON,KFLEV+1)      !jq-Introduced for aerosol forcings
101        REAL*8 ZRMU(KDLON)  
102        REAL*8 ZSEC(KDLON)      !jq - Fluxes including aerosol effects
103        REAL*8 ZUD(KDLON,5,KFLEV+1)      DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
104        REAL*8 ZCLDSW0(KDLON,KFLEV)      DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
105  c  
106        REAL*8 ZFSUP(KDLON,KFLEV+1)      logical:: initialized = .false.
107        REAL*8 ZFSDN(KDLON,KFLEV+1)      REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2
108        REAL*8 ZFSUP0(KDLON,KFLEV+1)  
109        REAL*8 ZFSDN0(KDLON,KFLEV+1)      !-------------------------------------------------------------------
110  C  
111        INTEGER inu, jl, jk, i, k, kpl1      if(.not.initialized) then
112  c         initialized=.TRUE.
113        INTEGER swpas  ! Every swpas steps, sw is calculated         ZFSUPAD = 0.
114        PARAMETER(swpas=1)         ZFSDNAD = 0.
115  c      endif
116        INTEGER itapsw      !rv
117        LOGICAL appel1er  
118        DATA itapsw /0/      IF (appel1er) THEN
119        DATA appel1er /.TRUE./         PRINT*, 'SW calling frequency: ', swpas
120  cjq-Introduced for aerosol forcings         PRINT*, " In general, it should be 1"
121        real*8 flag_aer         appel1er = .FALSE.
122        logical ok_ade, ok_aie    ! use aerosol forcings or not?      ENDIF
123        real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties  
124        real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)      IF (MOD(itapsw, swpas) == 0) THEN
125        real*8 cgae(kdlon,kflev,2)   ! -"-         DO JK = 1, KFLEV
126        REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)            DO JL = 1, KDLON
127        REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO               ZCLDSW0(JL, JK) = 0.0
128        REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)               ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
129        REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)            ENDDO
130        REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)         ENDDO
131        REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)  
132  cjq - Fluxes including aerosol effects         ! clear-sky:
133        REAL*8 ZFSUPAD(KDLON,KFLEV+1)         CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
134        REAL*8 ZFSDNAD(KDLON,KFLEV+1)              PRMU0, PFRAC, PTAVE, PWV, &
135        REAL*8 ZFSUPAI(KDLON,KFLEV+1)              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
136        REAL*8 ZFSDNAI(KDLON,KFLEV+1)         INU = 1
137        logical initialized         CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
138        SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes              ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
139  !rv         INU = 2
140        save flag_aer         CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
141        data initialized/.false./              ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
142  cjq-end         DO JK = 1, KFLEV+1
143        if(.not.initialized) then            DO JL = 1, KDLON
144          flag_aer=0.               ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
145          initialized=.TRUE.               ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
146        endif            ENDDO
147  !rv         ENDDO
148          
149  c         CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
150        IF (appel1er) THEN              PRMU0, PFRAC, PTAVE, PWV, &
151           PRINT*, 'SW calling frequency : ', swpas              ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
152           PRINT*, "   In general, it should be 1"         INU = 1
153           appel1er = .FALSE.         CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
154        ENDIF              ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
155  C     ------------------------------------------------------------------         INU = 2
156        IF (MOD(itapsw,swpas).EQ.0) THEN         CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
157  c              ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
158        DO JK = 1 , KFLEV  
159        DO JL = 1, KDLON         ! cloudy-sky:
160           ZCLDSW0(JL,JK) = 0.0  
161           IF (bug_ozone) then         DO JK = 1, KFLEV+1
162             ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG            DO JL = 1, KDLON
163       .               *PDP(JL,JK)*(101325.0/PPSOL(JL))               ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
164           ELSE               ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
165  c        Correction MPL 100505            ENDDO
166             ZOZ(JL,JK) = POZON(JL,JK)*RMD/RMO3*46.6968/RG*PDP(JL,JK)         ENDDO
167           ENDIF            
168        ENDDO         IF (ok_ade) THEN
169        ENDDO            ! cloudy-sky + aerosol dir OB
170  C            CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, PRMU0, PFRAC, PTAVE, PWV, ZAKI, &
171  C                 ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
172  c clear-sky:            INU = 1
173  cIM ctes ds clesphys.h  CALL SWU(PSCT,RCO2,ZCLDSW0,PPMB,PPSOL,            CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
174        CALL SWU(PSCT,ZCLDSW0,PPMB,PPSOL,                 ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
175       S         PRMU0,PFRAC,PTAVE,PWV,            INU = 2
176       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)            CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
177        INU = 1                 POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
178        CALL SW1S(INU,            DO JK = 1, KFLEV+1
179       S     PAER, flag_aer, tauae, pizae, cgae,               DO JL = 1, KDLON
180       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,                  ZFSUPAD(JL, JK) = ZFSUP(JL, JK)
181       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,                  ZFSDNAD(JL, JK) = ZFSDN(JL, JK)
182       S     ZFD, ZFU)                  ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
183        INU = 2                  ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
184        CALL SW2S(INU,               ENDDO
185       S     PAER, flag_aer, tauae, pizae, cgae,            ENDDO
186       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,         ENDIF
187       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,  
188       S     PWV, PQS,         itapsw = 0
189       S     ZFDOWN, ZFUP)      ENDIF
190        DO JK = 1 , KFLEV+1      itapsw = itapsw + 1
191        DO JL = 1, KDLON  
192           ZFSUP0(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)      DO k = 1, KFLEV
193           ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)         kpl1 = k+1
194        ENDDO         DO i = 1, KDLON
195        ENDDO            PHEAT(i, k) = -(ZFSUP(i, kpl1)-ZFSUP(i, k)) &
196                         -(ZFSDN(i, k)-ZFSDN(i, kpl1))
197        flag_aer=0.0            PHEAT(i, k) = PHEAT(i, k) * RDAY*RG/RCPD / PDP(i, k)
198        CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,            PHEAT0(i, k) = -(ZFSUP0(i, kpl1)-ZFSUP0(i, k)) &
199       S         PRMU0,PFRAC,PTAVE,PWV,                 -(ZFSDN0(i, k)-ZFSDN0(i, kpl1))
200       S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)            PHEAT0(i, k) = PHEAT0(i, k) * RDAY*RG/RCPD / PDP(i, k)
201        INU = 1         ENDDO
202        CALL SW1S(INU,      ENDDO
203       S     PAER, flag_aer, tauae, pizae, cgae,      DO i = 1, KDLON
204       S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         PALBPLA(i) = ZFSUP(i, KFLEV+1)/(ZFSDN(i, KFLEV+1)+1.0e-20)
205       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,  
206       S     ZFD, ZFU)         PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
207        INU = 2         PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)
208        CALL SW2S(INU,  
209       S     PAER, flag_aer, tauae, pizae, cgae,         PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
210       S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,         PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)
211       S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,  
212       S     PWV, PQS,         PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 1)
213       S    ZFDOWN, ZFUP)         PTOPSWAD(i) = ZFSDNAD(i, KFLEV+1) - ZFSUPAD(i, KFLEV+1)
214        ENDDO
215  c cloudy-sky:  
216            END SUBROUTINE SW
217        DO JK = 1 , KFLEV+1  
218        DO JL = 1, KDLON  end module sw_m
          ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)  
          ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)  
       ENDDO  
       ENDDO  
         
 c        
       IF (ok_ade) THEN  
 c  
 c cloudy-sky + aerosol dir OB  
       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, 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.220
  ViewVC Help
Powered by ViewVC 1.1.21