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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 81 - (show 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 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