phylmd/Radlwsw/sw.f

module sw_m

  IMPLICIT none

contains

  SUBROUTINE SW(PSCT, PRMU0, PFRAC, PPMB, PDP, PPSOL, PALBD, PALBP, PTAVE, &
       PWV, PQS, POZON, PCLDSW, PTAU, POMEGA, PCG, PHEAT, PHEAT0, PALBPLA, &
       PTOPSW, PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, &
       PTOPSWAD, PSOLSWAD, PTOPSWAI, PSOLSWAI, ok_ade)

    ! Purpose.
    ! This routine computes the shortwave radiation fluxes in two
    ! spectral intervals following Fouquart and Bonnel (1980).

    ! Method.
    ! 1. Computes absorber amounts (swu)
    ! 2. Computes fluxes in 1st spectral interval (SW1S)
    ! 3. Computes fluxes in 2nd spectral interval (SW2S)

    ! Reference.
    ! See radiation part of the ECMWF research department
    ! documentation, and Fouquart and Bonnel (1980)

    ! Author.
    ! Jean-Jacques Morcrette *ecmwf*

    ! Modifications.
    ! Original: 89-07-14
    ! 95-01-01 J.-J. Morcrette direct/diffuse albedo
    ! 03-11-27 J. Quaas Introduce aerosol forcings (based on Boucher)

    USE raddim, ONLY: kdlon, kflev
    USE suphec_m, ONLY: rcpd, rday, rg
    use sw1s_m, only: sw1s
    use sw2s_m, only: sw2s

    ! ARGUMENTS:

    DOUBLE PRECISION PSCT ! constante solaire (valeur conseillee: 1370)
    DOUBLE PRECISION PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
    DOUBLE PRECISION PFRAC(KDLON) ! fraction de la journee
    DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
    DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER THICKNESS (PA)
    DOUBLE PRECISION PPSOL(KDLON) ! SURFACE PRESSURE (PA)
    DOUBLE PRECISION PALBD(KDLON, 2) ! albedo du sol (lumiere diffuse)
    DOUBLE PRECISION PALBP(KDLON, 2) ! albedo du sol (lumiere parallele)
    DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
    DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (KG/KG)
    DOUBLE PRECISION PQS(KDLON, KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
    DOUBLE PRECISION POZON(KDLON, KFLEV) ! OZONE CONCENTRATION (KG/KG)
    DOUBLE PRECISION PCLDSW(KDLON, KFLEV) ! CLOUD FRACTION
    DOUBLE PRECISION PTAU(KDLON, 2, KFLEV) ! CLOUD OPTICAL THICKNESS
    DOUBLE PRECISION POMEGA(KDLON, 2, KFLEV) ! SINGLE SCATTERING ALBEDO
    DOUBLE PRECISION PCG(KDLON, 2, KFLEV) ! ASYMETRY FACTOR
    DOUBLE PRECISION PHEAT(KDLON, KFLEV) ! SHORTWAVE HEATING (K/DAY)
    DOUBLE PRECISION PHEAT0(KDLON, KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
    DOUBLE PRECISION PALBPLA(KDLON) ! PLANETARY ALBEDO
    DOUBLE PRECISION PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
    DOUBLE PRECISION PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
    DOUBLE PRECISION PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
    DOUBLE PRECISION PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
    DOUBLE PRECISION ZFSUP(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFSDN(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFSUP0(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFSDN0(KDLON, KFLEV+1)

    DOUBLE PRECISION, intent(out):: PTOPSWAD(KDLON) 
    ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)

    DOUBLE PRECISION, intent(out):: PSOLSWAD(KDLON) 
    ! (diagnosed aerosol forcing)SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)

    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)

    logical, intent(in):: ok_ade ! use aerosol forcings or not?

    ! Local:

    DOUBLE PRECISION ZOZ(KDLON, KFLEV)
    DOUBLE PRECISION ZAKI(KDLON, 2) 
    DOUBLE PRECISION ZCLD(KDLON, KFLEV)
    DOUBLE PRECISION ZCLEAR(KDLON) 
    DOUBLE PRECISION ZDSIG(KDLON, KFLEV)
    DOUBLE PRECISION ZFACT(KDLON)
    DOUBLE PRECISION ZFD(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFDOWN(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFU(KDLON, KFLEV+1)
    DOUBLE PRECISION ZFUP(KDLON, KFLEV+1)
    DOUBLE PRECISION ZRMU(KDLON)
    DOUBLE PRECISION ZSEC(KDLON)
    DOUBLE PRECISION ZUD(KDLON, 5, KFLEV+1)
    DOUBLE PRECISION ZCLDSW0(KDLON, KFLEV)

    INTEGER inu, jl, jk, i, k, kpl1

    INTEGER, PARAMETER:: swpas = 1 ! Every swpas steps, sw is calculated

    INTEGER:: itapsw = 0
    LOGICAL:: appel1er = .TRUE.
    !jq-Introduced for aerosol forcings

    !jq - Fluxes including aerosol effects
    DOUBLE PRECISION, save:: ZFSUPAD(KDLON, KFLEV+1)
    DOUBLE PRECISION, save:: ZFSDNAD(KDLON, KFLEV+1)
    DOUBLE PRECISION, save:: ZFSUPAI(KDLON, KFLEV+1)
    DOUBLE PRECISION, save:: ZFSDNAI(KDLON, KFLEV+1)

    logical:: initialized = .false.
    REAL, PARAMETER :: dobson_u = 2.1415E-05 ! Dobson unit, in kg m-2

    !-------------------------------------------------------------------

    if(.not.initialized) then
       initialized=.TRUE.
       ZFSUPAD = 0.
       ZFSDNAD = 0.
       ZFSUPAI = 0.
       ZFSDNAI = 0.
    endif
    !rv

    IF (appel1er) THEN
       PRINT*, 'SW calling frequency: ', swpas
       PRINT*, " In general, it should be 1"
       appel1er = .FALSE.
    ENDIF

    IF (MOD(itapsw, swpas).EQ.0) THEN
       DO JK = 1 , KFLEV
          DO JL = 1, KDLON
             ZCLDSW0(JL, JK) = 0.0
             ZOZ(JL, JK) = POZON(JL, JK) / (dobson_u * 1E3 * rg) * PDP(JL, JK)
          ENDDO
       ENDDO

       ! clear-sky:
       CALL SWU(PSCT, ZCLDSW0, PPMB, PPSOL, &
            PRMU0, PFRAC, PTAVE, PWV, &
            ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
       INU = 1
       CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
            ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
       INU = 2
       CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
            ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)
       DO JK = 1 , KFLEV+1
          DO JL = 1, KDLON
             ZFSUP0(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
             ZFSDN0(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
          ENDDO
       ENDDO

       CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, &
            PRMU0, PFRAC, PTAVE, PWV, &
            ZAKI, ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
       INU = 1
       CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
            ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
       INU = 2
       CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, &
            ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, ZFDOWN, ZFUP)

       ! cloudy-sky:

       DO JK = 1 , KFLEV+1
          DO JL = 1, KDLON
             ZFSUP(JL, JK) = (ZFUP(JL, JK) + ZFU(JL, JK)) * ZFACT(JL)
             ZFSDN(JL, JK) = (ZFDOWN(JL, JK) + ZFD(JL, JK)) * ZFACT(JL)
          ENDDO
       ENDDO

       IF (ok_ade) THEN
          ! cloudy-sky + aerosol dir OB
          CALL SWU(PSCT, PCLDSW, PPMB, PPSOL, PRMU0, PFRAC, PTAVE, PWV, ZAKI, &
               ZCLD, ZCLEAR, ZDSIG, ZFACT, ZRMU, ZSEC, ZUD)
          INU = 1
          CALL SW1S(INU, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, POMEGA, ZOZ, &
               ZRMU, ZSEC, PTAU, ZUD, ZFD, ZFU)
          INU = 2
          CALL SW2S(INU, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZDSIG, &
               POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD, PWV, PQS, 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

       itapsw = 0
    ENDIF
    itapsw = itapsw + 1

    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)

       PSOLSW(i) = ZFSDN(i, 1) - ZFSUP(i, 1)
       PTOPSW(i) = ZFSDN(i, KFLEV+1) - ZFSUP(i, KFLEV+1)

       PSOLSW0(i) = ZFSDN0(i, 1) - ZFSUP0(i, 1)
       PTOPSW0(i) = ZFSDN0(i, KFLEV+1) - ZFSUP0(i, KFLEV+1)

       PSOLSWAD(i) = ZFSDNAD(i, 1) - ZFSUPAD(i, 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)
    ENDDO

  END SUBROUTINE SW

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