phylmd/Radlwsw/lw.f

module lw_m

  IMPLICIT none

contains

  SUBROUTINE LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
       PCLDLU, PVIEW, PCOLR, PCOLR0, PTOPLW, PSOLLW, PTOPLW0, PSOLLW0, &
       psollwdown, plwup, plwdn, plwup0, plwdn0)

    use lwbv_m, only: lwbv
    use LWU_m, only: LWU
    USE raddim, ONLY: kdlon, kflev
    USE raddimlw, ONLY: nua
    USE suphec_m, ONLY: md, rcpd, rday, rg, rmo3

    ! Method.

    ! 1. Computes the pressure and temperature weighted amounts of
    ! absorbers.

    ! 2. Computes the Planck functions on the interfaces and the
    ! gradient of Planck functions in the layers.

    ! 3. Performs the vertical integration distinguishing the
    ! contributions of the adjacent and distant layers and those from
    ! the boundaries.

    ! 4. Computes the clear-sky downward and upward emissivities.

    ! 5. Introduces the effects of the clouds on the fluxes.

    ! Reference: see radiation part of ECMWF documentation of the IFS.

    ! Author:
    ! Jean-Jacques Morcrette ECMWF

    ! Original : July 14th, 1989

    DOUBLE PRECISION PCLDLD(KDLON, KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER
    DOUBLE PRECISION PCLDLU(KDLON, KFLEV) ! UPWARD EFFECTIVE CLOUD COVER
    DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER PRESSURE THICKNESS (Pa)
    DOUBLE PRECISION PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K)
    DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
    DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF LEVEL PRESSURE (mb)
    DOUBLE PRECISION POZON(KDLON, KFLEV) ! O3 CONCENTRATION (kg/kg)
    DOUBLE PRECISION PTL(KDLON, KFLEV+1) ! HALF LEVEL TEMPERATURE (K)
    DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
    DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
    DOUBLE PRECISION PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE
    DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (kg/kg)

    DOUBLE PRECISION PCOLR(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day)
    DOUBLE PRECISION PCOLR0(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky
    DOUBLE PRECISION PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A.
    DOUBLE PRECISION PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE
    DOUBLE PRECISION PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
    DOUBLE PRECISION PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
    ! Rajout LF
    double precision psollwdown(kdlon) ! LONGWAVE downwards flux at surface
    !IM
    DOUBLE PRECISION plwup(KDLON, KFLEV+1) ! LW up total sky
    DOUBLE PRECISION plwup0(KDLON, KFLEV+1) ! LW up clear sky
    DOUBLE PRECISION plwdn(KDLON, KFLEV+1) ! LW down total sky
    DOUBLE PRECISION plwdn0(KDLON, KFLEV+1) ! LW down clear sky

    DOUBLE PRECISION ZABCU(KDLON, NUA, 3*KFLEV+1)
    DOUBLE PRECISION ZOZ(KDLON, KFLEV)

    DOUBLE PRECISION, save:: ZFLUX(KDLON, 2, KFLEV+1)
    ! RADIATIVE FLUXES (1:up; 2:down)

    DOUBLE PRECISION, save:: ZFLUC(KDLON, 2, KFLEV+1)
    ! CLEAR-SKY RADIATIVE FLUXES

    ! Intermediate variables:
    DOUBLE PRECISION, save:: ZBINT(KDLON, KFLEV+1)
    DOUBLE PRECISION, save:: ZBSUI(KDLON)
    DOUBLE PRECISION, save:: ZCTS(KDLON, KFLEV)
    DOUBLE PRECISION, save:: ZCNTRB(KDLON, KFLEV+1, KFLEV+1)

    INTEGER ilim, i, k, kpl1

    INTEGER, PARAMETER:: lw0pas = 1 ! Every lw0pas steps, clear-sky is done
    INTEGER, PARAMETER:: lwpas = 1 ! Every lwpas steps, cloudy-sky is done
    ! In general, lw0pas and lwpas should be 1

    INTEGER:: itaplw0 = 0, itaplw = 0

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

    IF (MOD(itaplw0, lw0pas) == 0) THEN
       DO k = 1, KFLEV
          DO i = 1, KDLON
             ! convertir ozone de kg/kg en pa (modif MPL 100505)
             ZOZ(i, k) = POZON(i, k)*PDP(i, k) * MD/RMO3
          ENDDO
       ENDDO
       CALL LWU(PAER, PDP, PPMB, ZOZ, PTAVE, PVIEW, PWV, ZABCU)
       CALL LWBV(ILIM, PDT0, PEMIS, PPMB, PTL, PTAVE, ZABCU, &
            ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
       itaplw0 = 0
    ENDIF
    itaplw0 = itaplw0 + 1

    IF (MOD(itaplw, lwpas) == 0) THEN
       CALL LWC(ILIM, PCLDLD, PCLDLU, PEMIS, &
            ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB, &
            ZFLUX)
       itaplw = 0
    ENDIF
    itaplw = itaplw + 1

    DO k = 1, KFLEV
       kpl1 = k+1
       DO i = 1, KDLON
          PCOLR(i, k) = ZFLUX(i, 1, kpl1)+ZFLUX(i, 2, kpl1) &
               - ZFLUX(i, 1, k)- ZFLUX(i, 2, k)
          PCOLR(i, k) = PCOLR(i, k) * RDAY*RG/RCPD / PDP(i, k)
          PCOLR0(i, k) = ZFLUC(i, 1, kpl1)+ZFLUC(i, 2, kpl1) &
               - ZFLUC(i, 1, k)- ZFLUC(i, 2, k)
          PCOLR0(i, k) = PCOLR0(i, k) * RDAY*RG/RCPD / PDP(i, k)
       ENDDO
    ENDDO
    DO i = 1, KDLON
       PSOLLW(i) = -ZFLUX(i, 1, 1)-ZFLUX(i, 2, 1)
       PTOPLW(i) = ZFLUX(i, 1, KFLEV+1) + ZFLUX(i, 2, KFLEV+1)

       PSOLLW0(i) = -ZFLUC(i, 1, 1)-ZFLUC(i, 2, 1)
       PTOPLW0(i) = ZFLUC(i, 1, KFLEV+1) + ZFLUC(i, 2, KFLEV+1)
       psollwdown(i) = -ZFLUX(i, 2, 1)

       !IM attention aux signes !; LWtop >0, LWdn < 0
       DO k = 1, KFLEV+1
          plwup(i, k) = ZFLUX(i, 1, k)
          plwup0(i, k) = ZFLUC(i, 1, k)
          plwdn(i, k) = ZFLUX(i, 2, k)
          plwdn0(i, k) = ZFLUC(i, 2, k)
       ENDDO
    ENDDO

  END SUBROUTINE LW

end module lw_m
1	guez	71	module lw_m
2
3			IMPLICIT none
4
5			contains
6
7	guez	145	SUBROUTINE LW(PPMB, PDP, PDT0, PEMIS, PTL, PTAVE, PWV, POZON, PAER, PCLDLD, &
8			PCLDLU, PVIEW, PCOLR, PCOLR0, PTOPLW, PSOLLW, PTOPLW0, PSOLLW0, &
9	guez	71	psollwdown, plwup, plwdn, plwup0, plwdn0)
10
11	guez	155	use lwbv_m, only: lwbv
12	guez	71	use LWU_m, only: LWU
13			USE raddim, ONLY: kdlon, kflev
14			USE raddimlw, ONLY: nua
15	guez	168	USE suphec_m, ONLY: md, rcpd, rday, rg, rmo3
16	guez	71
17			! Method.
18
19			! 1. Computes the pressure and temperature weighted amounts of
20			! absorbers.
21
22	guez	168	! 2. Computes the Planck functions on the interfaces and the
23			! gradient of Planck functions in the layers.
24	guez	71
25	guez	168	! 3. Performs the vertical integration distinguishing the
26			! contributions of the adjacent and distant layers and those from
27			! the boundaries.
28	guez	71
29			! 4. Computes the clear-sky downward and upward emissivities.
30
31			! 5. Introduces the effects of the clouds on the fluxes.
32
33	guez	168	! Reference: see radiation part of ECMWF documentation of the IFS.
34	guez	71
35			! Author:
36	guez	168	! Jean-Jacques Morcrette ECMWF
37	guez	71
38	guez	168	! Original : July 14th, 1989
39	guez	71
40			DOUBLE PRECISION PCLDLD(KDLON, KFLEV) ! DOWNWARD EFFECTIVE CLOUD COVER
41			DOUBLE PRECISION PCLDLU(KDLON, KFLEV) ! UPWARD EFFECTIVE CLOUD COVER
42			DOUBLE PRECISION PDP(KDLON, KFLEV) ! LAYER PRESSURE THICKNESS (Pa)
43			DOUBLE PRECISION PDT0(KDLON) ! SURFACE TEMPERATURE DISCONTINUITY (K)
44			DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
45			DOUBLE PRECISION PPMB(KDLON, KFLEV+1) ! HALF LEVEL PRESSURE (mb)
46			DOUBLE PRECISION POZON(KDLON, KFLEV) ! O3 CONCENTRATION (kg/kg)
47			DOUBLE PRECISION PTL(KDLON, KFLEV+1) ! HALF LEVEL TEMPERATURE (K)
48			DOUBLE PRECISION PAER(KDLON, KFLEV, 5) ! OPTICAL THICKNESS OF THE AEROSOLS
49			DOUBLE PRECISION PTAVE(KDLON, KFLEV) ! LAYER TEMPERATURE (K)
50			DOUBLE PRECISION PVIEW(KDLON) ! COSECANT OF VIEWING ANGLE
51			DOUBLE PRECISION PWV(KDLON, KFLEV) ! SPECIFIC HUMIDITY (kg/kg)
52
53			DOUBLE PRECISION PCOLR(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day)
54			DOUBLE PRECISION PCOLR0(KDLON, KFLEV) ! LONG-WAVE TENDENCY (K/day) clear-sky
55			DOUBLE PRECISION PTOPLW(KDLON) ! LONGWAVE FLUX AT T.O.A.
56			DOUBLE PRECISION PSOLLW(KDLON) ! LONGWAVE FLUX AT SURFACE
57			DOUBLE PRECISION PTOPLW0(KDLON) ! LONGWAVE FLUX AT T.O.A. (CLEAR-SKY)
58			DOUBLE PRECISION PSOLLW0(KDLON) ! LONGWAVE FLUX AT SURFACE (CLEAR-SKY)
59			! Rajout LF
60			double precision psollwdown(kdlon) ! LONGWAVE downwards flux at surface
61			!IM
62			DOUBLE PRECISION plwup(KDLON, KFLEV+1) ! LW up total sky
63			DOUBLE PRECISION plwup0(KDLON, KFLEV+1) ! LW up clear sky
64			DOUBLE PRECISION plwdn(KDLON, KFLEV+1) ! LW down total sky
65			DOUBLE PRECISION plwdn0(KDLON, KFLEV+1) ! LW down clear sky
66
67			DOUBLE PRECISION ZABCU(KDLON, NUA, 3*KFLEV+1)
68			DOUBLE PRECISION ZOZ(KDLON, KFLEV)
69
70	guez	168	DOUBLE PRECISION, save:: ZFLUX(KDLON, 2, KFLEV+1)
71			! RADIATIVE FLUXES (1:up; 2:down)
72	guez	71
73	guez	168	DOUBLE PRECISION, save:: ZFLUC(KDLON, 2, KFLEV+1)
74			! CLEAR-SKY RADIATIVE FLUXES
75
76			! Intermediate variables:
77			DOUBLE PRECISION, save:: ZBINT(KDLON, KFLEV+1)
78			DOUBLE PRECISION, save:: ZBSUI(KDLON)
79			DOUBLE PRECISION, save:: ZCTS(KDLON, KFLEV)
80			DOUBLE PRECISION, save:: ZCNTRB(KDLON, KFLEV+1, KFLEV+1)
81
82	guez	71	INTEGER ilim, i, k, kpl1
83
84			INTEGER, PARAMETER:: lw0pas = 1 ! Every lw0pas steps, clear-sky is done
85			INTEGER, PARAMETER:: lwpas = 1 ! Every lwpas steps, cloudy-sky is done
86			! In general, lw0pas and lwpas should be 1
87
88			INTEGER:: itaplw0 = 0, itaplw = 0
89
90			! ------------------------------------------------------------------
91
92			IF (MOD(itaplw0, lw0pas) == 0) THEN
93			DO k = 1, KFLEV
94			DO i = 1, KDLON
95			! convertir ozone de kg/kg en pa (modif MPL 100505)
96			ZOZ(i, k) = POZON(i, k)PDP(i, k) MD/RMO3
97			ENDDO
98			ENDDO
99	guez	139	CALL LWU(PAER, PDP, PPMB, ZOZ, PTAVE, PVIEW, PWV, ZABCU)
100	guez	155	CALL LWBV(ILIM, PDT0, PEMIS, PPMB, PTL, PTAVE, ZABCU, &
101	guez	71	ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB)
102			itaplw0 = 0
103			ENDIF
104			itaplw0 = itaplw0 + 1
105
106			IF (MOD(itaplw, lwpas) == 0) THEN
107			CALL LWC(ILIM, PCLDLD, PCLDLU, PEMIS, &
108			ZFLUC, ZBINT, ZBSUI, ZCTS, ZCNTRB, &
109			ZFLUX)
110			itaplw = 0
111			ENDIF
112			itaplw = itaplw + 1
113
114			DO k = 1, KFLEV
115			kpl1 = k+1
116			DO i = 1, KDLON
117			PCOLR(i, k) = ZFLUX(i, 1, kpl1)+ZFLUX(i, 2, kpl1) &
118			- ZFLUX(i, 1, k)- ZFLUX(i, 2, k)
119			PCOLR(i, k) = PCOLR(i, k) * RDAY*RG/RCPD / PDP(i, k)
120			PCOLR0(i, k) = ZFLUC(i, 1, kpl1)+ZFLUC(i, 2, kpl1) &
121			- ZFLUC(i, 1, k)- ZFLUC(i, 2, k)
122			PCOLR0(i, k) = PCOLR0(i, k) * RDAY*RG/RCPD / PDP(i, k)
123			ENDDO
124			ENDDO
125			DO i = 1, KDLON
126			PSOLLW(i) = -ZFLUX(i, 1, 1)-ZFLUX(i, 2, 1)
127			PTOPLW(i) = ZFLUX(i, 1, KFLEV+1) + ZFLUX(i, 2, KFLEV+1)
128
129			PSOLLW0(i) = -ZFLUC(i, 1, 1)-ZFLUC(i, 2, 1)
130			PTOPLW0(i) = ZFLUC(i, 1, KFLEV+1) + ZFLUC(i, 2, KFLEV+1)
131			psollwdown(i) = -ZFLUX(i, 2, 1)
132
133			!IM attention aux signes !; LWtop >0, LWdn < 0
134			DO k = 1, KFLEV+1
135			plwup(i, k) = ZFLUX(i, 1, k)
136			plwup0(i, k) = ZFLUC(i, 1, k)
137			plwdn(i, k) = ZFLUX(i, 2, k)
138			plwdn0(i, k) = ZFLUC(i, 2, k)
139			ENDDO
140			ENDDO
141
142			END SUBROUTINE LW
143
144			end module lw_m