Context Navigation

writediagfi.F @ 1266

Last change on this file since 1266 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: 17.5 KB

Line
1	subroutine writediagfi(ngrid,nom,titre,unite,dim,px)
2
3	! Ecriture de variables diagnostiques au choix dans la physique
4	! dans un fichier NetCDF nomme 'diagfi'. Ces variables peuvent etre
5	! 3d (ex : temperature), 2d (ex : temperature de surface), ou
6	! 0d (pour un scalaire qui ne depend que du temps : ex : la longitude
7	! solaire)
8	! (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
9	! La periode d'ecriture est donnee par
10	! "ecritphy " regle dans le fichier de controle de run : run.def
11	!
12	! writediagfi peut etre appele de n'importe quelle subroutine
13	! de la physique, plusieurs fois. L'initialisation et la creation du
14	! fichier se fait au tout premier appel.
15	!
16	! WARNING : les variables dynamique (u,v,t,q,ps)
17	! sauvees par writediagfi avec une
18	! date donnee sont legerement differentes que dans le fichier histoire car
19	! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
20	! IL est RECOMMANDE d'ajouter les tendance physique a ces variables
21	! avant l'ecriture dans diagfi (cf. physiq.F)
22	!
23	! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
24	! Oct 2011 Francois: enable having a 'diagfi.def' file to select
25	! at runtime, which variables to put in file
26	!
27	! parametres (input) :
28	! ----------
29	! ngrid : nombres de point ou est calcule la physique
30	! (ngrid = 2+(jjm-1)*iim - 1/jjm)
31	! (= nlon ou klon dans la physique terrestre)
32	!
33	! unit : unite logique du fichier de sortie (toujours la meme)
34	! nom : nom de la variable a sortir (chaine de caracteres)
35	! titre: titre de la variable (chaine de caracteres)
36	! unite : unite de la variable (chaine de caracteres)
37	! px : variable a sortir (real 0, 1, 2, ou 3d)
38	! dim : dimension de px : 0, 1, 2, ou 3 dimensions
39	!
40	!=================================================================
41	use surfdat_h, only: phisfi
42	use control_mod, only: ecritphy, day_step, iphysiq
43	USE mod_phys_lmdz_para, only : is_parallel, is_mpi_root,
44	& is_master, gather
45	USE mod_grid_phy_lmdz, only : klon_glo, Grid1Dto2D_glo
46	implicit none
47
48	! Commons
49	#include "dimensions.h"
50	#include "paramet.h"
51	#include "comvert.h"
52	#include "comgeom.h"
53	#include "description.h"
54	#include "netcdf.inc"
55	#include "temps.h"
56
57	! Arguments on input:
58	integer,intent(in) :: ngrid
59	character (len=*),intent(in) :: nom,titre,unite
60	integer,intent(in) :: dim
61	real,intent(in) :: px(ngrid,llm)
62
63	! Local variables:
64
65	real*4 dx3(iip1,jjp1,llm) ! to store a 3D data set
66	real*4 dx2(iip1,jjp1) ! to store a 2D (surface) data set
67	real*4 dx1(llm) ! to store a 1D (column) data set
68	real*4 dx0
69
70	real*4,save :: date
71
72	REAL phis(ip1jmp1)
73
74	integer irythme
75	integer ierr,ierr2
76	integer iq
77	integer i,j,l,zmax , ig0
78
79	integer,save :: zitau=0
80	character(len=20),save :: firstnom='1234567890'
81
82	! Ajouts
83	integer, save :: ntime=0
84	integer :: idim,varid
85	integer :: nid
86	character(len=*),parameter :: fichnom="diagfi.nc"
87	integer, dimension(4) :: id
88	integer, dimension(4) :: edges,corner
89
90	! Added to use diagfi.def to select output variable
91	logical,save :: diagfi_def
92	logical :: getout
93	integer,save :: n_nom_def
94	integer :: n
95	integer,parameter :: n_nom_def_max=199
96	character(len=120),save :: nom_def(n_nom_def_max)
97	logical,save :: firstcall=.true.
98
99	#ifndef MESOSCALE
100
101	#ifdef CPP_PARA
102	! Added to work in parallel mode
103	real dx3_glop(klon_glo,llm)
104	real dx3_glo(iim,jjp1,llm) ! to store a global 3D data set
105	real dx2_glop(klon_glo)
106	real dx2_glo(iim,jjp1) ! to store a global 2D (surface) data set
107	real px2(ngrid)
108	! real dx1_glo(llm) ! to store a 1D (column) data set
109	! real dx0_glo
110	real phisfi_glo(klon_glo) ! surface geopotential on global physics grid
111	#else
112	real phisfi_glo(ngrid) ! surface geopotential on global physics grid
113	#endif
114
115	!***************************************************************
116	!Sortie des variables au rythme voulu
117
118	irythme = int(ecritphy) ! sortie au rythme de ecritphy
119	! irythme = iconser ! sortie au rythme des variables de controle
120	! irythme = iphysiq ! sortie a tous les pas physique
121	! irythme = iecri*day_step ! sortie au rythme des fichiers histoires
122	! irythme = periodav*day_step ! sortie au rythme des fichiers histmoy
123
124	!***************************************************************
125
126	! At very first call, check if there is a "diagfi.def" to use and read it
127	! -----------------------------------------------------------------------
128	IF (firstcall) THEN
129	firstcall=.false.
130
131	! Open diagfi.def definition file if there is one:
132	open(99,file="diagfi.def",status='old',form='formatted',
133	s iostat=ierr2)
134
135	if(ierr2.eq.0) then
136	diagfi_def=.true.
137	write(,) "******************"
138	write(,) "Reading diagfi.def"
139	write(,) "******************"
140	do n=1,n_nom_def_max
141	read(99,fmt='(a)',end=88) nom_def(n)
142	write(,) 'Output in diagfi: ', trim(nom_def(n))
143	end do
144	88 continue
145	if (n.ge.n_nom_def_max) then
146	write(,)"n_nom_def_max too small in writediagfi.F:",n
147	stop
148	end if
149	n_nom_def=n-1
150	close(99)
151	else
152	diagfi_def=.false.
153	endif
154	END IF ! of IF (firstcall)
155
156	! Get out of write_diagfi if there is diagfi.def AND variable not listed
157	! ---------------------------------------------------------------------
158	if (diagfi_def) then
159	getout=.true.
160	do n=1,n_nom_def
161	if(trim(nom_def(n)).eq.nom) getout=.false.
162	end do
163	if (getout) return
164	end if
165
166	! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
167	! ------------------------------------------------------------------------
168	! (at very first call to the subroutine, in accordance with diagfi.def)
169
170	if (firstnom.eq.'1234567890') then ! .true. for the very first valid
171	! call to this subroutine; now set 'firstnom'
172	firstnom = nom
173	! just to be sure, check that firstnom is large enough to hold nom
174	if (len_trim(firstnom).lt.len_trim(nom)) then
175	write(,) "writediagfi: Error !!!"
176	write(,) " firstnom string not long enough!!"
177	write(,) " increase its size to at least ",len_trim(nom)
178	stop
179	endif
180
181	zitau = -1 ! initialize zitau
182
183	#ifdef CPP_PARA
184	! Gather phisfi() geopotential on physics grid
185	call Gather(phisfi,phisfi_glo)
186	#else
187	phisfi_glo(:)=phisfi(:)
188	#endif
189
190	!! parallel: we cannot use the usual writediagfi method
191	!! call iophys_ini
192	if (is_master) then
193	! only the master is required to do this
194
195	! Create the NetCDF file
196	ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
197	! Define the 'Time' dimension
198	ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim)
199	! Define the 'Time' variable
200	!#ifdef NC_DOUBLE
201	! ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid)
202	!#else
203	ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid)
204	!#endif
205	! Add a long_name attribute
206	ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name",
207	. 4,"Time")
208	! Add a units attribute
209	ierr = NF_PUT_ATT_TEXT(nid, varid,'units',29,
210	. "days since 0000-00-0 00:00:00")
211	! Switch out of NetCDF Define mode
212	ierr = NF_ENDDEF(nid)
213
214	! write "header" of file (longitudes, latitudes, geopotential, ...)
215	call gr_fi_dyn(1,size(phisfi_glo),iip1,jjp1,phisfi_glo,phis)
216	call iniwrite(nid,day_ini,phis)
217
218	endif ! of if (is_master)
219
220	else
221
222	if (is_master) then
223	! only the master is required to do this
224
225	! Open the NetCDF file
226	ierr = NF_OPEN(fichnom,NF_WRITE,nid)
227	endif ! of if (is_master)
228
229	endif ! if (firstnom.eq.'1234567890')
230
231	if (ngrid.eq.1) then
232	! in testphys1d, for the 1d version of the GCM, iphysiq and irythme
233	! are undefined; so set them to 1
234	iphysiq=1
235	irythme=1
236	! NB:
237	endif
238
239	! Increment time index 'zitau' if it is the "fist call" (at given time level)
240	! to writediagfi
241	!------------------------------------------------------------------------
242	if (nom.eq.firstnom) then
243	zitau = zitau + iphysiq
244	end if
245
246	!--------------------------------------------------------
247	! Write the variables to output file if it's time to do so
248	!--------------------------------------------------------
249
250	if ( MOD(zitau+1,irythme) .eq.0.) then
251
252	! Compute/write/extend 'Time' coordinate (date given in days)
253	! (done every "first call" (at given time level) to writediagfi)
254	! Note: date is incremented as 1 step ahead of physics time
255	!--------------------------------------------------------
256
257	if (is_master) then
258	! only the master is required to do this
259	if (nom.eq.firstnom) then
260	! We have identified a "first call" (at given date)
261	ntime=ntime+1 ! increment # of stored time steps
262	! compute corresponding date (in days and fractions thereof)
263	date= float (zitau +1)/float (day_step)
264	! Get NetCDF ID of 'Time' variable
265	ierr= NF_INQ_VARID(nid,"Time",varid)
266	! Write (append) the new date to the 'Time' array
267	!#ifdef NC_DOUBLE
268	! ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date)
269	!#else
270	ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date)
271	!#endif
272	if (ierr.ne.NF_NOERR) then
273	write(,) "***** PUT_VAR matter in writediagfi_nc"
274	write(,) "***** with time"
275	write(,) 'ierr=', ierr
276	c call abort
277	endif
278
279	write(6,*)'WRITEDIAGFI: date= ', date
280	end if ! of if (nom.eq.firstnom)
281
282	endif ! of if (is_master)
283
284	!Case of a 3D variable
285	!---------------------
286	if (dim.eq.3) then
287
288	#ifdef CPP_PARA
289	! Gather field on a "global" (without redundant longitude) array
290	call Gather(px,dx3_glop)
291	!$OMP MASTER
292	if (is_mpi_root) then
293	call Grid1Dto2D_glo(dx3_glop,dx3_glo)
294	! copy dx3_glo() to dx3(:) and add redundant longitude
295	dx3(1:iim,:,:)=dx3_glo(1:iim,:,:)
296	dx3(iip1,:,:)=dx3(1,:,:)
297	endif
298	!$OMP END MASTER
299	!$OMP BARRIER
300	#else
301	! Passage variable physique --> variable dynamique
302	! recast (copy) variable from physics grid to dynamics grid
303	DO l=1,llm
304	DO i=1,iip1
305	dx3(i,1,l)=px(1,l)
306	dx3(i,jjp1,l)=px(ngrid,l)
307	ENDDO
308	DO j=2,jjm
309	ig0= 1+(j-2)*iim
310	DO i=1,iim
311	dx3(i,j,l)=px(ig0+i,l)
312	ENDDO
313	dx3(iip1,j,l)=dx3(1,j,l)
314	ENDDO
315	ENDDO
316	#endif
317	! Ecriture du champs
318
319	if (is_master) then
320	! only the master writes to output
321	! name of the variable
322	ierr= NF_INQ_VARID(nid,nom,varid)
323	if (ierr /= NF_NOERR) then
324	! corresponding dimensions
325	ierr= NF_INQ_DIMID(nid,"longitude",id(1))
326	ierr= NF_INQ_DIMID(nid,"latitude",id(2))
327	ierr= NF_INQ_DIMID(nid,"altitude",id(3))
328	ierr= NF_INQ_DIMID(nid,"Time",id(4))
329
330	! Create the variable if it doesn't exist yet
331
332	write (,) "=========================="
333	write (,) "DIAGFI: creating variable ",nom
334	call def_var(nid,nom,titre,unite,4,id,varid,ierr)
335
336	endif
337
338	corner(1)=1
339	corner(2)=1
340	corner(3)=1
341	corner(4)=ntime
342
343	edges(1)=iip1
344	edges(2)=jjp1
345	edges(3)=llm
346	edges(4)=1
347	!#ifdef NC_DOUBLE
348	! ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3)
349	!#else
350	! write(,)"test: nid=",nid," varid=",varid
351	! write(,)" corner()=",corner
352	! write(,)" edges()=",edges
353	! write(,)" dx3()=",dx3
354	ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3)
355	!#endif
356
357	if (ierr.ne.NF_NOERR) then
358	write(,) "***** PUT_VAR problem in writediagfi"
359	write(,) "***** with ",nom
360	write(,) 'ierr=', ierr,": ",NF_STRERROR(ierr)
361	c call abort
362	endif
363
364	endif !of if (is_master)
365
366	!Case of a 2D variable
367	!---------------------
368
369	else if (dim.eq.2) then
370
371	#ifdef CPP_PARA
372	! Gather field on a "global" (without redundant longitude) array
373	px2(:)=px(:,1)
374	call Gather(px2,dx2_glop)
375	!$OMP MASTER
376	if (is_mpi_root) then
377	call Grid1Dto2D_glo(dx2_glop,dx2_glo)
378	! copy dx2_glo() to dx2(:) and add redundant longitude
379	dx2(1:iim,:)=dx2_glo(1:iim,:)
380	dx2(iip1,:)=dx2(1,:)
381	endif
382	!$OMP END MASTER
383	!$OMP BARRIER
384	#else
385
386	! Passage variable physique --> physique dynamique
387	! recast (copy) variable from physics grid to dynamics grid
388
389	DO i=1,iip1
390	dx2(i,1)=px(1,1)
391	dx2(i,jjp1)=px(ngrid,1)
392	ENDDO
393	DO j=2,jjm
394	ig0= 1+(j-2)*iim
395	DO i=1,iim
396	dx2(i,j)=px(ig0+i,1)
397	ENDDO
398	dx2(iip1,j)=dx2(1,j)
399	ENDDO
400	#endif
401
402	if (is_master) then
403	! only the master writes to output
404	! write (,) 'In writediagfi, on sauve: ' , nom
405	! write (,) 'In writediagfi. Estimated date = ' ,date
406	ierr= NF_INQ_VARID(nid,nom,varid)
407	if (ierr /= NF_NOERR) then
408	! corresponding dimensions
409	ierr= NF_INQ_DIMID(nid,"longitude",id(1))
410	ierr= NF_INQ_DIMID(nid,"latitude",id(2))
411	ierr= NF_INQ_DIMID(nid,"Time",id(3))
412
413	! Create the variable if it doesn't exist yet
414
415	write (,) "=========================="
416	write (,) "DIAGFI: creating variable ",nom
417
418	call def_var(nid,nom,titre,unite,3,id,varid,ierr)
419
420	endif
421
422	corner(1)=1
423	corner(2)=1
424	corner(3)=ntime
425	edges(1)=iip1
426	edges(2)=jjp1
427	edges(3)=1
428
429
430	!#ifdef NC_DOUBLE
431	! ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2)
432	!#else
433	ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2)
434	!#endif
435
436	if (ierr.ne.NF_NOERR) then
437	write(,) "***** PUT_VAR matter in writediagfi"
438	write(,) "***** with ",nom
439	write(,) 'ierr=', ierr,": ",NF_STRERROR(ierr)
440	c call abort
441	endif
442
443	endif !of if (is_master)
444
445	!Case of a 1D variable (ie: a column)
446	!---------------------------------------------------
447
448	else if (dim.eq.1) then
449	if (is_parallel) then
450	write(,) "writediagfi error: dim=1 not implemented ",
451	& "in parallel mode"
452	stop
453	endif
454	! Passage variable physique --> physique dynamique
455	! recast (copy) variable from physics grid to dynamics grid
456	do l=1,llm
457	dx1(l)=px(1,l)
458	enddo
459
460	ierr= NF_INQ_VARID(nid,nom,varid)
461	if (ierr /= NF_NOERR) then
462	! corresponding dimensions
463	ierr= NF_INQ_DIMID(nid,"altitude",id(1))
464	ierr= NF_INQ_DIMID(nid,"Time",id(2))
465
466	! Create the variable if it doesn't exist yet
467
468	write (,) "=========================="
469	write (,) "DIAGFI: creating variable ",nom
470
471	call def_var(nid,nom,titre,unite,2,id,varid,ierr)
472
473	endif
474
475	corner(1)=1
476	corner(2)=ntime
477
478	edges(1)=llm
479	edges(2)=1
480	!#ifdef NC_DOUBLE
481	! ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1)
482	!#else
483	ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1)
484	!#endif
485
486	if (ierr.ne.NF_NOERR) then
487	write(,) "***** PUT_VAR problem in writediagfi"
488	write(,) "***** with ",nom
489	write(,) 'ierr=', ierr,": ",NF_STRERROR(ierr)
490	c call abort
491	endif
492
493	!Case of a 0D variable (ie: a time-dependent scalar)
494	!---------------------------------------------------
495
496	else if (dim.eq.0) then
497
498	dx0 = px (1,1)
499
500	if (is_master) then
501	! only the master writes to output
502	ierr= NF_INQ_VARID(nid,nom,varid)
503	if (ierr /= NF_NOERR) then
504	! corresponding dimensions
505	ierr= NF_INQ_DIMID(nid,"Time",id(1))
506
507	! Create the variable if it doesn't exist yet
508
509	write (,) "=========================="
510	write (,) "DIAGFI: creating variable ",nom
511
512	call def_var(nid,nom,titre,unite,1,id,varid,ierr)
513
514	endif
515
516	corner(1)=ntime
517	edges(1)=1
518
519	!#ifdef NC_DOUBLE
520	! ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0)
521	!#else
522	ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0)
523	!#endif
524	if (ierr.ne.NF_NOERR) then
525	write(,) "***** PUT_VAR matter in writediagfi"
526	write(,) "***** with ",nom
527	write(,) 'ierr=', ierr,": ",NF_STRERROR(ierr)
528	c call abort
529	endif
530
531	endif !of if (is_master)
532
533	endif ! of if (dim.eq.3) elseif(dim.eq.2)...
534
535	endif ! of if ( MOD(zitau+1,irythme) .eq.0.)
536
537	if (is_master) then
538	ierr= NF_CLOSE(nid)
539	endif
540
541	#endif
542	end

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

Download in other formats:

Original Format