Context Navigation

iostart.F90 @ 1477

Last change on this file since 1477 was 1315, checked in by milmd, 10 years ago
LMDZ.GENERIC. OpenMP directives added in generic physic. When running in pure OpenMP or hybrid OpenMP/MPI, may have some bugs with condense_cloud and wstats routines.
File size: 34.0 KB

Line
1	MODULE iostart
2
3	IMPLICIT NONE
4	PRIVATE
5	INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
6	INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
7	!$OMP THREADPRIVATE(nid_start,nid_restart)
8
9	! restartfi.nc file dimension identifiers: (see open_restartphy())
10	INTEGER,SAVE :: idim1 ! "index" dimension
11	INTEGER,SAVE :: idim2 ! "physical_points" dimension
12	INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
13	INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
14	INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
15	INTEGER,SAVE :: idim6 ! "nlayer" dimension
16	INTEGER,SAVE :: idim7 ! "Time" dimension
17	INTEGER,SAVE :: idim8 ! "ocean_layers" dimension
18	INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
19	!$OMP THREADPRIVATE(idim1,idim2,idim3,idim4,idim5,idim6,idim7,timeindex)
20	INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
21
22	INTERFACE get_field
23	MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
24	END INTERFACE get_field
25
26	INTERFACE get_var
27	MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
28	END INTERFACE get_var
29
30	INTERFACE put_field
31	MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
32	END INTERFACE put_field
33
34	INTERFACE put_var
35	MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
36	END INTERFACE put_var
37
38	PUBLIC nid_start, length
39	PUBLIC get_field,get_var,put_field,put_var
40	PUBLIC inquire_dimension, inquire_dimension_length
41	PUBLIC inquire_field, inquire_field_ndims
42	PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
43
44	CONTAINS
45
46	SUBROUTINE open_startphy(filename)
47	USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
48	USE mod_phys_lmdz_para, only: is_master, bcast
49	IMPLICIT NONE
50	CHARACTER(LEN=*) :: filename
51	INTEGER :: ierr
52
53	IF (is_master) THEN
54	ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
55	IF (ierr.NE.NF90_NOERR) THEN
56	write(,)'open_startphy: problem opening file '//trim(filename)
57	write(,)trim(nf90_strerror(ierr))
58	CALL ABORT
59	ENDIF
60	ENDIF
61
62	CALL bcast(nid_start) ! tell all procs about nid_start
63
64	END SUBROUTINE open_startphy
65
66	SUBROUTINE close_startphy
67	USE netcdf, only: NF90_CLOSE
68	USE mod_phys_lmdz_para, only: is_master
69	IMPLICIT NONE
70	INTEGER :: ierr
71
72	IF (is_master) THEN
73	ierr = NF90_CLOSE (nid_start)
74	ENDIF
75
76	END SUBROUTINE close_startphy
77
78
79	FUNCTION inquire_field(Field_name)
80	! check if a given field is present in the input file
81	USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
82	USE mod_phys_lmdz_para, only: is_master, bcast
83	IMPLICIT NONE
84	CHARACTER(LEN=*),INTENT(IN) :: Field_name
85	LOGICAL :: inquire_field
86	INTEGER :: varid
87	INTEGER :: ierr
88
89	IF (is_master) THEN
90	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
91	IF (ierr==NF90_NOERR) THEN
92	Inquire_field=.TRUE.
93	ELSE
94	Inquire_field=.FALSE.
95	ENDIF
96	ENDIF
97
98	CALL bcast(inquire_field)
99
100	END FUNCTION inquire_field
101
102
103	FUNCTION inquire_field_ndims(Field_name)
104	! give the number of dimensions of "Field_name" stored in the input file
105	USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
106	NF90_NOERR, nf90_strerror
107	USE mod_phys_lmdz_para, only: is_master, bcast
108	IMPLICIT NONE
109	CHARACTER(LEN=*),INTENT(IN) :: Field_name
110	INTEGER :: inquire_field_ndims
111	INTEGER :: varid
112	INTEGER :: ierr
113
114	IF (is_master) THEN
115	ierr=nf90_inq_varid(nid_start,Field_name,varid)
116	ierr=nf90_inquire_variable(nid_start,varid,&
117	ndims=inquire_field_ndims)
118	IF (ierr.NE.NF90_NOERR) THEN
119	write(,)'inquire_field_ndims: problem obtaining ndims of '&
120	//trim(field_name)
121	write(,)trim(nf90_strerror(ierr))
122	CALL ABORT
123	ENDIF
124	ENDIF
125
126	CALL bcast(inquire_field_ndims)
127
128	END FUNCTION inquire_field_ndims
129
130
131	FUNCTION inquire_dimension(Field_name)
132	! check if a given dimension is present in the input file
133	USE netcdf, only: nf90_inq_dimid, NF90_NOERR
134	USE mod_phys_lmdz_para, only: is_master, bcast
135	IMPLICIT NONE
136	CHARACTER(LEN=*),INTENT(IN) :: Field_name
137	LOGICAL :: inquire_dimension
138	INTEGER :: varid
139	INTEGER :: ierr
140
141	IF (is_master) THEN
142	ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
143	IF (ierr==NF90_NOERR) THEN
144	Inquire_dimension=.TRUE.
145	ELSE
146	Inquire_dimension=.FALSE.
147	ENDIF
148	ENDIF
149
150	CALL bcast(inquire_dimension)
151
152	END FUNCTION inquire_dimension
153
154	FUNCTION inquire_dimension_length(Field_name)
155	! give the length of the "Field_name" dimension stored in the input file
156	USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
157	NF90_NOERR, nf90_strerror
158	USE mod_phys_lmdz_para, only: is_master, bcast
159	IMPLICIT NONE
160	CHARACTER(LEN=*),INTENT(IN) :: Field_name
161	INTEGER :: inquire_dimension_length
162	INTEGER :: varid
163	INTEGER :: ierr
164
165	IF (is_master) THEN
166	ierr=nf90_inq_dimid(nid_start,Field_name,varid)
167	ierr=nf90_inquire_dimension(nid_start,varid,&
168	len=inquire_dimension_length)
169	IF (ierr.NE.NF90_NOERR) THEN
170	write(,)'inquire_field_length: problem obtaining length of '&
171	//trim(field_name)
172	write(,)trim(nf90_strerror(ierr))
173	CALL ABORT
174	ENDIF
175	ENDIF
176
177	CALL bcast(inquire_dimension_length)
178
179	END FUNCTION inquire_dimension_length
180
181
182
183	SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
184	! For a surface field
185	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
186	IMPLICIT NONE
187	CHARACTER(LEN=*),INTENT(IN) :: Field_name
188	REAL,INTENT(INOUT) :: Field(:)
189	LOGICAL,INTENT(OUT),OPTIONAL :: found
190	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
191
192	integer :: edges(4), corners(4)
193
194	edges(1)=klon_glo
195	edges(2:4)=1
196	corners(1:4)=1
197	if (PRESENT(timeindex)) then
198	corners(2)=timeindex
199	endif
200
201	IF (PRESENT(found)) THEN
202	CALL Get_field_rgen(field_name,field,1,corners,edges,found)
203	ELSE
204	CALL Get_field_rgen(field_name,field,1,corners,edges)
205	ENDIF
206
207	END SUBROUTINE Get_Field_r1
208
209	SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
210	! For a "3D" horizontal-vertical field
211	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
212	IMPLICIT NONE
213	CHARACTER(LEN=*),INTENT(IN) :: Field_name
214	REAL,INTENT(INOUT) :: Field(:,:)
215	LOGICAL,INTENT(OUT),OPTIONAL :: found
216	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
217
218	integer :: edges(4), corners(4)
219
220	edges(1)=klon_glo
221	edges(2)=size(field,2)
222	edges(3:4)=1
223	corners(1:4)=1
224	if (PRESENT(timeindex)) then
225	corners(3)=timeindex
226	endif
227
228	IF (PRESENT(found)) THEN
229	CALL Get_field_rgen(field_name,field,size(field,2),&
230	corners,edges,found)
231	ELSE
232	CALL Get_field_rgen(field_name,field,size(field,2),&
233	corners,edges)
234	ENDIF
235
236
237	END SUBROUTINE Get_Field_r2
238
239	SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
240	! for a "4D" field surf/alt/??
241	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
242	IMPLICIT NONE
243	CHARACTER(LEN=*),INTENT(IN) :: Field_name
244	REAL,INTENT(INOUT) :: Field(:,:,:)
245	LOGICAL,INTENT(OUT),OPTIONAL :: found
246	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
247
248	integer :: edges(4), corners(4)
249
250	edges(1)=klon_glo
251	edges(2)=size(field,2)
252	edges(3)=size(field,3)
253	edges(4)=1
254	corners(1:4)=1
255	if (PRESENT(timeindex)) then
256	corners(4)=timeindex
257	endif
258
259	IF (PRESENT(found)) THEN
260	CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
261	corners,edges,found)
262	ELSE
263	CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
264	corners,edges)
265	ENDIF
266
267	END SUBROUTINE Get_Field_r3
268
269	SUBROUTINE Get_field_rgen(field_name,field,field_size, &
270	corners,edges,found)
271	USE netcdf
272	USE dimphy
273	USE mod_grid_phy_lmdz
274	USE mod_phys_lmdz_para
275	IMPLICIT NONE
276	CHARACTER(LEN=*) :: Field_name
277	INTEGER :: field_size
278	REAL :: field(klon,field_size)
279	INTEGER,INTENT(IN) :: corners(4)
280	INTEGER,INTENT(IN) :: edges(4)
281	LOGICAL,OPTIONAL :: found
282
283	REAL :: field_glo(klon_glo,field_size)
284	LOGICAL :: tmp_found
285	INTEGER :: varid
286	INTEGER :: ierr
287
288	IF (is_master) THEN
289
290	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
291
292	IF (ierr==NF90_NOERR) THEN
293	CALL body(field_glo)
294	tmp_found=.TRUE.
295	ELSE
296	tmp_found=.FALSE.
297	ENDIF
298
299	ENDIF
300
301	CALL bcast(tmp_found)
302
303	IF (tmp_found) THEN
304	CALL scatter(field_glo,field)
305	ENDIF
306
307	IF (PRESENT(found)) THEN
308	found=tmp_found
309	ELSE
310	IF (.NOT. tmp_found) THEN
311	PRINT*, 'get_field_rgen: Field <'//field_name//'> not found'
312	CALL abort
313	ENDIF
314	ENDIF
315
316
317	CONTAINS
318
319	SUBROUTINE body(field_glo)
320	REAL :: field_glo(klon_glo*field_size)
321	ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
322	IF (ierr/=NF90_NOERR) THEN
323	! La variable exist dans le fichier mais la lecture a echouee.
324	PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
325
326	! IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
327	! ! Essaye de lire le variable sur surface uniqument, comme fait avant
328	! field_glo(:)=0.
329	! ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
330	! IF (ierr/=NF90_NOERR) THEN
331	! PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
332	! CALL abort
333	! ELSE
334	! PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
335	! END IF
336	! ELSE
337	CALL abort
338	! ENDIF
339	ENDIF
340
341	END SUBROUTINE body
342
343	END SUBROUTINE Get_field_rgen
344
345
346	SUBROUTINE get_var_r0(var_name,var,found)
347	! Get a scalar from input file
348	IMPLICIT NONE
349	CHARACTER(LEN=*),INTENT(IN) :: var_name
350	REAL,INTENT(INOUT) :: var
351	LOGICAL,OPTIONAL,INTENT(OUT) :: found
352
353	REAL :: varout(1)
354
355	IF (PRESENT(found)) THEN
356	CALL Get_var_rgen(var_name,varout,size(varout),found)
357	ELSE
358	CALL Get_var_rgen(var_name,varout,size(varout))
359	ENDIF
360	var=varout(1)
361
362	END SUBROUTINE get_var_r0
363
364	SUBROUTINE get_var_r1(var_name,var,found)
365	! Get a vector from input file
366	IMPLICIT NONE
367	CHARACTER(LEN=*),INTENT(IN) :: var_name
368	REAL,INTENT(INOUT) :: var(:)
369	LOGICAL,OPTIONAL,INTENT(OUT) :: found
370
371	IF (PRESENT(found)) THEN
372	CALL Get_var_rgen(var_name,var,size(var),found)
373	ELSE
374	CALL Get_var_rgen(var_name,var,size(var))
375	ENDIF
376
377	END SUBROUTINE get_var_r1
378
379	SUBROUTINE get_var_r2(var_name,var,found)
380	! Get a 2D field from input file
381	IMPLICIT NONE
382	CHARACTER(LEN=*),INTENT(IN) :: var_name
383	REAL,INTENT(OUT) :: var(:,:)
384	LOGICAL,OPTIONAL,INTENT(OUT) :: found
385
386	IF (PRESENT(found)) THEN
387	CALL Get_var_rgen(var_name,var,size(var),found)
388	ELSE
389	CALL Get_var_rgen(var_name,var,size(var))
390	ENDIF
391
392	END SUBROUTINE get_var_r2
393
394	SUBROUTINE get_var_r3(var_name,var,found)
395	! Get a 3D field frominput file
396	IMPLICIT NONE
397	CHARACTER(LEN=*),INTENT(IN) :: var_name
398	REAL,INTENT(INOUT) :: var(:,:,:)
399	LOGICAL,OPTIONAL,INTENT(OUT) :: found
400
401	IF (PRESENT(found)) THEN
402	CALL Get_var_rgen(var_name,var,size(var),found)
403	ELSE
404	CALL Get_var_rgen(var_name,var,size(var))
405	ENDIF
406
407	END SUBROUTINE get_var_r3
408
409	SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
410	USE netcdf
411	USE dimphy
412	USE mod_grid_phy_lmdz
413	USE mod_phys_lmdz_para
414	IMPLICIT NONE
415	CHARACTER(LEN=*) :: var_name
416	INTEGER :: var_size
417	REAL :: var(var_size)
418	LOGICAL,OPTIONAL :: found
419
420	LOGICAL :: tmp_found
421	INTEGER :: varid
422	INTEGER :: ierr
423
424	IF (is_mpi_root .AND. is_omp_root) THEN
425
426	ierr=NF90_INQ_VARID(nid_start,var_name,varid)
427
428	IF (ierr==NF90_NOERR) THEN
429	ierr=NF90_GET_VAR(nid_start,varid,var)
430	IF (ierr/=NF90_NOERR) THEN
431	PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>'
432	CALL abort
433	ENDIF
434	tmp_found=.TRUE.
435	ELSE
436	tmp_found=.FALSE.
437	ENDIF
438
439	ENDIF
440
441	CALL bcast(tmp_found)
442
443	IF (tmp_found) THEN
444	CALL bcast(var)
445	ENDIF
446
447	IF (PRESENT(found)) THEN
448	found=tmp_found
449	ELSE
450	IF (.NOT. tmp_found) THEN
451	PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found'
452	CALL abort
453	ENDIF
454	ENDIF
455
456	END SUBROUTINE Get_var_rgen
457
458	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
459
460	SUBROUTINE open_restartphy(filename)
461	USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
462	NF90_NOERR, nf90_strerror, &
463	NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
464	NF90_UNLIMITED, NF90_ENDDEF, &
465	NF90_WRITE, NF90_OPEN
466	USE mod_phys_lmdz_para, only: is_master
467	USE mod_grid_phy_lmdz, only: klon_glo
468	USE dimphy, only: klev, klevp1
469	USE infotrac, only: nqtot
470	USE comsoil_h, only: nsoilmx
471	USE slab_ice_h, only: noceanmx
472
473	IMPLICIT NONE
474	CHARACTER(LEN=*),INTENT(IN) :: filename
475	INTEGER :: ierr
476	LOGICAL,SAVE :: already_created=.false.
477	!$OMP THREADPRIVATE(already_created)
478
479	IF (is_master) THEN
480	if (.not.already_created) then
481	! At the very first call, create the file
482	ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
483	nid_restart)
484	IF (ierr/=NF90_NOERR) THEN
485	write(,)'open_restartphy: problem creating file '//trim(filename)
486	write(,)trim(nf90_strerror(ierr))
487	CALL ABORT
488	ENDIF
489	already_created=.true.
490	else
491	! Just open the file
492	ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
493	IF (ierr/=NF90_NOERR) THEN
494	write(,)'open_restartphy: problem opening file '//trim(filename)
495	write(,)trim(nf90_strerror(ierr))
496	CALL ABORT
497	ENDIF
498	return
499	endif ! of if (.not.already_created)
500
501	ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
502	"Physics start file")
503	IF (ierr/=NF90_NOERR) THEN
504	write(,)'open_restartphy: problem writing title '
505	write(,)trim(nf90_strerror(ierr))
506	ENDIF
507
508	ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
509	IF (ierr/=NF90_NOERR) THEN
510	write(,)'open_restartphy: problem defining index dimension '
511	write(,)trim(nf90_strerror(ierr))
512	CALL ABORT
513	ENDIF
514
515	ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
516	IF (ierr/=NF90_NOERR) THEN
517	write(,)'open_restartphy: problem defining physical_points dimension '
518	write(,)trim(nf90_strerror(ierr))
519	CALL ABORT
520	ENDIF
521
522	ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
523	IF (ierr/=NF90_NOERR) THEN
524	write(,)'open_restartphy: problem defining subsurface_layers dimension '
525	write(,)trim(nf90_strerror(ierr))
526	CALL ABORT
527	ENDIF
528
529	ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
530	IF (ierr/=NF90_NOERR) THEN
531	write(,)'open_restartphy: problem defining nlayer_plus_1 dimension '
532	write(,)trim(nf90_strerror(ierr))
533	CALL ABORT
534	ENDIF
535
536	if (nqtot>0) then
537	! only define a tracer dimension if there are tracers
538	ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqtot,idim5)
539	IF (ierr/=NF90_NOERR) THEN
540	write(,)'open_restartphy: problem defining number_of_advected_fields dimension '
541	write(,)trim(nf90_strerror(ierr))
542	CALL ABORT
543	ENDIF
544	endif
545
546	ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
547	IF (ierr/=NF90_NOERR) THEN
548	write(,)'open_restartphy: problem defining nlayer dimension '
549	write(,)trim(nf90_strerror(ierr))
550	CALL ABORT
551	ENDIF
552
553	ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
554	IF (ierr/=NF90_NOERR) THEN
555	write(,)'open_restartphy: problem defining Time dimension '
556	write(,)trim(nf90_strerror(ierr))
557	CALL ABORT
558	ENDIF
559
560	ierr=NF90_DEF_DIM(nid_restart,"ocean_layers",noceanmx,idim8)
561	IF (ierr/=NF90_NOERR) THEN
562	write(,)'open_restartphy: problem defining oceanic layer dimension '
563	write(,)trim(nf90_strerror(ierr))
564	CALL ABORT
565	ENDIF
566
567
568	ierr=NF90_ENDDEF(nid_restart)
569	IF (ierr/=NF90_NOERR) THEN
570	write(,)'open_restartphy: problem ending definition mode '
571	write(,)trim(nf90_strerror(ierr))
572	CALL ABORT
573	ENDIF
574	ENDIF
575
576	END SUBROUTINE open_restartphy
577
578	SUBROUTINE close_restartphy
579	USE netcdf, only: NF90_CLOSE
580	USE mod_phys_lmdz_para, only: is_master
581	IMPLICIT NONE
582	INTEGER :: ierr
583
584	IF (is_master) THEN
585	ierr = NF90_CLOSE (nid_restart)
586	ENDIF
587
588	END SUBROUTINE close_restartphy
589
590	SUBROUTINE put_field_r1(field_name,title,field,time)
591	! For a surface field
592	IMPLICIT NONE
593	CHARACTER(LEN=*),INTENT(IN) :: field_name
594	CHARACTER(LEN=*),INTENT(IN) :: title
595	REAL,INTENT(IN) :: field(:)
596	REAL,OPTIONAL,INTENT(IN) :: time
597
598	IF (present(time)) THEN
599	! if timeindex is present, it is a time-dependent variable
600	CALL put_field_rgen(field_name,title,field,1,time)
601	ELSE
602	CALL put_field_rgen(field_name,title,field,1)
603	ENDIF
604
605	END SUBROUTINE put_field_r1
606
607	SUBROUTINE put_field_r2(field_name,title,field,time)
608	! For a "3D" horizontal-vertical field
609	IMPLICIT NONE
610	CHARACTER(LEN=*),INTENT(IN) :: field_name
611	CHARACTER(LEN=*),INTENT(IN) :: title
612	REAL,INTENT(IN) :: field(:,:)
613	REAL,OPTIONAL,INTENT(IN) :: time
614
615	IF (present(time)) THEN
616	! if timeindex is present, it is a time-dependent variable
617	CALL put_field_rgen(field_name,title,field,size(field,2),time)
618	ELSE
619	CALL put_field_rgen(field_name,title,field,size(field,2))
620	ENDIF
621
622	END SUBROUTINE put_field_r2
623
624	SUBROUTINE put_field_r3(field_name,title,field,time)
625	! For a "4D" field surf/alt/??
626	IMPLICIT NONE
627	CHARACTER(LEN=*),INTENT(IN) :: field_name
628	CHARACTER(LEN=*),INTENT(IN) :: title
629	REAL,INTENT(IN) :: field(:,:,:)
630	REAL,OPTIONAL,INTENT(IN) :: time
631
632	IF (present(time)) THEN
633	! if timeindex is present, it is a time-dependent variable
634	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
635	time)
636	ELSE
637	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
638	ENDIF
639
640	END SUBROUTINE put_field_r3
641
642	SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
643	USE netcdf
644	USE dimphy
645	USE comsoil_h, only: nsoilmx
646	USE mod_grid_phy_lmdz
647	USE mod_phys_lmdz_para
648	USE slab_ice_h, only: noceanmx
649	IMPLICIT NONE
650	CHARACTER(LEN=*),INTENT(IN) :: field_name
651	CHARACTER(LEN=*),INTENT(IN) :: title
652	INTEGER,INTENT(IN) :: field_size
653	REAL,INTENT(IN) :: field(klon,field_size)
654	REAL,OPTIONAL,INTENT(IN) :: time
655
656	REAL :: field_glo(klon_glo,field_size)
657	INTEGER :: ierr
658	INTEGER :: nvarid
659	INTEGER :: idim
660
661	CALL gather(field,field_glo)
662
663	IF (is_master) THEN
664
665	IF (field_size==1) THEN
666	! input is a 1D "surface field" array
667	if (.not.present(time)) then ! for a time-independent field
668	ierr=NF90_REDEF(nid_restart)
669	#ifdef NC_DOUBLE
670	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
671	(/idim2/),nvarid)
672	#else
673	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
674	(/idim2/),nvarid)
675	#endif
676	if (ierr.ne.NF90_NOERR) then
677	write(,)"put_field_rgen error: failed to define "//trim(field_name)
678	write(,)trim(nf90_strerror(ierr))
679	endif
680	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
681	ierr=NF90_ENDDEF(nid_restart)
682	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
683	else
684	! check if the variable has already been defined:
685	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
686	if (ierr/=NF90_NOERR) then ! variable not found, define it
687	ierr=NF90_REDEF(nid_restart)
688	#ifdef NC_DOUBLE
689	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
690	(/idim2,idim7/),nvarid)
691	#else
692	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
693	(/idim2,idim7/),nvarid)
694	#endif
695	if (ierr.ne.NF90_NOERR) then
696	write(,)"put_field_rgen error: failed to define "//trim(field_name)
697	write(,)trim(nf90_strerror(ierr))
698	endif
699	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
700	ierr=NF90_ENDDEF(nid_restart)
701	endif
702	! Write the variable
703	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
704	start=(/1,timeindex/))
705	endif ! of if (.not.present(timeindex))
706
707	ELSE IF (field_size==klev) THEN
708	! input is a 2D "atmospheric field" array
709	if (.not.present(time)) then ! for a time-independent field
710	ierr=NF90_REDEF(nid_restart)
711	#ifdef NC_DOUBLE
712	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
713	(/idim2,idim6/),nvarid)
714	#else
715	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
716	(/idim2,idim6/),nvarid)
717	#endif
718	if (ierr.ne.NF90_NOERR) then
719	write(,)"put_field_rgen error: failed to define "//trim(field_name)
720	write(,)trim(nf90_strerror(ierr))
721	endif
722	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
723	ierr=NF90_ENDDEF(nid_restart)
724	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
725	else
726	! check if the variable has already been defined:
727	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
728	if (ierr/=NF90_NOERR) then ! variable not found, define it
729	ierr=NF90_REDEF(nid_restart)
730	#ifdef NC_DOUBLE
731	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
732	(/idim2,idim6,idim7/),nvarid)
733	#else
734	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
735	(/idim2,idim6,idim7/),nvarid)
736	#endif
737	if (ierr.ne.NF90_NOERR) then
738	write(,)"put_field_rgen error: failed to define "//trim(field_name)
739	write(,)trim(nf90_strerror(ierr))
740	endif
741	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
742	ierr=NF90_ENDDEF(nid_restart)
743	endif
744	! Write the variable
745	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
746	start=(/1,1,timeindex/))
747	endif ! of if (.not.present(time))
748
749	ELSE IF (field_size==klevp1) THEN
750	! input is a 2D "interlayer atmospheric field" array
751	if (.not.present(time)) then ! for a time-independent field
752	ierr=NF90_REDEF(nid_restart)
753	#ifdef NC_DOUBLE
754	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
755	(/idim2,idim4/),nvarid)
756	#else
757	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
758	(/idim2,idim4/),nvarid)
759	#endif
760	if (ierr.ne.NF90_NOERR) then
761	write(,)"put_field_rgen error: failed to define "//trim(field_name)
762	write(,)trim(nf90_strerror(ierr))
763	endif
764	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
765	ierr = NF90_ENDDEF(nid_restart)
766	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
767	else
768	! check if the variable has already been defined:
769	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
770	if (ierr/=NF90_NOERR) then ! variable not found, define it
771	ierr=NF90_REDEF(nid_restart)
772	#ifdef NC_DOUBLE
773	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
774	(/idim2,idim4,idim7/),nvarid)
775	#else
776	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
777	(/idim2,idim4,idim7/),nvarid)
778	#endif
779	if (ierr.ne.NF90_NOERR) then
780	write(,)"put_field_rgen error: failed to define "//trim(field_name)
781	write(,)trim(nf90_strerror(ierr))
782	endif
783	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
784	ierr=NF90_ENDDEF(nid_restart)
785	endif
786	! Write the variable
787	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
788	start=(/1,1,timeindex/))
789	endif ! of if (.not.present(timeindex))
790
791	ELSE IF (field_size==nsoilmx) THEN
792	! input is a 2D "subsurface field" array
793	if (.not.present(time)) then ! for a time-independent field
794	ierr = NF90_REDEF(nid_restart)
795	#ifdef NC_DOUBLE
796	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
797	(/idim2,idim3/),nvarid)
798	#else
799	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
800	(/idim2,idim3/),nvarid)
801	#endif
802	if (ierr.ne.NF90_NOERR) then
803	write(,)"put_field_rgen error: failed to define "//trim(field_name)
804	write(,)trim(nf90_strerror(ierr))
805	endif
806	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
807	ierr = NF90_ENDDEF(nid_restart)
808	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
809	else
810	! check if the variable has already been defined:
811	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
812	if (ierr/=NF90_NOERR) then ! variable not found, define it
813	ierr=NF90_REDEF(nid_restart)
814	#ifdef NC_DOUBLE
815	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
816	(/idim2,idim3,idim7/),nvarid)
817	#else
818	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
819	(/idim2,idim3,idim7/),nvarid)
820	#endif
821	if (ierr.ne.NF90_NOERR) then
822	write(,)"put_field_rgen error: failed to define "//trim(field_name)
823	write(,)trim(nf90_strerror(ierr))
824	endif
825	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
826	ierr=NF90_ENDDEF(nid_restart)
827	endif
828	! Write the variable
829	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
830	start=(/1,1,timeindex/))
831
832	endif ! of if (.not.present(time))
833
834	ELSE IF (field_size==noceanmx) THEN
835	! input is a 2D "oceanic field" array
836	if (.not.present(time)) then ! for a time-independent field
837	ierr = NF90_REDEF(nid_restart)
838	#ifdef NC_DOUBLE
839	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
840	(/idim2,idim8/),nvarid)
841	#else
842	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
843	(/idim2,idim8/),nvarid)
844	#endif
845	if (ierr.ne.NF90_NOERR) then
846	write(,)"put_field_rgen error: failed to define "//trim(field_name)
847	write(,)trim(nf90_strerror(ierr))
848	endif
849	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
850	ierr = NF90_ENDDEF(nid_restart)
851	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
852	else
853	! check if the variable has already been defined:
854	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
855	if (ierr/=NF90_NOERR) then ! variable not found, define it
856	ierr=NF90_REDEF(nid_restart)
857	#ifdef NC_DOUBLE
858	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
859	(/idim2,idim8,idim7/),nvarid)
860	#else
861	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
862	(/idim2,idim8,idim7/),nvarid)
863	#endif
864	if (ierr.ne.NF90_NOERR) then
865	write(,)"put_field_rgen error: failed to define "//trim(field_name)
866	write(,)trim(nf90_strerror(ierr))
867	endif
868	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
869	ierr=NF90_ENDDEF(nid_restart)
870	endif
871	! Write the variable
872	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
873	start=(/1,1,timeindex/))
874
875	endif ! of if (.not.present(time))
876
877
878	ELSE
879	PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
880	write(,) " field_size =",field_size
881	CALL ABORT
882	ENDIF
883
884	! Check the writting of field to file went OK
885	if (ierr.ne.NF90_NOERR) then
886	write(,) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
887	write(,)trim(nf90_strerror(ierr))
888	call abort
889	endif
890
891	ENDIF ! of IF (is_master)
892
893	END SUBROUTINE put_field_rgen
894
895	SUBROUTINE put_var_r0(var_name,title,var)
896	! Put a scalar in file
897	IMPLICIT NONE
898	CHARACTER(LEN=*),INTENT(IN) :: var_name
899	CHARACTER(LEN=*),INTENT(IN) :: title
900	REAL,INTENT(IN) :: var
901	REAL :: varin(1)
902
903	varin(1)=var
904
905	CALL put_var_rgen(var_name,title,varin,size(varin))
906
907	END SUBROUTINE put_var_r0
908
909
910	SUBROUTINE put_var_r1(var_name,title,var)
911	! Put a vector in file
912	IMPLICIT NONE
913	CHARACTER(LEN=*),INTENT(IN) :: var_name
914	CHARACTER(LEN=*),INTENT(IN) :: title
915	REAL,INTENT(IN) :: var(:)
916
917	CALL put_var_rgen(var_name,title,var,size(var))
918
919	END SUBROUTINE put_var_r1
920
921	SUBROUTINE put_var_r2(var_name,title,var)
922	! Put a 2D field in file
923	IMPLICIT NONE
924	CHARACTER(LEN=*),INTENT(IN) :: var_name
925	CHARACTER(LEN=*),INTENT(IN) :: title
926	REAL,INTENT(IN) :: var(:,:)
927
928	CALL put_var_rgen(var_name,title,var,size(var))
929
930	END SUBROUTINE put_var_r2
931
932	SUBROUTINE put_var_r3(var_name,title,var)
933	! Put a 3D field in file
934	IMPLICIT NONE
935	CHARACTER(LEN=*),INTENT(IN) :: var_name
936	CHARACTER(LEN=*),INTENT(IN) :: title
937	REAL,INTENT(IN) :: var(:,:,:)
938
939	CALL put_var_rgen(var_name,title,var,size(var))
940
941	END SUBROUTINE put_var_r3
942
943	SUBROUTINE put_var_rgen(var_name,title,var,var_size)
944	USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
945	NF90_FLOAT, NF90_DOUBLE, &
946	NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
947	nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
948	USE comsoil_h, only: nsoilmx
949	USE mod_phys_lmdz_para, only: is_master
950	USE slab_ice_h, only: noceanmx
951	IMPLICIT NONE
952	CHARACTER(LEN=*),INTENT(IN) :: var_name
953	CHARACTER(LEN=*),INTENT(IN) :: title
954	INTEGER,INTENT(IN) :: var_size
955	REAL,INTENT(IN) :: var(var_size)
956
957	INTEGER :: ierr
958	INTEGER :: nvarid
959	INTEGER :: idim1d
960	logical,save :: firsttime=.true.
961	!$OMP THREADPRIVATE(firsttime)
962
963	IF (is_master) THEN
964
965	IF (var_name=="Time") THEN
966	! Very specific case of "Time" variable
967	if (firsttime) then
968	! Create the "Time variable"
969	ierr=NF90_REDEF(nid_restart)
970	#ifdef NC_DOUBLE
971	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
972	(/idim7/),nvarid)
973	#else
974	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
975	(/idim7/),nvarid)
976	#endif
977	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
978	ierr=NF90_ENDDEF(nid_restart)
979
980	firsttime=.false.
981	endif
982	! Append "time" value
983	! get current length of "Time" dimension
984	ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
985	ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
986	timeindex=timeindex+1
987	ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
988	ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
989	start=(/timeindex/))
990	IF (ierr/=NF90_NOERR) THEN
991	write(,)'put_var_rgen: problem writing Time'
992	write(,)trim(nf90_strerror(ierr))
993	CALL ABORT
994	ENDIF
995	return ! nothing left to do
996	ELSEIF (var_size==length) THEN
997	! We know it is a "controle" kind of 1D array
998	idim1d=idim1
999	ELSEIF (var_size==nsoilmx) THEN
1000	! We know it is an "mlayer" kind of 1D array
1001	idim1d=idim3
1002	ELSEIF (var_size==noceanmx) THEN
1003	! We know it is an "mlayer" kind of 1D array
1004	idim1d=idim8
1005	ELSE
1006	PRINT *, "put_var_rgen error : wrong dimension"
1007	write(,) " var_size =",var_size
1008	CALL abort
1009
1010	ENDIF ! of IF (var_size==length) THEN
1011
1012	! Swich to NetCDF define mode
1013	ierr=NF90_REDEF (nid_restart)
1014	! Define the variable
1015	#ifdef NC_DOUBLE
1016	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
1017	#else
1018	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
1019	#endif
1020	! Add a "title" attribute
1021	IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
1022	! Swich out of define mode
1023	ierr=NF90_ENDDEF(nid_restart)
1024	! Write variable to file
1025	ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
1026	IF (ierr/=NF90_NOERR) THEN
1027	write(,)'put_var_rgen: problem writing '//trim(var_name)
1028	write(,)trim(nf90_strerror(ierr))
1029	CALL ABORT
1030	ENDIF
1031	ENDIF ! of IF (is_master)
1032
1033	END SUBROUTINE put_var_rgen
1034
1035	END MODULE iostart

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

Download in other formats:

Original Format