source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/iom_rstdimg.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File size: 62.7 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!----------------------------------------------------------------------
66MODULE 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
118CONTAINS
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   !> - 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   !> - 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   !> - 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   !> - November, 2013- Initial Version
397   !
398   !> @param[inout] td_file   file structure
399   !-------------------------------------------------------------------
400   SUBROUTINE iom_rstdimg_get_mpp(td_file)
401      IMPLICIT NONE
402      ! Argument     
403      TYPE(TFILE), INTENT(INOUT) :: td_file
404
405      ! local variable
406      TYPE(TATT)  :: tl_att
407      INTEGER(i4) :: il_status
408      INTEGER(i4) :: il_recl                          ! record length
409      INTEGER(i4) :: il_nx, il_ny, il_nz              ! x,y,z dimension
410      INTEGER(i4) :: il_n0d, il_n1d, il_n2d, il_n3d   ! number of 0/1/2/3D variables
411      INTEGER(i4) :: il_iglo, il_jglo                 ! domain global size
412      INTEGER(i4) :: il_rhd                           ! record of the header infos
413      INTEGER(i4) :: il_niproc, il_njproc, il_nproc   ! domain decomposition
414      INTEGER(i4) :: il_area                          ! domain index
415
416      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
417      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
418      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
419      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
420      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
421      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
422      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
423      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
424      !----------------------------------------------------------------
425
426      CALL logger_debug( " IOM RSTDIMG GET MPP: dimg file "//&
427      &  TRIM(td_file%c_name))
428
429      ! read first record
430      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
431      &     il_recl,                         &
432      &     il_nx, il_ny, il_nz,             &
433      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
434      &     il_rhd,                          &
435      &     il_niproc, il_njproc, il_nproc,  &
436      &     il_area,                         &
437      &     il_iglo, il_jglo
438      CALL fct_err(il_status)
439      IF( il_status /= 0 )THEN
440         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
441         &  TRIM(fct_str(il_status)))
442         CALL logger_error(" IOM RSTDIMG GET MPP: read first line of "//&
443         &  TRIM(td_file%c_name))
444      ENDIF
445
446      ! create attributes to save mpp value
447      tl_att=att_init( "DOMAIN_number_total", il_nproc)
448      CALL file_move_att(td_file, tl_att)
449
450      tl_att=att_init( "DOMAIN_I_number_total", il_niproc)
451      CALL file_move_att(td_file, tl_att)
452
453      tl_att=att_init( "DOMAIN_J_number_total", il_njproc)
454      CALL file_move_att(td_file, tl_att)
455
456      tl_att=att_init( "DOMAIN_number", il_area)
457      CALL file_move_att(td_file, tl_att)
458
459      tl_att=att_init( "DOMAIN_size_global", (/il_iglo, il_jglo/))
460      CALL file_move_att(td_file, tl_att)
461
462      ! allocate local variable
463      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
464      &         il_lci(il_nproc),  il_lcj(il_nproc), &
465      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
466      &         il_lei(il_nproc),  il_lej(il_nproc), &
467      &         stat=il_status)
468      IF(il_status /= 0 )THEN
469
470         CALL logger_error( " IOM RSTDIMG GET MPP: not enough space to put "//&
471         &  "domain decomposition in file "//TRIM(td_file%c_name) )
472
473      ENDIF
474
475      ! read first record
476      READ( td_file%i_id, IOSTAT=il_status, REC=1 )& 
477      &     il_recl,                         &
478      &     il_nx, il_ny, il_nz,             &
479      &     il_n0d, il_n1d, il_n2d, il_n3d,  &
480      &     il_rhd,                          &
481      &     il_niproc, il_njproc, il_nproc,  &
482      &     il_area,                         &
483      &     il_iglo, il_jglo,                &
484      &     il_lci(:), il_lcj(:),            &
485      &     il_ldi(:), il_ldj(:),            &
486      &     il_lei(:), il_lej(:),            &
487      &     il_impp(:),il_jmpp(:)
488      CALL fct_err(il_status)
489      IF( il_status /= 0 )THEN
490         CALL logger_debug(" IOM RSTDIMG GET MPP: read status: "//&
491         &  TRIM(fct_str(il_status)))
492         CALL logger_fatal("IOM RSTDIMG GET MPP: read domain decomposition "//&
493         &           "on first line of "//TRIM(td_file%c_name))
494      ENDIF
495
496      tl_att=att_init( "DOMAIN_position_first", (/il_impp(il_area), il_jmpp(il_area)/))
497      CALL file_move_att(td_file, tl_att)
498
499      tl_att=att_init( "DOMAIN_position_last", (/il_lci(il_area), il_lcj(il_area)/))
500      CALL file_move_att(td_file, tl_att)
501
502      tl_att=att_init( "DOMAIN_halo_size_start", (/il_ldi(il_area), il_ldj(il_area)/))
503      CALL file_move_att(td_file, tl_att)
504
505      tl_att=att_init( "DOMAIN_halo_size_end", (/il_lei(il_area), il_lej(il_area)/))
506      CALL file_move_att(td_file, tl_att)
507
508      tl_att=att_init( "DOMAIN_I_position_first", il_impp(:) )
509      CALL file_move_att(td_file, tl_att)
510      tl_att=att_init( "DOMAIN_J_position_first", il_jmpp(:) )
511      CALL file_move_att(td_file, tl_att)
512
513      tl_att=att_init( "DOMAIN_I_position_last", il_lci(:) )
514      CALL file_move_att(td_file, tl_att)
515      tl_att=att_init( "DOMAIN_J_position_last", il_lcj(:) )
516      CALL file_move_att(td_file, tl_att)
517
518      tl_att=att_init( "DOMAIN_I_halo_size_start", il_ldi(:) )
519      CALL file_move_att(td_file, tl_att)
520      tl_att=att_init( "DOMAIN_J_halo_size_start", il_ldj(:) )
521      CALL file_move_att(td_file, tl_att)
522
523      tl_att=att_init( "DOMAIN_I_halo_size_end", il_lei(:) )
524      CALL file_move_att(td_file, tl_att)
525      tl_att=att_init( "DOMAIN_J_halo_size_end", il_lej(:) )
526      CALL file_move_att(td_file, tl_att)
527
528      ! clean
529      CALL att_clean(tl_att)
530
531      DEALLOCATE( il_impp, il_jmpp,&
532      &           il_lci,  il_lcj, &
533      &           il_ldi,  il_ldj, &
534      &           il_lei,  il_lej  )
535
536   END SUBROUTINE iom_rstdimg_get_mpp
537   !-------------------------------------------------------------------
538   !> @brief This subroutine read information about variable on an
539   !> opened dimg file.
540   !> @details
541   !> The variables structures inside file structure are then completed.
542   !> Variables no0d, no1d, no2d, no3d are deleted from file strucutre.
543   !> @note variable value are read only for scalar variable (0d).
544   !
545   !> @author J.Paul
546   !> - November, 2013- Initial Version
547   !
548   !> @param[inout] td_file   file structure
549   !-------------------------------------------------------------------
550   SUBROUTINE iom_rstdimg__get_file_var(td_file)
551      IMPLICIT NONE
552      ! Argument     
553      TYPE(TFILE), INTENT(INOUT) :: td_file
554
555      ! local variable
556      CHARACTER(LEN=im_vnl), DIMENSION(:), ALLOCATABLE :: cl_name
557
558      REAL(dp)             , DIMENSION(:), ALLOCATABLE :: dl_value
559
560      INTEGER(i4)                                      :: il_status
561      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_start
562      INTEGER(i4)          , DIMENSION(:), ALLOCATABLE :: il_count
563
564      !----------------------------------------------------------------
565
566      IF( td_file%i_nvar > 0 )THEN
567
568         ALLOCATE( il_start(4), il_count(4) )
569
570         il_start(1) = 1
571         il_count(1) = td_file%i_n0d
572         
573         il_start(2) = 1 + il_count(1)
574         il_count(2) = il_start(2) - 1 + td_file%i_n1d
575         
576         il_start(3) = 1 + il_count(2)
577         il_count(3) = il_start(3) - 1 + td_file%i_n2d
578         
579         il_start(4) = 1 + il_count(3)
580         il_count(4) = il_start(4) - 1 + td_file%i_n3d
581         
582         ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
583
584         ! read first record
585         READ( td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )& 
586         & cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
587         & cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
588         & cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
589         & cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
590         CALL fct_err(il_status)
591         IF( il_status /= 0 )THEN
592            CALL logger_error("GET FILE: reading headers in file "//&
593            &   TRIM(td_file%c_name))
594         ENDIF
595
596         DEALLOCATE( il_start, il_count )
597
598         IF(ASSOCIATED(td_file%t_var))THEN
599            CALL var_clean(td_file%t_var(:))
600            DEALLOCATE(td_file%t_var)
601         ENDIF
602         ALLOCATE(td_file%t_var(td_file%i_nvar))
603
604         ! put information about variable 0D inside file structure
605         CALL iom_rstdimg__get_file_var_0d(td_file, cl_name(:), dl_value(:))
606
607         ! put information about variable 1D inside file structure
608         CALL iom_rstdimg__get_file_var_1d(td_file, cl_name(:), dl_value(:))
609
610         ! put information about variable 2D inside file structure
611         CALL iom_rstdimg__get_file_var_2d(td_file, cl_name(:), dl_value(:))
612
613         ! put information about variable 3D inside file structure
614         CALL iom_rstdimg__get_file_var_3d(td_file, cl_name(:), dl_value(:))
615
616         DEALLOCATE( cl_name, dl_value )
617
618         ! delete dummy variable
619         CALL file_del_var( td_file, 'no0d' )
620         CALL file_del_var( td_file, 'no1d' )
621         CALL file_del_var( td_file, 'no2d' )
622         CALL file_del_var( td_file, 'no3d' )
623
624      ELSE
625
626         CALL logger_debug( &
627         &  " GET FILE VAR: there is no variable in file "//&
628         &  TRIM(td_file%c_name))
629
630      ENDIF
631
632   END SUBROUTINE iom_rstdimg__get_file_var
633   !-------------------------------------------------------------------
634   !> @brief This subroutine put informations about scalar variable
635   !> inside file structure.
636   !
637   !> @author J.Paul
638   !> - November, 2013- Initial Version
639   !
640   !> @param[inout] td_file   file structure
641   !> @param[in] cd_name      array of variable name
642   !> @param[in] dd_value     array of variable value
643   !-------------------------------------------------------------------
644   SUBROUTINE iom_rstdimg__get_file_var_0d(td_file, cd_name, dd_value)
645      IMPLICIT NONE
646      ! Argument     
647      TYPE(TFILE),                         INTENT(INOUT) :: td_file
648      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
649      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
650
651      ! local variable
652      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
653
654      ! loop indices
655      INTEGER(i4) :: ji
656      !----------------------------------------------------------------
657
658      ! define same dimension as in file
659      tl_dim(:)=dim_copy(td_file%t_dim(:))
660      ! do not use any dimension
661      tl_dim(:)%l_use=.FALSE.
662      tl_dim(:)%i_len=1
663     
664      ! case scalar variable
665      DO ji = 1, td_file%i_n0d
666   
667         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
668         &                           tl_dim(:), dd_fill=0._dp,       &
669         &                           id_id=ji, id_rec=1 )
670
671         ! get value of scalar
672         IF( ASSOCIATED(td_file%t_var(ji)%d_value) )THEN
673            DEALLOCATE(td_file%t_var(ji)%d_value)
674         ENDIF
675         ALLOCATE(td_file%t_var(ji)%d_value(1,1,1,1))
676
677         td_file%t_var(ji)%d_value(1,1,1,1)=dd_value(ji)
678
679      ENDDO
680
681      ! clean
682      CALL dim_clean(tl_dim(:))
683
684   END SUBROUTINE iom_rstdimg__get_file_var_0d
685   !-------------------------------------------------------------------
686   !> @brief This subroutine put informations about variable 1D
687   !> inside file structure.
688   !
689   !> @author J.Paul
690   !> - November, 2013- Initial Version
691   !
692   !> @param[inout] td_file   file structure
693   !> @param[in] cd_name      array of variable name
694   !> @param[in] dd_value     array of variable record
695   !-------------------------------------------------------------------
696   SUBROUTINE iom_rstdimg__get_file_var_1d(td_file, cd_name, dd_value)
697      IMPLICIT NONE
698      ! Argument     
699      TYPE(TFILE),                         INTENT(INOUT) :: td_file
700      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
701      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
702
703      ! local variable
704      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
705
706      ! loop indices
707      INTEGER(i4) :: ji
708      !----------------------------------------------------------------
709
710      ! case variable 1D
711      DO ji = td_file%i_n0d + 1, &
712      &       td_file%i_n0d + td_file%i_n1d
713
714         ! define same dimension as in file
715         tl_dim(:)=dim_copy(td_file%t_dim(:))
716         ! do not use X and Y dimension
717         td_file%t_var(ji)%t_dim(1:2)%l_use=.FALSE.
718         td_file%t_var(ji)%t_dim(1:2)%i_len=1
719     
720         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
721         &                           tl_dim(:), dd_fill=0._dp,       &
722         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
723
724         ! clean
725         CALL dim_clean(tl_dim(:))
726
727      ENDDO
728
729   END SUBROUTINE iom_rstdimg__get_file_var_1d
730   !-------------------------------------------------------------------
731   !> @brief This subroutine put informations about variable 2D
732   !> inside file structure.
733   !
734   !> @author J.Paul
735   !> - November, 2013- Initial Version
736   !
737   !> @param[inout] td_file   file structure
738   !> @param[in] cd_name      array of variable name
739   !> @param[in] dd_value     array of variable record
740   !-------------------------------------------------------------------
741   SUBROUTINE iom_rstdimg__get_file_var_2d(td_file, cd_name, dd_value)
742      IMPLICIT NONE
743      ! Argument     
744      TYPE(TFILE),                         INTENT(INOUT) :: td_file
745      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
746      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
747
748      ! local variable
749      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
750
751      ! loop indices
752      INTEGER(i4) :: ji
753      !----------------------------------------------------------------
754
755      ! case variable 2D (X,Y)
756      DO ji = td_file%i_n0d + td_file%i_n1d + 1 , &
757      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d
758
759         ! define same dimension as in file
760         tl_dim(:)=dim_copy(td_file%t_dim(:))
761         ! do not use Z dimension
762         tl_dim(3)%l_use=.FALSE.
763         tl_dim(3)%i_len=1       
764
765         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
766         &                           tl_dim(:), dd_fill=0._dp,       &
767         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
768
769         ! clean
770         CALL dim_clean(tl_dim(:))
771
772      ENDDO
773
774   END SUBROUTINE iom_rstdimg__get_file_var_2d
775   !-------------------------------------------------------------------
776   !> @brief This subroutine put informations about variable 3D
777   !> inside file structure.
778   !
779   !> @author J.Paul
780   !> - November, 2013- Initial Version
781   !
782   !> @param[inout] td_file   file structure
783   !> @param[in] cd_name      array of variable name
784   !> @param[in] dd_value     array of variable record
785   !-------------------------------------------------------------------
786   SUBROUTINE iom_rstdimg__get_file_var_3d(td_file, cd_name, dd_value)
787      IMPLICIT NONE
788      ! Argument     
789      TYPE(TFILE),                         INTENT(INOUT) :: td_file
790      CHARACTER(LEN=im_vnl), DIMENSION(:), INTENT(IN)    :: cd_name
791      REAL(dp),              DIMENSION(:), INTENT(IN)    :: dd_value
792
793      ! local variable
794      TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
795
796      ! loop indices
797      INTEGER(i4) :: ji
798      !----------------------------------------------------------------
799
800      ! case variable 3D (X,Y,Z)
801      DO ji = td_file%i_n0d + td_file%i_n1d + td_file%i_n2d +1 , &
802      &       td_file%i_n0d + td_file%i_n1d + td_file%i_n2d + td_file%i_n3d
803
804         ! define same dimension as in file
805         tl_dim(:)=dim_copy(td_file%t_dim(:)) 
806
807         td_file%t_var(ji)=var_init( TRIM(cd_name(ji)), NF90_DOUBLE, &
808         &                           tl_dim(:), dd_fill=0._dp,       &
809         &                           id_id=ji, id_rec=INT(dd_value(ji),i4) )
810
811         ! clean
812         CALL dim_clean(tl_dim(:))
813
814      ENDDO
815
816   END SUBROUTINE iom_rstdimg__get_file_var_3d
817   !-------------------------------------------------------------------
818   !> @brief This function read one dimension in an opened netcdf file,
819   !> given dimension id.
820   !
821   !> @author J.Paul
822   !> - Nov, 2013- Initial Version
823   !
824   !> @param[in] td_file   file structure
825   !> @param[in] id_dimid  dimension id
826   !> @return  dimension structure
827   !-------------------------------------------------------------------
828   TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_id(td_file, id_dimid)
829      IMPLICIT NONE
830      ! Argument     
831      TYPE(TFILE), INTENT(IN) :: td_file
832      INTEGER(i4), INTENT(IN) :: id_dimid
833      !----------------------------------------------------------------
834
835      ! check if file opened
836      IF( td_file%i_id == 0 )THEN
837
838         CALL logger_error( &
839         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
840
841      ELSE     
842
843         iom_rstdimg__read_dim_id%i_id=id_dimid
844
845         CALL logger_debug( &
846         &  " READ DIM: dimension "//TRIM(fct_str(id_dimid))//&
847         &  " in file "//TRIM(td_file%c_name))
848
849         IF( id_dimid <= 4 )THEN
850            iom_rstdimg__read_dim_id=td_file%t_dim(id_dimid)
851         ELSE
852            CALL logger_error( &
853            &  " READ DIM: no dimension with id "//TRIM(fct_str(id_dimid))//&
854            &  " in file "//TRIM(td_file%c_name))
855         ENDIF
856
857      ENDIF
858
859   END FUNCTION iom_rstdimg__read_dim_id
860   !-------------------------------------------------------------------
861   !> @brief This function read one dimension in an opened netcdf file,
862   !> given dimension name.
863   !
864   !> @author J.Paul
865   !> - Nov, 2013- Initial Version
866   !
867   !> @param[in] td_file   file structure
868   !> @param[in] cd_name   dimension name
869   !> @return  dimension structure
870   !-------------------------------------------------------------------
871   TYPE(TDIM) FUNCTION iom_rstdimg__read_dim_name(td_file, cd_name)
872      IMPLICIT NONE
873      ! Argument     
874      TYPE(TFILE),      INTENT(IN) :: td_file
875      CHARACTER(LEN=*), INTENT(IN) :: cd_name
876
877      ! local variable
878      INTEGER(i4) :: il_dimid
879      !----------------------------------------------------------------
880
881      ! check if file opened
882      IF( td_file%i_id == 0 )THEN
883
884         CALL logger_error( &
885         &  " READ DIM: no id associated to dimg file "//TRIM(td_file%c_name))
886
887      ELSE     
888
889         il_dimid=dim_get_id(td_file%t_dim(:), TRIM(cd_name))
890         IF( il_dimid /= 0 )THEN
891            iom_rstdimg__read_dim_name=iom_rstdimg_read_dim(td_file, il_dimid)
892         ELSE
893            CALL logger_error( &
894            &  " READ DIM: no dimension "//TRIM(cd_name)//&
895            &  " in file "//TRIM(td_file%c_name))
896         ENDIF
897
898      ENDIF
899
900   END FUNCTION iom_rstdimg__read_dim_name
901   !-------------------------------------------------------------------
902   !> @brief This function read variable value in an opened
903   !> dimg file, given variable id.
904   !> @details
905   !> Optionaly, start indices and number of indices selected along each dimension
906   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
907   !
908   !> @author J.Paul
909   !> - November, 2013- Initial Version
910   !
911   !> @param[in] td_file   file structure
912   !> @param[in] id_varid  variable id
913   !> @param[in] id_start  index in the variable from which the data values
914   !> will be read
915   !> @param[in] id_count  number of indices selected along each dimension
916   !> @return  variable structure
917   !-------------------------------------------------------------------
918   TYPE(TVAR) FUNCTION iom_rstdimg__read_var_id(td_file, id_varid,&
919   &                                            id_start, id_count)
920      IMPLICIT NONE
921      ! Argument     
922      TYPE(TFILE),               INTENT(IN) :: td_file
923      INTEGER(i4),               INTENT(IN) :: id_varid
924      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_start
925      INTEGER(i4), DIMENSION(:), INTENT(IN), OPTIONAL :: id_count
926
927      ! local variable
928      INTEGER(i4), DIMENSION(1) :: il_varid
929      !----------------------------------------------------------------
930      ! check if file opened
931      IF( td_file%i_id == 0 )THEN
932
933         CALL logger_error( &
934         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
935
936      ELSE
937
938         ! look for variable id
939         il_varid(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid))
940         IF( il_varid(1) /= 0 )THEN
941
942            iom_rstdimg__read_var_id=var_copy(td_file%t_var(il_varid(1)))
943
944            IF( iom_rstdimg__read_var_id%i_ndim /= 0 )THEN
945               !!! read variable value
946               CALL iom_rstdimg__read_var_value( td_file, &
947               &                                 iom_rstdimg__read_var_id, &
948               &                                 id_start, id_count)
949            ELSE
950               CALL logger_debug( " READ VAR: variable 0d "//&
951               &               TRIM(td_file%t_var(il_varid(1))%c_name)//&
952               &               " should be already read ")
953            ENDIF           
954
955         ELSE
956            CALL logger_error( &
957            &  " READ VAR: there is no variable with id "//&
958            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name))
959         ENDIF
960
961      ENDIF
962   END FUNCTION iom_rstdimg__read_var_id
963   !-------------------------------------------------------------------
964   !> @brief This function read variable value in an opened
965   !> dimg file, given variable name or standard name.
966   !> @details
967   !> Optionaly, start indices and number of indices selected along each dimension
968   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
969   !
970   !> look first for variable name. If it doesn't
971   !> exist in file, look for variable standard name.<br/>
972   !
973   !> @author J.Paul
974   !> - November, 2013- Initial Version
975   !
976   !> @param[in] td_file   file structure
977   !> @param[in] cd_name   variable name or standard name
978   !> @param[in] id_start  index in the variable from which the data values
979   !> will be read
980   !> @param[in] id_count  number of indices selected along each dimension
981   !> @return  variable structure
982   !-------------------------------------------------------------------
983   TYPE(TVAR) FUNCTION iom_rstdimg__read_var_name(td_file, cd_name,   &
984   &                                              id_start, id_count  )
985      IMPLICIT NONE
986      ! Argument
987      TYPE(TFILE),                     INTENT(IN) :: td_file
988      CHARACTER(LEN=*),                INTENT(IN) :: cd_name
989      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_start
990      INTEGER(i4),      DIMENSION(:),  INTENT(IN), OPTIONAL :: id_count
991
992      ! local variable
993      INTEGER(i4)       :: il_varid
994      !----------------------------------------------------------------
995      ! check if file opened
996      IF( td_file%i_id == 0 )THEN
997
998         CALL logger_error( &
999         &  " READ VAR: no id associated to file "//TRIM(td_file%c_name))
1000
1001      ELSE
1002
1003         il_varid=var_get_index(td_file%t_var(:), cd_name)
1004         IF( il_varid /= 0 )THEN
1005
1006            iom_rstdimg__read_var_name=var_copy(td_file%t_var(il_varid))
1007
1008            IF( td_file%t_var(il_varid)%i_ndim /= 0 )THEN
1009               !!! read variable value
1010               CALL iom_rstdimg__read_var_value( td_file, &
1011               &                                 iom_rstdimg__read_var_name, &
1012               &                                 id_start, id_count)
1013            ELSE
1014               CALL logger_debug( " READ VAR: variable 0d "//&
1015               &               TRIM(td_file%t_var(il_varid)%c_name)//&
1016               &               " should have been already read ")
1017            ENDIF
1018
1019         ELSE
1020
1021            CALL logger_error( &
1022            &  " READ VAR NAME: there is no variable with "//&
1023            &  " name or standard name "//TRIM(cd_name)//&
1024            &  " in file "//TRIM(td_file%c_name) )
1025
1026         ENDIF
1027
1028      ENDIF
1029     
1030   END FUNCTION iom_rstdimg__read_var_name
1031   !-------------------------------------------------------------------
1032   !> @brief This subroutine read variable value in an opened dimg file, for
1033   !> variable 1,2,3d.
1034   !> @details
1035   !> Optionaly,start indices and number of indices selected along each dimension
1036   !> could be specify in a 4 dimension array (/'x','y','z','t'/)
1037   !>
1038   !> @author J.Paul
1039   !> - November, 2013- Initial Version
1040   !
1041   !> @param[in] td_file   file structure
1042   !> @param[inout] td_var variable structure
1043   !> @param[in] id_start  index in the variable from which the data values will be read
1044   !> @param[in] id_count  number of indices selected along each dimension
1045   !-------------------------------------------------------------------
1046   SUBROUTINE iom_rstdimg__read_var_value(td_file, td_var, &
1047   &                                      id_start, id_count )
1048      IMPLICIT NONE
1049      ! Argument     
1050      TYPE(TFILE),               INTENT(IN)    :: td_file
1051      TYPE(TVAR) ,               INTENT(INOUT) :: td_var
1052      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_start
1053      INTEGER(i4), DIMENSION(:), INTENT(IN),  OPTIONAL :: id_count
1054
1055      ! local variable
1056      INTEGER(i4)                                  :: il_status
1057      INTEGER(i4)                                  :: il_tmp1, il_tmp2
1058      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_start
1059      INTEGER(i4), DIMENSION(ip_maxdim)            :: il_count
1060      REAL(dp),    DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
1061
1062      ! loop indices
1063      INTEGER(i4) :: ji
1064      !----------------------------------------------------------------
1065
1066      ! check id_count and id_start optionals parameters...
1067      IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. &
1068          ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN
1069         CALL logger_warn( &
1070         &  " READ VAR VALUE: id_start and id_count should be both specify")
1071      ENDIF
1072
1073      IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
1074
1075         IF( SIZE(id_start(:)) /= ip_maxdim .OR. &
1076         &   SIZE(id_count(:)) /= ip_maxdim )THEN
1077            CALL logger_error("READ VAR: dimension of array start or count "//&
1078            &      " are invalid to read variable "//TRIM(td_var%c_name)//&
1079            &      " in file "//TRIM(td_file%c_name) )
1080         ENDIF
1081
1082         ! dimension order assume to be ('x','y','z','t')
1083         il_start(:)=id_start(:)
1084         il_count(:)=id_count(:)
1085
1086      ELSE
1087
1088         ! dimension order assume to be ('x','y','z','t')
1089         il_start(:)=(/1,1,1,1/)
1090         il_count(:)=td_var%t_dim(:)%i_len
1091
1092      ENDIF
1093
1094      ! check dimension
1095      IF( .NOT. ALL(il_start(:)>=(/1,1,1,1/)) )THEN
1096
1097         CALL logger_error( " READ VAR VALUE: "//&
1098         &               " start indices should be greater than or equal to 1")
1099
1100      ENDIF
1101
1102      IF(.NOT.ALL(il_start(:)+il_count(:)-1<=(/td_var%t_dim(1)%i_len,&
1103         &                                     td_var%t_dim(2)%i_len,&
1104         &                                     td_var%t_dim(3)%i_len,&
1105         &                                     td_var%t_dim(4)%i_len &
1106         &                                    /)) )THEN
1107
1108         CALL logger_error( " READ VAR VALUE: "//&
1109         &               "start + count exceed variable dimension" )
1110
1111         DO ji = 1, ip_maxdim
1112            il_tmp1=il_start(ji)+il_count(ji)-1
1113            il_tmp2=td_var%t_dim(ji)%i_len
1114            CALL logger_debug( &
1115            &  " READ VAR VALUE: start + count - 1 "//TRIM(fct_str(il_tmp1))//&
1116            &  " variable dimension"//TRIM(fct_str(il_tmp2)))
1117         ENDDO
1118
1119      ELSE
1120
1121         ! Allocate space to hold variable value
1122         ALLOCATE(dl_value( td_var%t_dim(1)%i_len, &
1123         &                  td_var%t_dim(2)%i_len, &
1124         &                  td_var%t_dim(3)%i_len, &
1125         &                  td_var%t_dim(4)%i_len),&
1126         &        stat=il_status)
1127         IF(il_status /= 0 )THEN
1128
1129           CALL logger_error( &
1130            &  " READ VAR VALUE: not enough space to put variable "//&
1131            &  TRIM(td_var%c_name)//&
1132            &  " in temporary array")
1133
1134         ENDIF
1135
1136         ! read values
1137         CALL logger_trace( &
1138         &  " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//&
1139         &  " in file "//TRIM(td_file%c_name))     
1140
1141         IF( ALL(td_var%t_dim(1:3)%l_use) )THEN
1142            ! 3D variable (X,Y,Z)
1143            DO ji=1,td_var%t_dim(3)%i_len
1144               READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec +ji-1) &
1145               &  dl_value(:,:,ji,:)
1146               CALL fct_err(il_status)
1147               IF( il_status /= 0 )THEN
1148                  CALL logger_error("READ VAR VALUE: reading 3D variable "//&
1149                  &              TRIM(td_var%c_name))
1150               ENDIF
1151            ENDDO
1152         ELSEIF( ALL(td_var%t_dim(1:2)%l_use) )THEN
1153            ! 2D variable (X,Y)
1154            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
1155            &  dl_value(:,:,:,:)
1156            CALL fct_err(il_status)
1157            IF( il_status /= 0 )THEN
1158               CALL logger_error("READ VAR VALUE: reading 2D variable "//&
1159                  &            TRIM(td_var%c_name))
1160            ENDIF
1161         ELSEIF( td_var%t_dim(3)%l_use )THEN
1162            ! 1D variable (Z)
1163            READ(td_file%i_id, IOSTAT=il_status, REC=td_var%i_rec ) &
1164            &  dl_value(:,:,:,:)
1165            CALL fct_err(il_status)
1166            IF( il_status /= 0 )THEN
1167               CALL logger_error("READ VAR VALUE: reading 1D variable "//&
1168                  &            TRIM(td_var%c_name))
1169            ENDIF
1170         ENDIF
1171 
1172         ! Allocate space to hold variable value in structure
1173         IF( ASSOCIATED(td_var%d_value) )THEN
1174            DEALLOCATE(td_var%d_value)   
1175         ENDIF
1176
1177         ALLOCATE(td_var%d_value( il_count(1), &
1178         &                        il_count(2), &
1179         &                        il_count(3), &
1180         &                        il_count(4)),&
1181         &        stat=il_status)
1182         IF(il_status /= 0 )THEN
1183
1184           CALL logger_error( &
1185            &  " READ VAR VALUE: not enough space to put variable "//&
1186            &  TRIM(td_var%c_name)//&
1187            &  " in variable structure")
1188
1189         ENDIF
1190         ! FillValue by default
1191         td_var%d_value(:,:,:,:)=td_var%d_fill
1192
1193         ! new dimension length
1194         td_var%t_dim(:)%i_len=il_count(:)
1195
1196         ! extract value
1197         td_var%d_value(:,:,:,:) = dl_value(il_start(1):il_start(1)+il_count(1)-1,&
1198         &                                  il_start(2):il_start(2)+il_count(2)-1,&
1199         &                                  il_start(3):il_start(3)+il_count(3)-1,&
1200         &                                  il_start(4):il_start(4)+il_count(4)-1)
1201
1202         DEALLOCATE(dl_value)
1203
1204      ENDIF
1205
1206   END SUBROUTINE iom_rstdimg__read_var_value
1207   !-------------------------------------------------------------------
1208   !> @brief This subroutine write dimg file from file structure.
1209   !
1210   !> @details
1211   !> dimg file have to be already opened in write mode.
1212   !>
1213   !> @author J.Paul
1214   !> - November, 2013- Initial Version
1215   !> @date September, 2014
1216   !> - use iom_rstdimg__get_rec
1217   !
1218   !> @param[inout] td_file   file structure
1219   !-------------------------------------------------------------------
1220   SUBROUTINE iom_rstdimg_write_file(td_file)
1221      IMPLICIT NONE
1222      ! Argument     
1223      TYPE(TFILE), INTENT(INOUT) :: td_file
1224
1225      ! local variable
1226      INTEGER(i4)           :: il_status
1227      INTEGER(i4)           :: il_ind
1228      !----------------------------------------------------------------
1229      ! check if file opened
1230      IF( td_file%i_id == 0 )THEN
1231
1232         CALL logger_error( &
1233         &  " WRITE FILE: no id associated to file "//TRIM(td_file%c_name))
1234
1235      ELSE
1236         IF( td_file%l_wrt )THEN
1237
1238            ! check dimension
1239            IF( td_file%t_dim(jp_L)%l_use .AND. &
1240            &   td_file%t_dim(jp_L)%i_len /= 1 )THEN
1241               CALL logger_fatal("WRITE FILE: can not write dimg file with "//&
1242               &  " several time step.")
1243            ENDIF
1244
1245            ! close and open file with right record length
1246            CALL iom_rstdimg_close(td_file)
1247
1248            ! compute record number to be used
1249            ! and add variable no0d, no1d,.. if need be
1250            CALL iom_rstdimg__get_rec(td_file)
1251
1252            ! compute record length
1253            il_ind=att_get_index(td_file%t_att(:),"DOMAIN_number_total")
1254            IF( il_ind /= 0 )THEN
1255               td_file%i_recl = MAX( &
1256               &     td_file%t_dim(1)%i_len * td_file%t_dim(2)%i_len * 8, &
1257               &     ( 8 * INT(td_file%t_att(il_ind)%d_value(1)) + 15 ) * 4 )
1258            ELSE
1259               td_file%i_recl = td_file%t_dim(1)%i_len * &
1260               &                td_file%t_dim(2)%i_len * 8
1261            ENDIF
1262            ! check record length
1263            IF( td_file%i_nvar*(im_vnl+dp) > td_file%i_recl )THEN
1264               CALL logger_fatal("WRITE FILE: record length is too small. "//&
1265               &  " Try to reduce the output number of processor.")
1266            ENDIF
1267
1268            ! get free unit
1269            td_file%i_id=fct_getunit()
1270
1271            OPEN( td_file%i_id, FILE=TRIM(td_file%c_name),&
1272            &                         FORM='UNFORMATTED',              &
1273            &                         ACCESS='DIRECT',                 &
1274            &                         STATUS='REPLACE',                &
1275            &                         ACTION='WRITE',                  &
1276            &                         RECL=td_file%i_recl,             &
1277            &                         IOSTAT=il_status)
1278            CALL fct_err(il_status)
1279            IF( il_status /= 0 )THEN
1280               CALL logger_error("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
1281               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
1282            ELSE
1283               CALL logger_debug("WRITE FILE: REPLACE file "//TRIM(td_file%c_name)//&
1284               &  " with record length "//TRIM(fct_str(td_file%i_recl)))
1285            ENDIF
1286
1287            ! write header
1288            CALL iom_rstdimg__write_header(td_file)
1289
1290            ! write variable in file
1291            CALL iom_rstdimg__write_var(td_file) 
1292
1293         ELSE
1294
1295            CALL logger_error( &
1296            &  " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//&
1297            &  ", not opened in write mode")
1298
1299         ENDIF
1300      ENDIF
1301
1302   END SUBROUTINE iom_rstdimg_write_file
1303   !-------------------------------------------------------------------
1304   !> @brief This subroutine compute record number to be used.
1305   !>
1306   !> @details
1307   !> Moreover it adds variable no0d, no1d, no2d and no3d if need be.
1308   !>
1309   !> @author J.Paul
1310   !> - September, 2014- Initial Version
1311   !
1312   !> @param[inout] td_file   file structure
1313   !-------------------------------------------------------------------
1314   SUBROUTINE iom_rstdimg__get_rec(td_file)
1315      IMPLICIT NONE
1316      ! Argument     
1317      TYPE(TFILE), INTENT(INOUT) :: td_file
1318
1319      ! local variable
1320      INTEGER(i4) :: il_rec
1321      TYPE(TVAR)  :: tl_var
1322
1323      INTEGER(i4), DIMENSION(:)    , ALLOCATABLE :: il_tmp1d
1324      INTEGER(i4), DIMENSION(:,:)  , ALLOCATABLE :: il_tmp2d
1325      INTEGER(i4), DIMENSION(:,:,:), ALLOCATABLE :: il_tmp3d
1326
1327      ! loop indices
1328      INTEGER(i4) :: ji
1329      !----------------------------------------------------------------
1330
1331      ! add dummy variable if necessary
1332      IF( td_file%i_n0d == 0 )THEN
1333         ! create var
1334         tl_var=var_init('no0d')
1335
1336         CALL file_add_var( td_file, tl_var )
1337      ENDIF
1338
1339      IF( td_file%i_n1d == 0 )THEN
1340         ! create var
1341         ALLOCATE( il_tmp1d( td_file%t_dim(3)%i_len ) )
1342         il_tmp1d(:)=-1
1343
1344         tl_var=var_init( 'no1d', il_tmp1d(:)) 
1345
1346         DEALLOCATE( il_tmp1d )
1347
1348         CALL file_add_var( td_file, tl_var ) 
1349      ENDIF
1350 
1351      IF( td_file%i_n2d == 0 )THEN
1352         ! create var
1353         ALLOCATE( il_tmp2d( td_file%t_dim(1)%i_len, &
1354         &                   td_file%t_dim(2)%i_len ) )
1355         il_tmp2d(:,:)=-1
1356
1357         tl_var=var_init('no2d', il_tmp2d(:,:) )
1358
1359         DEALLOCATE( il_tmp2d )
1360
1361         CALL file_add_var( td_file, tl_var ) 
1362
1363      ENDIF
1364 
1365      IF( td_file%i_n3d == 0 )THEN
1366         ! create var
1367         ALLOCATE( il_tmp3d( td_file%t_dim(1)%i_len, &
1368         &                   td_file%t_dim(2)%i_len, &
1369         &                   td_file%t_dim(3)%i_len ) )
1370         il_tmp3d(:,:,:)=-1
1371
1372         tl_var=var_init('no3d', il_tmp3d(:,:,:) )
1373
1374         DEALLOCATE( il_tmp3d )
1375
1376         CALL file_add_var( td_file, tl_var ) 
1377      ENDIF
1378
1379      ! clean
1380      CALL var_clean(tl_var)
1381
1382      il_rec=2
1383      DO ji=1,td_file%i_nvar
1384         SELECT CASE(td_file%t_var(ji)%i_ndim)
1385            CASE(0)
1386               IF( INDEX(td_file%t_var(ji)%c_name, 'no0d' ) == 0 )THEN
1387                  td_file%t_var(ji)%i_rec=il_rec
1388                  il_rec = il_rec  + 0
1389               ENDIF
1390            CASE(1)
1391               IF( INDEX(td_file%t_var(ji)%c_name, 'no1d' ) == 0 )THEN
1392                  td_file%t_var(ji)%i_rec=il_rec
1393                  il_rec = il_rec  + 1
1394               ENDIF
1395            CASE(2)
1396               IF( INDEX(td_file%t_var(ji)%c_name, 'no2d' ) == 0 )THEN
1397                  td_file%t_var(ji)%i_rec=il_rec
1398                  il_rec = il_rec  + 1
1399               ENDIF
1400            CASE(3)
1401               IF( INDEX(td_file%t_var(ji)%c_name, 'no3d' ) == 0 )THEN
1402                  td_file%t_var(ji)%i_rec=il_rec
1403                  il_rec = il_rec  + td_file%t_dim(3)%i_len
1404               ENDIF
1405         END SELECT
1406      ENDDO
1407      td_file%i_rhd  = il_rec
1408
1409      END SUBROUTINE iom_rstdimg__get_rec
1410   !-------------------------------------------------------------------
1411   !> @brief This subroutine write header in an opened dimg
1412   !> file in write mode.
1413   !
1414   !> @author J.Paul
1415   !> - November, 2013- Initial Version
1416   !
1417   !> @param[inout] td_file   file structure
1418   !-------------------------------------------------------------------
1419   SUBROUTINE iom_rstdimg__write_header(td_file)
1420      IMPLICIT NONE
1421      ! Argument     
1422      TYPE(TFILE), INTENT(INOUT) :: td_file
1423
1424      ! local variable
1425      INTEGER(i4) :: il_status
1426      INTEGER(i4) :: il_ind
1427      INTEGER(i4) :: il_nproc
1428      INTEGER(i4) :: il_niproc
1429      INTEGER(i4) :: il_njproc
1430      INTEGER(i4) :: il_area
1431      INTEGER(i4) :: il_iglo
1432      INTEGER(i4) :: il_jglo
1433
1434      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_impp
1435      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_jmpp
1436      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lci
1437      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lcj
1438      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldi
1439      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_ldj
1440      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lei
1441      INTEGER(i4), DIMENSION(:), ALLOCATABLE :: il_lej
1442     
1443      ! loop indices
1444      INTEGER(i4) :: ji
1445      !----------------------------------------------------------------
1446      ! check record length
1447      IF( td_file%i_recl <= 8 )THEN
1448         CALL logger_warn(" WRITE FILE: record length seems to be tiny!! &
1449         & ("//TRIM(fct_str(td_file%i_recl))//")")
1450      ENDIF
1451
1452      ! check dimension
1453      IF( ANY(td_file%t_dim(1:3)%i_len <= 0 ) )THEN
1454         CALL logger_error(" WRITE FILE: at least one dimension size is less &
1455         &                than or equal to zero !! ")
1456         DO ji=1,3
1457            CALL logger_debug(" WRITE FILE: dimension "//&
1458            &               TRIM(td_file%t_dim(ji)%c_name)//" : "//&
1459            &               TRIM(fct_str(td_file%t_dim(ji)%i_len)) )
1460         ENDDO
1461      ENDIF
1462
1463      ! get domain decomposition
1464      il_ind=att_get_index( td_file%t_att, "DOMAIN_number_total" )
1465      il_nproc = 1
1466      IF( il_ind /= 0 )THEN
1467         il_nproc = INT(td_file%t_att(il_ind)%d_value(1))
1468      ENDIF
1469
1470      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_number_total" )
1471      il_niproc = 0
1472      IF( il_ind /= 0 )THEN
1473         il_niproc = INT(td_file%t_att(il_ind)%d_value(1))
1474      ENDIF
1475
1476      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_number_total" )
1477      il_njproc = 0
1478      IF( il_ind /= 0 )THEN
1479         il_njproc = INT(td_file%t_att(il_ind)%d_value(1))
1480      ENDIF
1481
1482      ! check domain decomposition
1483      IF( il_niproc  <= 0 .OR. &
1484      &   il_njproc  <= 0 .OR. &
1485      &   il_nproc <= 0 .OR. &
1486      &   il_nproc > il_niproc * il_njproc )THEN
1487     
1488         CALL logger_error(" WRITE FILE: invalid domain splitting ")
1489
1490         CALL logger_debug(" WRITE FILE: niproc "//TRIM(fct_str(il_niproc)) )
1491         CALL logger_debug(" WRITE FILE: njproc "//TRIM(fct_str(il_njproc)) )
1492         CALL logger_debug(" WRITE FILE: nproc "//TRIM(fct_str(il_nproc)) )
1493
1494      ENDIF
1495     
1496      ! get domain number
1497      il_ind=att_get_index( td_file%t_att, "DOMAIN_number" )
1498      il_area = 0
1499      IF( il_ind /= 0 )THEN
1500         il_area = INT(td_file%t_att(il_ind)%d_value(1))
1501      ENDIF
1502
1503      ! get domain global size
1504      il_ind=att_get_index( td_file%t_att, "DOMAIN_size_global" )
1505      il_iglo = 0
1506      il_jglo = 0
1507      IF( il_ind /= 0 )THEN
1508         il_iglo = INT(td_file%t_att(il_ind)%d_value(1))
1509         il_jglo = INT(td_file%t_att(il_ind)%d_value(2))
1510      ENDIF
1511
1512      ! check domain global size
1513      IF( il_iglo < td_file%t_dim(1)%i_len .OR. &
1514      &   il_jglo < td_file%t_dim(2)%i_len )THEN
1515         CALL logger_error(" WRITE FILE: invalid global domain ")
1516
1517         CALL logger_debug(" WRITE FILE: global domain : "//&
1518         &              TRIM(fct_str(il_iglo))//" x "//&
1519         &              TRIM(fct_str(il_jglo)) )
1520         CALL logger_debug(" WRITE FILE: local domain : "//&
1521         &              TRIM(fct_str(td_file%t_dim(1)%i_len))//" x "//&
1522         &              TRIM(fct_str(td_file%t_dim(2)%i_len)) )
1523      ENDIF
1524
1525      ! allocate local variable
1526      ALLOCATE( il_impp(il_nproc), il_jmpp(il_nproc),&
1527      &         il_lci(il_nproc),  il_lcj(il_nproc), &
1528      &         il_ldi(il_nproc),  il_ldj(il_nproc), &
1529      &         il_lei(il_nproc),  il_lej(il_nproc) )
1530
1531      ! get domain first poistion
1532      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_first" )
1533      il_impp(:) = 0
1534      IF( il_ind /= 0 )THEN
1535         il_impp(:) = INT(td_file%t_att(il_ind)%d_value(:))
1536      ENDIF
1537
1538      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_first" )
1539      il_jmpp(:) = 0
1540      IF( il_ind /= 0 )THEN
1541         il_jmpp(:) = INT(td_file%t_att(il_ind)%d_value(:))
1542      ENDIF
1543     
1544      ! check domain first poistion
1545      IF( ANY(il_impp(:)==0) .OR. ANY(il_jmpp(:)==0) )THEN
1546         CALL logger_warn("WRITE FILE: no data for domain first position")
1547      ENDIF
1548
1549      ! get domain last poistion
1550      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_position_last" )
1551      il_lci(:) = 0
1552      IF( il_ind /= 0 )THEN
1553         il_lci(:) = INT(td_file%t_att(il_ind)%d_value(:))
1554      ENDIF
1555
1556      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_position_last" )
1557      il_lcj(:) = 0
1558      IF( il_ind /= 0 )THEN
1559         il_lcj(:) = INT(td_file%t_att(il_ind)%d_value(:))
1560      ENDIF
1561
1562      ! check domain last poistion
1563      IF( ANY(il_lci(:)==0) .OR. ANY(il_lcj(:)==0) )THEN
1564         CALL logger_warn("WRITE FILE: no data for domain last position")
1565      ENDIF
1566
1567      ! get halo size start
1568      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_start" )
1569      il_ldi(:) = 0
1570      IF( il_ind /= 0 )THEN
1571         il_ldi(:) = INT(td_file%t_att(il_ind)%d_value(:))
1572      ENDIF
1573
1574      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_start" )
1575      il_ldj(:) = 0
1576      IF( il_ind /= 0 )THEN
1577         il_ldj(:) = INT(td_file%t_att(il_ind)%d_value(:))
1578      ENDIF
1579     
1580      ! check halo size start
1581      IF( ANY(il_ldi(:)==0) .OR. ANY(il_ldj(:)==0) )THEN
1582         CALL logger_warn("WRITE FILE: no data for halo size start")
1583      ENDIF
1584
1585      ! get halo size end
1586      il_ind=att_get_index( td_file%t_att, "DOMAIN_I_halo_size_end" )
1587      il_lei(:) = 0
1588      IF( il_ind /= 0 )THEN
1589         il_lei(:) = INT(td_file%t_att(il_ind)%d_value(:))
1590      ENDIF
1591
1592      il_ind=att_get_index( td_file%t_att, "DOMAIN_J_halo_size_end" )
1593      il_lej(:) = 0
1594      IF( il_ind /= 0 )THEN
1595         il_lej(:) = INT(td_file%t_att(il_ind)%d_value(:))
1596      ENDIF
1597
1598      ! check halo size end
1599      IF( ANY(il_lei(:)==0) .OR. ANY(il_lej(:)==0) )THEN
1600         CALL logger_warn("WRITE FILE: no data for halo size end")
1601      ENDIF     
1602
1603      ! write file header
1604      WRITE(td_file%i_id, IOSTAT=il_status, REC=1 )&
1605      &  td_file%i_recl, &
1606      &  td_file%t_dim(1)%i_len, &
1607      &  td_file%t_dim(2)%i_len, &
1608      &  td_file%t_dim(3)%i_len, &
1609      &  td_file%i_n0d, &
1610      &  td_file%i_n1d, &
1611      &  td_file%i_n2d, &
1612      &  td_file%i_n3d, &
1613      &  td_file%i_rhd, &
1614      &  il_niproc, il_njproc, il_nproc, &
1615      &  il_area,                &
1616      &  il_iglo, il_jglo,       &
1617      &  il_lci(:), il_lcj(:),   &
1618      &  il_ldi(:), il_ldj(:),   &
1619      &  il_lei(:), il_lej(:),   &
1620      &  il_impp(:), il_jmpp(:)
1621
1622      DEALLOCATE( il_impp, il_jmpp,&
1623      &           il_lci,  il_lcj, &
1624      &           il_ldi,  il_ldj, &
1625      &           il_lei,  il_lej  )
1626
1627      END SUBROUTINE iom_rstdimg__write_header
1628   !-------------------------------------------------------------------
1629   !> @brief This subroutine write variables in an opened dimg file.
1630   !>
1631   !> @author J.Paul
1632   !> - November, 2013- Initial Version
1633   !>
1634   !> @param[in] id_fileid file id
1635   !-------------------------------------------------------------------
1636   SUBROUTINE iom_rstdimg__write_var(td_file)
1637      IMPLICIT NONE
1638      ! Argument     
1639      TYPE(TFILE), INTENT(INOUT) :: td_file
1640
1641      ! local variable
1642      INTEGER(i4) :: il_status
1643      INTEGER(i4) :: il_rec
1644
1645      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_start
1646      INTEGER(i4),            DIMENSION(:), ALLOCATABLE :: il_count
1647      CHARACTER(LEN=im_vnl),  DIMENSION(:), ALLOCATABLE :: cl_name
1648      REAL(dp),               DIMENSION(:), ALLOCATABLE :: dl_value
1649
1650      ! loop indices
1651      INTEGER(i4) :: ji
1652      INTEGER(i4) :: jk
1653      !----------------------------------------------------------------
1654
1655      ! reform name and record
1656      ALLOCATE( cl_name(td_file%i_nvar), dl_value(td_file%i_nvar) )
1657
1658      DO ji=1,td_file%i_nvar
1659
1660         ! change FillValue to 0.
1661         CALL var_chg_FillValue(td_file%t_var(ji),0._dp)
1662
1663         cl_name(ji)  = TRIM(td_file%t_var(ji)%c_name)
1664         dl_value(ji) = REAL(td_file%t_var(ji)%i_rec,dp)
1665         
1666         SELECT CASE (TRIM(td_file%t_var(ji)%c_name))
1667            CASE('no0d','no1d','no2d','no3d')
1668            CASE DEFAULT
1669               DO jk=1,td_file%t_var(ji)%t_dim(3)%i_len
1670                  SELECT CASE (td_file%t_var(ji)%i_ndim)
1671                     CASE(0)
1672                        ! special case for 0d, value save in rec
1673                        dl_value(ji)=td_file%t_var(ji)%d_value(1,1,1,1)
1674                        il_rec = td_file%t_var(ji)%i_rec
1675                     CASE(1,2)
1676                        il_rec = td_file%t_var(ji)%i_rec
1677                     CASE(3)
1678                        il_rec = td_file%t_var(ji)%i_rec + jk -1
1679                  END SELECT
1680                  WRITE( td_file%i_id, IOSTAT=il_status, REC=il_rec ) &
1681                  &  td_file%t_var(ji)%d_value(:,:,jk,1)
1682                  CALL fct_err(il_status)
1683                  IF( il_status /= 0 )THEN
1684                     CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
1685                     &  "write variable "//TRIM(td_file%t_var(ji)%c_name)//&
1686                     &  " in record "//TRIM(fct_str(il_rec)))
1687                  ENDIF
1688               ENDDO
1689            END SELECT
1690
1691      ENDDO
1692
1693      ALLOCATE( il_start(4), il_count(4) )
1694
1695      il_start(1) = 1
1696      il_count(1) = td_file%i_n0d
1697     
1698      il_start(2) = 1 + il_count(1)
1699      il_count(2) = il_start(2) - 1 + td_file%i_n1d
1700     
1701      il_start(3) = 1 + il_count(2)
1702      il_count(3) = il_start(3) - 1 + td_file%i_n2d
1703     
1704      il_start(4) = 1 + il_count(3)
1705      il_count(4) = il_start(4) - 1 + td_file%i_n3d
1706
1707      WRITE(td_file%i_id, IOSTAT=il_status, REC=td_file%i_rhd )&
1708      &  cl_name(il_start(1):il_count(1)), dl_value(il_start(1):il_count(1)),&
1709      &  cl_name(il_start(2):il_count(2)), dl_value(il_start(2):il_count(2)),&
1710      &  cl_name(il_start(3):il_count(3)), dl_value(il_start(3):il_count(3)),&
1711      &  cl_name(il_start(4):il_count(4)), dl_value(il_start(4):il_count(4))
1712      CALL fct_err(il_status)
1713      IF( il_status /= 0 )THEN
1714         CALL logger_error("IOM RSTDIMG WRITE VAR: can not "//&
1715         &  "write restart header in record "//TRIM(fct_str(td_file%i_rhd)))
1716      ENDIF
1717
1718      ! clean
1719      DEALLOCATE( cl_name, dl_value )
1720      DEALLOCATE( il_start, il_count )
1721
1722   END SUBROUTINE iom_rstdimg__write_var
1723END MODULE iom_rstdimg
Note: See TracBrowser for help on using the repository browser.