Context Navigation

write_histday.h @ 3643

Last change on this file since 3643 was 1572, checked in by emillour, 9 years ago

All GCMs:
Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation (up to rev r2500 of LMDZ5)

arch:
remove ifort debug option '-check all', replace it with '-check bounds,format,output_conversion,pointers,uninit' (i.e. get it to stop complaining about copying into temporary arrays)

dyn3d_common:
comconst_mod.F90 : add ngroup

dyn3d:
gcm.F90 : minor bug fix (arguments to a call_abort())
leapfrog.F90 : recompute geopotential for bilan_dyn outputs
conf_gcm.F90 : read "ngroup" from run.def
groupe.F , groupeun.F : ngroup no longer a local parameter

dyn3d_par:
conf_gcm.F90 : read "ngroup" from run.def
groupe_p.F , groupeun_p.F : ngroup no longer a local parameter

misc:
regr1_step_av_m.F90 : removed (not used)

phy_common:
mod_phys_lmdz_mpi_transfert.F90 , mod_phys_lmdz_mpi_data.F90 : change is_north_pole and is_south_pole to is_north_pole_dyn and is_south_pole_dyn
mod_phys_lmdz_omp_data.F90 : introduce is_nort_pole_phy and is_south_pole_phy

dynphy_lonlat:
mod_interface_dyn_phys.F90 : use is_north_pole_dyn and is_south_pole_dyn
calfis_p.F : use is_north_pole_dyn and is_south_pole_dyn

phyvenus:
physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.

phytitan:
physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.

File size: 11.3 KB

