phylmd/Radlwsw/lwv.f

module lwv_m

  IMPLICIT NONE

contains

  SUBROUTINE lwv(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, pbtop, &
       pdbsl, pemis, ppmb, pga, pgb, pgasur, pgbsur, pgatop, pgbtop, &
       pcntrb, pcts, pfluc)
    USE dimens_m
    USE dimphy
    use lwvd_m, only: lwvd
    use lwvn_m, only: lwvn
    USE suphec_m
    USE raddim
    USE raddimlw

    ! -----------------------------------------------------------------------
    ! PURPOSE.
    ! --------
    ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
    ! FLUXES OR RADIANCES

    ! METHOD.
    ! -------

    ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
    ! CONTRIBUTIONS BY -  THE NEARBY LAYERS
    ! -  THE DISTANT LAYERS
    ! -  THE BOUNDARY TERMS
    ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.

    ! REFERENCE.
    ! ----------

    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS

    ! AUTHOR.
    ! -------
    ! JEAN-JACQUES MORCRETTE  *ECMWF*

    ! MODIFICATIONS.
    ! --------------
    ! ORIGINAL : 89-07-14
    ! -----------------------------------------------------------------------

    ! * ARGUMENTS:
    INTEGER kuaer, ktraer, klim

    DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
    DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
    DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
    DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
    DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
    DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
    DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
    DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
    DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
    DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
    DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
    DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
    DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
    DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
    DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS

    DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
    DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
    DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
    ! -----------------------------------------------------------------------
    ! LOCAL VARIABLES:
    DOUBLE PRECISION zadjd(kdlon, kflev+1)
    DOUBLE PRECISION zadju(kdlon, kflev+1)
    DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)
    DOUBLE PRECISION zdisd(kdlon, kflev+1)
    DOUBLE PRECISION zdisu(kdlon, kflev+1)

    INTEGER jk, jl
    ! -----------------------------------------------------------------------

    DO jk = 1, kflev + 1
       DO jl = 1, kdlon
          zadjd(jl, jk) = 0.
          zadju(jl, jk) = 0.
          zdisd(jl, jk) = 0.
          zdisu(jl, jk) = 0.
       END DO
    END DO

    DO jk = 1, kflev
       DO jl = 1, kdlon
          pcts(jl, jk) = 0.
       END DO
    END DO

    ! * CONTRIBUTION FROM ADJACENT LAYERS

    CALL lwvn(kuaer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, zdbdt)
    ! * CONTRIBUTION FROM DISTANT LAYERS

    CALL lwvd(ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)

    ! * EXCHANGE WITH THE BOUNDARIES

    CALL lwvb(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, pbsuin, &
         pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
         pgatop, pgbtop, pcts, pfluc)


    RETURN
  END SUBROUTINE lwv

end module lwv_m
1	guez	155	module lwv_m
2
3	guez	81	IMPLICIT NONE
4
5	guez	155	contains
6	guez	81
7	guez	155	SUBROUTINE lwv(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, pbtop, &
8			pdbsl, pemis, ppmb, pga, pgb, pgasur, pgbsur, pgatop, pgbtop, &
9			pcntrb, pcts, pfluc)
10			USE dimens_m
11			USE dimphy
12			use lwvd_m, only: lwvd
13	guez	166	use lwvn_m, only: lwvn
14	guez	155	USE suphec_m
15			USE raddim
16			USE raddimlw
17	guez	81
18	guez	155	! -----------------------------------------------------------------------
19			! PURPOSE.
20			! --------
21			! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
22			! FLUXES OR RADIANCES
23	guez	81
24	guez	155	! METHOD.
25			! -------
26	guez	81
27	guez	155	! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
28			! CONTRIBUTIONS BY - THE NEARBY LAYERS
29			! - THE DISTANT LAYERS
30			! - THE BOUNDARY TERMS
31			! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
32	guez	81
33	guez	155	! REFERENCE.
34			! ----------
35	guez	81
36	guez	155	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
37			! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
38	guez	81
39	guez	155	! AUTHOR.
40			! -------
41			! JEAN-JACQUES MORCRETTE ECMWF
42	guez	81
43	guez	155	! MODIFICATIONS.
44			! --------------
45			! ORIGINAL : 89-07-14
46			! -----------------------------------------------------------------------
47	guez	81
48	guez	155	! * ARGUMENTS:
49			INTEGER kuaer, ktraer, klim
50	guez	81
51	guez	155	DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
52			DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
53			DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
54			DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
55			DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
56			DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
57			DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
58			DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
59			DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
60			DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
61			DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
62			DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
63			DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
64			DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
65			DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS
66	guez	81
67	guez	155	DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
68			DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
69			DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
70			! -----------------------------------------------------------------------
71			! LOCAL VARIABLES:
72			DOUBLE PRECISION zadjd(kdlon, kflev+1)
73			DOUBLE PRECISION zadju(kdlon, kflev+1)
74			DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)
75			DOUBLE PRECISION zdisd(kdlon, kflev+1)
76			DOUBLE PRECISION zdisu(kdlon, kflev+1)
77
78			INTEGER jk, jl
79			! -----------------------------------------------------------------------
80
81			DO jk = 1, kflev + 1
82			DO jl = 1, kdlon
83			zadjd(jl, jk) = 0.
84			zadju(jl, jk) = 0.
85			zdisd(jl, jk) = 0.
86			zdisu(jl, jk) = 0.
87			END DO
88	guez	81	END DO
89
90	guez	155	DO jk = 1, kflev
91			DO jl = 1, kdlon
92			pcts(jl, jk) = 0.
93			END DO
94	guez	81	END DO
95
96	guez	155	! * CONTRIBUTION FROM ADJACENT LAYERS
97	guez	81
98	guez	166	CALL lwvn(kuaer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, zdbdt)
99	guez	155	! * CONTRIBUTION FROM DISTANT LAYERS
100	guez	81
101	guez	155	CALL lwvd(ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)
102	guez	81
103	guez	155	! * EXCHANGE WITH THE BOUNDARIES
104	guez	81
105	guez	155	CALL lwvb(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, pbsuin, &
106			pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
107			pgatop, pgbtop, pcts, pfluc)
108	guez	81
109
110	guez	155	RETURN
111			END SUBROUTINE lwv
112
113			end module lwv_m