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/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90 @ 7261

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

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

Download in other formats: