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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 3 months ago) by guez
File size: 5354 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
1 guez 166 module lwvn_m
2    
3 guez 81 IMPLICIT NONE
4    
5 guez 166 contains
6 guez 81
7 guez 166 SUBROUTINE lwvn(kuaer, pabcu, pdbsl, pga, pgb, padjd, padju, pcntrb, pdbdt)
8     USE dimens_m
9     USE dimphy
10     USE raddim
11     USE raddimlw
12     ! -----------------------------------------------------------------------
13     ! PURPOSE.
14     ! --------
15     ! CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
16     ! TO GIVE LONGWAVE FLUXES OR RADIANCES
17 guez 81
18 guez 166 ! METHOD.
19     ! -------
20 guez 81
21 guez 166 ! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
22     ! CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
23 guez 81
24 guez 166 ! REFERENCE.
25     ! ----------
26 guez 81
27 guez 166 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
28     ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
29 guez 81
30 guez 166 ! AUTHOR.
31     ! -------
32     ! JEAN-JACQUES MORCRETTE *ECMWF*
33 guez 81
34 guez 166 ! MODIFICATIONS.
35     ! --------------
36     ! ORIGINAL : 89-07-14
37     ! -----------------------------------------------------------------------
38 guez 81
39 guez 166 ! * ARGUMENTS:
40 guez 81
41 guez 166 INTEGER kuaer
42 guez 81
43 guez 166 DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! ABSORBER AMOUNTS
44     DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
45     DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
46     DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
47 guez 81
48 guez 166 DOUBLE PRECISION padjd(kdlon, kflev+1) ! CONTRIBUTION OF ADJACENT LAYERS
49     DOUBLE PRECISION padju(kdlon, kflev+1) ! CONTRIBUTION OF ADJACENT LAYERS
50     DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
51     DOUBLE PRECISION pdbdt(kdlon, ninter, kflev) ! LAYER PLANCK FUNCTION GRADIENT
52 guez 81
53 guez 166 ! * LOCAL ARRAYS:
54 guez 81
55 guez 166 DOUBLE PRECISION zglayd(kdlon)
56     DOUBLE PRECISION zglayu(kdlon)
57     DOUBLE PRECISION ztt(kdlon, ntra)
58     DOUBLE PRECISION zuu(kdlon, nua)
59 guez 81
60 guez 166 INTEGER jk, jl, ja, im12, ind, inu, ixu, jg
61     INTEGER ixd, ibs, idd, imu, jk1, jk2, jnu
62     DOUBLE PRECISION zwtr
63 guez 81
64 guez 166 ! * Data Block:
65 guez 81
66 guez 166 DOUBLE PRECISION wg1(2)
67     SAVE wg1
68 guez 178 DATA (wg1(jk), jk=1, 2)/1d0, 1d0/
69 guez 166 ! -----------------------------------------------------------------------
70 guez 81
71 guez 166 ! * 1. INITIALIZATION
72     ! --------------
73 guez 81
74    
75 guez 166 ! * 1.1 INITIALIZE LAYER CONTRIBUTIONS
76     ! ------------------------------
77 guez 81
78 guez 166
79     DO jk = 1, kflev + 1
80     DO jl = 1, kdlon
81     padjd(jl, jk) = 0.
82     padju(jl, jk) = 0.
83     END DO
84 guez 81 END DO
85    
86 guez 166 ! * 1.2 INITIALIZE TRANSMISSION FUNCTIONS
87     ! ---------------------------------
88 guez 81
89    
90 guez 166 DO ja = 1, ntra
91     DO jl = 1, kdlon
92     ztt(jl, ja) = 1.0
93     END DO
94 guez 81 END DO
95    
96 guez 166 DO ja = 1, nua
97     DO jl = 1, kdlon
98     zuu(jl, ja) = 0.
99     END DO
100 guez 81 END DO
101    
102 guez 166 ! ------------------------------------------------------------------
103 guez 81
104 guez 166 ! * 2. VERTICAL INTEGRATION
105     ! --------------------
106 guez 81
107    
108    
109 guez 166 ! * 2.1 CONTRIBUTION FROM ADJACENT LAYERS
110     ! ---------------------------------
111 guez 81
112    
113 guez 166 DO jk = 1, kflev
114 guez 81
115 guez 166 ! * 2.1.1 DOWNWARD LAYERS
116     ! ---------------
117 guez 81
118    
119 guez 166 im12 = 2*(jk-1)
120     ind = (jk-1)*ng1p1 + 1
121     ixd = ind
122     inu = jk*ng1p1 + 1
123     ixu = ind
124 guez 81
125 guez 166 DO jl = 1, kdlon
126     zglayd(jl) = 0.
127     zglayu(jl) = 0.
128     END DO
129 guez 81
130 guez 166 DO jg = 1, ng1
131     ibs = im12 + jg
132     idd = ixd + jg
133     DO ja = 1, kuaer
134     DO jl = 1, kdlon
135     zuu(jl, ja) = pabcu(jl, ja, ind) - pabcu(jl, ja, idd)
136     END DO
137     END DO
138 guez 81
139    
140 guez 166 CALL lwtt(pga(1,1,1,jk), pgb(1,1,1,jk), zuu, ztt)
141 guez 81
142 guez 166 DO jl = 1, kdlon
143     zwtr = pdbsl(jl, 1, ibs)*ztt(jl, 1)*ztt(jl, 10) + &
144     pdbsl(jl, 2, ibs)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
145     pdbsl(jl, 3, ibs)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
146     pdbsl(jl, 4, ibs)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
147     pdbsl(jl, 5, ibs)*ztt(jl, 3)*ztt(jl, 14) + &
148     pdbsl(jl, 6, ibs)*ztt(jl, 6)*ztt(jl, 15)
149     zglayd(jl) = zglayd(jl) + zwtr*wg1(jg)
150     END DO
151 guez 81
152 guez 166 ! * 2.1.2 DOWNWARD LAYERS
153     ! ---------------
154 guez 81
155    
156 guez 166 imu = ixu + jg
157     DO ja = 1, kuaer
158     DO jl = 1, kdlon
159     zuu(jl, ja) = pabcu(jl, ja, imu) - pabcu(jl, ja, inu)
160     END DO
161     END DO
162 guez 81
163    
164 guez 166 CALL lwtt(pga(1,1,1,jk), pgb(1,1,1,jk), zuu, ztt)
165 guez 81
166 guez 166 DO jl = 1, kdlon
167     zwtr = pdbsl(jl, 1, ibs)*ztt(jl, 1)*ztt(jl, 10) + &
168     pdbsl(jl, 2, ibs)*ztt(jl, 2)*ztt(jl, 7)*ztt(jl, 11) + &
169     pdbsl(jl, 3, ibs)*ztt(jl, 4)*ztt(jl, 8)*ztt(jl, 12) + &
170     pdbsl(jl, 4, ibs)*ztt(jl, 5)*ztt(jl, 9)*ztt(jl, 13) + &
171     pdbsl(jl, 5, ibs)*ztt(jl, 3)*ztt(jl, 14) + &
172     pdbsl(jl, 6, ibs)*ztt(jl, 6)*ztt(jl, 15)
173     zglayu(jl) = zglayu(jl) + zwtr*wg1(jg)
174     END DO
175 guez 81
176 guez 166 END DO
177    
178     DO jl = 1, kdlon
179     padjd(jl, jk) = zglayd(jl)
180     pcntrb(jl, jk, jk+1) = zglayd(jl)
181     padju(jl, jk+1) = zglayu(jl)
182     pcntrb(jl, jk+1, jk) = zglayu(jl)
183     pcntrb(jl, jk, jk) = 0.0
184     END DO
185 guez 81 END DO
186    
187 guez 166 DO jk = 1, kflev
188     jk2 = 2*jk
189     jk1 = jk2 - 1
190     DO jnu = 1, ninter
191     DO jl = 1, kdlon
192     pdbdt(jl, jnu, jk) = pdbsl(jl, jnu, jk1) + pdbsl(jl, jnu, jk2)
193     END DO
194     END DO
195 guez 81 END DO
196    
197 guez 166 END SUBROUTINE lwvn
198 guez 81
199 guez 166 end module lwvn_m
  ViewVC Help
Powered by ViewVC 1.1.21