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_rstdimg.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_rstdimg.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: 67.1 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! MODULE: iom_rstdimg
6	!
7	! DESCRIPTION:
8	!> @brief
9	!> This module is a library to read/write dimg file.
10	!>
11	!> @details
12	!>
13	!> to open dimg file (create file structure):<br/>
14	!> CALL iom_rstdimg_open(td_file)
15	!> - td_file is file structure (see file.f90)
16	!>
17	!> to write in dimg file:<br/>
18	!> CALL iom_rstdimg_write_file(td_file)
19	!>
20	!> to close dimg file:<br/>
21	!> CALL iom_rstdimg_close(tl_file)
22	!>
23	!> to read one dimension in dimg file:<br/>
24	!> tl_dim = iom_rstdimg_read_dim(tl_file, id_dimid)<br/>
25	!> or<br/>
26	!> tl_dim = iom_rstdimg_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 dimg file:<br/>
31	!> tl_att = iom_rstdimg_read_att(tl_file, id_varid, id_attid)<br/>
32	!> or<br/>
33	!> tl_att = iom_rstdimg_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 dimg file:<br/>
39	!> tl_var = iom_rstdimg_read_var(td_file, id_varid, [id_start, id_count])<br/>
40	!> or<br/>
41	!> tl_var = iom_rstdimg_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	!----------------------------------------------------------------------
61	MODULE iom_rstdimg
62	USE netcdf ! nf90 library
63	USE kind ! F90 kind parameter
64	USE fct ! basic useful function
65	USE logger ! log file manager
66	USE att ! attribute manager
67	USE dim ! dimension manager
68	USE var ! variable manager
69	USE file ! file manager
70	USE dom ! domain manager
71	IMPLICIT NONE
72	PRIVATE
73	! NOTE_avoid_public_variables_if_possible
74
75	! function and subroutine
76	PUBLIC :: iom_rstdimg_open !< open or create dimg file, return file structure
77	PUBLIC :: iom_rstdimg_close !< close dimg file
78	PUBLIC :: iom_rstdimg_read_dim !< read one dimension in an opened dimg file, return variable structure
79	PUBLIC :: iom_rstdimg_read_var !< read one variable in an opened dimg file, return dimension structure
80	PUBLIC :: iom_rstdimg_fill_var !< fill variable value in an opened dimg file
81	PUBLIC :: iom_rstdimg_write_file !< write file structure contents in an opened dimg file
82	PUBLIC :: iom_rstdimg_get_mpp !< get sub domain decomppistion in a dimg file
83
84	PRIVATE :: iom_rstdimg__get_info !< get global information in an opened dimg file
85	PRIVATE :: iom_rstdimg__get_file_var !< read information about variable on an opened dimg file.
86	PRIVATE :: iom_rstdimg__get_file_var_0d !< put information about scalar variable in file structure
87	PRIVATE :: iom_rstdimg__get_file_var_1d !< put information about variable 1D in file structure
88	PRIVATE :: iom_rstdimg__get_file_var_2d !< put information about variable 2D in file structure
89	PRIVATE :: iom_rstdimg__get_file_var_3d !< put information about variable 3D in file structure
90	PRIVATE :: iom_rstdimg__read_dim_id !< read dimension structure in an opened dimg file, given variable id.
91	PRIVATE :: iom_rstdimg__read_dim_name !< read dimension structure in an opened dimg file, given variable name or standard name.
92	PRIVATE :: iom_rstdimg__read_var_id !< read variable value in an opened dimg file, given variable id.
93	PRIVATE :: iom_rstdimg__read_var_name !< read variable value in an opened dimg file, given variable name or standard name.
94	PRIVATE :: iom_rstdimg__read_var_value !< read variable value in an opened dimg file, for variable 1,2,3d
95	PRIVATE :: iom_rstdimg__write_header !< write header in an opened dimg file
96	PRIVATE :: iom_rstdimg__write_var !< write variables in an opened dimg file
97	PRIVATE :: iom_rstdimg__fill_var_id !< fill variable value in an opened dimg file, given variable id
98	PRIVATE :: iom_rstdimg__fill_var_name !< fill variable value in an opened dimg file, given variable name
99	PRIVATE :: iom_rstdimg__fill_var_all !< fill all variable value in an opened dimg file
100
101	! module variable
102	INTEGER(i4), PARAMETER :: ip_vnl = 32 ! variable name length
103
104	INTERFACE iom_rstdimg_read_dim
105	MODULE PROCEDURE iom_rstdimg__read_dim_id
106	MODULE PROCEDURE iom_rstdimg__read_dim_name
107	END INTERFACE iom_rstdimg_read_dim
108
109	INTERFACE iom_rstdimg_read_var
110	MODULE PROCEDURE iom_rstdimg__read_var_id
111	MODULE PROCEDURE iom_rstdimg__read_var_name
112	END INTERFACE iom_rstdimg_read_var
113
114	INTERFACE iom_rstdimg_fill_var
115	MODULE PROCEDURE iom_rstdimg__fill_var_id
116	MODULE PROCEDURE iom_rstdimg__fill_var_name
117	MODULE PROCEDURE iom_rstdimg__fill_var_all
118	END INTERFACE iom_rstdimg_fill_var
119
120	CONTAINS
121	!-------------------------------------------------------------------
122	!> @brief This subroutine open a dimg file in read or write mode<br/>
123	!> if try to open a file in write mode that did not exist, create it.<br/>
124	!> if file already exist, get information about:
125	!> - the number of variables
126	!> - the number of dimensions
127	!> - the number of global attributes
128	!> - the ID of the unlimited dimension
129	!> - the file format
130	!> and finally read dimensions.
131	!>
132	!> @author J.Paul
133	!> - Nov, 2013- Initial Version
134	!
135	!> @param[inout] td_file : file structure
136	!-------------------------------------------------------------------
137	!> @code
138	SUBROUTINE iom_rstdimg_open(td_file)
139	IMPLICIT NONE
140	! Argument
141	TYPE(TFILE), INTENT(INOUT) :: td_file
142
143	! local variable
144	LOGICAL :: ll_exist
145	LOGICAL :: ll_open
146
147	INTEGER(i4) :: il_status
148
149	TYPE(TVAR) :: tl_lon
150	!----------------------------------------------------------------
151
152	! check file existence
153	! WARNING may be some issue with dimg file !!!
154	INQUIRE(FILE=TRIM(td_file%c_name), EXIST=ll_exist, OPENED=ll_open)
155	IF( .NOT. ll_exist .OR. TRIM(td_file%c_type) /= 'dimg' )THEN
156
157	IF( .NOT. td_file%l_wrt )THEN
158
159	CALL logger_fatal( " OPEN: can not open dimg file "//&
160	& TRIM(td_file%c_name) )
161
162	ELSE
163
164	CALL logger_info( " CREATE: dimg file "//TRIM(td_file%c_name) )
165
166	! get free unit
167	td_file%i_id=fct_getunit()
168
169	OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
170	& FORM='UNFORMATTED', &
171	& ACCESS='DIRECT', &
172	& STATUS='NEW', &
173	& ACTION='WRITE', &
174	& RECL=8, &
175	& IOSTAT=il_status)
176	CALL fct_err(il_status)
177	IF( il_status /= 0 )THEN
178	CALL logger_error("CREATE: dimg file "//&
179	& TRIM(td_file%c_name))
180	ENDIF
181
182
183	ENDIF
184
185	ELSE
186
187	IF( ll_open )THEN
188
189	CALL logger_error( " OPEN: dimg file "//&
190	& TRIM(td_file%c_name)//" already opened")
191
192	ELSE
193
194	! get free unit
195	td_file%i_id=fct_getunit()
196
197	! open temporary in read only mode
198	OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
199	& FORM='UNFORMATTED', &
200	& ACCESS='DIRECT', &
201	& STATUS='OLD', &
202	& ACTION='READ', &
203	& RECL=8, &
204	& IOSTAT=il_status)
205	CALL fct_err(il_status)
206	IF( il_status /= 0 )THEN
207	CALL logger_error("OPEN: file "//TRIM(td_file%c_name))
208	ENDIF
209
210	! get record length
211	READ( td_file%i_id, IOSTAT=il_status, &
212	& REC=1) td_file%i_recl
213	CALL fct_err(il_status)
214	IF( il_status /= 0 )THEN
215	CALL logger_error("OPEN: read record length : "//&
216	& TRIM(fct_str(td_file%i_recl))//" in file "//&
217	& TRIM(td_file%c_name) )
218	ENDIF
219
220	CLOSE( td_file%i_id, IOSTAT=il_status )
221	CALL fct_err(il_status)
222	IF( il_status /= 0 )THEN
223	CALL logger_error("OPEN: close file "//TRIM(td_file%c_name))
224	ENDIF
225
226
227	IF( .NOT. td_file%l_wrt )THEN
228
229	CALL logger_info( " OPEN: dimg file "//&
230	& TRIM(td_file%c_name)//" in read only mode" )
231
232	! open file in read mode
233	OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
234	& FORM='UNFORMATTED', &
235	& ACCESS='DIRECT', &
236	& STATUS='OLD', &
237	& ACTION='READ', &
238	& RECL=td_file%i_recl, &
239	& IOSTAT=il_status)
240	CALL fct_err(il_status)
241	IF( il_status /= 0 )THEN
242	CALL logger_error("OPEN: file "//TRIM(td_file%c_name)&
243	& //" with record length "//TRIM(fct_str(td_file%i_recl)))
244	ENDIF
245
246	ELSE
247
248	CALL logger_info( " OPEN: dimg file "//&
249	& TRIM(td_file%c_name)//&
250	& " in read and write mode")
251
252	! open file in read mode
253	OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
254	& FORM='UNFORMATTED', &
255	& ACCESS='DIRECT', &
256	& STATUS='OLD', &
257	& ACTION='READWRITE', &
258	& RECL=td_file%i_recl, &
259	& IOSTAT=il_status)
260	CALL fct_err(il_status)
261	IF( il_status /= 0 )THEN
262	CALL logger_error("OPEN: file "//TRIM(td_file%c_name))
263	ENDIF
264
265	ENDIF
266
267	! get general information about file
268	CALL iom_rstdimg__get_info(td_file)
269
270	! get domain decomposition in file
271	CALL iom_rstdimg_get_mpp(td_file)
272
273	! get information about variables in file
274	CALL iom_rstdimg__get_file_var(td_file)
275
276	! get ew overlap
277	tl_lon=iom_rstdimg_read_var(td_file,'longitude')
278	td_file%i_ew=dom_get_ew_overlap(tl_lon)
279	WHERE( td_file%t_var(:)%t_dim(1)%l_use )
280	td_file%t_var(:)%i_ew=td_file%i_ew
281	ENDWHERE
282	CALL var_clean(tl_lon)
283
284	ENDIF
285
286	ENDIF
287
288	END SUBROUTINE iom_rstdimg_open
289	!> @endcode
290	!-------------------------------------------------------------------
291	!> @brief This subroutine close dimg file
292	!>
293	!> @author J.Paul
294	!> - Nov, 2013- Initial Version
295	!
296	!> @param[in] td_file : file structure
297	!-------------------------------------------------------------------
298	!> @code
299	SUBROUTINE iom_rstdimg_close(td_file)
300	IMPLICIT NONE
301	! Argument
302	TYPE(TFILE), INTENT(INOUT) :: td_file
303
304	! local variable
305	INTEGER(i4) :: il_status
306	!----------------------------------------------------------------
307
308	! check if file opened
309	IF( td_file%i_id == 0 )THEN
310
311	CALL logger_error( &
312	& " CLOSE: no id associated to file "//TRIM(td_file%c_name))
313
314	ELSE
315	CALL logger_info( &
316	& " CLOSE: file "//TRIM(td_file%c_name))
317
318	CLOSE( td_file%i_id, IOSTAT=il_status )
319	CALL fct_err(il_status)
320	IF( il_status /= 0 )THEN
321	CALL logger_error("CLOSE "//TRIM(td_file%c_name))
322	ENDIF
323
324	td_file%i_id = 0
325
326	ENDIF
327
328	END SUBROUTINE iom_rstdimg_close
329	!> @endcode
330	!-------------------------------------------------------------------
331	!> @brief This subroutine get global information in an opened dimg
332	!> file.<br/>
333	!> @details
334	!> It gets the number of variables, the domain decompistion,
335	!> the record of the header infos.<br/>
336	!> It read dimensions, and add it to dimension structure inside
337	!> file structure.
338	!>
339	!> @author J.Paul
340	!> - Nov, 2013- Initial Version
341	!
342	!> @param[inout] td_file : file structure
343	!> @return file structure completed
344	!-------------------------------------------------------------------
345	!> @code
346	SUBROUTINE iom_rstdimg__get_info(td_file)
347	IMPLICIT NONE
348	! Argument
349	TYPE(TFILE), INTENT(INOUT) :: td_file
350
351	! local variable
352	INTEGER(i4) :: il_status
353	INTEGER(i4) :: il_recl ! record length
354	INTEGER(i4) :: il_nx, il_ny, il_nz ! x,y,z dimension
355	INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d ! number of 0/1/2/3D variables
356	INTEGER(i4) :: il_rhd ! record of the header infos
357
358	TYPE(TDIM) :: tl_dim ! dimension structure
359	!----------------------------------------------------------------
360
361	CALL logger_debug( &
362	& " GET INFO: about dimg file "//TRIM(td_file%c_name))
363
364	! read first record
365	READ( td_file%i_id, IOSTAT=il_status, REC=1 )&
366	& il_recl, &
367	& il_nx, il_ny, il_nz, &
368	& il_n0d, il_n1d, il_n2d, il_n3d, &
369	& il_rhd
370	CALL fct_err(il_status)
371	IF( il_status /= 0 )THEN
372	CALL logger_error("GET INFO: read first line of "//TRIM(td_file%c_name))
373	ENDIF
374
375	CALL logger_trace( &
376	& " GET INFO: about dimg file "//TRIM(td_file%c_name))
377
378	td_file%c_type='dimg'
379
380	! add dimension to file structure
381	tl_dim=dim_init('X', il_nx)
382	CALL file_add_dim(td_file, tl_dim)
383	tl_dim=dim_init('Y', il_ny)
384	CALL file_add_dim(td_file, tl_dim)
385	tl_dim=dim_init('Z', il_nz)
386	CALL file_add_dim(td_file, tl_dim)
387
388	! reorder dimension to ('x','y','z','t')
389	! actually fill unused dimension
390	CALL dim_reorder(td_file%t_dim)
391
392	! save total number of variable
393	td_file%i_n0d=il_n0d
394	td_file%i_n1d=il_n1d
395	td_file%i_n2d=il_n2d
396	td_file%i_n3d=il_n3d
397	td_file%i_nvar=il_n0d+il_n1d+il_n2d+il_n3d
398
399	! record header infos
400	td_file%i_rhd=il_rhd
401
402	END SUBROUTINE iom_rstdimg__get_info
403	!> @endcode
404	!-------------------------------------------------------------------
405	!> @brief This subroutine get sub domain decomposition in a dimg file.<br/>
406	!> @details
407	!> domain decomposition informations are saved in attributes.
408	!>
409	!> @author J.Paul
410	!> - Nov, 2013- Initial Version
411	!
412	!> @param[inout] td_file : file structure
413	!> @return mpp structure
414	!-------------------------------------------------------------------
415	!> @code
416	SUBROUTINE iom_rstdimg_get_mpp(td_file)
417	IMPLICIT NONE
418	! Argument
419	TYPE(TFILE), INTENT(INOUT) :: td_file
420
421	! local variable
422	TYPE(TATT) :: tl_att
423	INTEGER(i4) :: il_status
424	INTEGER(i4) :: il_recl ! record length
425	INTEGER(i4) :: il_nx, il_ny, il_nz ! x,y,z dimension
426	INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d ! number of 0/1/2/3D variables
427	INTEGER(i4) :: il_iglo, il_jglo ! domain global size
428	INTEGER(i4) :: il_rhd ! record of the header infos
429	INTEGER(i4) :: il_niproc, il_njproc, il_nproc ! domain decomposition
430	INTEGER(i4) :: il_area ! domain index
431
432	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
433	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
434	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
435	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
436	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
437	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
438	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
439	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
440	!----------------------------------------------------------------
441
442	CALL logger_trace( " GET MPP: dimg file "//TRIM(td_file%c_name))
443
444	! read first record
445	READ( td_file%i_id, IOSTAT=il_status, REC=1 )&
446	& il_recl, &
447	& il_nx, il_ny, il_nz, &
448	& il_n0d, il_n1d, il_n2d, il_n3d, &
449	& il_rhd, &
450	& il_niproc, il_njproc, il_nproc, &
451	& il_area, &
452	& il_iglo, il_jglo
453	CALL fct_err(il_status)
454	IF( il_status /= 0 )THEN
455	CALL logger_error("GET MPP: read first line of "//TRIM(td_file%c_name))
456	ENDIF
457
458	! create attributes to save mpp value
459	tl_att=att_init( "DOMAIN_number_total", il_nproc)
460	CALL file_add_att(td_file, tl_att)
461
462	tl_att=att_init( "DOMAIN_I_number_total", il_niproc)
463	CALL file_add_att(td_file, tl_att)
464
465	tl_att=att_init( "DOMAIN_J_number_total", il_njproc)
466	CALL file_add_att(td_file, tl_att)
467
468	tl_att=att_init( "DOMAIN_number", il_area)
469	CALL file_add_att(td_file, tl_att)
470
471	tl_att=att_init( "DOMAIN_size_global", (/il_iglo, il_jglo/))
472	CALL file_add_att(td_file, tl_att)
473
474	! allocate local variable
475	ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
476	& il_lci(il_nproc), il_lcj(il_nproc), &
477	& il_ldi(il_nproc), il_ldj(il_nproc), &
478	& il_lei(il_nproc), il_lej(il_nproc), &
479	& stat=il_status)
480	IF(il_status /= 0 )THEN
481
482	CALL logger_error( " GET MPP: not enough space to put domain &
483	& decomposition in file "//TRIM(td_file%c_name) )
484
485	ENDIF
486
487	! read first record
488	READ( td_file%i_id, IOSTAT=il_status, REC=1 )&
489	& il_recl, &
490	& il_nx, il_ny, il_nz, &
491	& il_n0d, il_n1d, il_n2d, il_n3d, &
492	& il_rhd, &
493	& il_niproc, il_njproc, il_nproc, &
494	& il_area, &
495	& il_iglo, il_jglo, &
496	& il_lci(:), il_lcj(:), &
497	& il_ldi(:), il_ldj(:), &
498	& il_lei(:), il_lej(:), &
499	& il_impp(:),il_jmpp(:)
500	CALL fct_err(il_status)
501	IF( il_status /= 0 )THEN
502	CALL logger_error("GET INFO: read domain decomposition on first &
503	& line of "//TRIM(td_file%c_name))
504	ENDIF
505
506	tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/))
507	CALL file_add_att(td_file, tl_att)
508
509	tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/))
510	CALL file_add_att(td_file, tl_att)
511
512	tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/))
513	CALL file_add_att(td_file, tl_att)
514
515	tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/))
516	CALL file_add_att(td_file, tl_att)
517
518	tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) )
519	CALL file_add_att(td_file, tl_att)
520	tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) )
521	CALL file_add_att(td_file, tl_att)
522
523	tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) )
524	CALL file_add_att(td_file, tl_att)
525	tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) )
526	CALL file_add_att(td_file, tl_att)
527
528	tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) )
529	CALL file_add_att(td_file, tl_att)
530	tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) )
531	CALL file_add_att(td_file, tl_att)
532
533	tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) )
534	CALL file_add_att(td_file, tl_att)
535	tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) )
536	CALL file_add_att(td_file, tl_att)
537
538	DEALLOCATE( il_impp, il_jmpp,&
539	& il_lci, il_lcj, &
540	& il_ldi, il_ldj, &
541	& il_lei, il_lej )
542
543	END SUBROUTINE iom_rstdimg_get_mpp
544	!> @endcode
545	!-------------------------------------------------------------------
546	!> @brief This subroutine read information about variable on an
547	!> opened dimg file.<br/>
548	!> The variable structure inside file structure is then completed.
549	!> @note variable value are read only for scalar variable (0d).
550	!
551	!> @author J.Paul
552	!> - Nov, 2013- Initial Version
553	!
554	!> @param[inout] td_file : file structure
555	!> @return file structure completed
556	!-------------------------------------------------------------------
557	!> @code
558	SUBROUTINE iom_rstdimg__get_file_var(td_file)
559	IMPLICIT NONE
560	! Argument
561	TYPE(TFILE), INTENT(INOUT) :: td_file
562
563	! local variable
564	CHARACTER(LEN=ip_vnl), DIMENSION(:), ALLOCATABLE :: cl_name
565
566	REAL(dp) , DIMENSION(:), ALLOCATABLE :: dl_value
567
568	INTEGER(i4) :: il_status
569	INTEGER(i4) , DIMENSION(:), ALLOCATABLE :: il_start
570	INTEGER(i4) , DIMENSION(:), ALLOCATABLE :: il_count
571
572	!----------------------------------------------------------------
573
574	IF( td_file%i_nvar > 0 )THEN
575
576	ALLOCATE( il_start(4), il_count(4) )
577
578	il_start(1) = 1
579	il_count(1) = td_file%i_n0d
580
581	il_start(2) = 1 + il_count(1)
582	il_count(2) = il_start(2) - 1 + td_file%i_n1d
583
584	il_start(3) = 1 + il_count(2)
585	il_count(3) = il_start(3) - 1 + td_file%i_n2d
586
587	il_start(4) = 1 + il_count(3)
588	il_count(4) = il_start(4) - 1 + td_file%i_n3d
589
590	ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
591
592	! read first record
593	READ( td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )&
594	& cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
595	& cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
596	& cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
597	& cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
598	CALL fct_err(il_status)
599	IF( il_status /= 0 )THEN
600	CALL logger_error("GET FILE: reading headers in file "//&
601	& TRIM(td_file%c_name))
602	ENDIF
603
604	DEALLOCATE( il_start, il_count )
605
606	IF(ASSOCIATED(td_file%t_var))THEN
607	DEALLOCATE(td_file%t_var)
608	ENDIF
609	ALLOCATE(td_file%t_var(td_file%i_nvar))
610
611	! put information about variable 0D inside file structure
612	CALL iom_rstdimg__get_file_var_0d(td_file, cl_name(:), dl_value(:))
613
614	! put information about variable 1D inside file structure
615	CALL iom_rstdimg__get_file_var_1d(td_file, cl_name(:), dl_value(:))
616
617	! put information about variable 2D inside file structure
618	CALL iom_rstdimg__get_file_var_2d(td_file, cl_name(:), dl_value(:))
619
620	! put information about variable 3D inside file structure
621	CALL iom_rstdimg__get_file_var_3d(td_file, cl_name(:), dl_value(:))
622
623	DEALLOCATE( cl_name, dl_value )
624
625	! delete dummy variable
626	CALL file_del_var( td_file, 'no0d' )
627	CALL file_del_var( td_file, 'no1d' )
628	CALL file_del_var( td_file, 'no2d' )
629	CALL file_del_var( td_file, 'no3d' )
630
631	ELSE
632
633	CALL logger_debug( &
634	& " GET FILE VAR: there is no variable in file "//&
635	& TRIM(td_file%c_name))
636
637	ENDIF
638
639	END SUBROUTINE iom_rstdimg__get_file_var
640	!> @endcode
641	!-------------------------------------------------------------------
642	!> @brief This subroutine put information about scalar variable
643	!> inside file structure.
644	!
645	!> @author J.Paul
646	!> - Nov, 2013- Initial Version
647	!
648	!> @param[inout] td_file : file structure
649	!> @param[in] cd_name : table of variable name
650	!> @param[in] dd_value : table of variable value
651	!> @return file structure completed
652	!-------------------------------------------------------------------
653	!> @code
654	SUBROUTINE iom_rstdimg__get_file_var_0d(td_file, cd_name, dd_value)
655	IMPLICIT NONE
656	! Argument
657	TYPE(TFILE), INTENT(INOUT) :: td_file
658	CHARACTER(LEN=ip_vnl), DIMENSION(:), INTENT(IN) :: cd_name
659	REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value
660
661	! local variable
662	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
663
664	! loop indices
665	INTEGER(i4) :: ji
666	!----------------------------------------------------------------
667
668	! define same dimension as in file
669	tl_dim(:)=td_file%t_dim(:)
670	! do not use any dimension
671	tl_dim(:)%l_use=.FALSE.
672	tl_dim(:)%i_len=1
673
674	! case scalar variable
675	DO ji = 1, td_file%i_n0d
676
677	td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
678	& tl_dim(:), id_id=ji, id_rec=1 )
679
680	! get value of scalar
681	IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
682	DEALLOCATE(td_file%t_var(ji)%d_value)
683	ENDIF
684	ALLOCATE(td_file%t_var(ji)%d_value(1,1,1,1))
685
686	td_file%t_var(ji)%d_value(1,1,1,1)=dd_value(ji)
687
688	ENDDO
689
690	END SUBROUTINE iom_rstdimg__get_file_var_0d
691	!> @endcode
692	!-------------------------------------------------------------------
693	!> @brief This subroutine put information about variable 1D
694	!> inside file structure.
695	!
696	!> @author J.Paul
697	!> - Nov, 2013- Initial Version
698	!
699	!> @param[inout] td_file : file structure
700	!> @param[in] cd_name : table of variable name
701	!> @param[in] dd_value : table of variable record
702	!> @return file structure completed
703	!-------------------------------------------------------------------
704	!> @code
705	SUBROUTINE iom_rstdimg__get_file_var_1d(td_file, cd_name, dd_value)
706	IMPLICIT NONE
707	! Argument
708	TYPE(TFILE), INTENT(INOUT) :: td_file
709	CHARACTER(LEN=ip_vnl), DIMENSION(:), INTENT(IN) :: cd_name
710	REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value
711
712	! local variable
713	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
714
715	! loop indices
716	INTEGER(i4) :: ji
717	!----------------------------------------------------------------
718
719	! case variable 1D
720	DO ji = td_file%i_n0d + 1, &
721	& td_file%i_n0d + td_file%i_n1d
722
723	! define same dimension as in file
724	tl_dim(:)=td_file%t_dim(:)
725	! do not use X and Y dimension
726	td_file%t_var(ji)%t_dim(1:2)%l_use=.FALSE.
727	td_file%t_var(ji)%t_dim(1:2)%i_len=1
728
729	td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
730	& tl_dim(:), id_id=ji, &
731	& id_rec=INT(dd_value(ji),i4) )
732
733	ENDDO
734
735	END SUBROUTINE iom_rstdimg__get_file_var_1d
736	!> @endcode
737	!-------------------------------------------------------------------
738	!> @brief This subroutine put information about variable 2D
739	!> inside file structure.
740	!
741	!> @author J.Paul
742	!> - Nov, 2013- Initial Version
743	!
744	!> @param[inout] td_file : file structure
745	!> @param[in] cd_name : table of variable name
746	!> @param[in] dd_value : table of variable record
747	!> @return file structure completed
748	!-------------------------------------------------------------------
749	!> @code
750	SUBROUTINE iom_rstdimg__get_file_var_2d(td_file, cd_name, dd_value)
751	IMPLICIT NONE
752	! Argument
753	TYPE(TFILE), INTENT(INOUT) :: td_file
754	CHARACTER(LEN=ip_vnl), DIMENSION(:), INTENT(IN) :: cd_name
755	REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value
756
757	! local variable
758	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
759
760	! loop indices
761	INTEGER(i4) :: ji
762	!----------------------------------------------------------------
763
764	! case variable 2D (X,Y)
765	DO ji = td_file%i_n0d + td_file%i_n1d + 1 , &
766	& td_file%i_n0d + td_file%i_n1d + td_file%i_n2d
767
768	! define same dimension as in file
769	tl_dim(:)=td_file%t_dim(:)
770	! do not use Z dimension
771	tl_dim(3)%l_use=.FALSE.
772	tl_dim(3)%i_len=1
773
774	td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
775	& tl_dim(:), id_id=ji, &
776	& id_rec=INT(dd_value(ji),i4) )
777
778	ENDDO
779
780	END SUBROUTINE iom_rstdimg__get_file_var_2d
781	!> @endcode
782	!-------------------------------------------------------------------
783	!> @brief This subroutine put information about variable 3D
784	!> inside file structure.
785	!
786	!> @author J.Paul
787	!> - Nov, 2013- Initial Version
788	!
789	!> @param[inout] td_file : file structure
790	!> @param[in] cd_name : table of variable name
791	!> @param[in] dd_value : table of variable record
792	!> @return file structure completed
793	!-------------------------------------------------------------------
794	!> @code
795	SUBROUTINE iom_rstdimg__get_file_var_3d(td_file, cd_name, dd_value)
796	IMPLICIT NONE
797	! Argument
798	TYPE(TFILE), INTENT(INOUT) :: td_file
799	CHARACTER(LEN=ip_vnl), DIMENSION(:), INTENT(IN) :: cd_name
800	REAL(dp), DIMENSION(:), INTENT(IN) :: dd_value
801
802	! local variable
803	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
804
805	! loop indices
806	INTEGER(i4) :: ji
807	!----------------------------------------------------------------
808
809	! case variable 3D (X,Y,Z)
810	DO ji = td_file%i_n0d + td_file%i_n1d + td_file%i_n2d +1 , &
811	& td_file%i_n0d + td_file%i_n1d + td_file%i_n2d + td_file%i_n3d
812
813	! define same dimension as in file
814	tl_dim(:)=td_file%t_dim(:)
815
816	td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
817	& tl_dim(:), id_id=ji, &
818	& id_rec=INT(dd_value(ji),i4) )
819
820	ENDDO
821
822	END SUBROUTINE iom_rstdimg__get_file_var_3d
823	!> @endcode
824	!-------------------------------------------------------------------
825	!> @brief This function read one dimension in an opened netcdf file,
826	!> given dimension id.
827	!
828	!> @author J.Paul
829	!> - Nov, 2013- Initial Version
830	!
831	!> @param[in] td_file : file structure
832	!> @param[in] id_dimid : dimension id
833	!> @return dimension structure
834	!-------------------------------------------------------------------
835	!> @code
836	TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_id(td_file, id_dimid)
837	IMPLICIT NONE
838	! Argument
839	TYPE(TFILE), INTENT(IN) :: td_file
840	INTEGER(i4), INTENT(IN) :: id_dimid
841	!----------------------------------------------------------------
842
843	! check if file opened
844	IF( td_file%i_id == 0 )THEN
845
846	CALL logger_error( &
847	& " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
848
849	ELSE
850
851	iom_rstdimg__read_dim_id%i_id=id_dimid
852
853	CALL logger_debug( &
854	& " READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
855	& " in file "//TRIM(td_file%c_name))
856
857	IF( id_dimid <= 4 )THEN
858	iom_rstdimg__read_dim_id=td_file%t_dim(id_dimid)
859	ELSE
860	CALL logger_error( &
861	& " READ DIM: no dimension with id "//TRIM(fct_str(id_dimid))//&
862	& " in file "//TRIM(td_file%c_name))
863	ENDIF
864
865	ENDIF
866
867	END FUNCTION iom_rstdimg__read_dim_id
868	!> @endcode
869	!-------------------------------------------------------------------
870	!> @brief This function read one dimension in an opened netcdf file,
871	!> given dimension name.
872	!
873	!> @author J.Paul
874	!> - Nov, 2013- Initial Version
875	!
876	!> @param[in] td_file : file structure
877	!> @param[in] cd_name : dimension name
878	!> @return dimension structure
879	!-------------------------------------------------------------------
880	!> @code
881	TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_name(td_file, cd_name)
882	IMPLICIT NONE
883	! Argument
884	TYPE(TFILE), INTENT(IN) :: td_file
885	CHARACTER(LEN=*), INTENT(IN) :: cd_name
886
887	! local variable
888	INTEGER(i4) :: il_dimid
889	!----------------------------------------------------------------
890
891	! check if file opened
892	IF( td_file%i_id == 0 )THEN
893
894	CALL logger_error( &
895	& " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
896
897	ELSE
898
899	il_dimid=dim_get_id(td_file%t_dim(:), TRIM(cd_name))
900	IF( il_dimid /= 0 )THEN
901	iom_rstdimg__read_dim_name=iom_rstdimg_read_dim(td_file, il_dimid)
902	ELSE
903	CALL logger_error( &
904	& " READ DIM: no dimension "//TRIM(cd_name)//&
905	& " in file "//TRIM(td_file%c_name))
906	ENDIF
907
908	ENDIF
909
910	END FUNCTION iom_rstdimg__read_dim_name
911	!> @endcode
912	!-------------------------------------------------------------------
913	!> @brief This function read variable value in an opened
914	!> dimg file, given variable id.</br/>
915	!> start indices and number of indices selected along each dimension
916	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
917	!
918	!> @author J.Paul
919	!> - Nov, 2013- Initial Version
920	!
921	!> @param[in] td_file : file structure
922	!> @param[in] id_varid : variable id
923	!> @param[in] id_start : index in the variable from which the data values
924	!> will be read
925	!> @param[in] id_count : number of indices selected along each dimension
926	!> @return variable structure
927	!-------------------------------------------------------------------
928	!> @code
929	TYPE(TVAR) FUNCTION iom_rstdimg__read_var_id(td_file, id_varid,&
930	& id_start, id_count)
931	IMPLICIT NONE
932	! Argument
933	TYPE(TFILE), INTENT(IN) :: td_file
934	INTEGER(i4), INTENT(IN) :: id_varid
935	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
936	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
937	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
938	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
939
940	! local variable
941	INTEGER(i4), DIMENSION(1) :: il_ind
942	!----------------------------------------------------------------
943	! check if file opened
944	IF( td_file%i_id == 0 )THEN
945
946	CALL logger_error( &
947	& " READ VAR: no id associated to file "//TRIM(td_file%c_name))
948
949	ELSE
950
951	! look for variable id
952	il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
953	IF( il_ind(1) /= 0 )THEN
954
955	iom_rstdimg__read_var_id=td_file%t_var(il_ind(1))
956
957	IF( iom_rstdimg__read_var_id%i_ndim /= 0 )THEN
958	!!! read variable value
959	CALL iom_rstdimg__read_var_value( td_file, &
960	& iom_rstdimg__read_var_id, &
961	& id_start, id_count)
962	ELSE
963	CALL logger_debug( " READ VAR: variable 0d "//&
964	& TRIM(td_file%t_var(il_ind(1))%c_name)//&
965	& " should be already read ")
966	ENDIF
967
968	ELSE
969	CALL logger_error( &
970	& " READ VAR: there is no variable with id "//&
971	& TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
972	ENDIF
973
974	ENDIF
975	END FUNCTION iom_rstdimg__read_var_id
976	!> @endcode
977	!-------------------------------------------------------------------
978	!> @brief This function read variable value in an opened
979	!> dimg file, given variable name or standard name.</br/>
980	!> start indices and number of indices selected along each dimension
981	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
982	!
983	!> @details
984	!> look first for variable name. If it doesn't
985	!> exist in file, look for variable standard name.<br/>
986	!> If variable name is not present, check variable standard name.<br/>
987	!
988	!> @author J.Paul
989	!> - Nov, 2013- Initial Version
990	!
991	!> @param[in] td_file : file structure
992	!> @param[in] cd_name : variable name or standard name
993	!> @param[in] id_start : index in the variable from which the data values
994	!> will be read
995	!> @param[in] id_count : number of indices selected along each dimension
996	!> @return variable structure
997	!-------------------------------------------------------------------
998	!> @code
999	TYPE(TVAR) FUNCTION iom_rstdimg__read_var_name(td_file, cd_name, &
1000	& id_start, id_count )
1001	IMPLICIT NONE
1002	! Argument
1003	TYPE(TFILE), INTENT(IN) :: td_file
1004	CHARACTER(LEN=*), INTENT(IN) :: cd_name
1005	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1006	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1007	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
1008	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
1009
1010	! local variable
1011	INTEGER(i4) :: il_ind
1012	!----------------------------------------------------------------
1013	! check if file opened
1014	IF( td_file%i_id == 0 )THEN
1015
1016	CALL logger_error( &
1017	& " READ VAR: no id associated to file "//TRIM(td_file%c_name))
1018
1019	ELSE
1020
1021	il_ind=var_get_id(td_file%t_var(:), cd_name)
1022	IF( il_ind /= 0 )THEN
1023
1024	iom_rstdimg__read_var_name=td_file%t_var(il_ind)
1025
1026	IF( td_file%t_var(il_ind)%i_ndim /= 0 )THEN
1027	!!! read variable value
1028	CALL iom_rstdimg__read_var_value( td_file, &
1029	& iom_rstdimg__read_var_name, &
1030	& id_start, id_count)
1031	ELSE
1032	CALL logger_debug( " READ VAR: variable 0d "//&
1033	& TRIM(td_file%t_var(il_ind)%c_name)//&
1034	& " should have been already read ")
1035	ENDIF
1036
1037	ELSE
1038
1039	CALL logger_error( &
1040	& " READ VAR NAME: there is no variable with "//&
1041	& " name or standard name "//TRIM(cd_name)//&
1042	& " in file "//TRIM(td_file%c_name) )
1043
1044	ENDIF
1045
1046	ENDIF
1047
1048	END FUNCTION iom_rstdimg__read_var_name
1049	!> @endcode
1050	!-------------------------------------------------------------------
1051	!> @brief This subroutine fill all variable value in an opened
1052	!> dimg file.</br/>
1053	!> start indices and number of indices selected along each dimension
1054	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1055	!
1056	!> @author J.Paul
1057	!> - Nov, 2013- Initial Version
1058	!
1059	!> @param[inout] td_file : file structure
1060	!> @param[in] id_start : index in the variable from which the data values
1061	!> will be read
1062	!> @param[in] id_count : number of indices selected along each dimension
1063	!-------------------------------------------------------------------
1064	!> @code
1065	SUBROUTINE iom_rstdimg__fill_var_all(td_file, id_start, id_count)
1066	IMPLICIT NONE
1067	! Argument
1068	TYPE(TFILE), INTENT(INOUT) :: td_file
1069	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1070	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1071	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
1072	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
1073
1074	! local variable
1075
1076	! loop indices
1077	INTEGER(i4) :: ji
1078	!----------------------------------------------------------------
1079	! check if file opened
1080	IF( td_file%i_id == 0 )THEN
1081
1082	CALL logger_error( &
1083	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1084
1085	ELSE
1086
1087	DO ji=1,td_file%i_nvar
1088	CALL iom_rstdimg_fill_var(td_file, ji, id_start, id_count)
1089	ENDDO
1090
1091	ENDIF
1092	END SUBROUTINE iom_rstdimg__fill_var_all
1093	!> @endcode
1094	!-------------------------------------------------------------------
1095	!> @brief This subroutine fill variable value in an opened
1096	!> dimg file, given variable id.</br/>
1097	!> start indices and number of indices selected along each dimension
1098	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1099	!
1100	!> @author J.Paul
1101	!> - Nov, 2013- Initial Version
1102	!
1103	!> @param[inout] td_file : file structure
1104	!> @param[in] id_varid : variable id
1105	!> @param[in] id_start : index in the variable from which the data values
1106	!> will be read
1107	!> @param[in] id_count : number of indices selected along each dimension
1108	!-------------------------------------------------------------------
1109	!> @code
1110	SUBROUTINE iom_rstdimg__fill_var_id(td_file, id_varid, id_start, id_count)
1111	IMPLICIT NONE
1112	! Argument
1113	TYPE(TFILE), INTENT(INOUT) :: td_file
1114	INTEGER(i4), INTENT(IN) :: id_varid
1115	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1116	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1117	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
1118	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
1119
1120	! local variable
1121	INTEGER(i4), DIMENSION(1) :: il_ind
1122	TYPE(TVAR) :: tl_var
1123	!----------------------------------------------------------------
1124	! check if file opened
1125	IF( td_file%i_id == 0 )THEN
1126
1127	CALL logger_error( &
1128	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1129
1130	ELSE
1131
1132	! look for variable id
1133	il_ind(:) = MINLOC( td_file%t_var(:)%i_id, &
1134	& mask=(td_file%t_var(:)%i_id==id_varid))
1135	IF( il_ind(1) /= 0 )THEN
1136
1137	IF( tl_var%i_ndim /= 0 )THEN
1138	!!! read variable value
1139	CALL iom_rstdimg__read_var_value(td_file, td_file%t_var(il_ind(1)), &
1140	& id_start, id_count)
1141
1142	ELSE
1143	CALL logger_debug( " FILL VAR: variable 0d "//&
1144	& TRIM(td_file%t_var(il_ind(1))%c_name)//&
1145	& " should be already read ")
1146	ENDIF
1147
1148	ELSE
1149	CALL logger_error( &
1150	& " FILL VAR: there is no variable with id "//&
1151	& TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
1152	ENDIF
1153
1154	ENDIF
1155	END SUBROUTINE iom_rstdimg__fill_var_id
1156	!> @endcode
1157	!-------------------------------------------------------------------
1158	!> @brief This subroutine fill variable value in an opened
1159	!> dimg file, given variable name or standard name.</br/>
1160	!> start indices and number of indices selected along each dimension
1161	!> could be specify in a 4 dimension table (/'x','y','z','t'/)
1162	!
1163	!> @details
1164	!> look first for variable name. If it doesn't
1165	!> exist in file, look for variable standard name.<br/>
1166	!> If variable name is not present, check variable standard name.<br/>
1167	!
1168	!> @author J.Paul
1169	!> - Nov, 2013- Initial Version
1170	!
1171	!> @param[inout] td_file : file structure
1172	!> @param[in] cd_name : variable name or standard name
1173	!> @param[in] id_start : index in the variable from which the data values
1174	!> will be read
1175	!> @param[in] id_count : number of indices selected along each dimension
1176	!> @return variable structure
1177	!-------------------------------------------------------------------
1178	!> @code
1179	SUBROUTINE iom_rstdimg__fill_var_name(td_file, cd_name, id_start, id_count )
1180	IMPLICIT NONE
1181	! Argument
1182	TYPE(TFILE), INTENT(INOUT) :: td_file
1183	CHARACTER(LEN=*), INTENT(IN) :: cd_name
1184	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1185	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1186	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
1187	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
1188	!CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
1189
1190	! local variable
1191	INTEGER(i4) :: il_ind
1192	!----------------------------------------------------------------
1193	! check if file opened
1194	IF( td_file%i_id == 0 )THEN
1195
1196	CALL logger_error( &
1197	& " FILL VAR: no id associated to file "//TRIM(td_file%c_name))
1198
1199	ELSE
1200
1201	il_ind=var_get_id(td_file%t_var, cd_name)
1202	IF( il_ind /= 0 )THEN
1203
1204	IF( td_file%t_var(il_ind)%i_ndim /= 0 )THEN
1205	!!! read variable value
1206	CALL iom_rstdimg__read_var_value( td_file, td_file%t_var(il_ind), &
1207	& id_start, id_count)
1208
1209	ELSE
1210	CALL logger_debug( " FILL VAR: variable 0d "//&
1211	& TRIM(td_file%t_var(il_ind)%c_name)//&
1212	& " should have been already read ")
1213	ENDIF
1214
1215	ELSE
1216
1217	CALL logger_error( &
1218	& " FILL VAR: there is no variable with "//&
1219	& " name or standard name "//TRIM(cd_name)//&
1220	& " in file "//TRIM(td_file%c_name))
1221
1222	ENDIF
1223
1224	ENDIF
1225
1226	END SUBROUTINE iom_rstdimg__fill_var_name
1227	!> @endcode
1228	!-------------------------------------------------------------------
1229	!> @brief This subroutine read variable value in an opened dimg file, for
1230	!> variable 1,2,3d.
1231	!
1232	!> @author J.Paul
1233	!> - Nov, 2013- Initial Version
1234	!
1235	!> @param[in] td_file : file structure
1236	!> @param[inout] td_var : variable structure
1237	!> @param[in] id_start : index in the variable from which the data values will be read
1238	!> @param[in] id_count : number of indices selected along each dimension
1239	!> @return variable structure completed
1240	!-------------------------------------------------------------------
1241	!> @code
1242	SUBROUTINE iom_rstdimg__read_var_value(td_file, td_var, &
1243	& id_start, id_count )
1244	IMPLICIT NONE
1245	! Argument
1246	TYPE(TFILE), INTENT(IN) :: td_file
1247	TYPE(TVAR) , INTENT(INOUT) :: td_var
1248	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
1249	INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
1250	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
1251	!INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
1252
1253	! local variable
1254	INTEGER(i4) :: il_status
1255	INTEGER(i4) :: il_tmp1, il_tmp2
1256	INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
1257	INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
1258	REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1259
1260	! loop indices
1261	INTEGER(i4) :: ji
1262	!----------------------------------------------------------------
1263
1264	! check id_count and id_start optionals parameters...
1265	IF( ( PRESENT(id_start) .AND. (.NOT. PRESENT(id_count))) .OR. &
1266	((.NOT. PRESENT(id_start)) .AND. PRESENT(id_count) ) )THEN
1267	CALL logger_warn( &
1268	& " READ VAR VALUE: id_start and id_count should be both specify")
1269	ENDIF
1270
1271	IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
1272
1273	IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
1274	& SIZE(id_count(:)) /= ip_maxdim )THEN
1275	CALL logger_error("READ VAR: dimension of table start or count "//&
1276	& " are invalid to read variable "//TRIM(td_var%c_name)//&
1277	& " in file "//TRIM(td_file%c_name) )
1278	ENDIF
1279
1280	! dimension order assume to be ('x','y','z','t')
1281	il_start(:)=id_start(:)
1282	il_count(:)=id_count(:)
1283
1284	ELSE
1285
1286	! dimension order assume to be ('x','y','z','t')
1287	il_start(:)=(/1,1,1,1/)
1288	il_count(:)=td_var%t_dim(:)%i_len
1289
1290	ENDIF
1291
1292	! check dimension
1293	IF( .NOT. ALL(il_start(:)>=(/1,1,1,1/)) )THEN
1294
1295	CALL logger_error( " READ VAR VALUE: "//&
1296	& " start indices should be greater than or equal to 1")
1297
1298	ENDIF
1299
1300	IF(.NOT.ALL(il_start(:)+il_count(:)-1<=(/td_var%t_dim(1)%i_len,&
1301	& td_var%t_dim(2)%i_len,&
1302	& td_var%t_dim(3)%i_len,&
1303	& td_var%t_dim(4)%i_len &
1304	& /)) )THEN
1305
1306	CALL logger_error( " READ VAR VALUE: "//&
1307	& "start + count exceed variable dimension" )
1308
1309	DO ji = 1, ip_maxdim
1310	il_tmp1=il_start(ji)+il_count(ji)-1
1311	il_tmp2=td_var%t_dim(ji)%i_len
1312	CALL logger_debug( &
1313	& " READ VAR VALUE: start + count - 1 "//TRIM(fct_str(il_tmp1))//&
1314	& " variable dimension"//TRIM(fct_str(il_tmp2)))
1315	ENDDO
1316
1317	ELSE
1318
1319	! Allocate space to hold variable value
1320	ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
1321	& td_var%t_dim(2)%i_len, &
1322	& td_var%t_dim(3)%i_len, &
1323	& td_var%t_dim(4)%i_len),&
1324	& stat=il_status)
1325	IF(il_status /= 0 )THEN
1326
1327	CALL logger_error( &
1328	& " READ VAR VALUE: not enough space to put variable "//&
1329	& TRIM(td_var%c_name)//&
1330	& " in temporary table")
1331
1332	ENDIF
1333
1334	! read values
1335	CALL logger_trace( &
1336	& " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
1337	& " in file "//TRIM(td_file%c_name))
1338
1339	IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
1340	! 3D variable (X,Y,Z)
1341	DO ji=1,td_var%t_dim(3)%i_len
1342	READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) &
1343	& dl_value(:,:,ji,:)
1344	CALL fct_err(il_status)
1345	IF( il_status /= 0 )THEN
1346	CALL logger_error("READ VAR VALUE: reading 3D variable "//&
1347	& TRIM(td_var%c_name))
1348	ENDIF
1349	ENDDO
1350	ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN
1351	! 2D variable (X,Y)
1352	READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
1353	& dl_value(:,:,:,:)
1354	CALL fct_err(il_status)
1355	IF( il_status /= 0 )THEN
1356	CALL logger_error("READ VAR VALUE: reading 2D variable "//&
1357	& TRIM(td_var%c_name))
1358	ENDIF
1359	ELSEIF( td_var%t_dim(3)%l_use )THEN
1360	! 1d variable (Z)
1361	READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
1362	& dl_value(:,:,:,:)
1363	CALL fct_err(il_status)
1364	IF( il_status /= 0 )THEN
1365	CALL logger_error("READ VAR VALUE: reading 1D variable "//&
1366	& TRIM(td_var%c_name))
1367	ENDIF
1368	ENDIF
1369
1370	! Allocate space to hold variable value in structure
1371	IF( ASSOCIATED(td_var%d_value) )THEN
1372	DEALLOCATE(td_var%d_value)
1373	ENDIF
1374
1375	ALLOCATE(td_var%d_value( il_count(1), &
1376	& il_count(2), &
1377	& il_count(3), &
1378	& il_count(4)),&
1379	& stat=il_status)
1380	IF(il_status /= 0 )THEN
1381
1382	CALL logger_error( &
1383	& " READ VAR VALUE: not enough space to put variable "//&
1384	& TRIM(td_var%c_name)//&
1385	& " in variable structure")
1386
1387	ENDIF
1388	! FillValue by default
1389	td_var%d_value(:,:,:,:)=td_var%d_fill
1390
1391	! new dimension length
1392	td_var%t_dim(:)%i_len=il_count(:)
1393
1394	! extract value
1395	td_var%d_value(:,:,:,:) = dl_value(il_start(1):il_start(1)+il_count(1)-1,&
1396	& il_start(2):il_start(2)+il_count(2)-1,&
1397	& il_start(3):il_start(3)+il_count(3)-1,&
1398	& il_start(4):il_start(4)+il_count(4)-1)
1399
1400	DEALLOCATE(dl_value)
1401
1402	ENDIF
1403
1404	END SUBROUTINE iom_rstdimg__read_var_value
1405	!> @endcode
1406	!-------------------------------------------------------------------
1407	!> @brief This subroutine write file structure in an opened dimg file.
1408	!
1409	!> @details
1410	!
1411	!> @author J.Paul
1412	!> - Nov, 2013- Initial Version
1413	!
1414	!> @param[in] td_file : file structure
1415	!-------------------------------------------------------------------
1416	!> @code
1417	SUBROUTINE iom_rstdimg_write_file(td_file)
1418	IMPLICIT NONE
1419	! Argument
1420	TYPE(TFILE), INTENT(INOUT) :: td_file
1421
1422	! local variable
1423	INTEGER(i4) :: il_status
1424	INTEGER(i4) :: il_attid
1425	!----------------------------------------------------------------
1426	! check if file opened
1427	IF( td_file%i_id == 0 )THEN
1428
1429	CALL logger_error( &
1430	& " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
1431
1432	ELSE
1433	IF( td_file%l_wrt )THEN
1434
1435	! close and open file with right record length
1436	CALL iom_rstdimg_close(td_file)
1437
1438	! compute record length
1439	il_attid=att_get_id(td_file%t_att(:),"DOMAIN_number_total")
1440	IF( il_attid /= 0 )THEN
1441	td_file%i_recl = MAX( &
1442	& td_file%t_dim(1)%i_len * td_file%t_dim(2)%i_len * 8, &
1443	& ( 8 * INT(td_file%t_att(il_attid)%d_value(1)) + 15 ) * 4 )
1444	ELSE
1445	td_file%i_recl = td_file%t_dim(1)%i_len * &
1446	& td_file%t_dim(2)%i_len * 8
1447	ENDIF
1448
1449	OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
1450	& FORM='UNFORMATTED', &
1451	& ACCESS='DIRECT', &
1452	& STATUS='REPLACE', &
1453	& ACTION='WRITE', &
1454	& RECL=td_file%i_recl, &
1455	& IOSTAT=il_status)
1456	CALL fct_err(il_status)
1457	IF( il_status /= 0 )THEN
1458	CALL logger_error("REPLACE: file "//TRIM(td_file%c_name)//&
1459	& " with record length "//TRIM(fct_str(td_file%i_recl)))
1460	ELSE
1461	CALL logger_debug("REPLACE: file "//TRIM(td_file%c_name)//&
1462	& " with record length "//TRIM(fct_str(td_file%i_recl)))
1463	ENDIF
1464
1465	! write header
1466	CALL iom_rstdimg__write_header(td_file)
1467
1468	! write variable in file
1469	CALL iom_rstdimg__write_var(td_file)
1470
1471	ELSE
1472
1473	CALL logger_error( &
1474	& " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
1475	& ", not opened in write mode")
1476
1477	ENDIF
1478	ENDIF
1479
1480	END SUBROUTINE iom_rstdimg_write_file
1481	!> @endcode
1482	!-------------------------------------------------------------------
1483	!> @brief This subroutine write header in an opened dimg
1484	!> file in write mode.
1485	!
1486	!> @author J.Paul
1487	!> - Nov, 2013- Initial Version
1488	!
1489	!> @param[in] td_file : file structure
1490	!> @param[in] td_dim : dimension structure
1491	!> @return dimension id
1492	!-------------------------------------------------------------------
1493	!> @code
1494	SUBROUTINE iom_rstdimg__write_header(td_file)
1495	IMPLICIT NONE
1496	! Argument
1497	TYPE(TFILE), INTENT(INOUT) :: td_file
1498
1499	! local variable
1500	INTEGER(i4) :: il_status
1501	INTEGER(i4) :: il_attid
1502	INTEGER(i4) :: il_nproc
1503	INTEGER(i4) :: il_niproc
1504	INTEGER(i4) :: il_njproc
1505	INTEGER(i4) :: il_area
1506	INTEGER(i4) :: il_iglo
1507	INTEGER(i4) :: il_jglo
1508
1509	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
1510	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
1511	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
1512	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
1513	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
1514	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
1515	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
1516	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
1517
1518	! loop indices
1519	INTEGER(i4) :: ji
1520	!----------------------------------------------------------------
1521	! check record length
1522	IF( td_file%i_recl <= 8 )THEN
1523	CALL logger_warn(" WRITE FILE: record length seems to be tiny!! &
1524	& ("//TRIM(fct_str(td_file%i_recl))//")")
1525	ENDIF
1526
1527	! check dimension
1528	IF( ANY(td_file%t_dim(1:3)%i_len <= 0 ) )THEN
1529	CALL logger_error(" WRITE FILE: at least one dimension size is less &
1530	& than or equal to zero !! ")
1531	DO ji=1,3
1532	CALL logger_debug(" WRITE FILE: dimension "//&
1533	& TRIM(td_file%t_dim(ji)%c_name)//" : "//&
1534	& TRIM(fct_str(td_file%t_dim(ji)%i_len)) )
1535	ENDDO
1536	ENDIF
1537
1538	! get domain decomposition
1539	il_attid=att_get_id( td_file%t_att, "DOMAIN_number_total" )
1540	il_nproc = 1
1541	IF( il_attid /= 0 )THEN
1542	il_nproc = INT(td_file%t_att(il_attid)%d_value(1))
1543	ENDIF
1544
1545	il_attid=att_get_id( td_file%t_att, "DOMAIN_I_number_total" )
1546	il_niproc = 0
1547	IF( il_attid /= 0 )THEN
1548	il_niproc = INT(td_file%t_att(il_attid)%d_value(1))
1549	ENDIF
1550
1551	il_attid=att_get_id( td_file%t_att, "DOMAIN_J_number_total" )
1552	il_njproc = 0
1553	IF( il_attid /= 0 )THEN
1554	il_njproc = INT(td_file%t_att(il_attid)%d_value(1))
1555	ENDIF
1556
1557	! check domain decomposition
1558	IF( il_niproc <= 0 .OR. &
1559	& il_njproc <= 0 .OR. &
1560	& il_nproc <= 0 .OR. &
1561	& il_nproc > il_niproc * il_njproc )THEN
1562
1563	CALL logger_error(" WRITE FILE: invalid domain splitting ")
1564
1565	CALL logger_debug(" WRITE FILE: niproc "//TRIM(fct_str(il_niproc)) )
1566	CALL logger_debug(" WRITE FILE: njproc "//TRIM(fct_str(il_njproc)) )
1567	CALL logger_debug(" WRITE FILE: nproc "//TRIM(fct_str(il_nproc)) )
1568
1569	ENDIF
1570
1571	! get domain number
1572	il_attid=att_get_id( td_file%t_att, "DOMAIN_number" )
1573	il_area = 0
1574	IF( il_attid /= 0 )THEN
1575	il_area = INT(td_file%t_att(il_attid)%d_value(1))
1576	ENDIF
1577
1578	! get domain global size
1579	il_attid=att_get_id( td_file%t_att, "DOMAIN_size_global" )
1580	il_iglo = 0
1581	il_jglo = 0
1582	IF( il_attid /= 0 )THEN
1583	il_iglo = INT(td_file%t_att(il_attid)%d_value(1))
1584	il_jglo = INT(td_file%t_att(il_attid)%d_value(2))
1585	ENDIF
1586
1587	! check domain global size
1588	IF( il_iglo < td_file%t_dim(1)%i_len .OR. &
1589	& il_jglo < td_file%t_dim(2)%i_len )THEN
1590	CALL logger_error(" WRITE FILE: invalid global domain ")
1591
1592	CALL logger_debug(" WRITE FILE: global domain : "//&
1593	& TRIM(fct_str(il_iglo))//" x "//&
1594	& TRIM(fct_str(il_jglo)) )
1595	CALL logger_debug(" WRITE FILE: local domain : "//&
1596	& TRIM(fct_str(td_file%t_dim(1)%i_len))//" x "//&
1597	& TRIM(fct_str(td_file%t_dim(2)%i_len)) )
1598	ENDIF
1599
1600	! allocate local variable
1601	ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
1602	& il_lci(il_niproc), il_lcj(il_njproc), &
1603	& il_ldi(il_niproc), il_ldj(il_njproc), &
1604	& il_lei(il_niproc), il_lej(il_njproc) )
1605
1606	! get domain first poistion
1607	il_attid=att_get_id( td_file%t_att, "DOMAIN_I_position_first" )
1608	il_impp(:) = 0
1609	IF( il_attid /= 0 )THEN
1610	il_impp(:) = INT(td_file%t_att(il_attid)%d_value(:))
1611	ENDIF
1612
1613	il_attid=att_get_id( td_file%t_att, "DOMAIN_J_position_first" )
1614	il_jmpp(:) = 0
1615	IF( il_attid /= 0 )THEN
1616	il_jmpp(:) = INT(td_file%t_att(il_attid)%d_value(:))
1617	ENDIF
1618
1619	! check domain first poistion
1620	IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN
1621	CALL logger_warn("WRITE FILE: no data for domain first position")
1622	ENDIF
1623
1624	! get domain last poistion
1625	il_attid=att_get_id( td_file%t_att, "DOMAIN_I_position_last" )
1626	il_lci(:) = 0
1627	IF( il_attid /= 0 )THEN
1628	il_lci(:) = INT(td_file%t_att(il_attid)%d_value(:))
1629	ENDIF
1630
1631	il_attid=att_get_id( td_file%t_att, "DOMAIN_J_position_last" )
1632	il_lcj(:) = 0
1633	IF( il_attid /= 0 )THEN
1634	il_lcj(:) = INT(td_file%t_att(il_attid)%d_value(:))
1635	ENDIF
1636
1637	! check domain last poistion
1638	IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN
1639	CALL logger_warn("WRITE FILE: no data for domain last position")
1640	ENDIF
1641
1642	! get halo size start
1643	il_attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_start" )
1644	il_ldi(:) = 0
1645	IF( il_attid /= 0 )THEN
1646	il_ldi(:) = INT(td_file%t_att(il_attid)%d_value(:))
1647	ENDIF
1648
1649	il_attid=att_get_id( td_file%t_att, "DOMAIN_J_halo_size_start" )
1650	il_ldj(:) = 0
1651	IF( il_attid /= 0 )THEN
1652	il_ldj(:) = INT(td_file%t_att(il_attid)%d_value(:))
1653	ENDIF
1654
1655	! check halo size start
1656	IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN
1657	CALL logger_warn("WRITE FILE: no data for halo size start")
1658	ENDIF
1659
1660	! get halo size end
1661	il_attid=att_get_id( td_file%t_att, "DOMAIN_I_halo_size_end" )
1662	il_lei(:) = 0
1663	IF( il_attid /= 0 )THEN
1664	il_lei(:) = INT(td_file%t_att(il_attid)%d_value(:))
1665	ENDIF
1666
1667	il_attid=att_get_id( td_file%t_att, "DOMAIN_J_halo_size_end" )
1668	il_lej(:) = 0
1669	IF( il_attid /= 0 )THEN
1670	il_lej(:) = INT(td_file%t_att(il_attid)%d_value(:))
1671	ENDIF
1672
1673	! check halo size end
1674	IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN
1675	CALL logger_warn("WRITE FILE: no data for halo size end")
1676	ENDIF
1677
1678	! write file header
1679	WRITE(td_file%i_id, IOSTAT=il_status, REC=1 )&
1680	& td_file%i_recl, &
1681	& td_file%t_dim(1)%i_len, &
1682	& td_file%t_dim(2)%i_len, &
1683	& td_file%t_dim(3)%i_len, &
1684	& td_file%i_n0d, &
1685	& td_file%i_n1d, &
1686	& td_file%i_n2d, &
1687	& td_file%i_n3d, &
1688	& td_file%i_rhd, &
1689	& il_niproc, il_njproc, il_nproc, &
1690	& il_area, &
1691	& il_iglo, il_jglo, &
1692	& il_impp(:), il_jmpp(:), &
1693	& il_lci(:), il_lcj(:), &
1694	& il_ldi(:), il_ldj(:), &
1695	& il_lei(:), il_lej(:)
1696
1697	DEALLOCATE( il_impp, il_jmpp,&
1698	& il_lci, il_lcj, &
1699	& il_ldi, il_ldj, &
1700	& il_lei, il_lej )
1701
1702	END SUBROUTINE iom_rstdimg__write_header
1703	!> @endcode
1704	!-------------------------------------------------------------------
1705	!> @brief This subroutine write variables in an opened dimg file.</br/>
1706	!
1707	!> @author J.Paul
1708	!> - Nov, 2013- Initial Version
1709	!
1710	!> @param[in] id_fileid : file id
1711	!-------------------------------------------------------------------
1712	!> @code
1713	SUBROUTINE iom_rstdimg__write_var(td_file)
1714	IMPLICIT NONE
1715	! Argument
1716	TYPE(TFILE), INTENT(INOUT) :: td_file
1717
1718	! local variable
1719	INTEGER(i4) :: il_status
1720	TYPE(TVAR) :: tl_var
1721
1722	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_start
1723	INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_count
1724	CHARACTER(LEN=ip_vnl), DIMENSION(:), ALLOCATABLE :: cl_name
1725	REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
1726
1727	INTEGER(i4), DIMENSION(:,:,:,:), ALLOCATABLE :: il_tmp
1728
1729	! loop indices
1730	INTEGER(i4) :: ji
1731	!----------------------------------------------------------------
1732
1733	! add dummy variable if necessary
1734	IF( td_file%i_n0d == 0 )THEN
1735	! create var
1736	tl_var=var_init('no0d')
1737	! add value
1738	ALLOCATE( il_tmp(1,1,1,1) )
1739	il_tmp(:,:,:,:)=-1
1740	CALL var_add_value(tl_var, il_tmp)
1741	DEALLOCATE( il_tmp )
1742
1743	CALL file_add_var( td_file, tl_var )
1744	ENDIF
1745
1746	IF( td_file%i_n1d == 0 )THEN
1747	! create var
1748	tl_var=var_init('no1d')
1749	! add dimension
1750	CALL var_add_dim(tl_var, td_file%t_dim(3))
1751	! add value
1752	ALLOCATE( il_tmp(1,1,td_file%t_dim(3)%i_len, 1) )
1753	il_tmp(:,:,:,:)=-1
1754	CALL var_add_value(tl_var, il_tmp)
1755	DEALLOCATE( il_tmp )
1756
1757	CALL file_add_var( td_file, tl_var )
1758	ENDIF
1759
1760	IF( td_file%i_n2d == 0 )THEN
1761	! create var
1762	tl_var=var_init('no2d' )
1763	! add dimension
1764	CALL var_add_dim(tl_var, td_file%t_dim(1))
1765	CALL var_add_dim(tl_var, td_file%t_dim(2))
1766	! add value
1767	ALLOCATE( il_tmp( td_file%t_dim(1)%i_len, &
1768	& td_file%t_dim(2)%i_len, &
1769	& 1, &
1770	& 1 ) )
1771	il_tmp(:,:,:,:)=-1
1772	CALL var_add_value(tl_var, il_tmp)
1773	DEALLOCATE( il_tmp )
1774
1775	CALL file_add_var( td_file, tl_var )
1776	ENDIF
1777
1778	IF( td_file%i_n3d == 0 )THEN
1779	! create var
1780	tl_var=var_init('no3d' )
1781	! add dimension
1782	CALL var_add_dim(tl_var, td_file%t_dim(1))
1783	CALL var_add_dim(tl_var, td_file%t_dim(2))
1784	CALL var_add_dim(tl_var, td_file%t_dim(3))
1785	! add value
1786	ALLOCATE( il_tmp( td_file%t_dim(1)%i_len, &
1787	& td_file%t_dim(2)%i_len, &
1788	& td_file%t_dim(3)%i_len, &
1789	& 1 ) )
1790	il_tmp(:,:,:,:)=-1
1791	CALL var_add_value(tl_var, il_tmp)
1792	DEALLOCATE( il_tmp )
1793
1794	CALL file_add_var( td_file, tl_var )
1795	ENDIF
1796
1797	! reform name and record
1798	ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
1799	DO ji=1,td_file%i_nvar
1800	cl_name(ji) = TRIM(td_file%t_var(ji)%c_name)
1801	dl_value(ji) = REAL(td_file%t_var(ji)%i_rec,dp)
1802	ENDDO
1803
1804	! special case for 0d
1805	DO ji=1,td_file%i_n0d
1806	dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1)
1807	ENDDO
1808
1809	ALLOCATE( il_start(4), il_count(4) )
1810
1811	il_start(1) = 1
1812	il_count(1) = td_file%i_n0d
1813
1814	il_start(2) = 1 + il_count(1)
1815	il_count(2) = il_start(2) - 1 + td_file%i_n1d
1816
1817	il_start(3) = 1 + il_count(2)
1818	il_count(3) = il_start(3) - 1 + td_file%i_n2d
1819
1820	il_start(4) = 1 + il_count(3)
1821	il_count(4) = il_start(4) - 1 + td_file%i_n3d
1822
1823
1824	WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )&
1825	& cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
1826	& cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
1827	& cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
1828	& cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
1829
1830	DEALLOCATE( il_start, il_count )
1831
1832	END SUBROUTINE iom_rstdimg__write_var
1833	!> @endcode
1834	END MODULE iom_rstdimg

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

Download in other formats: