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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (hide annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 10 months ago) by guez
Original Path: trunk/Sources/phylmd/Radlwsw/lwv.f
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 guez 155 module lwv_m
2    
3 guez 81 IMPLICIT NONE
4    
5 guez 155 contains
6 guez 81
7 guez 155 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 guez 166 use lwvn_m, only: lwvn
14 guez 155 USE suphec_m
15     USE raddim
16     USE raddimlw
17 guez 81
18 guez 155 ! -----------------------------------------------------------------------
19     ! PURPOSE.
20     ! --------
21     ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
22     ! FLUXES OR RADIANCES
23 guez 81
24 guez 155 ! METHOD.
25     ! -------
26 guez 81
27 guez 155 ! 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 guez 81
33 guez 155 ! REFERENCE.
34     ! ----------
35 guez 81
36 guez 155 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
37     ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
38 guez 81
39 guez 155 ! AUTHOR.
40     ! -------
41     ! JEAN-JACQUES MORCRETTE *ECMWF*
42 guez 81
43 guez 155 ! MODIFICATIONS.
44     ! --------------
45     ! ORIGINAL : 89-07-14
46     ! -----------------------------------------------------------------------
47 guez 81
48 guez 155 ! * ARGUMENTS:
49     INTEGER kuaer, ktraer, klim
50 guez 81
51 guez 155 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 guez 81
67 guez 155 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 guez 81 END DO
89    
90 guez 155 DO jk = 1, kflev
91     DO jl = 1, kdlon
92     pcts(jl, jk) = 0.
93     END DO
94 guez 81 END DO
95    
96 guez 155 ! * CONTRIBUTION FROM ADJACENT LAYERS
97 guez 81
98 guez 166 CALL lwvn(kuaer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, zdbdt)
99 guez 155 ! * CONTRIBUTION FROM DISTANT LAYERS
100 guez 81
101 guez 155 CALL lwvd(ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)
102 guez 81
103 guez 155 ! * EXCHANGE WITH THE BOUNDARIES
104 guez 81
105 guez 155 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 guez 81
109    
110 guez 155 RETURN
111     END SUBROUTINE lwv
112    
113     end module lwv_m
  ViewVC Help
Powered by ViewVC 1.1.21