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.
file.f90 in branches/2013/dev_rev4119_MERCATOR4_CONFMAN/NEMOGCM/TOOLS/SIREN/src – NEMO

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

Last change on this file since 4213 was 4213, checked in by cbricaud, 10 years ago

first draft of the CONFIGURATION MANAGER demonstrator

File size: 68.2 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: file
6!
7!> @brief
8!> This module manage file structure.
9!
10!> @details
11!>
12!>    define type TFILE:<br/>
13!>    TYPE(TFILE) :: tl_file<br/>
14!>
15!>    to initialise a file structure:<br/>
16!>    tl_file=file_init(cd_file [,cd_type] [,ld_wrt])
17!>       - cd_file is the file name
18!>       - cd_type is the type of the file ('cdf', 'dimg') (optional)
19!>       - ld_wrt  file in write mode or not (optional)
20!>
21!>    to get file name:<br/>
22!>    - tl_file\%c_name
23!>
24!>    to get file id (units):<br/>
25!>    - tl_file\%i_id
26!>   
27!>    to get the type of the file (cdf, cdf4, dimg):<br/>
28!>    - tl_file\%c_type
29!>
30!>    to know if file was open in write mode:<br/>
31!>    - tl_file\%l_wrt
32!>
33!>    to get the record length of the file:<br/>
34!>    - tl_file\%i_recl
35!>
36!>    Files variables<br/>
37!>    to get the number of variable in the file:<br/>
38!>    - tl_file\%i_nvar
39!>
40!>    to get the table of variable structure associated to the file:<br/>
41!>    - tl_file\%t_var(:)
42!>
43!>    Files attributes<br/>
44!>    to get the nmber of global attributes of the file:<br/>
45!>    - tl_file\%i_natt
46!>
47!>    to get the table of attributes structure associated to the file:<br/>
48!>    - tl_file\%t_att(:)
49!>
50!>    Files dimensions<br/>
51!>    to get the number of dimension used in the file:<br/>
52!>    - tl_file\%i_ndim
53!>
54!>    to get the table of dimension structure (4 elts) associated to the
55!>    file:<br/>
56!>    - tl_file\%t_dim(:)
57!>
58!>    to print information about file structure:<br/>
59!>    CALL file_print(td_file)
60!>
61!>    to add a global attribute structure in file structure:<br/>
62!>    CALL file_add_att(td_file, td_att)
63!>       - td_att is an attribute structure
64!>
65!>    to add a dimension structure in file structure:<br/>
66!>    CALL file_add_dim(td_file, td_dim)
67!>       - td_dim is a dimension structure
68!>
69!>    to add a variable structure in file structure:<br/>
70!>    CALL file_add_var(td_file, td_var)
71!>       - td_var is a variable structure
72!>
73!>    to delete a global attribute structure in file structure:<br/>
74!>    CALL file_del_att(td_file, td_att)
75!>       - td_att is an attribute structure
76!>
77!>    to delete a dimension structure in file structure:<br/>
78!>    CALL file_del_dim(td_file, td_dim)
79!>       - td_dim is a dimension structure
80!>
81!>    to delete a variable structure in file structure:<br/>
82!>    CALL file_del_var(td_file, td_var)
83!>       - td_var is a variable structure
84!>
85!>    to overwrite one attribute structure in file structure:<br/>
86!>    CALL file_move_att(td_file, td_att)
87!>       - td_att is an attribute structure
88!>
89!>    to  overwrite one dimension strucutre in file structure:<br/>
90!>    CALL file_move_dim(td_file, td_dim)
91!>       - td_dim is a dimension structure
92!>
93!>    to overwrite one variable  structure in file structure:<br/>
94!>    CALL file_move_var(td_file, td_var)
95!>       - td_var is a variable structure
96!>
97!>    to check if file and variable structure share same dimension:<br/>
98!>    ll_check_dim = file_check_var_dim(td_file, td_var)
99!>       - td_var is a variable structure
100!>
101!> @author
102!> J.Paul
103! REVISION HISTORY:
104!> @date Nov, 2013- Initial Version
105!>
106!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
107!> @todo
108!> - file_get_var(td_file, varname)
109!> - add description generique de l'objet file
110!----------------------------------------------------------------------
111MODULE file
112   USE kind                            ! F90 kind parameter
113   USE global                          ! global variable
114   USE fct                             ! basic useful function
115   USE logger                             ! log file manager
116   USE dim                             ! dimension manager
117   USE att                             ! attribute manager
118   USE var                             ! variable manager
119   IMPLICIT NONE
120   PRIVATE
121   ! NOTE_avoid_public_variables_if_possible
122
123   ! type and variable
124   PUBLIC :: TFILE   ! file structure
125
126   ! function and subroutine
127   PUBLIC :: ASSIGNMENT(=)   !< copy file structure
128   PUBLIC :: file_print      !< print information about file structure
129   PUBLIC :: file_clean      !< clean file structure
130   PUBLIC :: file_init       !< initialise file structure
131   PUBLIC :: file_add_att    !< add one attribute structure in file structure
132   PUBLIC :: file_add_var    !< add one variable  structure in file structure
133   PUBLIC :: file_add_dim    !< add one dimension strucutre in file structure
134   PUBLIC :: file_del_att    !< delete one attribute structure of file structure
135   PUBLIC :: file_del_var    !< delete one variable  structure of file structure
136   PUBLIC :: file_del_dim    !< delete one dimension strucutre of file structure
137   PUBLIC :: file_move_att   !< overwrite one attribute structure in file structure
138   PUBLIC :: file_move_var   !< overwrite one variable  structure in file structure
139   PUBLIC :: file_move_dim   !< overwrite one dimension strucutre in file structure
140   PUBLIC :: file_check_var_dim  !< check if file and variable structure use same dimension.
141   PUBLIC :: file_get_type   !< get type of file
142   PUBLIC :: file_get_id     !< get file id
143   PUBLIC :: file_rename     !< rename file name
144   PUBLIC :: file_add_suffix !< add suffix to file name
145 
146   PRIVATE :: file__del_var_name !< delete a variable structure in file structure, given variable name or standard name
147   PRIVATE :: file__del_var_str  !< delete a variable structure in file structure, given variable structure
148   PRIVATE :: file__del_att_name !< delete a attribute structure in file structure, given attribute name
149   PRIVATE :: file__del_att_str  !< delete a attribute structure in file structure, given attribute structure
150   PRIVATE :: file__get_number   !< get number in file name without suffix
151   PRIVATE :: file__get_suffix   !< get suffix of file name
152   PRIVATE :: file__copy_unit    !< copy file structure
153   PRIVATE :: file__copy_tab     !< copy file structure
154
155   !> @struct
156   TYPE TFILE
157
158      ! general
159      CHARACTER(LEN=lc)                 :: c_name = "" !< file name
160      CHARACTER(LEN=lc)                 :: c_type = "" !< type of the file (cdf, cdf4, dimg)
161      INTEGER(i4)                       :: i_id   = 0         !< file id
162      LOGICAL                           :: l_wrt  = .FALSE.   !< read or write mode
163      INTEGER(i4)                       :: i_nvar = 0         !< number of variable
164      TYPE(TVAR), DIMENSION(:), POINTER :: t_var  => NULL()   !< file variables
165
166      CHARACTER(LEN=lc)                 :: c_grid = 'ARAKAWA-C' !< grid type
167
168      INTEGER(i4)                       :: i_ew    =-1   !< east-west overlap
169      INTEGER(i4)                       :: i_perio =-1   !< NEMO periodicity index
170      INTEGER(i4)                       :: i_pivot =-1   !< NEMO pivot point index F(0),T(1)
171
172      INTEGER(i4)                       :: i_depthid = 0         !< variable id of depth
173      INTEGER(i4)                       :: i_timeid  = 0         !< variable id of time
174
175      ! netcdf file
176      INTEGER(i4)                       :: i_ndim  = 0        !< number of dimensions used in the file
177      INTEGER(i4)                       :: i_natt  = 0        !< number of global attributes in the file
178      INTEGER(i4)                       :: i_uldid = 0        !< id of the unlimited dimension in the file
179      LOGICAL                           :: l_def   = .FALSE.  !< define mode or not
180      TYPE(TATT), DIMENSION(:), POINTER :: t_att   => NULL()  !< global attributes
181      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim              !< dimension structure
182     
183      ! dimg file
184      INTEGER(i4)                       :: i_recl = 0         !< record length (binary file)
185      INTEGER(i4)                       :: i_n0d  = 0         !< number of scalar variable
186      INTEGER(i4)                       :: i_n1d  = 0         !< number of 1D variable
187      INTEGER(i4)                       :: i_n2d  = 0         !< number of 2D variable
188      INTEGER(i4)                       :: i_n3d  = 0         !< number of 3D variable
189      INTEGER(i4)                       :: i_rhd  = 0         !< record of the header infos (last record)
190
191      ! mpp
192      ! only use for massively parallel processing
193      INTEGER(i4)                       :: i_pid  = -1        !< processor id (start to 1)
194      INTEGER(i4)                       :: i_impp = 0         !< i-indexes for mpp-subdomain left bottom
195      INTEGER(i4)                       :: i_jmpp = 0         !< j-indexes for mpp-subdomain left bottom
196      INTEGER(i4)                       :: i_lci  = 0         !< i-dimensions of subdomain
197      INTEGER(i4)                       :: i_lcj  = 0         !< j-dimensions of subdomain
198      INTEGER(i4)                       :: i_ldi  = 0         !< first indoor i-indices
199      INTEGER(i4)                       :: i_ldj  = 0         !< first indoor j-indices
200      INTEGER(i4)                       :: i_lei  = 0         !< last  indoor i-indices
201      INTEGER(i4)                       :: i_lej  = 0         !< last  indoor j-indices
202
203      LOGICAL                           :: l_ctr  = .FALSE.   !< domain is on border
204      LOGICAL                           :: l_use  = .FALSE.   !< domain is used
205
206      ! only use to draw domain decomposition when initialise with mpp_init
207      INTEGER(i4)                       :: i_iind = 0         !< i-direction indices
208      INTEGER(i4)                       :: i_jind = 0         !< j-direction indices
209
210   END TYPE TFILE
211
212   INTERFACE file_del_var
213      MODULE PROCEDURE file__del_var_name
214      MODULE PROCEDURE file__del_var_str
215   END INTERFACE file_del_var
216
217   INTERFACE file_del_att
218      MODULE PROCEDURE file__del_att_name
219      MODULE PROCEDURE file__del_att_str
220   END INTERFACE file_del_att
221   
222   INTERFACE file_rename
223      MODULE PROCEDURE file__rename_char
224      MODULE PROCEDURE file__rename_str
225   END INTERFACE file_rename
226
227    INTERFACE ASSIGNMENT(=)
228      MODULE PROCEDURE file__copy_unit   ! copy file structure
229      MODULE PROCEDURE file__copy_tab    ! copy file structure
230   END INTERFACE
231
232CONTAINS
233   !-------------------------------------------------------------------
234   !> @brief
235   !> This function copy file structure in another file
236   !> structure
237   !> @details
238   !> file variable and attribute value are copied in a temporary table,
239   !> so input and output file structure value do not point on the same
240   !> "memory cell", and so on are independant.
241   !>
242   !> @note new file is assume to be closed.
243   !>
244   !> @warning to avoid infinite loop, do not use any function inside
245   !> this subroutine
246   !>   
247   !> @author J.Paul
248   !> - Nov, 2013- Initial Version
249   !
250   !> @param[out] td_file1  : file structure
251   !> @param[in] td_file2  : file structure
252   !-------------------------------------------------------------------
253   !> @code
254   SUBROUTINE file__copy_unit( td_file1, td_file2 )
255      IMPLICIT NONE
256      ! Argument
257      TYPE(TFILE), INTENT(  OUT) :: td_file1
258      TYPE(TFILE), INTENT(IN   )  :: td_file2
259
260      ! loop indices
261      INTEGER(i4) :: ji
262      !----------------------------------------------------------------
263
264      CALL logger_trace("COPY: file "//TRIM(td_file2%c_name) )
265
266      ! copy file variable
267      td_file1%c_name = TRIM(td_file2%c_name)
268      td_file1%c_type = TRIM(td_file2%c_type)
269      ! file1 should be closed even if file2 is opened right now
270      td_file1%i_id   = 0
271      td_file1%l_wrt  = td_file2%l_wrt
272      td_file1%i_nvar = td_file2%i_nvar
273
274      td_file1%c_grid = td_file2%c_grid
275
276      td_file1%i_ew   = td_file2%i_ew
277      td_file1%i_perio= td_file2%i_perio
278      td_file1%i_pivot= td_file2%i_pivot
279
280      ! copy variable structure
281      IF( ASSOCIATED(td_file1%t_var) ) DEALLOCATE(td_file1%t_var)
282      IF( ASSOCIATED(td_file2%t_var) .AND. td_file1%i_nvar > 0 )THEN
283         ALLOCATE( td_file1%t_var(td_file1%i_nvar) )
284         DO ji=1,td_file1%i_nvar
285            td_file1%t_var(ji) = td_file2%t_var(ji)
286         ENDDO
287      ENDIF
288     
289      ! copy netcdf variable
290      td_file1%i_ndim    = td_file2%i_ndim
291      td_file1%i_natt    = td_file2%i_natt
292      td_file1%i_uldid   = td_file2%i_uldid
293      td_file1%l_def     = td_file2%l_def
294
295      ! copy dimension
296      td_file1%t_dim(:) = td_file2%t_dim(:)
297     
298      ! copy attribute structure
299      IF( ASSOCIATED(td_file1%t_att) ) DEALLOCATE(td_file1%t_att)
300      IF( ASSOCIATED(td_file2%t_att) .AND. td_file1%i_natt > 0 )THEN
301         ALLOCATE( td_file1%t_att(td_file1%i_natt) )
302         DO ji=1,td_file1%i_natt
303            td_file1%t_att(ji) = td_file2%t_att(ji)
304         ENDDO
305      ENDIF
306
307      ! copy dimg variable
308      td_file1%i_recl = td_file2%i_recl
309      td_file1%i_n0d  = td_file2%i_n0d
310      td_file1%i_n1d  = td_file2%i_n1d
311      td_file1%i_n2d  = td_file2%i_n2d
312      td_file1%i_n3d  = td_file2%i_n3d 
313      td_file1%i_rhd  = td_file2%i_rhd
314     
315      ! copy mpp variable
316      td_file1%i_pid  = td_file2%i_pid
317      td_file1%i_impp = td_file2%i_impp
318      td_file1%i_jmpp = td_file2%i_jmpp
319      td_file1%i_lci  = td_file2%i_lci
320      td_file1%i_lcj  = td_file2%i_lcj
321      td_file1%i_ldi  = td_file2%i_ldi
322      td_file1%i_ldj  = td_file2%i_ldj
323      td_file1%i_lei  = td_file2%i_lei
324      td_file1%i_lej  = td_file2%i_lej
325      td_file1%l_ctr  = td_file2%l_ctr
326      td_file1%l_use  = td_file2%l_use
327      td_file1%i_iind = td_file2%i_iind
328      td_file1%i_jind = td_file2%i_jind
329
330   END SUBROUTINE file__copy_unit
331   !> @endcode
332   !-------------------------------------------------------------------
333   !> @brief
334   !> This function copy file structure in another file
335   !> structure
336   !> @details
337   !> file variable and attribute value are copied in a temporary table,
338   !> so input and output file structure value do not point on the same
339   !> "memory cell", and so on are independant.
340   !>
341   !> @note new file is assume to be closed.
342   !>
343   !> @warning to avoid infinite loop, do not use any function inside
344   !> this subroutine
345   !>   
346   !> @author J.Paul
347   !> - Nov, 2013- Initial Version
348   !
349   !> @param[out] td_file1  : file structure
350   !> @param[in] td_file2  : file structure
351   !-------------------------------------------------------------------
352   !> @code
353   SUBROUTINE file__copy_tab( td_file1, td_file2 )
354      IMPLICIT NONE
355      ! Argument
356      TYPE(TFILE), DIMENSION(:)                , INTENT(IN   )  :: td_file2
357      TYPE(TFILE), DIMENSION(SIZE(td_file2(:))), INTENT(  OUT) :: td_file1
358
359      ! loop indices
360      INTEGER(i4) :: ji
361      !----------------------------------------------------------------
362
363      DO ji=1,SIZE(td_file2(:))
364         td_file1(ji)=td_file2(ji)
365      ENDDO
366
367   END SUBROUTINE file__copy_tab
368   !> @endcode
369   !-------------------------------------------------------------------
370   !> @brief This function initialise file structure.<br/>
371   !> If cd_type is not specify, check if file name include '.nc' or
372   !> .'dimg'<br/>
373   !
374   !> @details
375   !
376   !> @author J.Paul
377   !> - Nov, 2013- Initial Version
378   !
379   !> @param[in] cd_file : file name
380   !> @param[in] cd_type : file type ('cdf', 'dimg')
381   !> @param[in] ld_wrt  : write mode (default .FALSE.)
382   !> @return file structure
383   !-------------------------------------------------------------------
384   !> @code
385   TYPE(TFILE) FUNCTION file_init( cd_file, cd_type, ld_wrt, &
386   &                               id_ew, id_perio, id_pivot,&
387   &                               cd_grid)
388      IMPLICIT NONE
389      ! Argument     
390      CHARACTER(LEN=*), INTENT(IN) :: cd_file
391      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_type
392      LOGICAL         , INTENT(IN), OPTIONAL :: ld_wrt
393      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_ew
394      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_perio
395      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_pivot
396      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_grid
397
398      ! local variable
399      TYPE(TATT) :: tl_att
400      !----------------------------------------------------------------
401
402      ! clean file
403      CALL file_clean(file_init)
404
405      file_init%c_name=TRIM(ADJUSTL(cd_file))
406      CALL logger_trace("INIT: initialise file "//TRIM(file_init%c_name))
407
408      ! create some global attribute
409      tl_att=att_init("Conventions","CF-1.5")
410      CALL file_add_att(file_init,tl_att)
411     
412      tl_att=att_init("Grid",TRIM(file_init%c_grid))
413      CALL file_add_att(file_init,tl_att)
414
415      ! check type
416      IF( PRESENT(cd_type) )THEN
417         SELECT CASE(TRIM(cd_type))
418            CASE('cdf')
419               file_init%c_type='cdf'
420            CASE('dimg')
421               file_init%c_type='dimg'
422            CASE DEFAULT
423               CALL logger_error( " INIT: can't initialise file "//&
424               &               TRIM(file_init%c_name)//" : type unknown " )
425         END SELECT
426      ELSE
427         file_init%c_type=TRIM(file_get_type(cd_file))
428      ENDIF
429
430      IF( PRESENT(ld_wrt) )THEN
431         file_init%l_wrt=ld_wrt
432      ENDIF
433
434      IF( PRESENT(id_ew) )THEN
435         file_init%i_ew=id_ew
436         IF( id_ew >= 0 )THEN
437            tl_att=att_init('ew_overlap',id_ew)
438            CALL file_move_att(file_init, tl_att)
439         ENDIF
440      ENDIF
441
442      IF( PRESENT(id_perio) )THEN
443         file_init%i_perio=id_perio
444         IF( id_perio >= 0 )THEN
445            tl_att=att_init('periodicity',id_perio)
446            CALL file_move_att(file_init, tl_att)
447         ENDIF
448      ENDIF
449
450      IF( PRESENT(id_pivot) )THEN
451         file_init%i_pivot=id_pivot
452         IF( id_pivot > 0 )THEN
453            tl_att=att_init('pivot_point',id_pivot)
454            CALL file_move_att(file_init, tl_att)
455         ENDIF
456      ENDIF
457
458      IF( PRESENT(cd_grid) )THEN
459         file_init%c_grid=cd_grid
460      ENDIF
461
462   END FUNCTION file_init
463   !> @endcode
464   !-------------------------------------------------------------------
465   !> @brief
466   !> This function get type of file, given file name.
467   !> @details
468   !> Actually it get suffix of the file name, and compare it to 'nc', 'cdf' or
469   !> 'dimg'<br/>
470   !> If no suffix or suffix not identify, we assume file is dimg
471   !
472   !> @details
473   !
474   !> @author J.Paul
475   !> - Nov, 2013- Initial Version
476   !
477   !> @param[in] cd_file : file name
478   !> @return type of file
479   !-------------------------------------------------------------------
480   !> @code
481   CHARACTER(LEN=lc) FUNCTION file_get_type(cd_file)
482      IMPLICIT NONE
483      ! Argument     
484      CHARACTER(LEN=*), INTENT(IN) :: cd_file
485      !local variable
486      CHARACTER(LEN=lc) :: cl_suffix
487      !----------------------------------------------------------------
488
489      cl_suffix=file__get_suffix(cd_file)
490      SELECT CASE( TRIM(fct_lower(cl_suffix)) )
491         CASE('.nc','.cdf')
492            CALL logger_debug(" GET TYPE: file "//TRIM(cd_file)//" is cdf")
493            file_get_type='cdf'
494         CASE('.dimg')
495            CALL logger_debug(" GET TYPE: file "//TRIM(cd_file)//" is dimg" )
496            file_get_type='dimg'
497         CASE DEFAULT
498            CALL logger_warn(" GET TYPE: type unknown, we assume file: "//&
499            &              TRIM(cd_file)//" is dimg ")
500            file_get_type='dimg'
501      END SELECT
502
503   END FUNCTION file_get_type
504   !> @endcode
505   !-------------------------------------------------------------------
506   !> @brief This function check if variable dimension to be used
507   !> have the same length that in file structure.
508   !
509   !> @details
510   !
511   !> @author J.Paul
512   !> - Nov, 2013- Initial Version
513   !
514   !> @param[in] td_file : file structure
515   !> @param[in] td_var : variable structure
516   !> @return dimension of variable and file structure agree (or not)
517   !-------------------------------------------------------------------
518   !> @code
519   LOGICAL FUNCTION file_check_var_dim(td_file, td_var)
520      IMPLICIT NONE
521      ! Argument     
522      TYPE(TFILE), INTENT(IN) :: td_file
523      TYPE(TVAR),  INTENT(IN) :: td_var
524
525      ! local variable
526      INTEGER(i4) :: il_ndim
527
528      ! loop indices
529      INTEGER(i4) :: ji
530      !----------------------------------------------------------------
531      file_check_var_dim=.TRUE.
532      ! check used dimension
533      IF( ANY( td_var%t_dim(:)%l_use .AND. &
534      &        td_var%t_dim(:)%i_len /= td_file%t_dim(:)%i_len) )THEN
535
536         file_check_var_dim=.FALSE.
537
538         CALL logger_error( &
539         &  " FILE CHECK VAR DIM: variable and file dimension differ"//&
540         &  " for variable "//TRIM(td_var%c_name)//&
541         &  " and file "//TRIM(td_file%c_name))
542
543
544         CALL logger_debug( &
545         &  " file dimension: "//TRIM(fct_str(td_file%i_ndim))//&
546         &  " variable dimension: "//TRIM(fct_str(td_var%i_ndim)) )
547         il_ndim=MIN(td_var%i_ndim, td_file%i_ndim )
548         DO ji = 1, il_ndim
549            CALL logger_debug( &
550            &  " FILE CHECK VAR DIM: for dimension "//&
551            &  TRIM(td_file%t_dim(ji)%c_name)//&
552            &  ", file length: "//&
553            &  TRIM(fct_str(td_file%t_dim(ji)%i_len))//&
554            &  ", variable length: "//&
555            &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//&
556            &  ", variable used "//TRIM(fct_str(td_var%t_dim(ji)%l_use)))
557         ENDDO
558      ELSE
559         IF( ANY( td_var%t_dim(:)%l_use .AND. &
560         &  .NOT. td_file%t_dim(:)%l_use ) )THEN
561           
562            CALL logger_info("FILE CHECK VAR DIM: variable use more dimension "//&
563            &  " than file do until now. file dimension use will change.")
564
565         ENDIF
566      ENDIF
567
568   END FUNCTION file_check_var_dim
569   !> @endcode   
570   !-------------------------------------------------------------------
571   !> @brief This subroutine add a variable structure in a file structure.<br/>
572   !> Do not overwrite, if variable already in file structure.
573   !
574   !> @note variable value is suppose to be ordered ('x','y','z','t')
575   !
576   !> @details
577   !
578   !> @author J.Paul
579   !> - Nov, 2013- Initial Version
580   !
581   !> @param[inout] td_file : file structure
582   !> @param[in] td_var : variable structure
583   !
584   !> @todo
585   !> - check dimension order
586   !> - voir pour ajouter variable avec plus de dim que deja presente dans fichier
587   !-------------------------------------------------------------------
588   !> @code
589   SUBROUTINE file_add_var(td_file, td_var)
590      IMPLICIT NONE
591
592      ! Argument     
593      TYPE(TFILE), INTENT(INOUT) :: td_file
594      TYPE(TVAR) , INTENT(IN   ) :: td_var
595
596      ! local variable
597      INTEGER(i4) :: il_status
598      INTEGER(i4) :: il_varid
599      INTEGER(i4) :: il_rec
600      INTEGER(i4) :: il_ind
601
602      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
603
604      ! loop indices
605      INTEGER(i4) :: ji
606      !----------------------------------------------------------------
607      ! check if file opened
608      !IF( TRIM(td_file%c_name) == "unknown" )THEN
609      IF( TRIM(td_file%c_name) == '' )THEN
610
611         CALL logger_error( " ADD VAR: structure file unknown" )
612         CALL logger_debug( " ADD VAR: you should have used file_init before "//&
613         & "running file_add_var" )
614
615      ELSE
616         ! check if variable exist
617         IF( TRIM(td_var%c_name) == '' .AND. &
618         &   TRIM(td_var%c_stdname) == '' )THEN
619            CALL logger_error(" ADD VAR: variable not define ")
620         ELSE
621            ! check if variable already in file structure
622            il_varid=0
623            IF( ASSOCIATED(td_file%t_var) )THEN
624               il_varid=var_get_id( td_file%t_var(:), td_var%c_name,   &
625               &                                      td_var%c_stdname )
626            ENDIF
627
628            IF( il_varid /= 0 )THEN
629
630               CALL logger_error( &
631               &  " ADD VAR: variable "//TRIM(td_var%c_name)//&
632               &  ", standard name "//TRIM(td_var%c_stdname)//&
633               &  ", already in file "//TRIM(td_file%c_name) )
634
635               DO ji=1,td_file%i_nvar
636                  CALL logger_debug( " ADD VAR: in file : &
637                  &  variable "//TRIM(td_file%t_var(ji)%c_name)//&
638                  &  ", standard name "//TRIM(td_file%t_var(ji)%c_stdname) )
639               ENDDO
640
641            ELSE
642
643               CALL logger_info( &
644               &  " ADD VAR: add variable "//TRIM(td_var%c_name)//&
645               &  ", standard name "//TRIM(td_var%c_stdname)//&
646               &  ", in file "//TRIM(td_file%c_name) )
647
648               ! if none, force to use variable dimension
649               IF( ALL( .NOT. td_file%t_dim(:)%l_use) )THEN
650                  td_file%t_dim(:)=td_var%t_dim(:)
651               ENDIF
652
653               ! check used dimension
654               IF( file_check_var_dim(td_file, td_var) )THEN
655
656                  SELECT CASE(td_var%i_ndim)
657                     CASE(0)
658                        il_ind=td_file%i_n0d+1
659                        il_rec=0
660                     CASE(1)
661                        il_ind=td_file%i_n0d+td_file%i_n1d+1
662                        il_rec=1
663                     CASE(2)
664                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+1
665                        il_rec=1
666                     CASE(3,4)
667                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+td_file%i_n3d+1
668                        il_rec=td_file%t_dim(3)%i_len
669                  END SELECT
670
671                  IF( td_file%i_nvar > 0 )THEN
672                  ! already other variable in file structure
673                     ALLOCATE( tl_var(td_file%i_nvar), stat=il_status )
674                     IF(il_status /= 0 )THEN
675
676                        CALL logger_error( &
677                        &  " ADD VAR: not enough space to put variables "//&
678                        &  "from "//TRIM(td_file%c_name)//&
679                        &  " in variable structure")
680
681                     ELSE
682
683                        ! save temporary variable of file structure
684                        tl_var(:)=td_file%t_var(:)
685
686                        DEALLOCATE( td_file%t_var )
687                        ALLOCATE( td_file%t_var(td_file%i_nvar+1), &
688                        &         stat=il_status)
689                        IF(il_status /= 0 )THEN
690
691                           CALL logger_error( &
692                           &  " ADD VAR: not enough space to put variable "//&
693                           &  "in file structure "//TRIM(td_file%c_name) )
694
695                        ENDIF
696
697                        ! copy variable in file before
698                        ! variable with less than or equal dimension that new variable
699                        td_file%t_var( 1:il_ind-1 ) = tl_var( 1:il_ind-1 )
700
701                        ! variable with greater dimension than new variable
702                        td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = &
703                        &                 tl_var( il_ind : td_file%i_nvar )
704
705                        ! update id
706                        td_file%t_var( il_ind+1 : td_file%i_nvar+1 )%i_id = &
707                        &           tl_var( il_ind : td_file%i_nvar )%i_id + 1
708
709                        ! update record index
710                        td_file%t_var( il_ind+1 : td_file%i_nvar+1 )%i_rec = &
711                        & tl_var( il_ind : td_file%i_nvar )%i_rec + il_rec
712
713                        DEALLOCATE(tl_var)
714                     ENDIF
715
716                  ELSE
717                  ! no variable in file structure
718                     IF( ASSOCIATED(td_file%t_var) )THEN
719                        DEALLOCATE(td_file%t_var)
720                     ENDIF
721                     ALLOCATE( td_file%t_var(td_file%i_nvar+1), stat=il_status )
722                     IF(il_status /= 0 )THEN
723
724                        CALL logger_error( &
725                        &  " ADD VAR: not enough space to put variable "//&
726                        &  "in file structure "//TRIM(td_file%c_name) )
727
728                     ENDIF
729
730                  ENDIF
731
732                  ALLOCATE( tl_var(1), stat=il_status )
733                  IF(il_status /= 0 )THEN
734
735                     CALL logger_error( &
736                     &  " ADD VAR: not enough space to put variables from "//&
737                     &  TRIM(td_var%c_name)//" in variable structure")
738
739                  ELSE
740                     tl_var(1)=td_var
741
742                     ! update dimension name in new variable
743                     tl_var(1)%t_dim(:)%c_name = td_file%t_dim(:)%c_name
744                 
745                     ! add new variable
746                     td_file%t_var(il_ind)=tl_var(1)
747
748                     ! update number of variable
749                     td_file%i_nvar=td_file%i_nvar+1
750                     SELECT CASE(tl_var(1)%i_ndim)
751                        CASE(0)
752                           td_file%i_n0d=td_file%i_n0d+1
753                        CASE(1)
754                           td_file%i_n1d=td_file%i_n1d+1
755                        CASE(2)
756                           td_file%i_n2d=td_file%i_n2d+1
757                        CASE(3)
758                           td_file%i_n3d=td_file%i_n3d+1
759                     END SELECT
760
761                     ! update variable id
762                     td_file%t_var(il_ind)%i_id=il_ind
763
764                     ! update record header index
765                     td_file%i_rhd=td_file%i_rhd+il_rec
766
767                     ! update record index
768                     IF( il_ind > 1 )THEN
769                        td_file%t_var(il_ind)%i_rec = &
770                        &     td_file%t_var(il_ind-1)%i_rec+il_rec
771                     ELSE
772                        td_file%t_var(il_ind)%i_rec = il_rec
773                     ENDIF
774
775                     ! update dimension used
776                     td_file%t_dim(:)%l_use=.FALSE.
777                     DO ji=1,ip_maxdim
778                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
779                           td_file%t_dim(ji)%l_use=.TRUE.
780                        ENDIF
781                     ENDDO
782                     CALL dim_reorder(td_file%t_dim(:))
783                     ! update number of dimension
784                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
785
786                     DEALLOCATE( tl_var )
787                  ENDIF
788
789               ENDIF
790            ENDIF
791         ENDIF
792      ENDIF
793
794   END SUBROUTINE file_add_var
795   !> @endcode
796   !-------------------------------------------------------------------
797   !> @brief This subroutine delete a variable structure
798   !> in file structure.
799   !
800   !> @details
801   !
802   !> @author J.Paul
803   !> - Nov, 2013- Initial Version
804   !
805   !> @param[inout] td_file : file structure
806   !> @param[in] cd_name : variable name or standard name
807   !-------------------------------------------------------------------
808   !> @code
809   SUBROUTINE file__del_var_name(td_file, cd_name )
810      IMPLICIT NONE
811
812      ! Argument     
813      TYPE(TFILE)     , INTENT(INOUT) :: td_file
814      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
815
816      ! local variable
817      INTEGER(i4)       :: il_varid
818      !----------------------------------------------------------------
819
820      ! check if file opened
821      IF( TRIM(td_file%c_name) == '' )THEN
822
823         CALL logger_error( " DEL VAR NAME: file structure unknown ")
824         CALL logger_debug( " DEL VAR NAME: you should have used file_init before "//&
825         & "running file_del_var" )
826
827      ELSE
828
829         IF( td_file%i_nvar /= 0 )THEN
830
831            ! get the variable id, in file variable structure
832            il_varid=0
833            IF( ASSOCIATED(td_file%t_var) )THEN
834               il_varid=var_get_id(td_file%t_var(:), cd_name )
835            ENDIF
836            IF( il_varid /= 0 )THEN
837   
838               CALL file_del_var(td_file, td_file%t_var(il_varid))
839
840            ELSE
841
842               CALL logger_warn( &
843               &  " DEL VAR NAME: there is no variable with name or "//&
844               &  "standard name "//TRIM(cd_name)//" in file "//&
845               &  TRIM(td_file%c_name))
846
847            ENDIF
848
849         ELSE
850            CALL logger_debug( " DEL VAR NAME: no variable associated to file "//&
851            &               TRIM(td_file%c_name) )
852         ENDIF
853
854      ENDIF
855
856   END SUBROUTINE file__del_var_name
857   !> @endcode
858   !-------------------------------------------------------------------
859   !> @brief This subroutine delete a variable structure
860   !> in file structure, given variable structure.
861   !
862   !> @details
863   !
864   !> @author J.Paul
865   !> - Nov, 2013- Initial Version
866   !
867   !> @param[inout] td_file : file structure
868   !> @param[in] td_var : variable structure
869   !> @todo
870   !> - verifier pose pas de souci de ne pas modifier id
871   !-------------------------------------------------------------------
872   !> @code
873   SUBROUTINE file__del_var_str(td_file, td_var)
874      IMPLICIT NONE
875
876      ! Argument     
877      TYPE(TFILE), INTENT(INOUT) :: td_file
878      TYPE(TVAR),  INTENT(IN)    :: td_var
879
880      ! local variable
881      INTEGER(i4) :: il_status
882      INTEGER(i4) :: il_varid
883      INTEGER(i4) :: il_rec
884      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var
885
886      ! loop indices
887      INTEGER(i4) :: ji
888      !----------------------------------------------------------------
889
890      ! check if file opened
891      !IF( TRIM(td_file%c_name) == "unknown" )THEN
892      IF( TRIM(td_file%c_name) == '' )THEN
893
894         CALL logger_error( " DEL VAR: file structure unknown ")
895         CALL logger_debug( " DEL VAR: you should have used file_init before "//&
896         & "running file_del_var" )     
897
898      ELSE
899
900         ! check if variable already in file structure
901         il_varid=var_get_id(td_file%t_var(:), td_var%c_name, td_var%c_stdname )
902         IF( il_varid == 0 )THEN
903
904            CALL logger_error( &
905            &  " DEL VAR: no variable "//TRIM(td_var%c_name)//&
906            &  ", in file "//TRIM(td_file%c_name) )
907
908            DO ji=1,td_file%i_nvar
909               CALL logger_debug( &
910               &  " DEL VAR: in file "//TRIM(td_file%t_var(ji)%c_name)//&
911               &  ", standard name "//TRIM(td_file%t_var(ji)%c_stdname) )
912            ENDDO
913
914         ELSE
915           
916            CALL logger_trace( &
917            &  " DEL VAR: delete variable "//TRIM(td_var%c_name)//&
918            &  ", from file "//TRIM(td_file%c_name) )
919
920            ALLOCATE( tl_var(td_file%i_nvar-1), stat=il_status )
921            IF(il_status /= 0 )THEN
922
923               CALL logger_error( &
924               &  " DEL VAR: not enough space to put variables from "//&
925               &  TRIM(td_file%c_name)//" in temporary variable structure")
926
927            ELSE
928
929               ! save temporary variable's file structure
930               tl_var(1:il_varid-1)=td_file%t_var(1:il_varid-1)
931               tl_var(il_varid:)=td_file%t_var(il_varid+1:)
932
933               ! new number of variable in file
934               td_file%i_nvar=td_file%i_nvar-1
935
936               SELECT CASE(td_var%i_ndim)
937                  CASE(0)
938                     td_file%i_n0d=td_file%i_n0d-1
939                     il_rec=0
940                  CASE(1)
941                     td_file%i_n1d=td_file%i_n1d-1
942                     il_rec=1
943                  CASE(2)
944                     td_file%i_n2d=td_file%i_n2d-1
945                     il_rec=1
946                  CASE(3,4)
947                     td_file%i_n3d=td_file%i_n3d-1
948                     il_rec=td_file%t_dim(3)%i_len
949               END SELECT
950
951               DEALLOCATE( td_file%t_var )
952
953               IF( td_file%i_nvar > 0 )THEN
954                  ALLOCATE( td_file%t_var(td_file%i_nvar), stat=il_status )
955                  IF(il_status /= 0 )THEN
956
957                     CALL logger_error( &
958                     &  " DEL VAR: not enough space to put variables "//&
959                     &  "in file structure "//TRIM(td_file%c_name) )
960
961                  ENDIF
962
963                  ! copy attribute in file before
964                  td_file%t_var(:)=tl_var(:)
965
966                  ! update record header index
967                  td_file%i_rhd = td_file%i_rhd - il_rec
968
969!                  ! update id
970!                  td_file%t_var( il_varid : td_file%i_nvar )%i_id = &
971!                  &     td_file%t_var( il_varid : td_file%i_nvar )%i_id - 1
972
973                  ! update record index
974                  td_file%t_var( il_varid : td_file%i_nvar )%i_rec = &
975                  &     td_file%t_var( il_varid : td_file%i_nvar )%i_rec - il_rec
976
977                  ! update dimension used
978                  td_file%t_dim(:)%l_use=.FALSE.
979                  DO ji=1,ip_maxdim
980                     IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN
981                        td_file%t_dim(ji)%l_use=.TRUE.
982                     ENDIF
983                  ENDDO
984                  CALL dim_reorder(td_file%t_dim(:))
985                  ! update number of dimension
986                  td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
987
988               ENDIF
989               DEALLOCATE(tl_var)
990               
991            ENDIF
992         ENDIF
993      ENDIF
994
995   END SUBROUTINE file__del_var_str
996   !> @endcode
997   !-------------------------------------------------------------------
998   !> @brief This subroutine overwrite variable structure
999   !> in file structure.
1000   !
1001   !> @details
1002   !
1003   !> @author J.Paul
1004   !> - Nov, 2013- Initial Version
1005   !
1006   !> @param[inout] td_file : file structure
1007   !> @param[in] td_var : variable structure
1008   !> @todo
1009   !> - check independance td_var (cf move dim variable)
1010   !-------------------------------------------------------------------
1011   !> @code
1012   SUBROUTINE file_move_var(td_file, td_var)
1013      IMPLICIT NONE
1014
1015      ! Argument     
1016      TYPE(TFILE), INTENT(INOUT) :: td_file
1017      TYPE(TVAR),  INTENT(IN)    :: td_var
1018
1019      ! local variable
1020      TYPE(TVAR) :: tl_var
1021      INTEGER(i4):: il_varid
1022      !----------------------------------------------------------------
1023
1024      ! copy variable
1025      tl_var=td_var
1026
1027      IF( ASSOCIATED(td_file%t_var) )THEN
1028         il_varid=var_get_id(td_file%t_var(:),TRIM(tl_var%c_name))
1029         IF( il_varid /= 0 )THEN
1030            ! remove variable with same name or standard name
1031            CALL file_del_var(td_file, tl_var)
1032         ENDIF
1033      ENDIF
1034
1035      ! add new variable
1036      CALL file_add_var(td_file, tl_var)
1037
1038   END SUBROUTINE file_move_var
1039   !> @endcode
1040   !-------------------------------------------------------------------
1041   !> @brief This subroutine add a global attribute
1042   !> in a file structure.<br/>
1043   !> Do not overwrite, if attribute already in file structure.
1044   !
1045   !> @details
1046   !
1047   !> @author J.Paul
1048   !> - Nov, 2013- Initial Version
1049   !
1050   !> @param[inout] td_file : file structure
1051   !> @param[in] td_att : attribute structure
1052   !-------------------------------------------------------------------
1053   !> @code
1054   SUBROUTINE file_add_att(td_file, td_att)
1055      IMPLICIT NONE
1056
1057      ! Argument     
1058      TYPE(TFILE), INTENT(INOUT) :: td_file
1059      TYPE(TATT),  INTENT(IN)    :: td_att
1060
1061      ! local variable
1062      INTEGER(i4) :: il_status
1063      INTEGER(i4) :: il_attid
1064      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
1065
1066      ! loop indices
1067      INTEGER(i4) :: ji
1068      !----------------------------------------------------------------
1069
1070      ! check if file opened
1071      !IF( TRIM(td_file%c_name) == "unknown" )THEN
1072      IF( TRIM(td_file%c_name) == '' )THEN
1073
1074         CALL logger_error( " ADD ATT: file structure unknown ")
1075         CALL logger_debug( " ADD ATT: you should have used file_init before "//&
1076         & "running file_add_att" )     
1077
1078      ELSE
1079
1080         ! check if attribute already in file structure
1081         il_attid=0
1082         IF( ASSOCIATED(td_file%t_att) )THEN
1083            il_attid=att_get_id( td_file%t_att(:), td_att%c_name )
1084         ENDIF
1085
1086         IF( il_attid /= 0 )THEN
1087         
1088            CALL logger_error( &
1089            &  " ADD ATT: attribute "//TRIM(td_att%c_name)//&
1090            &  ", already in file "//TRIM(td_file%c_name) )
1091            CALL logger_flush()
1092
1093            DO ji=1,td_file%i_natt
1094               CALL logger_debug( &
1095               &  " ADD ATT: in file "//TRIM(td_file%t_att(ji)%c_name) )
1096            ENDDO
1097
1098         ELSE
1099           
1100            CALL logger_debug( &
1101            &  " ADD ATT: add attribute "//TRIM(td_att%c_name)//&
1102            &  ", in file "//TRIM(td_file%c_name) )
1103
1104            IF( td_file%i_natt > 0 )THEN
1105            ! already other attribute in file structure
1106               ALLOCATE( tl_att(td_file%i_natt), stat=il_status )
1107               IF(il_status /= 0 )THEN
1108
1109                  CALL logger_error( &
1110                  &  " ADD ATT: not enough space to put attributes from "//&
1111                  &  TRIM(td_file%c_name)//" in temporary attribute structure")
1112
1113               ELSE
1114
1115                  ! save temporary global attribute's file structure
1116                  tl_att(:)=td_file%t_att(:)
1117
1118                  DEALLOCATE( td_file%t_att )
1119                  ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
1120                  IF(il_status /= 0 )THEN
1121
1122                     CALL logger_error( &
1123                     &  " ADD ATT: not enough space to put attributes "//&
1124                     &  "in file structure "//TRIM(td_file%c_name) )
1125
1126                  ENDIF
1127
1128                  ! copy attribute in file before
1129                  td_file%t_att(1:td_file%i_natt)=tl_att(:)
1130
1131                  DEALLOCATE(tl_att)
1132               ENDIF
1133            ELSE
1134            ! no attribute in file structure
1135               IF( ASSOCIATED(td_file%t_att) )THEN
1136                  DEALLOCATE(td_file%t_att)
1137               ENDIF
1138               CALL logger_debug(" natt "//TRIM(fct_str(td_file%i_natt)) )
1139               ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status )
1140               IF(il_status /= 0 )THEN
1141
1142                  CALL logger_error( &
1143                  &  " ADD ATT: not enough space to put attributes "//&
1144                  &  "in file structure "//TRIM(td_file%c_name) )
1145
1146               ENDIF
1147            ENDIF
1148            ! add new attributes
1149            td_file%t_att(td_file%i_natt+1)=td_att
1150
1151            ! update attributes id
1152            td_file%t_att(td_file%i_natt+1)%i_id=td_file%i_natt+1
1153
1154            ! update number of attribute
1155            td_file%i_natt=td_file%i_natt+1
1156         ENDIF
1157      ENDIF
1158
1159   END SUBROUTINE file_add_att
1160   !> @endcode
1161   !-------------------------------------------------------------------
1162   !> @brief This subroutine delete a variable structure
1163   !> in file structure.
1164   !
1165   !> @details
1166   !
1167   !> @author J.Paul
1168   !> - Nov, 2013- Initial Version
1169   !
1170   !> @param[inout] td_file : file structure
1171   !> @param[in] cd_name : variable name or standard name
1172   !-------------------------------------------------------------------
1173   !> @code
1174   SUBROUTINE file__del_att_name(td_file, cd_name )
1175      IMPLICIT NONE
1176
1177      ! Argument     
1178      TYPE(TFILE)     , INTENT(INOUT) :: td_file
1179      CHARACTER(LEN=*), INTENT(IN   ) :: cd_name
1180
1181      ! local variable
1182      INTEGER(i4)       :: il_attid
1183      !----------------------------------------------------------------
1184
1185      ! check if file opened
1186      IF( TRIM(td_file%c_name) == '' )THEN
1187
1188         CALL logger_error( " DEL ATT NAME: file structure unknown ")
1189         CALL logger_debug( " DEL ATT NAME: you should have used file_init before "//&
1190         & "running file_del_var" )
1191
1192      ELSE
1193
1194         IF( td_file%i_natt /= 0 )THEN
1195
1196            ! get the variable id, in file variable structure
1197            il_attid=0
1198            IF( ASSOCIATED(td_file%t_att) )THEN
1199               il_attid=att_get_id(td_file%t_att(:), cd_name )
1200            ENDIF
1201            IF( il_attid /= 0 )THEN
1202   
1203               CALL file_del_att(td_file, td_file%t_att(il_attid))
1204
1205            ELSE
1206
1207               CALL logger_warn( &
1208               &  " DEL ATT NAME: there is no attribute with name "//&
1209               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name))
1210
1211            ENDIF
1212
1213         ELSE
1214            CALL logger_debug( " DEL ATT NAME: no attribute associated to file "//&
1215            &               TRIM(td_file%c_name) )
1216         ENDIF
1217
1218      ENDIF
1219
1220   END SUBROUTINE file__del_att_name
1221   !> @endcode
1222   !-------------------------------------------------------------------
1223   !> @brief This subroutine delete a global attribute structure
1224   !> from file structure.
1225   !
1226   !> @details
1227   !
1228   !> @author J.Paul
1229   !> - Nov, 2013- Initial Version
1230   !
1231   !> @param[inout] td_file : file structure
1232   !> @param[in] td_att : attribute structure
1233   !-------------------------------------------------------------------
1234   !> @code
1235   SUBROUTINE file__del_att_str(td_file, td_att)
1236      IMPLICIT NONE
1237
1238      ! Argument     
1239      TYPE(TFILE), INTENT(INOUT) :: td_file
1240      TYPE(TATT),  INTENT(IN)    :: td_att
1241
1242      ! local variable
1243      INTEGER(i4) :: il_status
1244      INTEGER(i4) :: il_attid
1245      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
1246
1247      ! loop indices
1248      INTEGER(i4) :: ji
1249      !----------------------------------------------------------------
1250
1251      ! check if file opened
1252      !IF( TRIM(td_file%c_name) == "unknown" )THEN
1253      IF( TRIM(td_file%c_name) == '' )THEN
1254
1255         CALL logger_error( " DEL ATT: file structure unknown ")
1256         CALL logger_debug( " DEL ATT: you should have used file_init before "//&
1257         & "running file_del_att" )     
1258
1259      ELSE
1260
1261         ! check if attribute already in file structure
1262         il_attid=0
1263         IF( ASSOCIATED(td_file%t_att) )THEN
1264            il_attid=att_get_id( td_file%t_att(:), td_att%c_name )
1265         ENDIF
1266
1267         IF( il_attid == 0 )THEN
1268
1269            CALL logger_error( &
1270            &  " DEL ATT: no attribute "//TRIM(td_att%c_name)//&
1271            &  ", in file "//TRIM(td_file%c_name) )
1272
1273         ELSE
1274           
1275            CALL logger_debug( &
1276            &  " DEL ATT: del attribute "//TRIM(td_att%c_name)//&
1277            &  ", in file "//TRIM(td_file%c_name) )
1278
1279            ALLOCATE( tl_att(td_file%i_natt-1), stat=il_status )
1280            IF(il_status /= 0 )THEN
1281
1282               CALL logger_error( &
1283               &  " ADD ATT: not enough space to put attributes from "//&
1284               &  TRIM(td_file%c_name)//" in temporary attribute structure")
1285
1286            ELSE
1287
1288               ! save temporary global attribute's file structure
1289               tl_att(1:il_attid-1)=td_file%t_att(1:il_attid-1)
1290               tl_att(il_attid:)=td_file%t_att(il_attid+1:)
1291
1292               DEALLOCATE( td_file%t_att )
1293
1294               ! new number of attribute in file
1295               td_file%i_natt=td_file%i_natt-1
1296
1297               ALLOCATE( td_file%t_att(td_file%i_natt), stat=il_status )
1298               IF(il_status /= 0 )THEN
1299
1300                  CALL logger_error( &
1301                  &  " ADD ATT: not enough space to put attributes "//&
1302                  &  "in file structure "//TRIM(td_file%c_name) )
1303
1304               ENDIF
1305
1306               ! copy attribute in file before
1307               td_file%t_att(1:td_file%i_natt)=tl_att(:)
1308
1309               ! update attribute id
1310               DO ji=1,td_file%i_natt
1311                  td_file%t_att(ji)%i_id=ji
1312               ENDDO
1313
1314               DEALLOCATE(tl_att)
1315            ENDIF
1316         ENDIF
1317      ENDIF
1318
1319   END SUBROUTINE file__del_att_str
1320   !> @endcode
1321   !-------------------------------------------------------------------
1322   !> @brief This subroutine move a global attribute structure
1323   !> from file structure.
1324   !> @note attribute id could be change
1325   !
1326   !> @details
1327   !
1328   !> @author J.Paul
1329   !> - Nov, 2013- Initial Version
1330   !
1331   !> @param[inout] td_file : file structure
1332   !> @param[in] td_att : attribute structure
1333   !> @todo
1334   !-------------------------------------------------------------------
1335   !> @code
1336   SUBROUTINE file_move_att(td_file, td_att)
1337      IMPLICIT NONE
1338
1339      ! Argument     
1340      TYPE(TFILE), INTENT(INOUT) :: td_file
1341      TYPE(TATT),  INTENT(IN)    :: td_att
1342
1343      ! local variable
1344      TYPE(TATT)  :: tl_att
1345      INTEGER(i4) :: il_attid
1346      !----------------------------------------------------------------
1347
1348      ! copy attribute
1349      tl_att=td_att
1350
1351      IF( ASSOCIATED(td_file%t_att) )THEN
1352         il_attid=att_get_id(td_file%t_att(:),TRIM(tl_att%c_name))
1353         IF( il_attid /= 0 )THEN
1354            ! remove attribute with same name
1355            CALL file_del_att(td_file, tl_att)
1356         ENDIF
1357      ENDIF
1358
1359      ! add new attribute
1360      CALL file_add_att(td_file, tl_att)
1361
1362   END SUBROUTINE file_move_att
1363   !> @endcode
1364   !-------------------------------------------------------------------
1365   !> @brief This subroutine add a dimension structure in file
1366   !> structure.
1367   !> Do not overwrite, if dimension already in file structure.
1368   !
1369   !> @details
1370   !
1371   !> @author J.Paul
1372   !> - Nov, 2013- Initial Version
1373   !
1374   !> @param[inout] td_file : file structure
1375   !> @param[in] td_dim : dimension structure
1376   !
1377   !> @todo
1378   !-------------------------------------------------------------------
1379   !> @code
1380   SUBROUTINE file_add_dim(td_file, td_dim)
1381      IMPLICIT NONE
1382
1383      ! Argument     
1384      TYPE(TFILE), INTENT(INOUT) :: td_file
1385      TYPE(TDIM),  INTENT(IN)    :: td_dim
1386
1387      ! local variable
1388      INTEGER(i4) :: il_dimid
1389      !----------------------------------------------------------------
1390      ! check if file opened
1391      !IF( TRIM(td_file%c_name) == "unknown" )THEN
1392      IF( TRIM(td_file%c_name) == '' )THEN
1393
1394         CALL logger_error( " ADD DIM: file structure unknown ")
1395         CALL logger_debug( " ADD DIM: you should have used file_init before "//&
1396         & "running file_add_dim" )     
1397
1398      ELSE
1399
1400         IF( td_file%i_ndim <= 4 )THEN
1401
1402            ! check if dimension already in file structure
1403            il_dimid=dim_get_id(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname)
1404            IF( il_dimid /= 0 )THEN
1405
1406               CALL logger_warn("ADD DIM: dimension "//TRIM(td_dim%c_name)//&
1407               &  ", short name "//TRIM(td_dim%c_sname)//&
1408               &  ", already in file "//TRIM(td_file%c_name) )
1409
1410               IF( td_file%t_dim(il_dimid)%i_len /= td_dim%i_len )THEN
1411                  CALL logger_error( &
1412                  &  "ADD DIM: dimension "//TRIM(td_dim%c_name)//&
1413                  &  " already in file "//TRIM(td_file%c_name)//&
1414                  &  " differ from added dimension ")
1415               ENDIF
1416
1417            ELSE
1418
1419               CALL logger_debug( &
1420               &  " ADD DIM: add dimension "//TRIM(td_dim%c_name)//&
1421               &  ", short name "//TRIM(td_dim%c_sname)//&
1422               &  ", in file "//TRIM(td_file%c_name) )
1423
1424               IF( td_file%i_ndim == 4 )THEN
1425                  ! search empty dimension
1426                  il_dimid=dim_get_void_id(td_file%t_dim(:),TRIM(td_dim%c_name), &
1427                  &                                         TRIM(td_dim%c_sname))
1428                  ! replace empty dimension
1429                  td_file%t_dim(il_dimid)=td_dim
1430                  td_file%t_dim(il_dimid)%i_id=il_dimid
1431                  td_file%t_dim(il_dimid)%l_use=.TRUE.
1432               ELSE
1433                  ! add new dimension
1434                  il_dimid=dim_get_void_id(td_file%t_dim(:),TRIM(td_dim%c_name), &
1435                  &                                         TRIM(td_dim%c_sname))
1436                  td_file%t_dim(il_dimid)=td_dim
1437                  td_file%t_dim(il_dimid)%i_id=td_file%i_ndim+1
1438                  td_file%t_dim(il_dimid)%l_use=.TRUE.
1439                  ! update number of attribute
1440                  td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use)
1441               ENDIF
1442
1443               ! reorder dimension to ('x','y','z','t')
1444               CALL dim_reorder(td_file%t_dim)
1445               
1446            ENDIF
1447         ELSE
1448            CALL logger_error( &
1449            &  " ADD DIM: too much dimension in file "//&
1450            &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
1451         ENDIF
1452
1453      ENDIF
1454
1455   END SUBROUTINE file_add_dim
1456   !> @endcode
1457   !-------------------------------------------------------------------
1458   !> @brief This subroutine delete a dimension structure in file
1459   !> structure.<br/>
1460   !
1461   !> @details
1462   !
1463   !> @author J.Paul
1464   !> - Nov, 2013- Initial Version
1465   !
1466   !> @param[inout] td_file : file structure
1467   !> @param[in] td_dim : dimension structure
1468   !
1469   !> @todo
1470   !-------------------------------------------------------------------
1471   !> @code
1472   SUBROUTINE file_del_dim(td_file, td_dim)
1473      IMPLICIT NONE
1474
1475      ! Argument     
1476      TYPE(TFILE), INTENT(INOUT) :: td_file
1477      TYPE(TDIM),  INTENT(IN)    :: td_dim
1478
1479      ! local variable
1480      INTEGER(i4) :: il_status
1481      INTEGER(i4) :: il_dimid
1482      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim
1483      !----------------------------------------------------------------
1484      ! check if file opened
1485      !IF( TRIM(td_file%c_name) == "unknown" )THEN
1486      IF( TRIM(td_file%c_name) == '' )THEN
1487
1488         CALL logger_error( " DEL DIM: file structure unknown ")
1489         CALL logger_debug( " DEL DIM: you should have used file_init before "//&
1490         & "running file_del_dim" )     
1491
1492      ELSE
1493
1494         IF( td_file%i_ndim <= 4 )THEN
1495
1496            ! check if dimension already in file structure
1497            il_dimid=dim_get_id(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname)
1498            IF( il_dimid == 0 )THEN
1499
1500               CALL logger_error( &
1501               &  " DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
1502               &  ", short name "//TRIM(td_dim%c_sname)//&
1503               &  ", in file "//TRIM(td_file%c_name) )
1504
1505            ELSE
1506
1507               CALL logger_debug( &
1508               &  " DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
1509               &  ", short name "//TRIM(td_dim%c_sname)//&
1510               &  ", in file "//TRIM(td_file%c_name) )
1511
1512               IF( td_file%i_ndim == 4 )THEN
1513                  ALLOCATE( tl_dim(1), stat=il_status )
1514                  IF(il_status /= 0 )THEN
1515                     CALL logger_error( &
1516                     &  " DEL DIM: not enough space to put dimensions from "//&
1517                     &  TRIM(td_file%c_name)//" in temporary dimension structure")
1518                  ELSE
1519                     ! replace dimension by empty one
1520                     td_file%t_dim(il_dimid)=tl_dim(1)
1521                  ENDIF
1522                  DEALLOCATE(tl_dim)
1523               ELSE
1524                  !
1525                  !ALLOCATE( tl_dim(td_file%i_ndim), stat=il_status )
1526                  ALLOCATE( tl_dim(ip_maxdim), stat=il_status )
1527                  IF(il_status /= 0 )THEN
1528
1529                     CALL logger_error( &
1530                     &  " DEL DIM: not enough space to put dimensions from "//&
1531                     &  TRIM(td_file%c_name)//" in temporary dimension structure")
1532
1533                  ELSE
1534
1535                     print *,"<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
1536                     print *,'il_dimid '//TRIM(fct_str(il_dimid))
1537                     CALL dim_print(td_file%t_dim(:))
1538                     ! save temporary dimension's file structure
1539                     tl_dim( 1 : il_dimid-1 ) = td_file%t_dim( 1 : il_dimid-1 )
1540                     !tl_dim( il_dimid : td_file%i_ndim-1 ) = &
1541                     !&           td_file%t_dim( il_dimid+1 : td_file%i_ndim )
1542                     tl_dim( il_dimid : ip_maxdim-1 ) = &
1543                     &           td_file%t_dim( il_dimid+1 : ip_maxdim )
1544                     print *,"<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
1545                     CALL dim_print(tl_dim(:))
1546
1547                     ! copy dimension in file, except one
1548                     !td_file%t_dim(1:td_file%i_ndim)=tl_dim(:)
1549                     td_file%t_dim(:)=tl_dim(:)
1550                     print *,"<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
1551                     CALL dim_print(td_file%t_dim(:))
1552
1553                     ! update number of dimension
1554                     td_file%i_ndim=td_file%i_ndim-1
1555
1556                  ENDIF
1557               ENDIF
1558
1559               ! reorder dimension to ('x','y','z','t')
1560               CALL dim_reorder(td_file%t_dim)
1561
1562            ENDIF
1563         ELSE
1564            CALL logger_error( &
1565            &  " DEL DIM: too much dimension in file "//&
1566            &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")")
1567         ENDIF
1568
1569      ENDIF
1570
1571   END SUBROUTINE file_del_dim
1572   !> @endcode
1573   !-------------------------------------------------------------------
1574   !> @brief This subroutine move a dimension structure
1575   !> in file structure.
1576   !> @warning dimension order Nov have changed
1577   !
1578   !> @details
1579   !
1580   !> @author J.Paul
1581   !> - Nov, 2013- Initial Version
1582   !
1583   !> @param[inout] td_file : file structure
1584   !> @param[in] td_dim : dimension structure
1585   !> @todo
1586   !-------------------------------------------------------------------
1587   !> @code
1588   SUBROUTINE file_move_dim(td_file, td_dim)
1589      IMPLICIT NONE
1590
1591      ! Argument     
1592      TYPE(TFILE), INTENT(INOUT) :: td_file
1593      TYPE(TDIM),  INTENT(IN)    :: td_dim
1594
1595      ! local variable
1596      TYPE(TDIM)  :: tl_dim
1597      INTEGER(i4) :: il_dimid
1598      !----------------------------------------------------------------
1599
1600      ! copy dimension
1601      tl_dim=td_dim
1602
1603      il_dimid=dim_get_id(td_file%t_dim(:), TRIM(td_dim%c_name), &
1604      &                                     TRIM(td_dim%c_sname))
1605      IF( il_dimid /= 0 )THEN
1606         ! remove dimension with same name
1607         CALL file_del_dim(td_file, tl_dim)
1608      ENDIF
1609
1610      ! add new dimension
1611      CALL file_add_dim(td_file, tl_dim)
1612
1613   END SUBROUTINE file_move_dim
1614   !> @endcode
1615   !-------------------------------------------------------------------
1616   !> @brief This subroutine print some information about file strucutre.
1617   !
1618   !> @author J.Paul
1619   !> - Nov, 2013- Initial Version
1620   !
1621   !> @param[in] td_file : file structure
1622   !-------------------------------------------------------------------
1623   !> @code
1624   SUBROUTINE file_print(td_file)
1625      IMPLICIT NONE
1626
1627      ! Argument     
1628      TYPE(TFILE), INTENT(IN) :: td_file
1629
1630      ! local variable
1631      CHARACTER(LEN=lc) :: cl_mode
1632
1633      ! loop indices
1634      INTEGER(i4) :: ji
1635      !----------------------------------------------------------------
1636
1637      cl_mode='READ'
1638      IF( td_file%l_wrt ) cl_mode='WRITE'
1639
1640      WRITE(*,'((a,a),2(/3x,a,a),4(/3x,a,i0))')&
1641      &  "File : ",TRIM(td_file%c_name), &
1642      &  " type : ",TRIM(td_file%c_type), &
1643      &  " mode : ",TRIM(cl_mode), &
1644      &  " id   : ",td_file%i_id, &
1645      &  " ndim : ",td_file%i_ndim, &
1646      &  " natt : ",td_file%i_natt, &
1647      &  " nvar : ",td_file%i_nvar
1648
1649      SELECT CASE(TRIM(td_file%c_type))
1650         CASE('cdf')
1651            WRITE(*,'((/3x,a,a),(/3x,a,i3))')&
1652            &  "define mode : ",TRIM(fct_str(td_file%l_def)),&
1653            &  "unlimited id : ",td_file%i_uldid
1654         CASE('dimg')
1655            WRITE(*,'(5(/3x,a,i0))')&
1656            &  " record length : ",td_file%i_recl, &
1657            &  " n0d : ",td_file%i_n0d, &
1658            &  " n1d : ",td_file%i_n1d, &
1659            &  " n2d : ",td_file%i_n2d, &
1660            &  " n3d : ",td_file%i_n3d
1661      END SELECT
1662
1663      ! print dimension
1664      IF(  td_file%i_ndim /= 0 )THEN
1665         WRITE(*,'(/a)') " File dimension"
1666         DO ji=1,ip_maxdim
1667            IF( td_file%t_dim(ji)%l_use )THEN
1668               CALL dim_print(td_file%t_dim(ji))
1669            ENDIF
1670         ENDDO
1671      ENDIF
1672
1673      ! print global attribute
1674      IF( td_file%i_natt /= 0 )THEN
1675         WRITE(*,'(/a)') " File attribute"
1676         DO ji=1,td_file%i_natt
1677            CALL att_print(td_file%t_att(ji))
1678         ENDDO
1679      ENDIF
1680
1681      ! print variable
1682      IF( td_file%i_nvar /= 0 )THEN
1683         WRITE(*,'(/a)') " File variable"
1684         DO ji=1,td_file%i_nvar
1685            CALL var_print(td_file%t_var(ji))!,.FALSE.)
1686         ENDDO
1687      ENDIF
1688
1689   END SUBROUTINE file_print
1690   !> @endcode
1691   !-------------------------------------------------------------------
1692   !> @brief This function get suffix of file name.
1693   !> @details
1694   !> we assume suffix is define as alphanumeric character following the
1695   !> last '.' in file name
1696   !> If no suffix is found, return empty character.
1697   !
1698   !> @author J.Paul
1699   !> - Nov, 2013- Initial Version
1700   !
1701   !> @param[in] cd_file : file structure
1702   !> @return suffix
1703   !-------------------------------------------------------------------
1704   !> @code
1705   CHARACTER(LEN=lc) FUNCTION file__get_suffix(cd_file)
1706      IMPLICIT NONE
1707
1708      ! Argument     
1709      CHARACTER(LEN=*), INTENT(IN) :: cd_file
1710
1711      ! local variable
1712      INTEGER(i4) :: il_ind
1713      !----------------------------------------------------------------
1714
1715      CALL logger_trace( "GET SUFFIX: look for suffix in file name "//&
1716      &               TRIM(cd_file) )
1717
1718      il_ind=INDEX(TRIM(cd_file),'.',BACK=.TRUE.)
1719      IF( il_ind /= 0 )THEN
1720         ! read number in basename
1721         READ( cd_file(il_ind:),'(a)' ) file__get_suffix
1722
1723         IF( fct_is_num(file__get_suffix) )THEN
1724            file__get_suffix=''
1725         ENDIF
1726
1727      ELSE
1728         file__get_suffix=''
1729      ENDIF
1730
1731   END FUNCTION file__get_suffix
1732   !> @endcode
1733   !-------------------------------------------------------------------
1734   !> @brief This function get number in file name without suffix.
1735   !> @details
1736   !> Actually it get the number following the last separator.
1737   !> separator could be '.' or '_'
1738   !
1739   !> @author J.Paul
1740   !> - Nov, 2013- Initial Version
1741   !
1742   !> @param[in] cd_file : file name (without suffix)
1743   !> @return file structure
1744   !-------------------------------------------------------------------
1745   !> @code
1746   CHARACTER(LEN=lc) FUNCTION file__get_number(cd_file)
1747      IMPLICIT NONE
1748
1749      ! Argument     
1750      CHARACTER(LEN=lc), INTENT(IN) :: cd_file
1751
1752      ! local variable
1753      INTEGER(i4) :: il_indmax
1754      INTEGER(i4) :: il_ind
1755
1756      ! loop indices
1757      INTEGER(i4) :: ji
1758      !----------------------------------------------------------------
1759
1760      ! get number position in file name
1761      il_indmax=0
1762      DO ji=1,ig_nsep
1763         il_ind=INDEX(TRIM(cd_file),TRIM(cg_sep(ji)),BACK=.TRUE.)
1764         IF( il_ind > il_indmax )THEN
1765            il_indmax=il_ind
1766         ENDIF
1767      ENDDO
1768
1769      IF( il_indmax /= 0 )THEN
1770         ! read number in basename
1771         READ( cd_file(il_indmax:),'(a)' ) file__get_number
1772
1773         IF( .NOT. fct_is_num(file__get_number(2:)) )THEN
1774            file__get_number=''
1775         ENDIF
1776      ELSE
1777         file__get_number=''
1778      ENDIF
1779
1780   END FUNCTION file__get_number
1781   !> @endcode
1782   !-------------------------------------------------------------------
1783   !> @brief This function rename file name.
1784   !> @details
1785   !> If no processor number is given, return file name without number
1786   !> If processor number is given, return file name with new number
1787   !
1788   !> @author J.Paul
1789   !> - Nov, 2013- Initial Version
1790   !
1791   !> @param[in] td_file : file structure
1792   !> @param[in] id_num : processor number (start to 1)
1793   !> @return file structure
1794   !-------------------------------------------------------------------
1795   !> @code
1796   CHARACTER(LEN=lc) FUNCTION file__rename_char(cd_file, id_num)
1797      IMPLICIT NONE
1798
1799      ! Argument     
1800      CHARACTER(LEN=*), INTENT(IN) :: cd_file
1801      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_num
1802
1803      ! local variable
1804      CHARACTER(LEN=lc) :: cl_suffix
1805      CHARACTER(LEN=lc) :: cl_file
1806      CHARACTER(LEN=lc) :: cl_number
1807      CHARACTER(LEN=lc) :: cl_base
1808      CHARACTER(LEN=lc) :: cl_sep
1809      CHARACTER(LEN=lc) :: cl_format
1810      INTEGER(i4)       :: il_ind
1811      INTEGER(i4)       :: il_numlen
1812      !----------------------------------------------------------------
1813
1814      ! get suffix
1815      cl_suffix=file__get_suffix(cd_file)
1816      IF( TRIM(cl_suffix) /= '' )THEN
1817         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
1818         cl_file=TRIM(cd_file(:il_ind-1))
1819      ELSE
1820         cl_file=TRIM(cd_file)
1821      ENDIF
1822
1823      cl_number=file__get_number(cl_file)
1824      IF( TRIM(cl_number) /= '' )THEN
1825         il_ind=INDEX(TRIM(cl_file),TRIM(cl_number(1:1)),BACK=.TRUE.)
1826         cl_base=TRIM(cl_file(:il_ind-1))
1827
1828         cl_sep=TRIM(cl_number(1:1))
1829         il_numlen=LEN(TRIM(cl_number))-1
1830      ELSE
1831         cl_base=TRIM(cl_file)
1832         il_numlen=4
1833         cl_sep='_'
1834      ENDIF
1835
1836      IF( PRESENT(id_num) )THEN
1837         ! format
1838         WRITE(cl_format,'(a,i1.1,a,i1.1,a)') '(a,a,i',il_numlen,'.',il_numlen,',a)'
1839         WRITE(file__rename_char,cl_format) TRIM(cl_base),TRIM(cl_sep),id_num,TRIM(cl_suffix)
1840      ELSE
1841         WRITE(file__rename_char,'(a,a)') TRIM(cl_base),TRIM(cl_suffix)
1842      ENDIF
1843      CALL logger_trace(" RENAME : "//TRIM(file__rename_char))
1844
1845   END FUNCTION file__rename_char
1846   !> @endcode
1847   !-------------------------------------------------------------------
1848   !> @brief This function rename file name, given file structure.
1849   !> @details
1850   !> If no processor number is given, return file name without number
1851   !> I processor number is given, return file name with new number
1852   !
1853   !> @author J.Paul
1854   !> - Nov, 2013- Initial Version
1855   !
1856   !> @param[in] td_file : file structure
1857   !> @param[in] id_num : processor number (start to 1)
1858   !> @return file structure
1859   !-------------------------------------------------------------------
1860   !> @code
1861   TYPE(TFILE) FUNCTION file__rename_str(td_file, id_num)
1862      IMPLICIT NONE
1863
1864      ! Argument     
1865      TYPE(TFILE), INTENT(IN) :: td_file
1866      INTEGER(i4), INTENT(IN), OPTIONAL :: id_num
1867
1868      ! local variable
1869      CHARACTER(LEN=lc) :: cl_name
1870      !----------------------------------------------------------------
1871
1872      ! change name
1873      cl_name=TRIM( file_rename(td_file%c_name, id_num) )
1874
1875      file__rename_str=file_init(TRIM(cl_name), TRIM(td_file%c_type))
1876
1877   END FUNCTION file__rename_str
1878   !> @endcode
1879   !-------------------------------------------------------------------
1880   !> @brief This function add suffix to file name.
1881   !
1882   !> @author J.Paul
1883   !> - Nov, 2013- Initial Version
1884   !
1885   !> @param[in] td_file : file structure
1886   !> @return file structure
1887   !-------------------------------------------------------------------
1888   !> @code
1889   CHARACTER(LEN=lc) FUNCTION file_add_suffix(cd_file, cd_type)
1890      IMPLICIT NONE
1891
1892      ! Argument     
1893      CHARACTER(LEN=*), INTENT(IN) :: cd_file
1894      CHARACTER(LEN=*), INTENT(IN) :: cd_type
1895
1896      ! local variable
1897      INTEGER(i4)       :: il_ind
1898      CHARACTER(LEN=lc) :: cl_file
1899      CHARACTER(LEN=lc) :: cl_suffix
1900      !----------------------------------------------------------------
1901      ! get suffix
1902      cl_suffix=file__get_suffix(cd_file)
1903      IF( TRIM(cl_suffix) /= '' )THEN
1904         il_ind=INDEX(TRIM(cd_file),TRIM(cl_suffix(1:1)),BACK=.TRUE.)
1905         cl_file=TRIM(cd_file(:il_ind-1))
1906      ELSE
1907         cl_file=TRIM(cd_file)
1908      ENDIF
1909
1910      SELECT CASE(TRIM(cd_type))
1911         CASE('cdf')
1912            file_add_suffix=TRIM(cl_file)//'.nc'
1913         CASE('dimg')
1914            IF( TRIM(cl_suffix) /= '' )THEN
1915               file_add_suffix=TRIM(cl_file)//'.dimg'
1916            ELSE
1917               file_add_suffix=TRIM(cl_file)
1918            ENDIF
1919         CASE DEFAULT
1920            CALL logger_error( " ADD SUFFIX: type unknown "//TRIM(cd_type) )
1921      END SELECT
1922
1923   END FUNCTION file_add_suffix
1924   !> @endcode
1925   !-------------------------------------------------------------------
1926   !> @brief
1927   !>  This subroutine clean mpp strcuture.
1928   !
1929   !> @author J.Paul
1930   !> @date Nov, 2013
1931   !
1932   !> @param[inout] td_mpp : mpp strcuture
1933   !-------------------------------------------------------------------
1934   !> @code
1935   SUBROUTINE file_clean( td_file )
1936      IMPLICIT NONE
1937      ! Argument
1938      TYPE(TFILE),  INTENT(INOUT) :: td_file
1939
1940      ! local variable
1941      TYPE(TFILE) :: tl_file ! empty file structure
1942
1943      ! loop indices
1944      INTEGER(i4) :: ji
1945      !----------------------------------------------------------------
1946
1947      CALL logger_info( &
1948      &  " CLEAN: reset file "//TRIM(td_file%c_name) )
1949
1950      ! del attribute
1951      IF( ASSOCIATED( td_file%t_att ) )THEN
1952         DO ji=td_file%i_natt,1,-1
1953            CALL att_clean( td_file%t_att(ji) )
1954         ENDDO
1955         DEALLOCATE( td_file%t_att )
1956      ENDIF
1957
1958      ! del dimension
1959      IF( td_file%i_ndim /= 0 )THEN
1960         DO ji=td_file%i_ndim,1,-1
1961            CALL dim_clean( td_file%t_dim(ji) )
1962         ENDDO
1963      ENDIF
1964
1965      ! del variable
1966      IF( ASSOCIATED( td_file%t_var ) )THEN
1967         DO ji=td_file%i_nvar,1,-1
1968            CALL var_clean( td_file%t_var(ji) )
1969         ENDDO
1970         DEALLOCATE( td_file%t_var )
1971      ENDIF
1972
1973      ! replace by empty structure
1974      td_file=tl_file
1975
1976   END SUBROUTINE file_clean
1977   !> @endcode
1978   !-------------------------------------------------------------------
1979   !> @brief This function return the file id, in a table of file
1980   !> structure,  given file name
1981   !
1982   !> @author J.Paul
1983   !> - Nov, 2013- Initial Version
1984   !
1985   !> @param[in] td_file : table of file structure
1986   !> @param[in] cd_name : file name
1987   !> @return file id in table of file structure (0 if not found)
1988   !-------------------------------------------------------------------
1989   !> @code
1990   INTEGER(i4) FUNCTION file_get_id(td_file, cd_name)
1991      IMPLICIT NONE
1992      ! Argument     
1993      TYPE(TFILE)     , DIMENSION(:), INTENT(IN) :: td_file
1994      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
1995
1996      ! local variable
1997      INTEGER(i4) :: il_size
1998
1999      ! loop indices
2000      INTEGER(i4) :: ji
2001      !----------------------------------------------------------------
2002      file_get_id=0
2003      il_size=SIZE(td_file(:))
2004
2005      ! check if file is in table of file structure
2006      DO ji=1,il_size
2007         ! look for file name
2008         CALL logger_debug(" cd_name "//TRIM(fct_lower(cd_name)) )
2009         IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN
2010         
2011            file_get_id=ji
2012            EXIT
2013
2014         ENDIF
2015      ENDDO
2016
2017   END FUNCTION file_get_id
2018   !> @endcode
2019END MODULE file
2020
Note: See TracBrowser for help on using the repository browser.