Context Navigation

lwxb.F @ 1112

Last change on this file since 1112 was 1047, checked in by emillour, 11 years ago

Mars GCM:

IMPORTANT CHANGE: Removed all reference/use of ngridmx (dimphys.h) in routines (necessary prerequisite to using parallel dynamics); in most cases this just means adding 'ngrid' as routine argument, and making local saved variables allocatable (and allocated at first call). In the process, had to convert many *.h files to equivalent modules: yomaer.h => yomaer_h.F90 , surfdat.h => surfdat_h.F90 , comsaison.h => comsaison_h.F90 , yomlw.h => yomlw_h.F90 , comdiurn.h => comdiurn_h.F90 , dimradmars.h => dimradmars_mod.F90 , comgeomfi.h => comgeomfi_h.F90, comsoil.h => comsoil_h.F90 , slope.h => slope_mod.F90
Also updated EOF routines, everything is now in eofdump_mod.F90
Removed unused routine lectfux.F (in dyn3d)

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

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

Download in other formats:

Original Format