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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (show annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 10 months ago) by guez
File size: 3721 byte(s) 
Split ppm3d.f into files containing a single procedure.

Factorized computations of filtering matrices into a procedure
inifilr_hemisph. Had then to change the matrices from allocatable to
pointer and from customized lower bound to lower bound 1. The change
in lower bounds does not matter because the matrices are only used as
a whole as actual arguments.

Also, in infilr, instead of finding jfilt[ns][uv] from approximately
jjm /2, start at index j1 that corresponds to the equator. This is not
the same if there is a zoom in latitude.

Also, the test (rlamda(modfrst[ns][uv](j)) * cos(rlat[uv](j)) < 1) in
the loops on filtered latitudes is not useful now that we start from
j1: it is necessarily true. See notes.

Just encapsulated lwvn into a module and removed unused argument ktraer.
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 dimens_m
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
  ViewVC Help
Powered by ViewVC 1.1.21