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