Context Navigation

lwxb.F @ 3567

Last change on this file since 3567 was 1266, checked in by aslmd, 11 years ago

LMDZ.MARS
IMPORTANT CHANGE

Remove all reference/use of nlayermx and dimphys.h
Made use of automatic arrays whenever arrays are needed with dimension nlayer
Remove lots of obsolete reference to dimensions.h
Converted iono.h and param_v4.h into corresponding modules

(with embedded subroutine to allocate arrays)
(no arrays allocated if thermosphere not used)

Deleted param.h and put contents into module param_v4_h
Adapted testphys1d, newstart, etc...
Made DATA arrays in param_read to be initialized by subroutine

fill_data_thermos in module param_v4_h

Optimized computations in paramfoto_compact (twice less dlog10 calculations)
Checked consistency before/after modification in debug mode
Checked performance is not impacted (same as before)

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

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

Download in other formats:

Original Format