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 dimensions
    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	module lwv_m
2
3	IMPLICIT NONE
4
5	contains
6
7	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 dimensions
11	USE dimphy
12	use lwvd_m, only: lwvd
13	use lwvn_m, only: lwvn
14	USE suphec_m
15	USE raddim
16	USE raddimlw
17
18	! -----------------------------------------------------------------------
19	! PURPOSE.
20	! --------
21	! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
22	! FLUXES OR RADIANCES
23
24	! METHOD.
25	! -------
26
27	! 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
33	! REFERENCE.
34	! ----------
35
36	! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
37	! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
38
39	! AUTHOR.
40	! -------
41	! JEAN-JACQUES MORCRETTE ECMWF
42
43	! MODIFICATIONS.
44	! --------------
45	! ORIGINAL : 89-07-14
46	! -----------------------------------------------------------------------
47
48	! * ARGUMENTS:
49	INTEGER kuaer, ktraer, klim
50
51	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
67	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	END DO
89
90	DO jk = 1, kflev
91	DO jl = 1, kdlon
92	pcts(jl, jk) = 0.
93	END DO
94	END DO
95
96	! * CONTRIBUTION FROM ADJACENT LAYERS
97
98	CALL lwvn(kuaer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, zdbdt)
99	! * CONTRIBUTION FROM DISTANT LAYERS
100
101	CALL lwvd(ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)
102
103	! * EXCHANGE WITH THE BOUNDARIES
104
105	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
109
110	RETURN
111	END SUBROUTINE lwv
112
113	end module lwv_m