phylmd/Radlwsw/sw.f90

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, PTOPSW, &
       PSOLSW, PTOPSW0, PSOLSW0, ZFSUP, ZFSDN, ZFSUP0, ZFSDN0, PTOPSWAD, &
       PSOLSWAD, 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
    use swu_m, only: swu

    ! ARGUMENTS:

    DOUBLE PRECISION PSCT ! constante solaire
    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 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)

    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)

    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.
    endif
    !rv

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

    IF (MOD(itapsw, swpas) == 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
       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)
    ENDDO

  END SUBROUTINE SW

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