Line
1	!
2	! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histday.h,v 1.2 2004/06/01 09:27:10 lmdzadmin Exp $
3	!
4	IF (ok_journe) THEN
5
6	zsto = dtime
7	zout = dtime * REAL(ecrit_day)
8	itau_w = itau_phy + itap
9
10	c-------------------------------------------------------
11	IF(lev_histday.GE.1) THEN
12
13	ccccccccccccc 2D fields, invariables
14
15	call histwrite_phy(nid_day,.false.,"phis",itau_w,pphis)
16	c call histwrite_phy(nid_day,.false.,"aire",itau_w,cell_area)
17	cell_area_out(:)=cell_area(:)
18	if (is_north_pole_phy) cell_area_out(1)=cell_area(1)/nbp_lon
19	if (is_south_pole_phy) cell_area_out(klon)=cell_area(klon)/nbp_lon
20	call histwrite_phy(nid_day,.false.,"aire",itau_w,cell_area_out)
21
22	ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
23	c Correction passage de 360 a 0... Sinon probleme avec moyenne
24	if (zls.lt.zlsm1) then
25	do i=1,klon
26	tmpout(i,1) = zls*180./RPI+360.
27	enddo
28	zlsm1 = 2.*RPI
29	else
30	do i=1,klon
31	tmpout(i,1) = zls*180./RPI
32	enddo
33	zlsm1 = zls
34	endif
35	call histwrite_phy(nid_day,.false.,"ls",itau_w,tmpout(:,1))
36
37	ccccccccccccc 2D fields, variables
38
39	call histwrite_phy(nid_day,.false.,"tsol",itau_w,ftsol)
40	call histwrite_phy(nid_day,.false.,"psol",itau_w,paprs(:,1))
41
42	c call histwrite_phy(nid_day,.false.,"ue",itau_w,ue)
43	c call histwrite_phy(nid_day,.false.,"ve",itau_w,ve)
44
45	ENDIF !lev_histday.GE.1
46
47	c-------------------------------------------------------
48	IF(lev_histday.GE.2) THEN
49
50	ccccccccccccc 3D fields, basics
51
52	call histwrite_phy(nid_day,.false.,"temp",itau_w,t_seri)
53	call histwrite_phy(nid_day,.false.,"pres",itau_w,pplay)
54	call histwrite_phy(nid_day,.false.,"geop",itau_w,zphi)
55	call histwrite_phy(nid_day,.false.,"vitu",itau_w,u_seri)
56	call histwrite_phy(nid_day,.false.,"vitv",itau_w,v_seri)
57	call histwrite_phy(nid_day,.false.,"vitw",itau_w,omega)
58	call histwrite_phy(nid_day,.false.,"tops",itau_w,topsw)
59	call histwrite_phy(nid_day,.false.,"duvdf",itau_w,d_u_vdf)
60	call histwrite_phy(nid_day,.false.,"dudyn",itau_w,d_u_dyn)
61
62	cccccccccccccccccc Tracers
63
64	if (iflag_trac.eq.1) THEN
65	if (microfi.ge.1) then
66	c DO iq=1,nmicro
67	c call histwrite_phy(nid_day,.false.,tname(iq),
68	c . itau_w,qaer(1:klon,1:klev,iq))
69	c ENDDO
70	c ------- NB AER TOT
71	do i=1,klon
72	do j=1,klev
73	tmpout(i,j)= SUM(qaer(i,j,1:nrad))
74	enddo
75	enddo
76	call histwrite_phy(nid_day,.false.,"qaer",itau_w,tmpout)
77
78	if (clouds.eq.1) then
79	c ------- NB NOY TOT
80	do i=1,klon
81	do j=1,klev
82	tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
83	enddo
84	enddo
85	call histwrite_phy(nid_day,.false.,"qnoy",itau_w,tmpout)
86	c ------- V GLA1 TOT
87	do i=1,klon
88	do j=1,klev
89	tmpout(i,j)= SUM(qaer(i,j,2nrad+1:3nrad))
90	enddo
91	enddo
92	call histwrite_phy(nid_day,.false.,"qgl1",itau_w,tmpout)
93	c ------- V GLA2 TOT
94	do i=1,klon
95	do j=1,klev
96	tmpout(i,j)= SUM(qaer(i,j,3nrad+1:4nrad))
97	enddo
98	enddo
99	call histwrite_phy(nid_day,.false.,"qgl2",itau_w,tmpout)
100	c ------- V GLA3 TOT
101	do i=1,klon
102	do j=1,klev
103	tmpout(i,j)= SUM(qaer(i,j,4nrad+1:5nrad))
104	enddo
105	enddo
106	call histwrite_phy(nid_day,.false.,"qgl3",itau_w,tmpout)
107	c --------------
108	c ----- SATURATION ESP NUAGES
109	call histwrite_phy(nid_day,.false.,"ch4sat",itau_w,satch4)
110	call histwrite_phy(nid_day,.false.,"c2h6sat",itau_w,satc2h6)
111	call histwrite_phy(nid_day,.false.,"c2h2sat",itau_w,satc2h2)
112	c --------------
113	c ----- RESERVOIR DE SURFACE
114	call histwrite_phy(nid_day,.false.,"reserv",itau_w,reservoir)
115	c --------------
116	c ----- ECHANGE GAZ SURF/ATM (evaporation)
117	call histwrite_phy(nid_day,.false.,"evapch4",itau_w,evapch4)
118	c --------------
119	c ----- PRECIPITATIONS
120	c ----- CH4
121	call histwrite_phy(nid_day,.false.,"prech4",
122	. itau_w,precip(1:klon,1))
123	c ----- C2H6
124	call histwrite_phy(nid_day,.false.,"prec2h6",
125	. itau_w,precip(1:klon,2))
126	c ----- C2H2
127	call histwrite_phy(nid_day,.false.,"prec2h2",
128	. itau_w,precip(1:klon,3))
129	c ----- NOY
130	call histwrite_phy(nid_day,.false.,"prenoy",
131	. itau_w,precip(1:klon,4))
132	c ----- AER
133	call histwrite_phy(nid_day,.false.,"preaer",
134	. itau_w,precip(1:klon,5))
135	c --------------
136	c ----- FLUX GLACE
137	c ----- CH4
138	call histwrite_phy(nid_day,.false.,"flxgl1",
139	. itau_w,flxesp_i(1:klon,1:klev,1))
140	c ----- C2H6
141	call histwrite_phy(nid_day,.false.,"flxgl2",
142	. itau_w,flxesp_i(1:klon,1:klev,2))
143	c ----- C2H2
144	call histwrite_phy(nid_day,.false.,"flxgl3",
145	. itau_w,flxesp_i(1:klon,1:klev,3))
146	c --------------
147	c ----- Source/puits GLACE
148	c ----- CH4
149	call histwrite_phy(nid_day,.false.,"solch4",
150	. itau_w,solesp(1:klon,1:klev,1))
151	c ----- C2H6
152	call histwrite_phy(nid_day,.false.,"solc2h6",
153	. itau_w,solesp(1:klon,1:klev,2))
154	c ----- C2H2
155	call histwrite_phy(nid_day,.false.,"solc2h2",
156	. itau_w,solesp(1:klon,1:klev,3))
157	c --------------
158	c ----- RAYON MOYEN GOUTTE
159	call histwrite_phy(nid_day,.false.,"rcldbar",itau_w,rmcloud)
160
161	endif
162	endif
163
164	c --------------
165	c ----- TRACEURS CHIMIQUES
166	if (nmicro.lt.nqmax) then
167	DO iq=nmicro+1,nqmax
168	call histwrite_phy(nid_day,.false.,tname(iq),
169	. itau_w,tr_seri(1:klon,1:klev,iq))
170	ENDDO
171	endif
172	endif
173
174	ENDIF !lev_histday.GE.2
175
176	c-------------------------------------------------------
177	IF(lev_histday.GE.3) THEN
178
179	cccccccccccccccccc Radiative transfer
180
181	c 2D
182
183	call histwrite_phy(nid_day,.false.,"topl",itau_w,toplw)
184	call histwrite_phy(nid_day,.false.,"sols",itau_w,solsw)
185	call histwrite_phy(nid_day,.false.,"soll",itau_w,sollw)
186
187	c 3D
188
189	call histwrite_phy(nid_day,.false.,"SWnet",
190	. itau_w,swnet(1:klon,1:klev))
191	call histwrite_phy(nid_day,.false.,"LWnet",
192	. itau_w,lwnet(1:klon,1:klev))
193
194	c --------------
195	c ----- OPACITE BRUME
196	do k=7,NSPECV,10
197	do i=1,klon
198	do l=1,klev
199	t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
200	enddo
201	enddo
202	write(str2,'(i2.2)') k
203	call histwrite_phy(nid_day,.false.,"thv"//str2,itau_w,t_tauhvd)
204	enddo ! fin boucle NSPECV
205
206	do k=8,NSPECI,10
207	do i=1,klon
208	do l=1,klev
209	t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
210	enddo
211	enddo
212	write(str2,'(i2.2)') k
213	call histwrite_phy(nid_day,.false.,"thi"//str2,itau_w,t_tauhvd)
214	enddo ! fin boucle NSPECI
215	c --------------
216	c ----- EXTINCTION BRUME
217	do k=7,NSPECV,10
218	do i=1,klon
219	do l=1,klev
220	if(l.ne.klev)
221	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
222	s -TAUHVD(i,klev-l+1-1,k)
223	if(l.eq.klev)
224	s t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
225
226	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
227	enddo
228	enddo
229	write(str2,'(i2.2)') k
230	call histwrite_phy(nid_day,.false.,"khv"//str2,itau_w,t_khvd)
231	enddo ! fin boucle NSPECV
232
233	do k=8,NSPECI,10
234	do i=1,klon
235	do l=1,klev
236	if(l.ne.klev)
237	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
238	s -TAUHID(i,klev-l+1-1,k)
239	if(l.eq.klev)
240	s t_khvd(i,l)=TAUHID(i,klev-l+1,k)
241
242	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
243	enddo
244	enddo
245	write(str2,'(i2.2)') k
246	call histwrite_phy(nid_day,.false.,"khi"//str2,itau_w,t_khvd)
247	enddo ! fin boucle NSPECI
248	c --------------
249	c ----- OPACITE GAZ
250	do k=7,NSPECV,10
251	do i=1,klon
252	do l=1,klev
253	t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
254	enddo
255	enddo
256	write(str2,'(i2.2)') k
257	call histwrite_phy(nid_day,.false.,"tgv"//str2,itau_w,t_tauhvd)
258	enddo ! fin boucle NSPECV
259
260	do k=8,NSPECI,10
261	do i=1,klon
262	do l=1,klev
263	t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
264	enddo
265	enddo
266	write(str2,'(i2.2)') k
267	call histwrite_phy(nid_day,.false.,"tgi"//str2,itau_w,t_tauhvd)
268	enddo ! fin boucle NSPECI
269	c --------------
270	c ----- EXTINCTION GAZ
271	do k=7,NSPECV,10
272	do i=1,klon
273	do l=1,klev
274	if(l.ne.klev)
275	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
276	s -TAUGVD(i,klev-l+1-1,k)
277	if(l.eq.klev)
278	s t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
279
280	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
281	enddo
282	enddo
283	write(str2,'(i2.2)') k
284	call histwrite_phy(nid_day,.false.,"kgv"//str2,itau_w,t_khvd)
285	enddo ! fin boucle NSPECV
286
287	do k=8,NSPECI,10
288	do i=1,klon
289	do l=1,klev
290	if(l.ne.klev)
291	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
292	s -TAUGID(i,klev-l+1-1,k)
293
294	if(l.eq.klev)
295	s t_khvd(i,l)=TAUGID(i,klev-l+1,k)
296
297	t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
298	enddo
299	enddo
300	write(str2,'(i2.2)') k
301	call histwrite_phy(nid_day,.false.,"kgi"//str2,itau_w,t_khvd)
302	enddo ! fin boucle NSPECI
303
304	c --------------
305	if (clouds.eq.1) then
306	c --------------
307	c ----- OPACITE NUAGES (ATTENTION PROXY)
308	call histwrite_phy(nid_day,.false.,"tcld",itau_w,occcld)
309	c --------------
310	c ----- EXTINCTION NUAGES (ATTENTION PROXY)
311	do i=1,klon
312	t_kcld(i,klev)=occcld(i,klev)
313	. /(zzlev(i,klev+1)-zzlev(i,klev))
314	do j=klev-1,1,-1
315	t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
316	. /(zzlev(i,j+1)-zzlev(i,j))
317	enddo
318	enddo
319	call histwrite_phy(nid_day,.false.,"kcld",itau_w,t_kcld)
320	c --------------
321	endif
322	c --------------
323
324	ENDIF !lev_histday.GE.3
325
326	c-------------------------------------------------------
327	IF(lev_histday.GE.4) THEN
328
329	call histwrite_phy(nid_day,.false.,"dtdyn",itau_w,d_t_dyn)
330	call histwrite_phy(nid_day,.false.,"dtphy",itau_w,d_t)
331	c K/s
332	call histwrite_phy(nid_day,.false.,"dtvdf",itau_w,d_t_vdf)
333	c K/s
334	call histwrite_phy(nid_day,.false.,"dtajs",itau_w,d_t_ajs)
335	c K/s
336	call histwrite_phy(nid_day,.false.,"dtswr",itau_w,heat)
337	c K/s
338	call histwrite_phy(nid_day,.false.,"dtlwr",itau_w,-1.*cool)
339	c K/s
340	c call histwrite_phy(nid_day,.false.,"dtec",itau_w,d_t_ec)
341
342	ENDIF !lev_histday.GE.4
343
344	c-------------------------------------------------------
345	IF(lev_histday.GE.5) THEN
346
347	c call histwrite_phy(nid_day,.false.,"taux",itau_w,fluxu)
348	c call histwrite_phy(nid_day,.false.,"tauy",itau_w,fluxv)
349	c call histwrite_phy(nid_day,.false.,"cdrm",itau_w,cdragm)
350	c call histwrite_phy(nid_day,.false.,"cdrh",itau_w,cdragh)
351
352	ENDIF !lev_histday.GE.5
353	c-------------------------------------------------------
354
355	if (ok_sync) then
356	call histsync(nid_day)
357	endif
358
359	ENDIF

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

Context Navigation

source: trunk/LMDZ.TITAN.old/libf/phytitan/write_histday.h @ 3643

Download in other formats: