Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

lwxb.F @ 706

Last change on this file since 706 was 38, checked in by emillour, 14 years ago
Ajout du modè Martien (mon LMDZ.MARS.BETA, du 28/01/2011) dans le rértoire mars, pour pouvoir suivre plus facilement les modifs. EM
File size: 7.5 KB

Line
1	subroutine lwxb (ig0,kdlon,kflev
2	. ,emis
3	. ,aer_t,co2_u,co2_up)
4
5	c----------------------------------------------------------------------
6	c LWXB computes transmission function and exchange coefficients
7	c for boundaries
8	c (co2 / aerosols)
9	c (bands 1 and 2 of co2)
10	c----------------------------------------------------------------------
11	c
12	c \|---\|---\|---\|---\|---\|---\|---\|---\|
13	c kflev+1 \|*\|\|\|\|\|\|**\| 0 \| (space)
14	c \|---\|---\|---\|---\|---\|---\|---\|---\|
15	c kflev \|*\| \| \| \| \| \| 0 \|*\|
16	c \|---\|---\|---\|---\|---\|---\|---\|---\|
17	c ... \|*\| \| \| \| \| 0 \| \|*\|
18	c \|---\|---\|---\|---\|---\|---\|---\|---\|
19	c 4 \|*\| \| \| \| 0 \| \| \|*\|
20	c \|---\|---\|---\|---\|---\|---\|---\|---\|
21	c 3 \|*\| \| \| 0 \| \| \| \|*\|
22	c \|---\|---\|---\|---\|---\|---\|---\|---\|
23	c 2 \|*\| \| 0 \| \| \| \| \|*\|
24	c \|---\|---\|---\|---\|---\|---\|---\|---\|
25	c 1 \|*\| 0 \| \| \| \| \| \|*\|
26	c \|---\|---\|---\|---\|---\|---\|---\|---\|
27	c 0 \| 0 \|*\|\|\|\|\|\|**\| (ground)
28	c \|---\|---\|---\|---\|---\|---\|---\|---\|
29	c 0 1 2 3 4 ... k \|k+1
30	c (ground) (space)
31	c
32	c (*) xi computed in this subroutine
33	c----------------------------------------------------------------------
34
35	implicit none
36
37	#include "dimensions.h"
38	#include "dimphys.h"
39	#include "dimradmars.h"
40	#include "callkeys.h"
41
42	#include "yomlw.h"
43
44	c----------------------------------------------------------------------
45	c 0.1 arguments
46	c ---------
47	c inputs:
48	c -------
49	integer kdlon ! part of ngrid
50	integer kflev ! part of nalyer
51
52	real emis (ndlo2) ! surface emissivity
53	real aer_t (ndlo2,nuco2,kflev+1) ! transmission (aer)
54	real co2_u (ndlo2,nuco2,kflev+1) ! absorber amounts (co2)
55	real co2_up (ndlo2,nuco2,kflev+1) ! idem scaled by the pressure (co2)
56
57	c----------------------------------------------------------------------
58	c 0.2 local arrays
59	c ------------
60
61	integer ja,jl,jk,ig0
62
63	real zt_co2 (ndlon,nuco2)
64	real zt_aer (ndlon,nuco2)
65	real zu (ndlon,nuco2)
66	real zup (ndlon,nuco2)
67	c 2 for ground(1) and space(2)
68	real trans (ndlon,nuco2,2,0:nflev+1)
69	real ksi (ndlon,nuco2,2,0:nflev+1)
70	c only for space
71	real trans_emis (ndlon,nuco2,0:nflev+1)
72	real ksi_emis (ndlon,nuco2,0:nflev+1)
73
74	c*************************************************************************
75	c 1.0 Transmissions
76	c -------------
77	c----------------------------------------------------------------------
78	c 1.1 Direct Transmission
79	c -------------------
80
81	c space
82	c -----
83	do jk = 1 , nlaylte+1
84
85	do ja = 1 , nuco2
86	do jl = 1 , kdlon
87	zu(jl,ja) = co2_u(jl,ja,jk)
88	zup(jl,ja) = co2_up(jl,ja,jk)
89	zt_aer(jl,ja) = aer_t(jl,ja,jk)
90	enddo
91	enddo
92
93	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
94
95	do ja = 1 , nuco2
96	do jl = 1 , kdlon
97	trans(jl,ja,2,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
98	enddo
99	enddo
100
101	enddo
102	c ground
103	c -----
104	do jk = 1 , nlaylte+1
105
106	do ja = 1 , nuco2
107	do jl = 1 , kdlon
108	zu(jl,ja) = co2_u(jl,ja,1) - co2_u(jl,ja,jk)
109	zup(jl,ja) = co2_up(jl,ja,1) - co2_up(jl,ja,jk)
110	zt_aer(jl,ja) = aer_t(jl,ja,1) /aer_t(jl,ja,jk)
111	enddo
112	enddo
113
114	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
115
116	do ja = 1 , nuco2
117	do jl = 1 , kdlon
118	trans(jl,ja,1,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
119	enddo
120	enddo
121
122	enddo
123
124	c----------------------------------------------------------------------
125	c 1.2 Transmission with reflexion
126	c ---------------------------
127
128	c space
129	c -----
130	do jk = 1 , nlaylte+1
131
132	do ja = 1 , nuco2
133	do jl = 1 , kdlon
134
135	zu(jl,ja) = 2 * co2_u(jl,ja,1) - co2_u(jl,ja,jk)
136	zup(jl,ja) = 2 * co2_up(jl,ja,1) - co2_up(jl,ja,jk)
137	zt_aer(jl,ja) = aer_t(jl,ja,1)
138	. * aer_t(jl,ja,1)
139	. / aer_t(jl,ja,jk)
140
141	enddo
142	enddo
143
144	call lwtt(kdlon,zu,zup,nuco2,zt_co2)
145
146	do ja = 1 , nuco2
147	do jl = 1 , kdlon
148	trans_emis(jl,ja,jk)=zt_co2(jl,ja)*zt_aer(jl,ja)
149	enddo
150	enddo
151
152	enddo
153
154	c*************************************************************************
155	c 2.0 Exchange Coefficiants
156	c ---------------------
157
158	do jk = 1 , nlaylte
159	do ja = 1 , nuco2
160	do jl = 1 , kdlon
161
162	c-------------------------------------------------------------------------
163	c 2.1 colling to space (from layer 1,nlaylte toward "layer" nlaylte+1)
164	c ----------------
165
166
167	ksi(jl,ja,2,jk) = trans(jl,ja,2,jk+1)
168	. - trans(jl,ja,2,jk)
169
170	ksi_emis(jl,ja,jk) = trans_emis(jl,ja,jk)
171	. - trans_emis(jl,ja,jk+1)
172
173	xi(ig0+jl,ja,jk,nlaylte+1)= ksi(jl,ja,2,jk)
174	. + ksi_emis(jl,ja,jk)* (1 - emis(jl))
175
176	c ksi Reciprocity
177	c ---------------
178	xi(ig0+jl,ja,nlaylte+1,jk) = xi(ig0+jl,ja,jk,nlaylte+1)
179
180	c-------------------------------------------------------------------------
181	c 2.2 echange with ground (from "layer" 0 toward layers 1,nlaylte)
182	c -------------------
183
184
185	ksi(jl,ja,1,jk) = trans(jl,ja,1,jk)
186	. - trans(jl,ja,1,jk+1)
187
188	xi(ig0+jl,ja,0,jk) = ksi(jl,ja,1,jk) * emis(jl)
189
190	c ksi Reciprocity
191	c ---------------
192	xi(ig0+jl,ja,jk,0) = xi(ig0+jl,ja,0,jk)
193
194	c-------------------------------------------------------------------------
195	enddo
196	enddo
197	enddo
198
199	c-------------------------------------------------------------------------
200	c 2.3 echange ground-space (from "layer" 0 toward "layer" nlaylte+1)
201	c ----------------------
202
203	c Is not used because we use sigma T4 for the ground budget in physiq.F
204
205	do ja = 1 , nuco2
206	do jl = 1 , kdlon
207
208	ksi(jl,ja,1,nlaylte+1) = trans(jl,ja,1,nlaylte+1)
209	xi(ig0+jl,ja,0,nlaylte+1) = ksi(jl,ja,1,nlaylte+1) * emis(jl)
210
211	c ksi Reciprocity
212	c ---------------
213	xi(ig0+jl,ja,nlaylte+1,0) = xi(ig0+jl,ja,0,nlaylte+1)
214
215	enddo
216	enddo
217
218	c-------------------------------------------------------------------------
219	return
220	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format