/[lmdze]/trunk/phylmd/Radlwsw/lwv.f90
ViewVC logotype

Annotation of /trunk/phylmd/Radlwsw/lwv.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 81 - (hide annotations)
Wed Mar 5 14:38:41 2014 UTC (10 years, 3 months ago) by guez
File size: 3517 byte(s) 
 Converted to free source form files which were still in fixed source
form. The conversion was done using the polish mode of the NAG Fortran
Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).
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