phylmd/Radlwsw/lwv.f

SUBROUTINE lwv(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, pbtop, &
    pdbsl, pemis, ppmb, ptave, pga, pgb, pgasur, pgbsur, pgatop, pgbtop, &
    pcntrb, pcts, pfluc)
  USE dimens_m
  USE dimphy
  USE suphec_m
  USE raddim
  USE raddimlw
  IMPLICIT NONE

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