Context Navigation

iostart.F90 @ 3397

Last change on this file since 3397 was 3311, checked in by yjaziri, 20 months ago

Generic PCM:

Split open_startphy to create_restartphy and only open_startphy
will before open_startphy was doing both by create_restartphy
at firstcall

File size: 34.1 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,create_restartphy,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 create_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	USE mod_phys_lmdz_para, only: is_master
466	USE mod_grid_phy_lmdz, only: klon_glo
467	USE dimphy, only: klev, klevp1
468	USE tracer_h, only: nqtot
469	USE comsoil_h, only: nsoilmx
470	! USE slab_ice_h, only: noceanmx
471	USE ocean_slab_mod, ONLY: nslay
472
473	IMPLICIT NONE
474	CHARACTER(LEN=*),INTENT(IN) :: filename
475	INTEGER :: ierr
476
477	IF (is_master) THEN
478
479	ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
480	nid_restart)
481	IF (ierr/=NF90_NOERR) THEN
482	write(,)'open_restartphy: problem creating file '//trim(filename)
483	write(,)trim(nf90_strerror(ierr))
484	CALL ABORT
485	ENDIF
486
487	ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
488	"Physics start file")
489	IF (ierr/=NF90_NOERR) THEN
490	write(,)'open_restartphy: problem writing title '
491	write(,)trim(nf90_strerror(ierr))
492	ENDIF
493
494	ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
495	IF (ierr/=NF90_NOERR) THEN
496	write(,)'open_restartphy: problem defining index dimension '
497	write(,)trim(nf90_strerror(ierr))
498	CALL ABORT
499	ENDIF
500
501	ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
502	IF (ierr/=NF90_NOERR) THEN
503	write(,)'open_restartphy: problem defining physical_points dimension '
504	write(,)trim(nf90_strerror(ierr))
505	CALL ABORT
506	ENDIF
507
508	ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
509	IF (ierr/=NF90_NOERR) THEN
510	write(,)'open_restartphy: problem defining subsurface_layers dimension '
511	write(,)trim(nf90_strerror(ierr))
512	CALL ABORT
513	ENDIF
514
515	ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
516	IF (ierr/=NF90_NOERR) THEN
517	write(,)'open_restartphy: problem defining nlayer_plus_1 dimension '
518	write(,)trim(nf90_strerror(ierr))
519	CALL ABORT
520	ENDIF
521
522	if (nqtot>0) then
523	! only define a tracer dimension if there are tracers
524	ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqtot,idim5)
525	IF (ierr/=NF90_NOERR) THEN
526	write(,)'open_restartphy: problem defining number_of_advected_fields dimension '
527	write(,)trim(nf90_strerror(ierr))
528	CALL ABORT
529	ENDIF
530	endif
531
532	ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
533	IF (ierr/=NF90_NOERR) THEN
534	write(,)'open_restartphy: problem defining nlayer dimension '
535	write(,)trim(nf90_strerror(ierr))
536	CALL ABORT
537	ENDIF
538
539	ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
540	IF (ierr/=NF90_NOERR) THEN
541	write(,)'open_restartphy: problem defining Time dimension '
542	write(,)trim(nf90_strerror(ierr))
543	CALL ABORT
544	ENDIF
545
546	ierr=NF90_DEF_DIM(nid_restart,"ocean_layers",nslay,idim8)
547	IF (ierr/=NF90_NOERR) THEN
548	write(,)'open_restartphy: problem defining oceanic layer dimension '
549	write(,)trim(nf90_strerror(ierr))
550	CALL ABORT
551	ENDIF
552
553
554	ierr=NF90_ENDDEF(nid_restart)
555	IF (ierr/=NF90_NOERR) THEN
556	write(,)'open_restartphy: problem ending definition mode '
557	write(,)trim(nf90_strerror(ierr))
558	CALL ABORT
559	ENDIF
560	ENDIF
561
562	END SUBROUTINE create_restartphy
563
564	SUBROUTINE open_restartphy(filename)
565	USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_WRITE, nf90_strerror
566	USE mod_phys_lmdz_para, only: is_master
567
568	IMPLICIT NONE
569	CHARACTER(LEN=*),INTENT(IN) :: filename
570	INTEGER :: ierr
571
572	IF (is_master) THEN
573	ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
574	IF (ierr/=NF90_NOERR) THEN
575	write(,)'open_restartphy: problem opening file '//trim(filename)
576	write(,)trim(nf90_strerror(ierr))
577	CALL ABORT
578	ENDIF
579	ENDIF
580
581	END SUBROUTINE open_restartphy
582
583	SUBROUTINE close_restartphy
584	USE netcdf, only: NF90_CLOSE
585	USE mod_phys_lmdz_para, only: is_master
586	IMPLICIT NONE
587	INTEGER :: ierr
588
589	IF (is_master) THEN
590	ierr = NF90_CLOSE (nid_restart)
591	ENDIF
592
593	END SUBROUTINE close_restartphy
594
595	SUBROUTINE put_field_r1(field_name,title,field,time)
596	! For a surface field
597	IMPLICIT NONE
598	CHARACTER(LEN=*),INTENT(IN) :: field_name
599	CHARACTER(LEN=*),INTENT(IN) :: title
600	REAL,INTENT(IN) :: field(:)
601	REAL,OPTIONAL,INTENT(IN) :: time
602
603	IF (present(time)) THEN
604	! if timeindex is present, it is a time-dependent variable
605	CALL put_field_rgen(field_name,title,field,1,time)
606	ELSE
607	CALL put_field_rgen(field_name,title,field,1)
608	ENDIF
609
610	END SUBROUTINE put_field_r1
611
612	SUBROUTINE put_field_r2(field_name,title,field,time)
613	! For a "3D" horizontal-vertical field
614	IMPLICIT NONE
615	CHARACTER(LEN=*),INTENT(IN) :: field_name
616	CHARACTER(LEN=*),INTENT(IN) :: title
617	REAL,INTENT(IN) :: field(:,:)
618	REAL,OPTIONAL,INTENT(IN) :: time
619
620	IF (present(time)) THEN
621	! if timeindex is present, it is a time-dependent variable
622	CALL put_field_rgen(field_name,title,field,size(field,2),time)
623	ELSE
624	CALL put_field_rgen(field_name,title,field,size(field,2))
625	ENDIF
626
627	END SUBROUTINE put_field_r2
628
629	SUBROUTINE put_field_r3(field_name,title,field,time)
630	! For a "4D" field surf/alt/??
631	IMPLICIT NONE
632	CHARACTER(LEN=*),INTENT(IN) :: field_name
633	CHARACTER(LEN=*),INTENT(IN) :: title
634	REAL,INTENT(IN) :: field(:,:,:)
635	REAL,OPTIONAL,INTENT(IN) :: time
636
637	IF (present(time)) THEN
638	! if timeindex is present, it is a time-dependent variable
639	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
640	time)
641	ELSE
642	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
643	ENDIF
644
645	END SUBROUTINE put_field_r3
646
647	SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
648	USE netcdf
649	USE dimphy
650	USE comsoil_h, only: nsoilmx
651	USE mod_grid_phy_lmdz
652	USE mod_phys_lmdz_para
653	! USE slab_ice_h, only: noceanmx
654	USE ocean_slab_mod, ONLY: nslay
655
656	IMPLICIT NONE
657	CHARACTER(LEN=*),INTENT(IN) :: field_name
658	CHARACTER(LEN=*),INTENT(IN) :: title
659	INTEGER,INTENT(IN) :: field_size
660	REAL,INTENT(IN) :: field(klon,field_size)
661	REAL,OPTIONAL,INTENT(IN) :: time
662
663	REAL :: field_glo(klon_glo,field_size)
664	INTEGER :: ierr
665	INTEGER :: nvarid
666	INTEGER :: idim
667
668	CALL gather(field,field_glo)
669
670	IF (is_master) THEN
671
672	IF (field_size==1) THEN
673	! input is a 1D "surface field" array
674	if (.not.present(time)) then ! for a time-independent field
675	ierr=NF90_REDEF(nid_restart)
676	#ifdef NC_DOUBLE
677	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
678	(/idim2/),nvarid)
679	#else
680	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
681	(/idim2/),nvarid)
682	#endif
683	if (ierr.ne.NF90_NOERR) then
684	write(,)"put_field_rgen error: failed to define "//trim(field_name)
685	write(,)trim(nf90_strerror(ierr))
686	endif
687	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
688	ierr=NF90_ENDDEF(nid_restart)
689	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
690	else
691	! check if the variable has already been defined:
692	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
693	if (ierr/=NF90_NOERR) then ! variable not found, define it
694	ierr=NF90_REDEF(nid_restart)
695	#ifdef NC_DOUBLE
696	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
697	(/idim2,idim7/),nvarid)
698	#else
699	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
700	(/idim2,idim7/),nvarid)
701	#endif
702	if (ierr.ne.NF90_NOERR) then
703	write(,)"put_field_rgen error: failed to define "//trim(field_name)
704	write(,)trim(nf90_strerror(ierr))
705	endif
706	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
707	ierr=NF90_ENDDEF(nid_restart)
708	endif
709	! Write the variable
710	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
711	start=(/1,timeindex/))
712	endif ! of if (.not.present(timeindex))
713
714	ELSE IF (field_size==klev) THEN
715	! input is a 2D "atmospheric field" array
716	if (.not.present(time)) then ! for a time-independent field
717	ierr=NF90_REDEF(nid_restart)
718	#ifdef NC_DOUBLE
719	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
720	(/idim2,idim6/),nvarid)
721	#else
722	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
723	(/idim2,idim6/),nvarid)
724	#endif
725	if (ierr.ne.NF90_NOERR) then
726	write(,)"put_field_rgen error: failed to define "//trim(field_name)
727	write(,)trim(nf90_strerror(ierr))
728	endif
729	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
730	ierr=NF90_ENDDEF(nid_restart)
731	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
732	else
733	! check if the variable has already been defined:
734	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
735	if (ierr/=NF90_NOERR) then ! variable not found, define it
736	ierr=NF90_REDEF(nid_restart)
737	#ifdef NC_DOUBLE
738	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
739	(/idim2,idim6,idim7/),nvarid)
740	#else
741	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
742	(/idim2,idim6,idim7/),nvarid)
743	#endif
744	if (ierr.ne.NF90_NOERR) then
745	write(,)"put_field_rgen error: failed to define "//trim(field_name)
746	write(,)trim(nf90_strerror(ierr))
747	endif
748	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
749	ierr=NF90_ENDDEF(nid_restart)
750	endif
751	! Write the variable
752	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
753	start=(/1,1,timeindex/))
754	endif ! of if (.not.present(time))
755
756	ELSE IF (field_size==klevp1) THEN
757	! input is a 2D "interlayer atmospheric field" array
758	if (.not.present(time)) then ! for a time-independent field
759	ierr=NF90_REDEF(nid_restart)
760	#ifdef NC_DOUBLE
761	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
762	(/idim2,idim4/),nvarid)
763	#else
764	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
765	(/idim2,idim4/),nvarid)
766	#endif
767	if (ierr.ne.NF90_NOERR) then
768	write(,)"put_field_rgen error: failed to define "//trim(field_name)
769	write(,)trim(nf90_strerror(ierr))
770	endif
771	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
772	ierr = NF90_ENDDEF(nid_restart)
773	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
774	else
775	! check if the variable has already been defined:
776	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
777	if (ierr/=NF90_NOERR) then ! variable not found, define it
778	ierr=NF90_REDEF(nid_restart)
779	#ifdef NC_DOUBLE
780	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
781	(/idim2,idim4,idim7/),nvarid)
782	#else
783	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
784	(/idim2,idim4,idim7/),nvarid)
785	#endif
786	if (ierr.ne.NF90_NOERR) then
787	write(,)"put_field_rgen error: failed to define "//trim(field_name)
788	write(,)trim(nf90_strerror(ierr))
789	endif
790	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
791	ierr=NF90_ENDDEF(nid_restart)
792	endif
793	! Write the variable
794	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
795	start=(/1,1,timeindex/))
796	endif ! of if (.not.present(timeindex))
797
798	ELSE IF (field_size==nsoilmx) THEN
799	! input is a 2D "subsurface field" array
800	if (.not.present(time)) then ! for a time-independent field
801	ierr = NF90_REDEF(nid_restart)
802	#ifdef NC_DOUBLE
803	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
804	(/idim2,idim3/),nvarid)
805	#else
806	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
807	(/idim2,idim3/),nvarid)
808	#endif
809	if (ierr.ne.NF90_NOERR) then
810	write(,)"put_field_rgen error: failed to define "//trim(field_name)
811	write(,)trim(nf90_strerror(ierr))
812	endif
813	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
814	ierr = NF90_ENDDEF(nid_restart)
815	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
816	else
817	! check if the variable has already been defined:
818	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
819	if (ierr/=NF90_NOERR) then ! variable not found, define it
820	ierr=NF90_REDEF(nid_restart)
821	#ifdef NC_DOUBLE
822	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
823	(/idim2,idim3,idim7/),nvarid)
824	#else
825	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
826	(/idim2,idim3,idim7/),nvarid)
827	#endif
828	if (ierr.ne.NF90_NOERR) then
829	write(,)"put_field_rgen error: failed to define "//trim(field_name)
830	write(,)trim(nf90_strerror(ierr))
831	endif
832	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
833	ierr=NF90_ENDDEF(nid_restart)
834	endif
835	! Write the variable
836	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
837	start=(/1,1,timeindex/))
838
839	endif ! of if (.not.present(time))
840
841	ELSE IF (field_size==nslay) THEN
842	! input is a 2D "oceanic field" array
843	if (.not.present(time)) then ! for a time-independent field
844	ierr = NF90_REDEF(nid_restart)
845	#ifdef NC_DOUBLE
846	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
847	(/idim2,idim8/),nvarid)
848	#else
849	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
850	(/idim2,idim8/),nvarid)
851	#endif
852	if (ierr.ne.NF90_NOERR) then
853	write(,)"put_field_rgen error: failed to define "//trim(field_name)
854	write(,)trim(nf90_strerror(ierr))
855	endif
856	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
857	ierr = NF90_ENDDEF(nid_restart)
858	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
859	else
860	! check if the variable has already been defined:
861	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
862	if (ierr/=NF90_NOERR) then ! variable not found, define it
863	ierr=NF90_REDEF(nid_restart)
864	#ifdef NC_DOUBLE
865	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
866	(/idim2,idim8,idim7/),nvarid)
867	#else
868	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
869	(/idim2,idim8,idim7/),nvarid)
870	#endif
871	if (ierr.ne.NF90_NOERR) then
872	write(,)"put_field_rgen error: failed to define "//trim(field_name)
873	write(,)trim(nf90_strerror(ierr))
874	endif
875	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
876	ierr=NF90_ENDDEF(nid_restart)
877	endif
878	! Write the variable
879	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
880	start=(/1,1,timeindex/))
881
882	endif ! of if (.not.present(time))
883
884
885	ELSE
886	PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
887	write(,) " field_size =",field_size
888	CALL ABORT
889	ENDIF
890
891	! Check the writting of field to file went OK
892	if (ierr.ne.NF90_NOERR) then
893	write(,) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
894	write(,)trim(nf90_strerror(ierr))
895	call abort
896	endif
897
898	ENDIF ! of IF (is_master)
899
900	END SUBROUTINE put_field_rgen
901
902	SUBROUTINE put_var_r0(var_name,title,var)
903	! Put a scalar in file
904	IMPLICIT NONE
905	CHARACTER(LEN=*),INTENT(IN) :: var_name
906	CHARACTER(LEN=*),INTENT(IN) :: title
907	REAL,INTENT(IN) :: var
908	REAL :: varin(1)
909
910	varin(1)=var
911
912	CALL put_var_rgen(var_name,title,varin,size(varin))
913
914	END SUBROUTINE put_var_r0
915
916
917	SUBROUTINE put_var_r1(var_name,title,var)
918	! Put a vector in file
919	IMPLICIT NONE
920	CHARACTER(LEN=*),INTENT(IN) :: var_name
921	CHARACTER(LEN=*),INTENT(IN) :: title
922	REAL,INTENT(IN) :: var(:)
923
924	CALL put_var_rgen(var_name,title,var,size(var))
925
926	END SUBROUTINE put_var_r1
927
928	SUBROUTINE put_var_r2(var_name,title,var)
929	! Put a 2D field in file
930	IMPLICIT NONE
931	CHARACTER(LEN=*),INTENT(IN) :: var_name
932	CHARACTER(LEN=*),INTENT(IN) :: title
933	REAL,INTENT(IN) :: var(:,:)
934
935	CALL put_var_rgen(var_name,title,var,size(var))
936
937	END SUBROUTINE put_var_r2
938
939	SUBROUTINE put_var_r3(var_name,title,var)
940	! Put a 3D field in file
941	IMPLICIT NONE
942	CHARACTER(LEN=*),INTENT(IN) :: var_name
943	CHARACTER(LEN=*),INTENT(IN) :: title
944	REAL,INTENT(IN) :: var(:,:,:)
945
946	CALL put_var_rgen(var_name,title,var,size(var))
947
948	END SUBROUTINE put_var_r3
949
950	SUBROUTINE put_var_rgen(var_name,title,var,var_size)
951	USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
952	NF90_FLOAT, NF90_DOUBLE, &
953	NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
954	nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
955	USE comsoil_h, only: nsoilmx
956	USE mod_phys_lmdz_para, only: is_master
957	! USE slab_ice_h, only: noceanmx
958	USE ocean_slab_mod, ONLY: nslay
959	IMPLICIT NONE
960	CHARACTER(LEN=*),INTENT(IN) :: var_name
961	CHARACTER(LEN=*),INTENT(IN) :: title
962	INTEGER,INTENT(IN) :: var_size
963	REAL,INTENT(IN) :: var(var_size)
964
965	INTEGER :: ierr
966	INTEGER :: nvarid
967	INTEGER :: idim1d
968	logical,save :: firsttime=.true.
969	!$OMP THREADPRIVATE(firsttime)
970
971	IF (is_master) THEN
972
973	IF (var_name=="Time") THEN
974	! Very specific case of "Time" variable
975	if (firsttime) then
976	! Create the "Time variable"
977	ierr=NF90_REDEF(nid_restart)
978	#ifdef NC_DOUBLE
979	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
980	(/idim7/),nvarid)
981	#else
982	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
983	(/idim7/),nvarid)
984	#endif
985	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
986	ierr=NF90_ENDDEF(nid_restart)
987
988	firsttime=.false.
989	endif
990	! Append "time" value
991	! get current length of "Time" dimension
992	ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
993	ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
994	timeindex=timeindex+1
995	ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
996	ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
997	start=(/timeindex/))
998	IF (ierr/=NF90_NOERR) THEN
999	write(,)'put_var_rgen: problem writing Time'
1000	write(,)trim(nf90_strerror(ierr))
1001	CALL ABORT
1002	ENDIF
1003	return ! nothing left to do
1004	ELSEIF (var_size==length) THEN
1005	! We know it is a "controle" kind of 1D array
1006	idim1d=idim1
1007	ELSEIF (var_size==nsoilmx) THEN
1008	! We know it is an "mlayer" kind of 1D array
1009	idim1d=idim3
1010	ELSEIF (var_size==nslay) THEN
1011	! We know it is an "mlayer" kind of 1D array
1012	idim1d=idim8
1013	ELSE
1014	PRINT *, "put_var_rgen error : wrong dimension"
1015	write(,) " var_size =",var_size
1016	CALL abort
1017
1018	ENDIF ! of IF (var_size==length) THEN
1019
1020	! Swich to NetCDF define mode
1021	ierr=NF90_REDEF (nid_restart)
1022	! Define the variable
1023	#ifdef NC_DOUBLE
1024	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
1025	#else
1026	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
1027	#endif
1028	! Add a "title" attribute
1029	IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
1030	! Swich out of define mode
1031	ierr=NF90_ENDDEF(nid_restart)
1032	! Write variable to file
1033	ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
1034	IF (ierr/=NF90_NOERR) THEN
1035	write(,)'put_var_rgen: problem writing '//trim(var_name)
1036	write(,)trim(nf90_strerror(ierr))
1037	CALL ABORT
1038	ENDIF
1039	ENDIF ! of IF (is_master)
1040
1041	END SUBROUTINE put_var_rgen
1042
1043	END MODULE iostart

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

Download in other formats:

Original Format