/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwv.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/Radlwsw/lwv.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (hide annotations)
Wed Mar 5 14:57:53 2014 UTC (10 years, 3 months ago) by guez
Original Path: trunk/phylmd/Radlwsw/lwv.f
File size: 3517 byte(s)
Changed all ".f90" suffixes to ".f".
1 guez 81 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

  ViewVC Help
Powered by ViewVC 1.1.21