New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

iom_cdf.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90 @ 4213

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago
first draft of the CONFIGURATION MANAGER demonstrator
File size: 78.5 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! MODULE: iom_cdf
6	!
7	! DESCRIPTION:
8	!> @brief
9	!> This module is a library to read/write Netcdf file.
10	!>
11	!> @details
12	!>
13	!> to open netcdf file:<br/>
14	!> CALL iom_cdf_open(td_file)
15	!> - td_file is file structure (see file.f90)
16	!>
17	!> to write in netcdf file:<br/>
18	!> CALL iom_cdf_write_file(td_file)
19	!>
20	!> to close netcdf file:<br/>
21	!> CALL iom_cdf_close(tl_file)
22	!>
23	!> to read one dimension in netcdf file:<br/>
24	!> tl_dim = iom_cdf_read_dim(tl_file, id_dimid)<br/>
25	!> or<br/>
26	!> tl_dim = iom_cdf_read_dim(tl_file, cd_name)
27	!> - id_dimid is dimension id<br/>
28	!> - cd_name is dimension name
29	!>
30	!> to read one global attribute in netcdf file:<br/>
31	!> tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid)<br/>
32	!> or<br/>
33	!> tl_att = iom_cdf_read_att(tl_file, id_varid, cd_name)
34	!> - id_varid is variable id
35	!> - id_attid is attribute id<br/>
36	!> - cd_name is attribute name
37	!>
38	!> to read one variable in netcdf file:<br/>
39	!> tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count])<br/>
40	!> or<br/>
41	!> tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]] [cd_stdname])
42	!> - id_varid is variabale id
43	!> - cd_name is variabale name
44	!> - id_start is a integer(4) 1D table of index from which the data
45	!> values will be read (optional)
46	!> - id_count is a integer(4) 1D table of the number of indices selected
47	!> along each dimension (optional)
48	!> - cd_stdname is variable standard name (optional)
49	!>
50	!> @author
51	!> J.Paul
52	! REVISION HISTORY:
53	!> @date Nov, 2013 - Initial Version
54	!
55	!> @param MyModule_type : brief_description
56	!
57	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
58	!
59	!> @todo
60	!> - inform variable pni, pnj, pnij, area, iglo, jglo
61	!> - use var_init when read new variable
62	!> - use dim_init when read new dimension
63	!> - use att_init when read new attribute
64	!> - add read td_dom
65	!> @todo
66	!> - voir si il ne faut pas redefinir (__copy) variable si elle vient de mpp
67	!> exemple CALL mpp_move_var( td_mpp, td_mpp%t_var )
68	!----------------------------------------------------------------------
69	MODULE iom_cdf
70	USE netcdf ! nf90 library
71	USE global ! global parameter
72	USE kind ! F90 kind parameter
73	USE fct ! basic useful function
74	USE logger ! log file manager
75	USE att ! attribute manage
76	USE dim ! dimension manager
77	USE var ! variable manager
78	USE file ! file manager
79	USE dom ! domain manager
80	! USE proc ! processor manager
81	IMPLICIT NONE
82	PRIVATE
83	! NOTE_avoid_public_variables_if_possible
84
85	! function and subroutine
86	PUBLIC :: iom_cdf_open !< open or create netcdf file, return file structure
87	PUBLIC :: iom_cdf_close !< close netcdf file
88	PUBLIC :: iom_cdf_read_dim !< read one dimension in an opened netcdf file, return dimension structure
89	PUBLIC :: iom_cdf_read_att !< read one attribute in an opened netcdf file, return attribute structure
90	PUBLIC :: iom_cdf_read_var !< read one variable in an opened netcdf file, return variable structure
91	PUBLIC :: iom_cdf_fill_var !< fill variable value in an opened netcdf file
92	PUBLIC :: iom_cdf_write_file !< write file structure contents in an opened netcdf file
93	! PUBLIC :: iom_cdf_get_mpp ! get sub domain decomposition in a netcdf file
94
95	PRIVATE :: iom_cdf__check !< provides a simple interface to netcdf error message
96	PRIVATE :: iom_cdf__get_info !< get global information in an opened netcdf file
97	PRIVATE :: iom_cdf__get_file_dim !< read dimension on an opened netcdf file, and reorder it
98	PRIVATE :: iom_cdf__get_file_att !< read global attribute on an opened netcdf file
99	PRIVATE :: iom_cdf__get_file_var !< read information about variable on an opened netcdf file
100	PRIVATE :: iom_cdf__read_dim_id !< read one dimension in an opened netcdf file, given dimension id.
101	PRIVATE :: iom_cdf__read_dim_name !< read one dimension in an opened netcdf file, given dimension name.
102	PRIVATE :: iom_cdf__read_att_name !< read variable or global attribute in an opened netcdf file, given attribute name.
103	PRIVATE :: iom_cdf__read_att_id !< read variable or global attribute in an opened netcdf file, given attribute id.
104	PRIVATE :: iom_cdf__read_var_id !< read variable value in an opened netcdf file, given variable id.
105	PRIVATE :: iom_cdf__read_var_name !< read variable value in an opened netcdf file, given variable name or standard name.
106	PRIVATE :: iom_cdf__read_var_meta !< read metadata of a variable in an opened netcdf file.
107	PRIVATE :: iom_cdf__read_var_dim !< read variable dimension in an opened netcdf file.
108	PRIVATE :: iom_cdf__read_var_att !< read variable attributes in an opened netcdf file.
109	PRIVATE :: iom_cdf__read_var_value !< read variable value in an opened netcdf file.
110	PRIVATE :: iom_cdf__write_dim !< write one dimension in an opened netcdf file in write mode.
111	PRIVATE :: iom_cdf__write_att !< write a variable attribute in an opened netcdf file.
112	PRIVATE :: iom_cdf__write_var !< write a variable in an opened netcdf file.
113	PRIVATE :: iom_cdf__write_var_def !< define variable in an opened netcdf file.
114	PRIVATE :: iom_cdf__write_var_value !< put variable value in an opened netcdf file.
115	PRIVATE :: iom_cdf__fill_var_id !< fill variable value in an opened netcdf file, given variable id
116	PRIVATE :: iom_cdf__fill_var_name !< fill variable value in an opened netcdf file, given variable name
117	PRIVATE :: iom_cdf__fill_var_all !< fill all variable value in an opened netcdf file
118	PRIVATE :: iom_cdf__del_var_dim !< remove variable dimension from an opened netcdf file
119
120	INTERFACE iom_cdf_read_var
121	MODULE PROCEDURE iom_cdf__read_var_id
122	MODULE PROCEDURE iom_cdf__read_var_name
123	END INTERFACE iom_cdf_read_var
124
125	INTERFACE iom_cdf_fill_var
126	MODULE PROCEDURE iom_cdf__fill_var_id
127	MODULE PROCEDURE iom_cdf__fill_var_name
128	MODULE PROCEDURE iom_cdf__fill_var_all
129	END INTERFACE iom_cdf_fill_var
130
131	INTERFACE iom_cdf_read_dim
132	MODULE PROCEDURE iom_cdf__read_dim_id
133	MODULE PROCEDURE iom_cdf__read_dim_name
134	END INTERFACE iom_cdf_read_dim
135
136	INTERFACE iom_cdf_read_att
137	MODULE PROCEDURE iom_cdf__read_att_id
138	MODULE PROCEDURE iom_cdf__read_att_name
139	END INTERFACE iom_cdf_read_att
140
141	CONTAINS
142	!-------------------------------------------------------------------
143	!> @brief This subroutine provides a simple interface to
144	!> netcdf error message
145	!>
146	!> @author J.Paul
147	!> - Nov, 2013- Initial Version
148	!
149	!> @param[in] id_status : error status
150	!-------------------------------------------------------------------
151	!> @code
152	SUBROUTINE iom_cdf__check(id_status)
153	IMPLICIT NONE
154	! Argument
155	INTEGER(i4), INTENT(IN) :: id_status
156	!----------------------------------------------------------------
157
158	IF( id_status /= NF90_NOERR )THEN
159	CALL logger_error(TRIM(NF90_STRERROR(id_status)))
160	ENDIF
161
162	END SUBROUTINE iom_cdf__check
163	!> @endcode
164	!-------------------------------------------------------------------
165	!> @brief This subroutine open a netcdf file in read or write mode<br/>
166	!> if try to open a file in write mode that did not exist, create it.<br/>
167	!> if file already exist, get information about:
168	!> - the number of variables
169	!> - the number of dimensions
170	!> - the number of global attributes
171	!> - the ID of the unlimited dimension
172	!> - the file format
173	!> and finally read dimensions.
174	!>
175	!> @author J.Paul
176	!> - Nov, 2013- Initial Version
177	!
178	!> @param[inout] td_file : file structure
179	!-------------------------------------------------------------------
180	!> @code
181	SUBROUTINE iom_cdf_open(td_file)
182	IMPLICIT NONE
183	! Argument
184	TYPE(TFILE), INTENT(INOUT) :: td_file
185
186	! local variable
187	LOGICAL :: ll_exist
188	LOGICAL :: ll_open
189
190	INTEGER(i4) :: il_status
191
192	TYPE(TVAR) :: tl_lon
193	! loop indices
194	INTEGER(i4) :: ji
195	!----------------------------------------------------------------
196
197	! check file existence
198	INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
199	! ll_open do not work for netcdf file, always return FALSE
200	IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'cdf' )THEN
201
202	IF( .NOT. td_file%l_wrt )THEN
203
204	CALL logger_fatal( " OPEN: can not open file "//&
205	& TRIM(td_file%c_name) )
206	td_file%i_id=-1
207
208	ELSE
209
210	CALL logger_info( " CREATE: file "//TRIM(td_file%c_name) )
211
212	il_status = NF90_CREATE( TRIM(td_file%c_name),&
213	& NF90_WRITE, &
214	& td_file%i_id)
215	CALL iom_cdf__check(il_status)
216
217	td_file%l_def=.TRUE.
218
219	ENDIF
220
221	ELSE
222
223	IF( td_file%i_id /= 0 )THEN
224
225	CALL logger_error( " OPEN: file "//&
226	& TRIM(td_file%c_name)//" already opened")
227
228	ELSE
229
230	IF( .NOT. td_file%l_wrt )THEN
231
232	CALL logger_info( " OPEN: file "//&
233	& TRIM(td_file%c_name)//" in read only mode" )
234
235	il_status = NF90_OPEN( TRIM(td_file%c_name), &
236	& NF90_NOWRITE, &
237	& td_file%i_id)
238	CALL iom_cdf__check(il_status)
239
240	CALL logger_debug("OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id)))
241	ELSE
242
243	CALL logger_info( " OPEN: file "//&
244	& TRIM(td_file%c_name)//" in write mode" )
245
246	il_status = NF90_OPEN( TRIM(td_file%c_name), &
247	& NF90_WRITE, &
248	& td_file%i_id)
249	CALL iom_cdf__check(il_status)
250
251	ENDIF
252
253	! get general information about file
254	CALL iom_cdf__get_info(td_file)
255
256	! read dimension in file
257	CALL iom_cdf__get_file_dim(td_file)
258
259	! read global attribute in file
260	CALL iom_cdf__get_file_att(td_file)
261
262	! get information about variables in file
263	CALL iom_cdf__get_file_var(td_file)
264
265	! get ew overlap
266	tl_lon=iom_cdf_read_var(td_file,'longitude')
267	td_file%i_ew=dom_get_ew_overlap(tl_lon)
268	CALL logger_debug(" IOM OPEN EW "//TRIM(fct_str(td_file%i_ew)) )
269	WHERE( td_file%t_var(:)%t_dim(1)%l_use )
270	td_file%t_var(:)%i_ew=td_file%i_ew
271	END WHERE
272	CALL var_clean(tl_lon)
273
274	DO ji=1,td_file%i_nvar
275	CALL logger_debug(TRIM(td_file%t_var(ji)%c_name)//": "//TRIM(fct_str(td_file%t_var(ji)%i_ew)) )
276	ENDDO
277
278	! remove dimension variable from list of variable
279	CALL iom_cdf__del_var_dim(td_file)
280
281	ENDIF
282
283	ENDIF
284
285	END SUBROUTINE iom_cdf_open
286	!> @endcode
287	!-------------------------------------------------------------------
288	!> @brief This subroutine close netcdf file
289	!>
290	!> @author J.Paul
291	!> - Nov, 2013- Initial Version
292	!
293	!> @param[inout] td_file : file structure
294	!-------------------------------------------------------------------
295	!> @code
296	SUBROUTINE iom_cdf_close(td_file)
297	IMPLICIT NONE
298	! Argument
299	TYPE(TFILE), INTENT(INOUT) :: td_file
300
301	! local variable
302	INTEGER(i4) :: il_status
303	!----------------------------------------------------------------
304
305	! check if file opened
306	IF( td_file%i_id == 0 )THEN
307
308	CALL logger_error( &
309	& " CLOSE: no id associated to file "//TRIM(td_file%c_name))
310
311	ELSE
312	CALL logger_info( &
313	& " CLOSE: file "//TRIM(td_file%c_name))
314
315	il_status = NF90_CLOSE(td_file%i_id)
316	CALL iom_cdf__check(il_status)
317
318	td_file%i_id = 0
319
320	ENDIF
321
322	END SUBROUTINE iom_cdf_close
323	!> @endcode
324	!-------------------------------------------------------------------
325	!> @brief This subroutine get global information in an opened netcdf
326	!> file.<br/>
327	!> @details
328	!> It gets the number of variables, the number of dimensions,
329	!> the number of global attributes, the ID of the unlimited dimension
330	!> and finally the format version and filled file strucuture with it.
331	!>
332	!> @author J.Paul
333	!> - Nov, 2013- Initial Version
334	!
335	!> @param[inout] td_file : file structure
336	!> @return file structure completed
337	!-------------------------------------------------------------------
338	!> @code
339	SUBROUTINE iom_cdf__get_info(td_file)
340	IMPLICIT NONE
341	! Argument
342	TYPE(TFILE), INTENT(INOUT) :: td_file
343
344	! local variable
345	INTEGER(i4) :: il_fmt ! format version
346	INTEGER(i4) :: il_status
347	!----------------------------------------------------------------
348
349	CALL logger_trace( &
350	& " GET INFO: about netcdf file "//TRIM(td_file%c_name))
351
352	il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, &
353	& td_file%i_nvar, td_file%i_natt, td_file%i_uldid, il_fmt)
354	CALL iom_cdf__check(il_status)
355
356	SELECT CASE(il_fmt)
357	CASE(nf90_format_classic, nf90_format_64bit)
358	td_file%c_type='cdf'
359	CASE(nf90_format_netcdf4, nf90_format_netcdf4_classic)
360	td_file%c_type='cdf4'
361	END SELECT
362
363	! record header infos
364	td_file%i_rhd=1
365
366	END SUBROUTINE iom_cdf__get_info
367	!> @endcode
368	!-------------------------------------------------------------------
369	!> @brief This subroutine read dimension on an opened netcdf file, and
370	!> reorder dimension to ('x', 'y', 'z', 't').<br/>
371	!> The dimension structure inside file structure is then completed.
372	!
373	!> @author J.Paul
374	!> - Nov, 2013- Initial Version
375	!
376	!> @param[inout] td_file : file structure
377	!> @return file structure completed
378	!-------------------------------------------------------------------
379	!> @code
380	SUBROUTINE iom_cdf__get_file_dim(td_file)
381	IMPLICIT NONE
382	! Argument
383	TYPE(TFILE), INTENT(INOUT) :: td_file
384
385	! loop indices
386	INTEGER(i4) :: ji
387	!----------------------------------------------------------------
388
389	! clean dimension
390	DO ji=1,ip_maxdim
391	CALL dim_clean(td_file%t_dim(ji))
392	ENDDO
393
394	IF( td_file%i_ndim > 0 )THEN
395	DO ji = 1, td_file%i_ndim
396	! read dimension information
397	td_file%t_dim(ji)=iom_cdf_read_dim( td_file, ji)
398	ENDDO
399
400	! inform unlimited dimension
401	IF( td_file%i_uldid == -1 )THEN
402	CALL logger_warn( &
403	& " GET FILE DIM: there is no unlimited dimension in file "//&
404	& TRIM(td_file%c_name))
405	ELSE
406	td_file%t_dim( td_file%i_uldid )%l_uld=.TRUE.
407	ENDIF
408
409	ELSE
410
411	CALL logger_warn( &
412	& " GET FILE DIM: there is no dimension in file "//&
413	& TRIM(td_file%c_name))
414
415	ENDIF
416
417	! reorder dimension to ('x','y','z','t')
418	CALL dim_reorder(td_file%t_dim(:))
419
420	END SUBROUTINE iom_cdf__get_file_dim
421	!> @endcode
422	!-------------------------------------------------------------------
423	!> @brief This subroutine read global attribute on an opened netcdf
424	!> file.<br/>
425	!> The attribute structure inside file structure is then completed.
426	!
427	!> @author J.Paul
428	!> - Nov, 2013- Initial Version
429	!
430	!> @param[inout] td_file : file structure
431	!> @return file structure completed
432	!-------------------------------------------------------------------
433	!> @code
434	SUBROUTINE iom_cdf__get_file_att(td_file)
435	IMPLICIT NONE
436	! Argument
437	TYPE(TFILE), INTENT(INOUT) :: td_file
438
439	! loop indices
440	INTEGER(i4) :: ji
441	!----------------------------------------------------------------
442
443	IF( td_file%i_natt > 0 )THEN
444	IF(ASSOCIATED(td_file%t_att))THEN
445	DEALLOCATE(td_file%t_att)
446	ENDIF
447	ALLOCATE(td_file%t_att(td_file%i_natt))
448
449	DO ji = 1, td_file%i_natt
450	! read global attribute
451	td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji)
452
453	SELECT CASE(TRIM(td_file%t_att(ji)%c_name))
454	CASE('periodicity')
455	td_file%i_perio=INT(td_file%t_att(ji)%d_value(1),i4)
456	CASE('pivot_point')
457	td_file%i_pivot=INT(td_file%t_att(ji)%d_value(1),i4)
458	CASE('ew_overlap')
459	td_file%i_ew=INT(td_file%t_att(ji)%d_value(1),i4)
460	END SELECT
461
462	ENDDO
463
464	ELSE
465	CALL logger_debug( &
466	& " GET FILE ATT: there is no global attribute in file "//&
467	& TRIM(td_file%c_name))
468	ENDIF
469
470	END SUBROUTINE iom_cdf__get_file_att
471	!> @endcode
472	!-------------------------------------------------------------------
473	!> @brief This subroutine read information about variable of an
474	!> opened netcdf file.<br/>
475	!> The variable structure inside file structure is then completed.
476	!> @note variable value are not read !
477	!
478	!> @author J.Paul
479	!> - Nov, 2013- Initial Version
480	!
481	!> @param[inout] td_file : file structure
482	!> @return file structure completed
483	!-------------------------------------------------------------------
484	!> @code
485	SUBROUTINE iom_cdf__get_file_var(td_file)
486	IMPLICIT NONE
487	! Argument
488	TYPE(TFILE), INTENT(INOUT) :: td_file
489
490	! local variable
491	INTEGER(i4) :: il_attid
492
493	! loop indices
494	INTEGER(i4) :: ji
495	!----------------------------------------------------------------
496
497	IF( td_file%i_nvar > 0 )THEN
498	IF(ASSOCIATED(td_file%t_var))THEN
499	DEALLOCATE(td_file%t_var)
500	ENDIF
501	ALLOCATE(td_file%t_var(td_file%i_nvar))
502
503	DO ji = 1, td_file%i_nvar
504	! read dimension information
505	td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji)
506
507	SELECT CASE(td_file%t_var(ji)%i_ndim)
508	CASE(0)
509	td_file%i_n0d=td_file%i_n0d+1
510	CASE(1)
511	td_file%i_n1d=td_file%i_n1d+1
512	td_file%i_rhd=td_file%i_rhd+1
513	CASE(2)
514	td_file%i_n2d=td_file%i_n2d+1
515	td_file%i_rhd=td_file%i_rhd+1
516	CASE(3)
517	td_file%i_n3d=td_file%i_n3d+1
518	td_file%i_rhd=td_file%i_rhd+td_file%t_dim(3)%i_len
519	END SELECT
520
521	! look for depth id
522	IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'depth') /= 0 )THEN
523	IF( td_file%i_depthid == 0 )THEN
524	td_file%i_depthid=ji
525	ELSE
526	CALL logger_error("IOM OPEN: find more than one "//&
527	& "depth variable in file "//&
528	& TRIM(td_file%c_name) )
529	ENDIF
530	ENDIF
531
532	! look for time id
533	IF( INDEX(TRIM(td_file%t_var(ji)%c_name),'time') /= 0 )THEN
534	IF( td_file%i_timeid == 0 )THEN
535	td_file%i_timeid=ji
536	ELSE
537	il_attid=0
538	IF( ASSOCIATED(td_file%t_var(ji)%t_att) )THEN
539	il_attid=att_get_id(td_file%t_var(ji)%t_att(:),'calendar')
540	ENDIF
541	IF( il_attid /= 0 )THEN
542	td_file%i_timeid=ji
543	!ELSE
544	! print *,'error'
545	! CALL logger_error("IOM OPEN: find more than one "//&
546	! & "time variable in file "//&
547	! & TRIM(td_file%c_name) )
548	ENDIF
549	ENDIF
550	ENDIF
551
552	ENDDO
553
554	ELSE
555	CALL logger_debug( &
556	& " GET FILE VAR: there is no variable in file "//&
557	& TRIM(td_file%c_name))
558	ENDIF
559
560	END SUBROUTINE iom_cdf__get_file_var
561	!> @endcode
562	!-------------------------------------------------------------------
563	!> @brief This subroutine delete variable dimension from an
564	!> opened netcdf file.<br/>
565	!
566	!> @author J.Paul
567	!> - 2013- Initial Version
568	!
569	!> @param[inout] td_file : file structure
570	!-------------------------------------------------------------------
571	!> @code
572	SUBROUTINE iom_cdf__del_var_dim(td_file)
573	IMPLICIT NONE
574	! Argument
575	TYPE(TFILE), INTENT(INOUT) :: td_file
576
577	! local variable
578	CHARACTER(LEN=lc) :: cl_name
579	CHARACTER(LEN=lc) :: cl_sname
580
581	! loop indices
582	INTEGER(i4) :: ji
583	INTEGER(i4) :: jj
584	!----------------------------------------------------------------
585	IF( td_file%i_nvar > 0 )THEN
586	DO ji=td_file%i_nvar,1,-1
587	cl_name=TRIM(td_file%t_var(ji)%c_name)
588	DO jj=1,ip_maxdim
589	IF( td_file%t_dim(jj)%l_use )THEN
590	cl_sname=fct_upper(td_file%t_dim(jj)%c_sname)
591	IF( TRIM(cl_name) == TRIM(cl_sname) )THEN
592	CALL file_del_var(td_file,TRIM(cl_name))
593	EXIT
594	ENDIF
595	ENDIF
596	ENDDO
597	ENDDO
598	ELSE
599	CALL logger_debug( &
600	& " DEL VAR DIM: there is no variable in file "//&
601	& TRIM(td_file%c_name))
602	ENDIF
603	END SUBROUTINE iom_cdf__del_var_dim
604	!> @endcode
605	! !-------------------------------------------------------------------
606	! !> @brief This subroutine get variable time from an
607	! !> opened netcdf file.<br/>
608	! !
609	! !> @author J.Paul
610	! !> - 2013- Initial Version
611	! !
612	! !> @param[inout] td_file : file structure
613	! !-------------------------------------------------------------------
614	! !> @code
615	! SUBROUTINE iom_cdf__get_var_time(td_file)
616	! IMPLICIT NONE
617	! ! Argument
618	! TYPE(TFILE), INTENT(INOUT) :: td_file
619	!
620	! ! local variable
621	! CHARACTER(LEN=lc) :: cl_name
622	!
623	! ! loop indices
624	! INTEGER(i4) :: ji
625	! !----------------------------------------------------------------
626	! IF( td_file%i_nvar > 0 )THEN
627	! DO ji=1,td_file%i_nvar
628	! cl_name=TRIM(td_file%t_var(ji)%c_name)
629	! IF( INDEX(cl_name,'time') /= 0 )THEN
630	! ! read time variable
631	! td_file%t_time=iom_cdf_read_var(td_file,ji)
632	! ! remove time variable from variable list
633	! CALL file_del_ver(td_file,TRIM(cl_name))
634	! EXIT
635	! ENDIF
636	! ENDDO
637	! ELSE
638	! CALL logger_debug( &
639	! & " GET VAR TIME: there is no variable in file "//&
640	! & TRIM(td_file%c_name))
641	! ENDIF
642	! END SUBROUTINE iom_cdf__get_var_time
643	! !> @endcode
644	! !-------------------------------------------------------------------
645	! !> @brief This subroutine get variable depth from an
646	! !> opened netcdf file.<br/>
647	! !
648	! !> @author J.Paul
649	! !> - 2013- Initial Version
650	! !
651	! !> @param[inout] td_file : file structure
652	! !-------------------------------------------------------------------
653	! !> @code
654	! SUBROUTINE iom_cdf__get_var_depth(td_file)
655	! IMPLICIT NONE
656	! ! Argument
657	! TYPE(TFILE), INTENT(INOUT) :: td_file
658	!
659	! ! local variable
660	! CHARACTER(LEN=lc) :: cl_name
661	!
662	! ! loop indices
663	! INTEGER(i4) :: ji
664	! !----------------------------------------------------------------
665	! IF( td_file%i_nvar > 0 )THEN
666	! DO ji=1,td_file%i_nvar
667	! cl_name=TRIM(td_file%t_var(ji)%c_name)
668	! IF( INDEX(cl_name,'depth') /= 0 )THEN
669	! ! read depth variable
670	! td_file%t_depth=iom_cdf_read_var(td_file,ji)
671	! ! remove depth variable from variable list
672	! CALL file_del_ver(td_file,TRIM(cl_name))
673	! EXIT
674	! ENDIF
675	! ENDDO
676	! ELSE
677	! CALL logger_debug( &
678	! & " GET VAR TIME: there is no variable in file "//&
679	! & TRIM(td_file%c_name))
680	! ENDIF
681	! END SUBROUTINE iom_cdf__get_var_depth
682	! !> @endcode
683	!-------------------------------------------------------------------
684	!> @brief This function read one dimension in an opened netcdf file,
685	!> given dimension id.
686	!
687	!> @author J.Paul
688	!> - Nov, 2013- Initial Version
689	!
690	!> @param[in] td_file : file structure
691	!> @param[in] id_dimid : dimension id
692	!> @return dimension structure
693	!-------------------------------------------------------------------
694	!> @code
695	TYPE(TDIM) FUNCTION iom_cdf__read_dim_id(td_file, id_dimid)
696	IMPLICIT NONE
697	! Argument
698	TYPE(TFILE), INTENT(IN) :: td_file
699	INTEGER(i4), INTENT(IN) :: id_dimid
700
701	! local variable
702	INTEGER(i4) :: il_status
703	INTEGER(i4) :: il_len
704	CHARACTER(LEN=lc) :: cl_name
705	!----------------------------------------------------------------
706
707	! check if file opened
708	IF( td_file%i_id == 0 )THEN
709
710	CALL logger_error( &
711	& " READ DIM: no id associated to file "//TRIM(td_file%c_name))
712
713	ELSE
714
715	iom_cdf__read_dim_id%i_id=id_dimid
716
717	CALL logger_debug( &
718	& " READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
719	& " in file "//TRIM(td_file%c_name))
720
721	il_status=NF90_INQUIRE_DIMENSION(td_file%i_id, id_dimid, &
722	& cl_name, il_len )
723	CALL iom_cdf__check(il_status)
724
725	iom_cdf__read_dim_id=dim_init(cl_name, il_len)
726
727	ENDIF
728
729	END FUNCTION iom_cdf__read_dim_id
730	!> @endcode
731	!-------------------------------------------------------------------
732	!> @brief This function read one dimension in an opened netcdf file,
733	!> given dimension name.
734	!
735	!> @author J.Paul
736	!> - Nov, 2013- Initial Version
737	!
738	!> @param[in] td_file : file structure
739	!> @param[in] cd_name : dimension name
740	!> @return dimension structure
741	!-------------------------------------------------------------------
742	!> @code
743	TYPE(TDIM) FUNCTION iom_cdf__read_dim_name(td_file, cd_name)
744	IMPLICIT NONE
745	! Argument
746	TYPE(TFILE), INTENT(IN) :: td_file
747	CHARACTER(LEN=*), INTENT(IN) :: cd_name
748
749	! local variable
750	INTEGER(i4) :: il_status
751	INTEGER(i4) :: il_dimid
752	!----------------------------------------------------------------
753
754	! check if file opened
755	IF( td_file%i_id == 0 )THEN
756
757	CALL logger_error( &
758	& " READ DIM: no id associated to file "//TRIM(td_file%c_name))
759
760	ELSE
761
762	il_status=NF90_INQ_DIMID( td_file%i_id, TRIM(ADJUSTL(cd_name)), &
763	& il_dimid)
764	CALL iom_cdf__check(il_status)
765
766	iom_cdf__read_dim_name=iom_cdf_read_dim(td_file, il_dimid)
767
768	ENDIF
769
770	END FUNCTION iom_cdf__read_dim_name
771	!> @endcode
772	!-------------------------------------------------------------------
773	!> @brief This function read variable or global attribute in an opened
774	!> netcdf file, given attribute name.
775	!
776	!> @author J.Paul
777	!> - Nov, 2013- Initial Version
778	!
779	!> @param[in] td_file : file structure
780	!> @param[in] id_varid : variable id. use NF90_GLOBAL to read global
781	!> attribute in a file
782	!> @param[in] cd_name : attribute name
783	!> @return attribute structure
784	!-------------------------------------------------------------------
785	!> @code
786	TYPE(TATT) FUNCTION iom_cdf__read_att_name(td_file, id_varid, cd_name)
787	IMPLICIT NONE
788	! Argument
789	TYPE(TFILE), INTENT(IN) :: td_file
790	INTEGER(i4), INTENT(IN) :: id_varid
791	CHARACTER(LEN=*), INTENT(IN) :: cd_name
792
793	! local variable
794	CHARACTER(LEN=lc) :: cl_name
795
796	INTEGER(i4) :: il_status
797	INTEGER(i4) :: il_attid
798	INTEGER(i4) :: il_type
799	INTEGER(i4) :: il_len
800
801	CHARACTER(LEN=lc) :: cl_value
802	INTEGER(i1), DIMENSION(:), ALLOCATABLE :: bl_value
803	INTEGER(i2), DIMENSION(:), ALLOCATABLE :: sl_value
804	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
805	REAL(sp) , DIMENSION(:), ALLOCATABLE :: fl_value
806	REAL(dp) , DIMENSION(:), ALLOCATABLE :: dl_value
807	!----------------------------------------------------------------
808	! check if file opened
809	IF( td_file%i_id == 0 )THEN
810
811	CALL logger_error( &
812	& " READ ATT: no id associated to file "//TRIM(td_file%c_name))
813
814	ELSE
815
816	cl_name=TRIM(ADJUSTL(cd_name))
817
818	! inquire attribute
819	IF( id_varid == NF90_GLOBAL )THEN
820
821	CALL logger_debug( &
822	& " READ ATT: inquire global attribute "//&
823	& " in file "//TRIM(td_file%c_name))
824
825	ELSE
826
827	CALL logger_debug( &
828	& " READ ATT: inquire attribute "//&
829	& " of variable "//TRIM(fct_str(id_varid))//&
830	& " in file "//TRIM(td_file%c_name))
831
832	ENDIF
833
834	il_status=NF90_INQUIRE_ATTRIBUTE(td_file%i_id, id_varid, &
835	& cl_name,&
836	& il_type,&
837	& il_len, &
838	& il_attid )
839	CALL iom_cdf__check(il_status)
840
841	!! get attribute value
842	CALL logger_debug( " READ ATT: get attribute "//TRIM(cl_name)//&
843	& " in file "//TRIM(td_file%c_name))
844
845	SELECT CASE( il_type )
846
847	CASE(NF90_CHAR)
848
849	! check string lengths
850	IF( LEN(cl_value) < il_len )THEN
851
852	CALL logger_error( &
853	& " READ ATT: not enough space to put attribute "//&
854	& TRIM(cl_name) )
855
856	ELSE
857
858	! Read the attributes
859	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
860	& cl_name, &
861	& cl_value )
862	CALL iom_cdf__check(il_status)
863
864	iom_cdf__read_att_name=att_init(cl_name, cl_value)
865
866	ENDIF
867
868	CASE(NF90_BYTE)
869
870	ALLOCATE( bl_value( il_len), &
871	& stat=il_status)
872	IF(il_status /= 0 )THEN
873
874	CALL logger_error( &
875	& " READ ATT: not enough space to put attribute "//&
876	& TRIM(cl_name) )
877
878	ELSE
879
880	! Read the attributes
881	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
882	& cl_name, &
883	& bl_value(:))
884	CALL iom_cdf__check(il_status)
885
886	iom_cdf__read_att_name=att_init(cl_name, bl_value(:))
887
888	ENDIF
889
890	DEALLOCATE(bl_value)
891
892	CASE(NF90_SHORT)
893
894	ALLOCATE( sl_value( il_len), &
895	& stat=il_status)
896	IF(il_status /= 0 )THEN
897
898	CALL logger_error( &
899	& " READ ATT: not enough space to put attribute "//&
900	& TRIM(cl_name) )
901
902	ELSE
903
904	! Read the attributes
905	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
906	& cl_name, &
907	& sl_value(:))
908	CALL iom_cdf__check(il_status)
909
910	iom_cdf__read_att_name=att_init(cl_name, sl_value(:))
911
912	ENDIF
913
914	DEALLOCATE(sl_value)
915
916	CASE(NF90_INT)
917
918	ALLOCATE( il_value( il_len), &
919	& stat=il_status)
920	IF(il_status /= 0 )THEN
921
922	CALL logger_error( &
923	& " READ ATT: not enough space to put attribute "//&
924	& TRIM(cl_name) )
925
926	ELSE
927
928	! Read the attributes
929	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
930	& cl_name, &
931	& il_value(:))
932	CALL iom_cdf__check(il_status)
933
934	iom_cdf__read_att_name=att_init(cl_name, il_value(:))
935	ENDIF
936
937	DEALLOCATE(il_value)
938
939	CASE(NF90_FLOAT)
940
941	ALLOCATE( fl_value( il_len), &
942	& stat=il_status)
943	IF(il_status /= 0 )THEN
944
945	CALL logger_error( &
946	& " READ ATT: not enough space to put attribute "//&
947	& TRIM(cl_name) )
948
949	ELSE
950
951	! Read the attributes
952	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
953	& cl_name, &
954	& fl_value(:))
955	CALL iom_cdf__check(il_status)
956
957	iom_cdf__read_att_name=att_init(cl_name, fl_value(:))
958
959	ENDIF
960
961	DEALLOCATE(fl_value)
962
963	CASE(NF90_DOUBLE)
964
965	ALLOCATE( dl_value( il_len), &
966	& stat=il_status)
967	IF(il_status /= 0 )THEN
968
969	CALL logger_error( &
970	& " READ ATT: not enough space to put attribute "//&
971	& TRIM(cl_name) )
972
973	ELSE
974
975	! Read the attributes
976	il_status=NF90_GET_ATT(td_file%i_id, id_varid, &
977	& cl_name, &
978	& dl_value(:))
979	CALL iom_cdf__check(il_status)
980
981	iom_cdf__read_att_name=att_init(cl_name, dl_value(:))
982
983	ENDIF
984
985	DEALLOCATE(dl_value)
986
987	END SELECT
988
989	iom_cdf__read_att_name%i_id=il_attid
990
991	ENDIF
992
993	END FUNCTION iom_cdf__read_att_name
994	!> @endcode
995	!-------------------------------------------------------------------
996	!> @brief This function read variable or global attribute in an opened
997	!> netcdf file, given attribute id.
998	!
999	!> @author J.Paul
1000	!> - Nov, 2013- Initial Version
1001	!
1002	!> @param[in] td_file : file structure
1003	!> @param[in] id_varid : variable id. use NF90_GLOBAL to read global
1004	!> attribute in a file
1005	!> @param[in] id_attid : attribute id
1006	!> @return attribute structure
1007	!-------------------------------------------------------------------
1008	!> @code
1009	TYPE(TATT) FUNCTION iom_cdf__read_att_id(td_file, id_varid, id_attid)
1010	IMPLICIT NONE
1011	! Argument
1012	TYPE(TFILE), INTENT(IN) :: td_file
1013	INTEGER(i4), INTENT(IN) :: id_varid
1014	INTEGER(i4), INTENT(IN) :: id_attid
1015
1016	! local variable
1017	INTEGER(i4) :: il_status
1018	CHARACTER(LEN=lc) :: cl_name
1019	!----------------------------------------------------------------
1020	! check if file opened
1021	IF( td_file%i_id == 0 )THEN
1022
1023	CALL logger_error( &
1024	& " READ ATT: no id associated to file "//TRIM(td_file%c_name))
1025
1026	ELSE
1027
1028	! get attribute name
1029	il_status=NF90_INQ_ATTNAME(td_file%i_id, id_varid, id_attid, cl_name)
1030	CALL iom_cdf__check(il_status)
1031
1032	! read attribute
1033	iom_cdf__read_att_id=iom_cdf__read_att_name(td_file, id_varid, cl_name)
1034
1035	ENDIF
1036
1037	END FUNCTION iom_cdf__read_att_id
1038	!> @endcode
1039	!-------------------------------------------------------------------
1040	!> @brief This function read variable value in an opened
1041	!> netcdf file, given variable id.</br/>
1042	!> start indices and number of indices selected along each dimension
1043	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1044	!
1045	!> @author J.Paul
1046	!> - Nov, 2013- Initial Version
1047	!
1048	!> @param[in] td_file : file structure
1049	!> @param[in] id_varid : variable id
1050	!> @param[in] id_start : index in the variable from which the data values
1051	!> will be read
1052	!> @param[in] id_count : number of indices selected along each dimension
1053	!> @return variable structure
1054	!-------------------------------------------------------------------
1055	!> @code
1056	TYPE(TVAR) FUNCTION iom_cdf__read_var_id(td_file, id_varid,&
1057	& id_start, id_count)
1058	IMPLICIT NONE
1059	! Argument
1060	TYPE(TFILE), INTENT(IN) :: td_file
1061	INTEGER(i4), INTENT(IN) :: id_varid
1062	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1063	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1064
1065	! local variable
1066	INTEGER(i4), DIMENSION(1) :: il_ind
1067	!----------------------------------------------------------------
1068	! check if file opened
1069	IF( td_file%i_id == 0 )THEN
1070
1071	CALL logger_error( &
1072	& " IOM READ VAR: no id associated to file "//TRIM(td_file%c_name))
1073
1074	ELSE
1075
1076	! look for variable id
1077	il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
1078	IF( il_ind(1) /= 0 )THEN
1079
1080	iom_cdf__read_var_id=td_file%t_var(il_ind(1))
1081
1082	print *,"iom_cdf__read_var_id ",trim(iom_cdf__read_var_id%c_name)," ",iom_cdf__read_var_id%i_ew
1083	!!! read variable value
1084	CALL iom_cdf__read_var_value(td_file, iom_cdf__read_var_id, &
1085	& id_start, id_count)
1086
1087	ELSE
1088	print *,"iom_cdf__read_var_id "
1089	CALL logger_error( &
1090	& " IOM READ VAR: there is no variable with id "//&
1091	& TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
1092	ENDIF
1093
1094	ENDIF
1095	END FUNCTION iom_cdf__read_var_id
1096	!> @endcode
1097	!-------------------------------------------------------------------
1098	!> @brief This function read variable value in an opened
1099	!> netcdf file, given variable name or standard name.</br/>
1100	!> start indices and number of indices selected along each dimension
1101	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1102	!
1103	!> @details
1104	!> look first for variable name. If it doesn't
1105	!> exist in file, look for variable standard name.<br/>
1106	!> If variable name is not present, check variable standard name.<br/>
1107	!
1108	!> @author J.Paul
1109	!> - Nov, 2013- Initial Version
1110	!
1111	!> @param[in] td_file : file structure
1112	!> @param[in] cd_name : variable name
1113	!> @param[in] id_start : index in the variable from which the data values will be read
1114	!> @param[in] id_count : number of indices selected along each dimension
1115	!> @param[in] cd_stdname : variable standard name
1116	!> @return variable structure
1117	!-------------------------------------------------------------------
1118	!> @code
1119	TYPE(TVAR) FUNCTION iom_cdf__read_var_name(td_file, cd_name, &
1120	& id_start, id_count )
1121	IMPLICIT NONE
1122	! Argument
1123	TYPE(TFILE) , INTENT(IN) :: td_file
1124	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_name
1125	INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1126	INTEGER(i4) , DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1127
1128	! local variable
1129	INTEGER(i4) :: il_ind
1130	!----------------------------------------------------------------
1131	! check if file opened
1132	IF( td_file%i_id == 0 )THEN
1133
1134	CALL logger_error( &
1135	& " IOM READ VAR: no id associated to file "//TRIM(td_file%c_name))
1136
1137	ELSE
1138
1139	IF( .NOT. PRESENT(cd_name) )THEN
1140
1141	CALL logger_error( &
1142	& " IOM READ VAR: you must specify a variable to read "//&
1143	& " in file "//TRIM(td_file%c_name))
1144
1145	ELSE
1146
1147	il_ind=var_get_id(td_file%t_var(:), cd_name)
1148	IF( il_ind /= 0 )THEN
1149
1150	iom_cdf__read_var_name=td_file%t_var(il_ind)
1151
1152	!!! read variable value
1153	CALL iom_cdf__read_var_value( td_file, &
1154	& iom_cdf__read_var_name, &
1155	& id_start, id_count)
1156
1157	ELSE
1158
1159	CALL logger_error( &
1160	& " IOM READ VAR: there is no variable with "//&
1161	& " name or standard name "//TRIM(cd_name)//&
1162	& " in file "//TRIM(td_file%c_name) )
1163	ENDIF
1164
1165	ENDIF
1166
1167	ENDIF
1168
1169	END FUNCTION iom_cdf__read_var_name
1170	!> @endcode
1171	!-------------------------------------------------------------------
1172	!> @brief This subroutine fill variable value in an opened
1173	!> netcdf file, given variable id.</br/>
1174	!> start indices and number of indices selected along each dimension
1175	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1176	!
1177	!> @note ne peut pas marcher qd on fait boucle sur les variable d'un
1178	!> fichier. puisque change id.
1179
1180	!> @author J.Paul
1181	!> - Nov, 2013- Initial Version
1182	!
1183	!> @param[inout] td_file : file structure
1184	!> @param[in] id_start : index in the variable from which the data values
1185	!> will be read
1186	!> @param[in] id_count : number of indices selected along each dimension
1187	!-------------------------------------------------------------------
1188	!> @code
1189	SUBROUTINE iom_cdf__fill_var_all(td_file, id_start, id_count)
1190	IMPLICIT NONE
1191	! Argument
1192	TYPE(TFILE), INTENT(INOUT) :: td_file
1193	INTEGER(i4), DIMENSION(:), INTENT(IN ), OPTIONAL :: id_start
1194	INTEGER(i4), DIMENSION(:), INTENT(IN ), OPTIONAL :: id_count
1195
1196	! local variable
1197
1198	! loop indices
1199	INTEGER(i4) :: ji
1200	!----------------------------------------------------------------
1201	! check if file opened
1202	IF( td_file%i_id == 0 )THEN
1203
1204	CALL logger_error( &
1205	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1206
1207	ELSE
1208
1209	DO ji=1,td_file%i_nvar
1210	CALL iom_cdf_fill_var(td_file, ji, id_start, id_count)
1211	ENDDO
1212
1213	ENDIF
1214	END SUBROUTINE iom_cdf__fill_var_all
1215	!> @endcode
1216	!-------------------------------------------------------------------
1217	!> @brief This subroutine fill variable value in an opened
1218	!> netcdf file, given variable id.</br/>
1219	!> start indices and number of indices selected along each dimension
1220	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1221	!
1222	!> @note ne peut pas marcher qd on fait boucle sur les variable d'un
1223	!> fichier. puisque change id.
1224
1225	!> @author J.Paul
1226	!> - Nov, 2013- Initial Version
1227	!
1228	!> @param[inout] td_file : file structure
1229	!> @param[in] id_varid : variable id
1230	!> @param[in] id_start : index in the variable from which the data values
1231	!> will be read
1232	!> @param[in] id_count : number of indices selected along each dimension
1233	!-------------------------------------------------------------------
1234	!> @code
1235	SUBROUTINE iom_cdf__fill_var_id(td_file, id_varid, id_start, id_count)
1236	IMPLICIT NONE
1237	! Argument
1238	TYPE(TFILE), INTENT(INOUT) :: td_file
1239	INTEGER(i4), INTENT(IN) :: id_varid
1240	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1241	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1242
1243	! local variable
1244	INTEGER(i4), DIMENSION(1) :: il_ind
1245
1246	! loop indices
1247	INTEGER(i4) :: ji
1248	!----------------------------------------------------------------
1249	! check if file opened
1250	IF( td_file%i_id == 0 )THEN
1251
1252	CALL logger_error( &
1253	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1254
1255	ELSE
1256
1257	! look for variable id
1258	il_ind(:)=MINLOC( td_file%t_var(:)%i_id, &
1259	& mask=(td_file%t_var(:)%i_id==id_varid))
1260	IF( il_ind(1) /= 0 )THEN
1261
1262	!!! read variable value
1263	CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_ind(1)), &
1264	& id_start, id_count)
1265
1266	DO ji=1,td_file%i_nvar
1267	CALL logger_debug(" var id "//TRIM(td_file%t_var(ji)%c_name)//" "//TRIM(fct_str(td_file%t_var(ji)%i_id)) )
1268	ENDDO
1269	ELSE
1270	CALL logger_error( &
1271	& " FILL VAR: there is no variable with id "//&
1272	& TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
1273	ENDIF
1274
1275	ENDIF
1276	END SUBROUTINE iom_cdf__fill_var_id
1277	!> @endcode
1278	!-------------------------------------------------------------------
1279	!> @brief This subroutine fill variable value in an opened
1280	!> netcdf file, given variable name or standard name.</br/>
1281	!> start indices and number of indices selected along each dimension
1282	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1283	!
1284	!> @details
1285	!> look first for variable name. If it doesn't
1286	!> exist in file, look for variable standard name.<br/>
1287	!> If variable name is not present, check variable standard name.<br/>
1288	!
1289	!> @author J.Paul
1290	!> - Nov, 2013- Initial Version
1291	!
1292	!> @param[inout] td_file : file structure
1293	!> @param[in] cd_name : variable name or standard name
1294	!> @param[in] id_start : index in the variable from which the data values will be read
1295	!> @param[in] id_count : number of indices selected along each dimension
1296	!-------------------------------------------------------------------
1297	!> @code
1298	SUBROUTINE iom_cdf__fill_var_name(td_file, cd_name, id_start, id_count )
1299	IMPLICIT NONE
1300	! Argument
1301	TYPE(TFILE), INTENT(INOUT) :: td_file
1302	CHARACTER(LEN=*), INTENT(IN) :: cd_name
1303	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1304	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1305
1306	! local variable
1307	INTEGER(i4) :: il_ind
1308	!----------------------------------------------------------------
1309	! check if file opened
1310	IF( td_file%i_id == 0 )THEN
1311
1312	CALL logger_error( &
1313	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1314
1315	ELSE
1316
1317	il_ind=var_get_id(td_file%t_var(:), cd_name)
1318	IF( il_ind /= 0 )THEN
1319
1320	!!! read variable value
1321	CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_ind), &
1322	& id_start, id_count)
1323
1324	ELSE
1325
1326	CALL logger_error( &
1327	& " FILL VAR: there is no variable with "//&
1328	& "name or standard name"//TRIM(cd_name)//&
1329	& " in file "//TRIM(td_file%c_name))
1330	ENDIF
1331
1332	ENDIF
1333
1334	END SUBROUTINE iom_cdf__fill_var_name
1335	!> @endcode
1336	!-------------------------------------------------------------------
1337	!> @brief This function read metadata of a variable in an opened
1338	!> netcdf file.</br/>
1339	!
1340	!> @note variable value are not read
1341	!
1342	!> @author J.Paul
1343	!> - Nov, 2013- Initial Version
1344	!
1345	!> @param[in] id_fileid : file id
1346	!> @param[in] id_varid : variable id
1347	!> @return variable structure
1348	!-------------------------------------------------------------------
1349	!> @code
1350	TYPE(TVAR) FUNCTION iom_cdf__read_var_meta(td_file, id_varid)
1351	IMPLICIT NONE
1352	! Argument
1353	TYPE(TFILE), INTENT(IN) :: td_file
1354	INTEGER(i4), INTENT(IN) :: id_varid
1355
1356	! local variable
1357	CHARACTER(LEN=lc) :: cl_name
1358
1359	INTEGER(i4) :: il_status
1360	INTEGER(i4) :: il_type
1361	INTEGER(i4) :: il_ndim
1362	INTEGER(i4) :: il_natt
1363	INTEGER(i4) :: il_attid
1364	INTEGER(i4), DIMENSION(NF90_MAX_VAR_DIMS) :: il_dimid
1365
1366	TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
1367	TYPE(TATT) :: tl_fill
1368	TYPE(TATT) , DIMENSION(:) , ALLOCATABLE :: tl_att
1369	TYPE(TATT) , DIMENSION(:) , ALLOCATABLE :: tl_tmp
1370
1371	! loop indices
1372	!----------------------------------------------------------------
1373	! check if file opened
1374	IF( td_file%i_id == 0 )THEN
1375
1376	CALL logger_error( &
1377	& " READ ATT: no id associated to file "//TRIM(td_file%c_name))
1378
1379	ELSE
1380
1381	! inquire variable
1382	CALL logger_trace( &
1383	& " READ VAR: inquire variable "//TRIM(fct_str(id_varid))//&
1384	& " in file "//TRIM(td_file%c_name))
1385
1386	il_dimid(:)=0
1387
1388	il_status=NF90_INQUIRE_VARIABLE( td_file%i_id, id_varid, &
1389	& cl_name, &
1390	& il_type, &
1391	& il_ndim, &
1392	& il_dimid(:),&
1393	& il_natt )
1394	CALL iom_cdf__check(il_status)
1395
1396	!!! fill variable dimension structure
1397	tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) )
1398
1399	IF( il_natt /= 0 )THEN
1400	ALLOCATE( tl_att(il_natt) )
1401	!!! fill variable attribute structure
1402	tl_att(:)=iom_cdf__read_var_att(td_file, id_varid, il_natt)
1403
1404	!! look for _FillValue. if none add one
1405	il_attid=att_get_id(tl_att(:),'_FillValue')
1406	IF( il_attid == 0 )THEN
1407	CALL logger_warn("IOM READ VAR: no _FillValue for variable "//&
1408	& TRIM(cl_name)//" in file "//TRIM(td_file%c_name) )
1409
1410	il_attid=att_get_id(tl_att(:),'missing_value')
1411	IF( il_attid /= 0 )THEN
1412	! create attribute _FillValue
1413	CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//&
1414	& "missing_value for variable "//TRIM(cl_name) )
1415	tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:))
1416	ELSE
1417	! create attribute _FillValue
1418	CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//&
1419	& "zero for variable "//TRIM(cl_name) )
1420	tl_fill=att_init('_FillValue',0.)
1421	!tl_fill=att_init('_FillValue',1.e20)
1422	ENDIF
1423
1424	ALLOCATE( tl_tmp(il_natt) )
1425	! save read attribut
1426	tl_tmp(:)=tl_att(:)
1427	! change number of attribute in table
1428	DEALLOCATE( tl_att )
1429	ALLOCATE( tl_att(il_natt+1) )
1430	! copy read attribut
1431	tl_att(1:il_natt)=tl_tmp(:)
1432	DEALLOCATE( tl_tmp )
1433
1434	! create attribute _FillValue
1435	tl_att(il_natt+1)=tl_fill
1436
1437	ENDIF
1438
1439	ELSE
1440	ALLOCATE(tl_att(il_natt+1) )
1441	! create attribute _FillValue
1442	CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//&
1443	& "zero for variable "//TRIM(cl_name) )
1444	tl_fill=att_init('_FillValue',0.)
1445	! create attribute _FillValue
1446	tl_att(il_natt+1)=tl_fill
1447	ENDIF
1448
1449	!! initialize variable
1450	iom_cdf__read_var_meta=var_init( cl_name, il_type, tl_dim(:), &
1451	& tl_att(:), id_id=id_varid )
1452
1453	DEALLOCATE( tl_att )
1454
1455	ENDIF
1456
1457	END FUNCTION iom_cdf__read_var_meta
1458	!> @endcode
1459	!-------------------------------------------------------------------
1460	!> @brief This subroutine read variable dimension
1461	!> in an opened netcdf file.
1462	!
1463	!> @details
1464	!> the number of dimension can't exceed 4,
1465	!> and should be 'x', 'y', 'z', 't' (whatever their order).<br/>
1466	!> If the number of dimension read is less than 4, the table of dimension
1467	!> strucure is filled with unused dimension.<br/>
1468	!> So the table of dimension structure of a variable is always compose of 4
1469	!> dimension (use or not).
1470	!
1471	!> @author J.Paul
1472	!> - Nov, 2013- Initial Version
1473	!
1474	!> @param[inout] td_file : file structure
1475	!> @return file structure completed
1476	!-------------------------------------------------------------------
1477	!> @code
1478	FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid)
1479	IMPLICIT NONE
1480	! Argument
1481	TYPE(TFILE), INTENT(IN) :: td_file
1482	INTEGER(i4), INTENT(IN) :: id_ndim
1483	INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_dimid
1484
1485	! function
1486	TYPE(TDIM), DIMENSION(ip_maxdim) :: iom_cdf__read_var_dim
1487
1488	! local variable
1489	INTEGER(i4), DIMENSION(ip_maxdim) :: il_2xyzt
1490
1491	TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
1492
1493	! loop indices
1494	INTEGER(i4) :: ji
1495	!----------------------------------------------------------------
1496
1497	IF( id_ndim == 0 )THEN
1498
1499	tl_dim(:)%l_use=.FALSE.
1500
1501	! reorder dimension to ('x','y','z','t')
1502	CALL dim_reorder(tl_dim(:))
1503
1504	iom_cdf__read_var_dim(:)=tl_dim(:)
1505
1506	ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN
1507
1508
1509	DO ji = 1, id_ndim
1510	CALL logger_debug( " READ VAR DIM: get variable dimension "//&
1511	& TRIM(fct_str(ji)) )
1512
1513	il_2xyzt(ji)=td_file%t_dim(id_dimid(ji))%i_2xyzt
1514
1515	! read dimension information
1516	tl_dim(ji) = dim_init( td_file%t_dim(il_2xyzt(ji))%c_name, &
1517	& td_file%t_dim(il_2xyzt(ji))%i_len )
1518	ENDDO
1519
1520	! reorder dimension to ('x','y','z','t')
1521	CALL dim_reorder(tl_dim(:))
1522
1523	iom_cdf__read_var_dim(:)=tl_dim(:)
1524
1525	ELSE
1526
1527	CALL logger_error(" READ VAR DIM: can't manage "//&
1528	& TRIM(fct_str(id_ndim))//" dimension(s)" )
1529
1530	ENDIF
1531
1532	END FUNCTION iom_cdf__read_var_dim
1533	!> @endcode
1534	!-------------------------------------------------------------------
1535	!> @brief This subroutine read variable attributes
1536	!> in an opened netcdf file.
1537	!
1538	!> @author J.Paul
1539	!> - Nov, 2013- Initial Version
1540	!
1541	!> @param[in] td_file : file structure
1542	!> @param[inout] td_var : variable structure
1543	!> @return filled variable attribute structure
1544	!-------------------------------------------------------------------
1545	!> @code
1546	FUNCTION iom_cdf__read_var_att(td_file, id_varid, id_natt)
1547	IMPLICIT NONE
1548	! Argument
1549	TYPE(TFILE), INTENT(IN) :: td_file
1550	INTEGER(i4), INTENT(IN) :: id_varid
1551	INTEGER(i4), INTENT(IN) :: id_natt
1552
1553	! function
1554	TYPE(TATT), DIMENSION(id_natt) :: iom_cdf__read_var_att
1555
1556	! local variable
1557	TYPE(TATT), DIMENSION(id_natt) :: tl_att
1558
1559	! loop indices
1560	INTEGER(i4) :: ji
1561	!----------------------------------------------------------------
1562
1563	IF( id_natt > 0 )THEN
1564
1565	! read attributes
1566	DO ji = 1, id_natt
1567	CALL logger_debug( " READ VAR ATT: get attribute "//&
1568	& TRIM(fct_str(ji)) )
1569
1570	tl_att(ji)=iom_cdf_read_att(td_file, id_varid, ji)
1571
1572	ENDDO
1573
1574	iom_cdf__read_var_att(:)=tl_att(:)
1575
1576	ELSE
1577
1578	CALL logger_debug( " READ VAR ATT: no attribute for variable " )
1579
1580	ENDIF
1581
1582	END FUNCTION iom_cdf__read_var_att
1583	!> @endcode
1584	!-------------------------------------------------------------------
1585	!> @brief This subroutine read variable value
1586	!> in an opened netcdf file.
1587	!
1588	!> @author J.Paul
1589	!> - Nov, 2013- Initial Version
1590	!
1591	!> @param[in] td_file : file structure
1592	!> @param[inout] td_var : variable structure
1593	!> @param[in] id_start : index in the variable from which the data values will be read
1594	!> @param[in] id_count : number of indices selected along each dimension
1595	!> @return variable structure completed
1596	!
1597	!> @todo
1598	!> - warning do not change fill value when use scale factor..
1599	!-------------------------------------------------------------------
1600	!> @code
1601	SUBROUTINE iom_cdf__read_var_value(td_file, td_var, &
1602	& id_start, id_count )
1603	IMPLICIT NONE
1604	! Argument
1605	TYPE(TFILE), INTENT(IN) :: td_file
1606	TYPE(TVAR) , INTENT(INOUT) :: td_var
1607	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1608	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1609
1610	! local variable
1611	INTEGER(i4) :: il_status
1612	INTEGER(i4) :: il_tmp1, il_tmp2, il_varid
1613	INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
1614	INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
1615	INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord
1616	INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord
1617	REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1618
1619	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
1620	! loop indices
1621	INTEGER(i4) :: ji
1622	!----------------------------------------------------------------
1623
1624	! check id_count and id_start optionals parameters...
1625	IF( ( PRESENT(id_start) .AND. (.NOT. PRESENT(id_count))) .OR. &
1626	((.NOT. PRESENT(id_start)) .AND. PRESENT(id_count) ) )THEN
1627	CALL logger_warn( &
1628	& " READ VAR VALUE: id_start and id_count should be both specify")
1629	ENDIF
1630
1631	IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
1632
1633	IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
1634	& SIZE(id_count(:)) /= ip_maxdim )THEN
1635	CALL logger_error("READ VAR: dimension of table start or count "//&
1636	& " are invalid to read variable "//TRIM(td_var%c_name)//&
1637	& " in file "//TRIM(td_file%c_name) )
1638	ENDIF
1639
1640	! change dimension order from ('x','y','z','t')
1641	il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:))
1642	il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:))
1643
1644	! keep ordered table ('x','y','z','t')
1645	il_start_ord(:)=il_start(:)
1646	il_count_ord(:)=il_count(:)
1647
1648	ELSE
1649
1650	! change dimension order from ('x','y','z','t')
1651	il_start(:)=(/1,1,1,1/)
1652	il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len)
1653
1654	! keep ordered table ('x','y','z','t')
1655	il_start_ord(:)=(/1,1,1,1/)
1656	il_count_ord(:)=td_var%t_dim(:)%i_len
1657
1658	ENDIF
1659
1660	! check dimension
1661	IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN
1662
1663	CALL logger_error( &
1664	&" READ VAR VALUE: start indices should be greater than or equal to 1")
1665
1666	ENDIF
1667
1668	IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1<=(/td_var%t_dim(1)%i_len,&
1669	& td_var%t_dim(2)%i_len,&
1670	& td_var%t_dim(3)%i_len,&
1671	& td_var%t_dim(4)%i_len &
1672	& /)) )THEN
1673
1674	CALL logger_error( &
1675	& " READ VAR VALUE: start + count exceed variable dimension" )
1676
1677	DO ji = 1, ip_maxdim
1678	il_tmp1=il_start_ord(ji)+il_count_ord(ji)
1679	il_tmp2=td_var%t_dim(ji)%i_len
1680	CALL logger_debug( &
1681	& " READ VAR VALUE: start + count -1 "//TRIM(fct_str(il_tmp1))//&
1682	& " variable dimension"//TRIM(fct_str(il_tmp2)))
1683	ENDDO
1684
1685	ELSE
1686
1687	! Allocate space to hold variable value (unorder)
1688	ALLOCATE(dl_value( il_count(1), &
1689	& il_count(2), &
1690	& il_count(3), &
1691	& il_count(4)),&
1692	& stat=il_status)
1693	IF( il_status /= 0 )THEN
1694
1695	CALL logger_error( &
1696	& " READ VAR VALUE: not enough space to put variable "//&
1697	& TRIM(td_var%c_name))
1698
1699	ENDIF
1700
1701	! read values
1702	CALL logger_debug( &
1703	& " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
1704	& " in file "//TRIM(td_file%c_name))
1705	CALL logger_debug("start "//TRIM(fct_str(il_start(1)))//','//&
1706	& TRIM(fct_str(il_start(2)))//','//&
1707	& TRIM(fct_str(il_start(3)))//','//&
1708	& TRIM(fct_str(il_start(4)))//')' )
1709	CALL logger_debug("count "//TRIM(fct_str(il_count(1)))//','//&
1710	& TRIM(fct_str(il_count(2)))//','//&
1711	& TRIM(fct_str(il_count(3)))//','//&
1712	& TRIM(fct_str(il_count(4)))//')' )
1713	CALL logger_debug("dim "//TRIM(fct_str(td_file%t_dim(1)%i_len))//','//&
1714	& TRIM(fct_str(td_file%t_dim(2)%i_len))//','//&
1715	& TRIM(fct_str(td_file%t_dim(3)%i_len))//','//&
1716	& TRIM(fct_str(td_file%t_dim(4)%i_len))//')' )
1717	CALL logger_debug("shape "//TRIM(fct_str(SIZE(dl_value,DIM=1)))//","//&
1718	& TRIM(fct_str(SIZE(dl_value,DIM=2)))//","//&
1719	& TRIM(fct_str(SIZE(dl_value,DIM=3)))//","//&
1720	& TRIM(fct_str(SIZE(dl_value,DIM=4)))//")" )
1721	CALL logger_debug("var "//TRIM(td_var%c_name))
1722	il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name))
1723	CALL logger_debug("var id "//TRIM(fct_str(il_varid))//' '//TRIM(fct_str(td_var%i_id)))
1724	CALL logger_debug("file id "//TRIM(fct_str(td_file%i_id)))
1725	il_status = NF90_GET_VAR( td_file%i_id, td_var%i_id, &
1726	& dl_value(:,:,:,:), &
1727	& start = il_start(:),&
1728	& count = il_count(:) )
1729	CALL iom_cdf__check(il_status)
1730
1731	! Allocate space to hold variable value in structure
1732	IF( ASSOCIATED(td_var%d_value) )THEN
1733	DEALLOCATE(td_var%d_value)
1734	ENDIF
1735
1736	! new dimension length
1737	td_var%t_dim(:)%i_len=il_count_ord(:)
1738
1739	ALLOCATE(td_var%d_value( il_count_ord(1), &
1740	& il_count_ord(2), &
1741	& il_count_ord(3), &
1742	& il_count_ord(4)),&
1743	& stat=il_status)
1744	IF(il_status /= 0 )THEN
1745
1746	CALL logger_error( &
1747	& " READ VAR VALUE: not enough space to put variable "//&
1748	& TRIM(td_var%c_name)//&
1749	& " in variable structure")
1750
1751	ENDIF
1752	! FillValue by default
1753	td_var%d_value(:,:,:,:)=td_var%d_fill
1754
1755	! reshape values to be ordered as ('x','y','z','t')
1756	tl_dim(:)=td_var%t_dim(:)
1757	td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim,dl_value(:,:,:,:))
1758
1759	DEALLOCATE(dl_value)
1760
1761	! force to change _FillValue to avoid mistake
1762	! with dummy zero _FillValue
1763	IF( td_var%d_fill == 0._dp )THEN
1764	CALL var_chg_FillValue(td_var)
1765	ENDIF
1766	ENDIF
1767
1768	END SUBROUTINE iom_cdf__read_var_value
1769	!> @endcode
1770	!-------------------------------------------------------------------
1771	!> @brief This subroutine write file structure in an opened netcdf file.
1772	!
1773	!> @details
1774	!
1775	!> @author J.Paul
1776	!> - Nov, 2013- Initial Version
1777	!
1778	!> @param[in] td_file : file structure
1779	!-------------------------------------------------------------------
1780	!> @code
1781	SUBROUTINE iom_cdf_write_file(td_file)
1782	IMPLICIT NONE
1783	! Argument
1784	TYPE(TFILE), INTENT(INOUT) :: td_file
1785
1786	! local variable
1787	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_value
1788
1789	TYPE(TVAR) :: tl_var
1790
1791	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
1792
1793	! loop indices
1794	INTEGER(i4) :: ji
1795	INTEGER(i4) :: jj
1796	!----------------------------------------------------------------
1797
1798	! check if file opened
1799	IF( td_file%i_id == 0 )THEN
1800
1801	CALL logger_error( &
1802	& " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
1803
1804	ELSE
1805	IF( td_file%l_wrt )THEN
1806
1807	! delete dummy variable
1808	CALL file_del_var( td_file, 'no0d' )
1809	CALL file_del_var( td_file, 'no1d' )
1810	CALL file_del_var( td_file, 'no2d' )
1811	CALL file_del_var( td_file, 'no3d' )
1812
1813	DO ji = 1, td_file%i_nvar
1814	CALL var_check_dim( td_file%t_var(ji) )
1815	ENDDO
1816
1817	! save usefull dimension
1818	tl_dim(:)=var_max_dim(td_file%t_var(:))
1819
1820	DO ji=1,ip_maxdim
1821	IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji))
1822	ENDDO
1823
1824	! write dimension in file
1825	DO ji = 1, ip_maxdim
1826	IF( td_file%t_dim(ji)%l_use )THEN
1827	CALL iom_cdf__write_dim(td_file, td_file%t_dim(ji))
1828
1829	! write dimension variable
1830	ALLOCATE(il_value(td_file%t_dim(ji)%i_len))
1831	il_value(:)=(/(jj,jj=1,td_file%t_dim(ji)%i_len)/)
1832
1833	tl_var=var_init( fct_upper(td_file%t_dim(ji)%c_sname), &
1834	& il_value(:), &
1835	& td_dim=td_file%t_dim(ji) )
1836
1837	DEALLOCATE(il_value)
1838
1839	CALL iom_cdf__write_var(td_file,tl_var)
1840	CALL var_clean(tl_var)
1841
1842	ENDIF
1843	ENDDO
1844
1845	! write global attibute in file
1846	DO ji = 1, td_file%i_natt
1847	CALL iom_cdf__write_att(td_file, NF90_GLOBAL, td_file%t_att(ji))
1848	ENDDO
1849
1850	! write variable in file
1851	DO ji = 1, td_file%i_nvar
1852	CALL iom_cdf__write_var(td_file, td_file%t_var(ji))
1853	ENDDO
1854
1855	ELSE
1856
1857	CALL logger_error( &
1858	& " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
1859	& ", not opened in write mode")
1860
1861	ENDIF
1862	ENDIF
1863
1864	END SUBROUTINE iom_cdf_write_file
1865	!> @endcode
1866	!-------------------------------------------------------------------
1867	!> @brief This subroutine write one dimension in an opened netcdf
1868	!> file in write mode.
1869	!
1870	!> @author J.Paul
1871	!> - Nov, 2013- Initial Version
1872	!
1873	!> @param[inout] td_file : file structure
1874	!> @param[inout] td_dim : dimension structure
1875	!-------------------------------------------------------------------
1876	!> @code
1877	SUBROUTINE iom_cdf__write_dim(td_file, td_dim)
1878	IMPLICIT NONE
1879	! Argument
1880	TYPE(TFILE), INTENT(INOUT) :: td_file
1881	TYPE(TDIM), INTENT(INOUT) :: td_dim
1882
1883	! local variable
1884	INTEGER(i4) :: il_status
1885	!----------------------------------------------------------------
1886
1887	IF( .NOT. td_file%l_def )THEN
1888
1889	CALL logger_debug( &
1890	& " WRITE FILE DIM: Enter define mode, file "//TRIM(td_file%c_name))
1891
1892	! Enter define mode
1893	il_status=NF90_REDEF(td_file%i_id)
1894	CALL iom_cdf__check(il_status)
1895
1896	td_file%l_def=.TRUE.
1897
1898	ENDIF
1899
1900	IF( td_dim%l_use )THEN
1901	IF( td_dim%l_uld )THEN
1902	! write unlimited dimension
1903	CALL logger_debug( &
1904	& " WRITE FILE DIM: write unlimited dimension "//&
1905	& TRIM(td_dim%c_name)//" in file "//TRIM(td_file%c_name))
1906
1907	il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
1908	& NF90_UNLIMITED, td_dim%i_id)
1909	CALL iom_cdf__check(il_status)
1910
1911	ELSE
1912	! write not unlimited dimension
1913	CALL logger_debug( &
1914	& " WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//&
1915	& " in file "//TRIM(td_file%c_name))
1916
1917	il_status=NF90_DEF_DIM(td_file%i_id, fct_upper(td_dim%c_sname), &
1918	& td_dim%i_len, td_dim%i_id)
1919	CALL iom_cdf__check(il_status)
1920
1921	ENDIF
1922	ENDIF
1923
1924	END SUBROUTINE iom_cdf__write_dim
1925	!> @endcode
1926	!-------------------------------------------------------------------
1927	!> @brief This subroutine write a variable attribute in
1928	!> an opened netcdf file.
1929	!
1930	!> @author J.Paul
1931	!> - Nov, 2013- Initial Version
1932	!
1933	!> @param[inout] td_file : file structure
1934	!> @param[in] id_varid : variable id. use NF90_GLOBAL to write global attribute
1935	!> in a file
1936	!> @param[in] td_att : attribute structure
1937	!-------------------------------------------------------------------
1938	!> @code
1939	SUBROUTINE iom_cdf__write_att(td_file, id_varid, td_att)
1940	IMPLICIT NONE
1941	! Argument
1942	TYPE(TFILE), INTENT(INOUT) :: td_file
1943	INTEGER(i4), INTENT(IN) :: id_varid
1944	TYPE(TATT), INTENT(IN) :: td_att
1945
1946	! local variable
1947	INTEGER(i4) :: il_status
1948	!----------------------------------------------------------------
1949
1950	IF( .NOT. td_file%l_def )THEN
1951
1952	CALL logger_debug( &
1953	& " WRITE FILE ATT: Enter define mode, file "//TRIM(td_file%c_name))
1954
1955	! Enter define mode
1956	il_status=NF90_REDEF(td_file%i_id)
1957	CALL iom_cdf__check(il_status)
1958
1959	td_file%l_def=.TRUE.
1960
1961	ENDIF
1962
1963	!! put attribute value
1964	CALL logger_debug( &
1965	& " WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//&
1966	& " of variable "//TRIM(fct_str(id_varid))//&
1967	& " in file "//TRIM(td_file%c_name))
1968	SELECT CASE( td_att%i_type )
1969
1970	CASE(NF90_CHAR)
1971	! put the attribute
1972	il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
1973	& td_att%c_name, td_att%c_value )
1974	CALL iom_cdf__check(il_status)
1975
1976	CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)
1977	! put the attribute
1978	il_status = NF90_PUT_ATT(td_file%i_id, id_varid, &
1979	& td_att%c_name, td_att%d_value )
1980	CALL iom_cdf__check(il_status)
1981
1982	END SELECT
1983
1984	END SUBROUTINE iom_cdf__write_att
1985	!> @endcode
1986	!-------------------------------------------------------------------
1987	!> @brief This subroutine write a variable in an opened netcdf file.</br/>
1988	!
1989	!> @author J.Paul
1990	!> - Nov, 2013- Initial Version
1991	!
1992	!> @param[inout] td_file : file structure
1993	!> @param[inout] td_var : variable structure
1994	!-------------------------------------------------------------------
1995	!> @code
1996	SUBROUTINE iom_cdf__write_var(td_file, td_var)
1997	IMPLICIT NONE
1998	! Argument
1999	TYPE(TFILE), INTENT(INOUT) :: td_file
2000	TYPE(TVAR), INTENT(INOUT) :: td_var
2001
2002	! local variable
2003	INTEGER(i4) :: il_status
2004	!----------------------------------------------------------------
2005
2006	IF( .NOT. td_file%l_def )THEN
2007
2008	CALL logger_debug( &
2009	& " WRITE FILE VAR: Enter define mode, file "//TRIM(td_file%c_name))
2010
2011	! Enter define mode
2012	il_status=NF90_REDEF(td_file%i_id)
2013	CALL iom_cdf__check(il_status)
2014
2015	td_file%l_def=.TRUE.
2016
2017	ENDIF
2018
2019	! check if file and variable dimension conform
2020	IF( file_check_var_dim(td_file, td_var) )THEN
2021
2022	! check variable dimension expected
2023	CALL var_check_dim(td_var)
2024
2025	! change fill value to NETCDF standard
2026	CALL var_chg_FillValue(td_var)
2027
2028	! define variable in file
2029	td_var%i_id=iom_cdf__write_var_def(td_file, td_var)
2030
2031	IF( td_file%l_def )THEN
2032
2033	CALL logger_debug( &
2034	& " WRITE FILE VAR: Leave define mode, file "//TRIM(td_file%c_name))
2035
2036	! Leave define mode
2037	il_status=NF90_ENDDEF(td_file%i_id)
2038	CALL iom_cdf__check(il_status)
2039
2040	td_file%l_def=.FALSE.
2041
2042	ENDIF
2043
2044	IF( ASSOCIATED(td_var%d_value) )THEN
2045	! write variable value in file
2046	CALL iom_cdf__write_var_value(td_file, td_var)
2047	ENDIF
2048
2049	ENDIF
2050
2051	END SUBROUTINE iom_cdf__write_var
2052	!> @endcode
2053	!-------------------------------------------------------------------
2054	!> @brief This function define variable in an opened netcdf file.
2055	!
2056	!> @author J.Paul
2057	!> - Nov, 2013- Initial Version
2058	!
2059	!> @param[in] td_file : file structure
2060	!> @param[in] td_var : variable structure
2061	!> @return variable id
2062	!-------------------------------------------------------------------
2063	!> @code
2064	INTEGER(i4) FUNCTION iom_cdf__write_var_def(td_file, td_var)
2065	IMPLICIT NONE
2066	! Argument
2067	TYPE(TFILE), INTENT(IN) :: td_file
2068	TYPE(TVAR), INTENT(IN) :: td_var
2069
2070	! local variable
2071	INTEGER(i4) :: il_status
2072	INTEGER(i4), DIMENSION(ip_maxdim) :: il_dimid
2073
2074	! loop indices
2075	INTEGER(i4) :: ji
2076	INTEGER(i4) :: jj
2077	!----------------------------------------------------------------
2078
2079	CALL logger_debug( &
2080	& " WRITE FILE VAR DEF: get dimension to be used for variable "//&
2081	& TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
2082
2083	IF( ALL( .NOT. td_var%t_dim(:)%l_use ) )THEN
2084	! scalar value
2085	il_status = NF90_DEF_VAR(td_file%i_id, TRIM(td_var%c_name), &
2086	& td_var%i_type, varid=iom_cdf__write_var_def)
2087	CALL iom_cdf__check(il_status)
2088	ELSE
2089
2090	! check which dimension use
2091	jj=0
2092	il_dimid(:)=0
2093	! reorder dimension, so unused dimension won't be written
2094	DO ji = 1, ip_maxdim
2095	IF( td_var%t_dim(ji)%l_use )THEN
2096	jj=jj+1
2097	CALL logger_debug(" get dim id for dimension "//TRIM(td_var%t_dim(ji)%c_name))
2098	il_dimid(jj)=dim_get_id(td_file%t_dim(:),td_var%t_dim(ji)%c_name)
2099	ENDIF
2100	ENDDO
2101
2102	CALL logger_debug( &
2103	& " WRITE FILE VAR DEF: define dimension to be used for variable "//&
2104	& TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
2105
2106	DO ji=1,jj
2107	CALL logger_debug(" WRITE FILE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) )
2108	ENDDO
2109	il_status = NF90_DEF_VAR(td_file%i_id, TRIM(td_var%c_name), &
2110	& td_var%i_type, &
2111	& il_dimid(1:jj), &
2112	& varid=iom_cdf__write_var_def )
2113	CALL iom_cdf__check(il_status)
2114	ENDIF
2115
2116	DO ji = 1, td_var%i_natt
2117	CALL logger_debug( &
2118	& " WRITE FILE VAR DEF: put attribute "//TRIM(td_var%t_att(ji)%c_name)//&
2119	& " for variable "//TRIM(td_var%c_name)//&
2120	& " in file "//TRIM(td_file%c_name) )
2121
2122	IF( td_var%t_att(ji)%i_type == NF90_CHAR )THEN
2123	!IF( TRIM(td_var%t_att(ji)%c_value) /= 'unknown' )THEN
2124	IF( TRIM(td_var%t_att(ji)%c_value) /= '' )THEN
2125	il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, &
2126	& TRIM(td_var%t_att(ji)%c_name), &
2127	& TRIM(td_var%t_att(ji)%c_value) )
2128	CALL iom_cdf__check(il_status)
2129	ENDIF
2130	ELSE
2131	SELECT CASE(td_var%t_att(ji)%i_type)
2132	CASE(NF90_BYTE)
2133	il_status = NF90_PUT_ATT(td_file%i_id, &
2134	& iom_cdf__write_var_def, &
2135	& TRIM(td_var%t_att(ji)%c_name), &
2136	& INT(td_var%t_att(ji)%d_value(:),i1))
2137	CASE(NF90_SHORT)
2138	il_status = NF90_PUT_ATT(td_file%i_id, &
2139	& iom_cdf__write_var_def, &
2140	& TRIM(td_var%t_att(ji)%c_name), &
2141	& INT(td_var%t_att(ji)%d_value(:),i2))
2142	CASE(NF90_INT)
2143	il_status = NF90_PUT_ATT(td_file%i_id, &
2144	& iom_cdf__write_var_def, &
2145	& TRIM(td_var%t_att(ji)%c_name), &
2146	& INT(td_var%t_att(ji)%d_value(:),i4))
2147	CASE(NF90_FLOAT)
2148	il_status = NF90_PUT_ATT(td_file%i_id, &
2149	& iom_cdf__write_var_def, &
2150	& TRIM(td_var%t_att(ji)%c_name), &
2151	& REAL(td_var%t_att(ji)%d_value(:),sp))
2152	CASE(NF90_DOUBLE)
2153	il_status = NF90_PUT_ATT(td_file%i_id, &
2154	& iom_cdf__write_var_def, &
2155	& TRIM(td_var%t_att(ji)%c_name), &
2156	& REAL(td_var%t_att(ji)%d_value(:),dp))
2157	END SELECT
2158	CALL iom_cdf__check(il_status)
2159	ENDIF
2160	ENDDO
2161
2162	END FUNCTION iom_cdf__write_var_def
2163	!> @endcode
2164	!-------------------------------------------------------------------
2165	!> @brief This subroutine put variable value in an opened netcdf file.
2166	!
2167	!> @details
2168	!> The variable is written in the type define in variable structure.
2169	!> Only dimension used are printed, and fillValue in table are
2170	!> replaced by default fill values defined in module netcdf for each type.
2171	!
2172	!> @author J.Paul
2173	!> - Nov, 2013- Initial Version
2174	!
2175	!> @param[in] td_file : file structure
2176	!> @param[in] td_var : variable structure
2177	!-------------------------------------------------------------------
2178	!> @code
2179	SUBROUTINE iom_cdf__write_var_value(td_file, td_var)
2180	IMPLICIT NONE
2181	! Argument
2182	TYPE(TFILE), INTENT(IN) :: td_file
2183	TYPE(TVAR), INTENT(IN) :: td_var
2184
2185	! local variable
2186	INTEGER(i4) :: il_status
2187	INTEGER(i4), DIMENSION(ip_maxdim) :: il_order
2188	INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
2189	REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
2190
2191	! loop indices
2192	INTEGER(i4) :: ji, jj
2193	!----------------------------------------------------------------
2194
2195	! check which dimension use
2196	CALL logger_debug( &
2197	& " WRITE FILE VAR VALUE: get dimension to be used for variable "//&
2198	& TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name))
2199
2200	jj=0
2201	DO ji = 1, ip_maxdim
2202	IF( td_var%t_dim(ji)%l_use )THEN
2203	jj=jj+1
2204	!il_order(ji)=jj
2205	!il_shape(ji)=td_var%t_dim(jj)%i_len
2206	il_order(jj)=ji
2207	il_shape(jj)=td_var%t_dim(ji)%i_len
2208	ENDIF
2209	ENDDO
2210	! dimension not use
2211	DO ji = 1, ip_maxdim
2212	IF( .NOT. td_var%t_dim(ji)%l_use )THEN
2213	jj=jj+1
2214	!il_order(ji)=jj
2215	!il_shape(ji)=td_var%t_dim(jj)%i_len
2216	il_order(jj)=ji
2217	il_shape(jj)=td_var%t_dim(ji)%i_len
2218	ENDIF
2219	ENDDO
2220
2221	ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3),il_shape(4) ) )
2222
2223	! reshape table, so unused dimension won't be written
2224	dl_value(:,:,:,:)=RESHAPE(source=td_var%d_value(:,:,:,:),&
2225	& SHAPE = il_shape(:), &
2226	& ORDER = il_order(:))
2227
2228	! put value
2229	CALL logger_debug( &
2230	& " WRITE FILE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//&
2231	& "in file "//TRIM(td_file%c_name))
2232
2233	il_status = NF90_PUT_VAR( td_file%i_id, td_var%i_id, dl_value(:,:,:,:))
2234	CALL iom_cdf__check(il_status)
2235
2236	DEALLOCATE( dl_value )
2237
2238	END SUBROUTINE iom_cdf__write_var_value
2239	!> @endcode
2240	END MODULE iom_cdf

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

Download in other formats: