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.
Changeset 5240 for branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/file.f90 – NEMO

Ignore:
Timestamp:
2015-04-29T12:17:12+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO nn_etau_revision branch with trunk changes to rev 5107.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/TOOLS/SIREN/src/file.f90

    r4213 r5240  
    77!> @brief  
    88!> This module manage file structure. 
    9 ! 
     9!> 
    1010!> @details 
    11 !> 
    1211!>    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]) 
     12!> @code 
     13!>    TYPE(TFILE) :: tl_file 
     14!> @endcode 
     15!> 
     16!>    to initialize a file structure:<br/> 
     17!> @code 
     18!>    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,cd_grid]) 
     19!%    tl_file=file_init(cd_file [,cd_type] [,ld_wrt] [,id_ew] [,id_perio] [,id_pivot] [,cd_grid]) 
     20!> @endcode 
    1721!>       - 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) 
     22!>       - cd_type is the type of the file ('cdf', 'dimg') [optional] 
     23!>       - ld_wrt  file in write mode or not [optional] 
     24!%       - id_ew is the number of point for east-west overlap [optional] 
     25!%       - id_perio is the NEMO periodicity index [optional] 
     26!%       - id_pivot is the NEMO pivot point index F(0),T(1) [optional] 
     27!>       - cd_grid is the grid type (default 'ARAKAWA-C') 
    2028!> 
    2129!>    to get file name:<br/> 
     
    3846!>    - tl_file\%i_nvar 
    3947!> 
    40 !>    to get the table of variable structure associated to the file:<br/> 
     48!>    to get the array of variable structure associated to the file:<br/> 
    4149!>    - tl_file\%t_var(:) 
    4250!> 
     
    4553!>    - tl_file\%i_natt 
    4654!> 
    47 !>    to get the table of attributes structure associated to the file:<br/> 
     55!>    to get the array of attributes structure associated to the file:<br/> 
    4856!>    - tl_file\%t_att(:) 
    4957!> 
     
    5260!>    - tl_file\%i_ndim 
    5361!> 
    54 !>    to get the table of dimension structure (4 elts) associated to the 
     62!>    to get the array of dimension structure (4 elts) associated to the 
    5563!>    file:<br/> 
    5664!>    - tl_file\%t_dim(:) 
    5765!> 
    5866!>    to print information about file structure:<br/> 
     67!> @code 
    5968!>    CALL file_print(td_file) 
     69!> @endcode 
     70!> 
     71!>    to clean file structure:<br/> 
     72!> @code 
     73!>    CALL file_clean(td_file) 
     74!> @endcode 
    6075!> 
    6176!>    to add a global attribute structure in file structure:<br/> 
     77!> @code 
    6278!>    CALL file_add_att(td_file, td_att) 
     79!> @endcode 
    6380!>       - td_att is an attribute structure 
    6481!> 
    6582!>    to add a dimension structure in file structure:<br/> 
     83!> @code 
    6684!>    CALL file_add_dim(td_file, td_dim) 
     85!> @endcode 
    6786!>       - td_dim is a dimension structure 
    6887!> 
    6988!>    to add a variable structure in file structure:<br/> 
     89!> @code 
    7090!>    CALL file_add_var(td_file, td_var) 
     91!> @endcode 
    7192!>       - td_var is a variable structure 
    7293!> 
    7394!>    to delete a global attribute structure in file structure:<br/> 
     95!> @code 
    7496!>    CALL file_del_att(td_file, td_att) 
     97!> @endcode 
    7598!>       - td_att is an attribute structure 
    7699!> 
    77100!>    to delete a dimension structure in file structure:<br/> 
     101!> @code 
    78102!>    CALL file_del_dim(td_file, td_dim) 
     103!> @endcode 
    79104!>       - td_dim is a dimension structure 
    80105!> 
    81106!>    to delete a variable structure in file structure:<br/> 
     107!> @code 
    82108!>    CALL file_del_var(td_file, td_var) 
     109!> @endcode 
    83110!>       - td_var is a variable structure 
    84111!> 
    85112!>    to overwrite one attribute structure in file structure:<br/> 
     113!> @code 
    86114!>    CALL file_move_att(td_file, td_att) 
     115!> @endcode 
    87116!>       - td_att is an attribute structure 
    88117!> 
    89118!>    to  overwrite one dimension strucutre in file structure:<br/> 
     119!> @code 
    90120!>    CALL file_move_dim(td_file, td_dim) 
     121!> @endcode 
    91122!>       - td_dim is a dimension structure 
    92123!> 
    93124!>    to overwrite one variable  structure in file structure:<br/> 
     125!> @code 
    94126!>    CALL file_move_var(td_file, td_var) 
     127!> @endcode 
    95128!>       - td_var is a variable structure 
    96129!>  
    97130!>    to check if file and variable structure share same dimension:<br/> 
     131!> @code 
    98132!>    ll_check_dim = file_check_var_dim(td_file, td_var) 
     133!> @endcode 
    99134!>       - td_var is a variable structure 
    100135!> 
     
    102137!> J.Paul 
    103138! REVISION HISTORY: 
    104 !> @date Nov, 2013- Initial Version 
     139!> @date November, 2013- Initial Version 
     140!> @date November, 2014 - Fix memory leaks bug 
    105141!> 
    106142!> @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 
    110143!---------------------------------------------------------------------- 
    111144MODULE file 
     
    113146   USE global                          ! global variable 
    114147   USE fct                             ! basic useful function 
    115    USE logger                             ! log file manager 
     148   USE logger                          ! log file manager 
    116149   USE dim                             ! dimension manager 
    117150   USE att                             ! attribute manager 
    118151   USE var                             ! variable manager 
    119152   IMPLICIT NONE 
    120    PRIVATE 
    121153   ! NOTE_avoid_public_variables_if_possible 
    122154 
    123155   ! type and variable 
    124    PUBLIC :: TFILE   ! file structure 
     156   PUBLIC :: TFILE   !< file structure 
    125157 
    126158   ! 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 
     159   PUBLIC :: file_copy           !< copy file structure 
     160   PUBLIC :: file_print          !< print information about file structure 
     161   PUBLIC :: file_clean          !< clean file structure 
     162   PUBLIC :: file_init           !< initialize file structure 
     163   PUBLIC :: file_add_att        !< add one attribute structure in file structure 
     164   PUBLIC :: file_add_var        !< add one variable  structure in file structure 
     165   PUBLIC :: file_add_dim        !< add one dimension strucutre in file structure 
     166   PUBLIC :: file_del_att        !< delete one attribute structure of file structure 
     167   PUBLIC :: file_del_var        !< delete one variable  structure of file structure 
     168   PUBLIC :: file_del_dim        !< delete one dimension strucutre of file structure 
     169   PUBLIC :: file_move_att       !< overwrite one attribute structure in file structure 
     170   PUBLIC :: file_move_var       !< overwrite one variable  structure in file structure 
     171   PUBLIC :: file_move_dim       !< overwrite one dimension strucutre in file structure 
    140172   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 
     173   PUBLIC :: file_get_type       !< get type of file 
     174   PUBLIC :: file_get_id         !< get file id 
     175   PUBLIC :: file_rename         !< rename file name 
     176   PUBLIC :: file_add_suffix     !< add suffix to file name 
    145177  
    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 
     178   PRIVATE :: file__clean_unit    ! clean file structure 
     179   PRIVATE :: file__clean_arr     ! clean array of file structure 
     180   PRIVATE :: file__del_var_name ! delete a variable structure in file structure, given variable name or standard name 
     181   PRIVATE :: file__del_var_str  ! delete a variable structure in file structure, given variable structure 
     182   PRIVATE :: file__del_att_name ! delete a attribute structure in file structure, given attribute name 
     183   PRIVATE :: file__del_att_str  ! delete a attribute structure in file structure, given attribute structure 
     184   PRIVATE :: file__get_number   ! get number in file name without suffix 
     185   PRIVATE :: file__get_suffix   ! get suffix of file name 
     186   PRIVATE :: file__copy_unit    ! copy file structure 
     187   PRIVATE :: file__copy_arr     ! copy array of file structure 
     188   PRIVATE :: file__rename_char  ! rename file name, given processor number. 
     189   PRIVATE :: file__rename_str   ! rename file name, given file structure. 
     190 
     191   TYPE TFILE !< file structure 
    157192 
    158193      ! 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 
     194      CHARACTER(LEN=lc)                 :: c_name = ""       !< file name 
     195      CHARACTER(LEN=lc)                 :: c_type = ""       !< type of the file (cdf, cdf4, dimg) 
     196      INTEGER(i4)                       :: i_id   = 0        !< file id 
     197      LOGICAL                           :: l_wrt  = .FALSE.  !< read or write mode 
     198      INTEGER(i4)                       :: i_nvar = 0        !< number of variable 
     199      TYPE(TVAR), DIMENSION(:), POINTER :: t_var  => NULL()  !< file variables 
    165200 
    166201      CHARACTER(LEN=lc)                 :: c_grid = 'ARAKAWA-C' !< grid type 
    167202 
    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 
     203      INTEGER(i4)                       :: i_ew    =-1       !< east-west overlap 
     204      INTEGER(i4)                       :: i_perio =-1       !< NEMO periodicity index 
     205      INTEGER(i4)                       :: i_pivot =-1       !< NEMO pivot point index F(0),T(1) 
     206 
     207      INTEGER(i4)                       :: i_depthid = 0     !< variable id of depth 
     208      INTEGER(i4)                       :: i_timeid  = 0     !< variable id of time 
    174209 
    175210      ! 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 
     211      INTEGER(i4)                       :: i_ndim  = 0       !< number of dimensions used in the file 
     212      INTEGER(i4)                       :: i_natt  = 0       !< number of global attributes in the file 
     213      INTEGER(i4)                       :: i_uldid = 0       !< id of the unlimited dimension in the file 
     214      LOGICAL                           :: l_def   = .FALSE. !< define mode or not 
     215      TYPE(TATT), DIMENSION(:), POINTER :: t_att   => NULL() !< global attributes 
     216      TYPE(TDIM), DIMENSION(ip_maxdim)  :: t_dim             !< dimension structure 
    182217       
    183218      ! 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) 
     219      INTEGER(i4)                       :: i_recl = 0        !< record length (binary file) 
     220      INTEGER(i4)                       :: i_n0d  = 0        !< number of scalar variable 
     221      INTEGER(i4)                       :: i_n1d  = 0        !< number of 1D variable 
     222      INTEGER(i4)                       :: i_n2d  = 0        !< number of 2D variable 
     223      INTEGER(i4)                       :: i_n3d  = 0        !< number of 3D variable 
     224      INTEGER(i4)                       :: i_rhd  = 0        !< record of the header infos (last record) 
    190225 
    191226      ! mpp 
    192227      ! 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 
     228      INTEGER(i4)                       :: i_pid  = -1       !< processor id (start to 1) 
     229      INTEGER(i4)                       :: i_impp = 0        !< i-indexes for mpp-subdomain left bottom 
     230      INTEGER(i4)                       :: i_jmpp = 0        !< j-indexes for mpp-subdomain left bottom 
     231      INTEGER(i4)                       :: i_lci  = 0        !< i-dimensions of subdomain 
     232      INTEGER(i4)                       :: i_lcj  = 0        !< j-dimensions of subdomain 
     233      INTEGER(i4)                       :: i_ldi  = 0        !< first indoor i-indices 
     234      INTEGER(i4)                       :: i_ldj  = 0        !< first indoor j-indices 
     235      INTEGER(i4)                       :: i_lei  = 0        !< last  indoor i-indices 
     236      INTEGER(i4)                       :: i_lej  = 0        !< last  indoor j-indices 
     237 
     238      LOGICAL                           :: l_ctr  = .FALSE.  !< domain is on border 
     239      LOGICAL                           :: l_use  = .FALSE.  !< domain is used 
     240 
     241      ! only use to draw domain decomposition when initialize with mpp_init 
     242      INTEGER(i4)                       :: i_iind = 0        !< i-direction indices 
     243      INTEGER(i4)                       :: i_jind = 0        !< j-direction indices 
    209244 
    210245   END TYPE TFILE 
     246 
     247   INTERFACE file_clean 
     248      MODULE PROCEDURE file__clean_unit 
     249      MODULE PROCEDURE file__clean_arr 
     250   END INTERFACE file_clean 
    211251 
    212252   INTERFACE file_del_var 
     
    225265   END INTERFACE file_rename 
    226266 
    227     INTERFACE ASSIGNMENT(=) 
    228       MODULE PROCEDURE file__copy_unit   ! copy file structure 
    229       MODULE PROCEDURE file__copy_tab    ! copy file structure 
     267    INTERFACE file_copy 
     268      MODULE PROCEDURE file__copy_unit    
     269      MODULE PROCEDURE file__copy_arr     
    230270   END INTERFACE 
    231271 
     
    233273   !------------------------------------------------------------------- 
    234274   !> @brief 
    235    !> This function copy file structure in another file 
    236    !> structure 
     275   !> This subroutine copy file structure in another one 
    237276   !> @details  
    238    !> file variable and attribute value are copied in a temporary table,  
     277   !> file variable and attribute value are copied in a temporary array,  
    239278   !> so input and output file structure value do not point on the same  
    240279   !> "memory cell", and so on are independant.  
     
    242281   !> @note new file is assume to be closed. 
    243282   !> 
     283   !> @warning do not use on the output of a function who create or read an 
     284   !> structure (ex: tl_file=file_copy(file_init()) is forbidden). 
     285   !> This will create memory leaks. 
    244286   !> @warning to avoid infinite loop, do not use any function inside  
    245287   !> this subroutine 
    246288   !>    
    247289   !> @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 ) 
     290   !> - November, 2013- Initial Version 
     291   !> @date November, 2014 
     292   !>    - use function instead of overload assignment operator  
     293   !> (to avoid memory leak) 
     294   ! 
     295   !> @param[in] td_file  file structure 
     296   !> @return copy of input file structure 
     297   !------------------------------------------------------------------- 
     298   FUNCTION file__copy_unit( td_file ) 
    255299      IMPLICIT NONE 
    256300      ! Argument 
    257       TYPE(TFILE), INTENT(  OUT) :: td_file1 
    258       TYPE(TFILE), INTENT(IN   )  :: td_file2 
     301      TYPE(TFILE), INTENT(IN) :: td_file 
     302      ! function 
     303      TYPE(TFILE) :: file__copy_unit 
     304 
     305      ! local variable 
     306      TYPE(TVAR) :: tl_var 
     307      TYPE(TATT) :: tl_att 
    259308 
    260309      ! loop indices 
     
    262311      !---------------------------------------------------------------- 
    263312 
    264       CALL logger_trace("COPY: file "//TRIM(td_file2%c_name) ) 
     313      CALL logger_trace("FILE COPY: file "//TRIM(td_file%c_name) ) 
    265314 
    266315      ! copy file variable 
    267       td_file1%c_name = TRIM(td_file2%c_name) 
    268       td_file1%c_type = TRIM(td_file2%c_type) 
     316      file__copy_unit%c_name = TRIM(td_file%c_name) 
     317      file__copy_unit%c_type = TRIM(td_file%c_type) 
    269318      ! 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 
     319      file__copy_unit%i_id   = 0 
     320      file__copy_unit%l_wrt  = td_file%l_wrt 
     321      file__copy_unit%i_nvar = td_file%i_nvar 
     322 
     323      file__copy_unit%c_grid = td_file%c_grid 
     324 
     325      file__copy_unit%i_ew   = td_file%i_ew 
     326      file__copy_unit%i_perio= td_file%i_perio 
     327      file__copy_unit%i_pivot= td_file%i_pivot 
     328 
     329      file__copy_unit%i_depthid = td_file%i_depthid 
     330      file__copy_unit%i_timeid  = td_file%i_timeid 
    279331 
    280332      ! 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) 
     333      IF( ASSOCIATED(file__copy_unit%t_var) )THEN 
     334         CALL var_clean(file__copy_unit%t_var(:)) 
     335         DEALLOCATE(file__copy_unit%t_var) 
     336      ENDIF 
     337      IF( ASSOCIATED(td_file%t_var) .AND. file__copy_unit%i_nvar > 0 )THEN 
     338         ALLOCATE( file__copy_unit%t_var(file__copy_unit%i_nvar) ) 
     339         DO ji=1,file__copy_unit%i_nvar 
     340            tl_var = var_copy(td_file%t_var(ji)) 
     341            file__copy_unit%t_var(ji) = var_copy(tl_var) 
    286342         ENDDO 
    287343      ENDIF 
    288344       
    289345      ! 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 
     346      file__copy_unit%i_ndim   = td_file%i_ndim 
     347      file__copy_unit%i_natt   = td_file%i_natt 
     348      file__copy_unit%i_uldid  = td_file%i_uldid 
     349      file__copy_unit%l_def    = td_file%l_def 
    294350 
    295351      ! copy dimension 
    296       td_file1%t_dim(:) = td_file2%t_dim(:) 
     352      file__copy_unit%t_dim(:) = dim_copy(td_file%t_dim(:)) 
    297353       
    298354      ! 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) 
     355      IF( ASSOCIATED(file__copy_unit%t_att) )THEN 
     356         CALL att_clean(file__copy_unit%t_att(:)) 
     357         DEALLOCATE(file__copy_unit%t_att) 
     358      ENDIF 
     359      IF( ASSOCIATED(td_file%t_att) .AND. file__copy_unit%i_natt > 0 )THEN 
     360         ALLOCATE( file__copy_unit%t_att(file__copy_unit%i_natt) ) 
     361         DO ji=1,file__copy_unit%i_natt 
     362            tl_att = att_copy(td_file%t_att(ji)) 
     363            file__copy_unit%t_att(ji) = att_copy(tl_att) 
    304364         ENDDO 
    305365      ENDIF 
    306366 
     367      ! clean 
     368      CALL att_clean(tl_att) 
     369 
    307370      ! 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 
     371      file__copy_unit%i_recl = td_file%i_recl 
     372      file__copy_unit%i_n0d  = td_file%i_n0d 
     373      file__copy_unit%i_n1d  = td_file%i_n1d 
     374      file__copy_unit%i_n2d  = td_file%i_n2d 
     375      file__copy_unit%i_n3d  = td_file%i_n3d  
     376      file__copy_unit%i_rhd  = td_file%i_rhd 
    314377       
    315378      ! 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 
     379      file__copy_unit%i_pid  = td_file%i_pid 
     380      file__copy_unit%i_impp = td_file%i_impp 
     381      file__copy_unit%i_jmpp = td_file%i_jmpp 
     382      file__copy_unit%i_lci  = td_file%i_lci 
     383      file__copy_unit%i_lcj  = td_file%i_lcj 
     384      file__copy_unit%i_ldi  = td_file%i_ldi 
     385      file__copy_unit%i_ldj  = td_file%i_ldj 
     386      file__copy_unit%i_lei  = td_file%i_lei 
     387      file__copy_unit%i_lej  = td_file%i_lej 
     388      file__copy_unit%l_ctr  = td_file%l_ctr 
     389      file__copy_unit%l_use  = td_file%l_use 
     390      file__copy_unit%i_iind = td_file%i_iind 
     391      file__copy_unit%i_jind = td_file%i_jind 
     392 
     393   END FUNCTION file__copy_unit 
    332394   !------------------------------------------------------------------- 
    333395   !> @brief 
    334    !> This function copy file structure in another file 
    335    !> structure 
     396   !> This subroutine copy a array of file structure in another one 
    336397   !> @details  
    337    !> file variable and attribute value are copied in a temporary table,  
     398   !> file variable and attribute value are copied in a temporary array,  
    338399   !> so input and output file structure value do not point on the same  
    339400   !> "memory cell", and so on are independant.  
     
    341402   !> @note new file is assume to be closed. 
    342403   !> 
     404   !> @warning do not use on the output of a function who create or read an 
     405   !> structure (ex: tl_file=file_copy(file_init()) is forbidden). 
     406   !> This will create memory leaks. 
    343407   !> @warning to avoid infinite loop, do not use any function inside  
    344408   !> this subroutine 
    345409   !>    
    346410   !> @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 ) 
     411   !> - November, 2013- Initial Version 
     412   !> @date November, 2014 
     413   !>    - use function instead of overload assignment operator  
     414   !> (to avoid memory leak) 
     415   ! 
     416   !> @param[in] td_file  file structure 
     417   !> @return copy of input array of file structure 
     418   !------------------------------------------------------------------- 
     419   FUNCTION file__copy_arr( td_file ) 
    354420      IMPLICIT NONE 
    355421      ! Argument 
    356       TYPE(TFILE), DIMENSION(:)                , INTENT(IN   )  :: td_file2 
    357       TYPE(TFILE), DIMENSION(SIZE(td_file2(:))), INTENT(  OUT) :: td_file1 
     422      TYPE(TFILE), DIMENSION(:)                , INTENT(IN   ) :: td_file 
     423      ! function 
     424      TYPE(TFILE), DIMENSION(SIZE(td_file(:))) :: file__copy_arr 
    358425 
    359426      ! loop indices 
     
    361428      !---------------------------------------------------------------- 
    362429 
    363       DO ji=1,SIZE(td_file2(:)) 
    364          td_file1(ji)=td_file2(ji) 
     430      DO ji=1,SIZE(td_file(:)) 
     431         file__copy_arr(ji)=file_copy(td_file(ji)) 
    365432      ENDDO 
    366433 
    367    END SUBROUTINE file__copy_tab 
    368    !> @endcode 
    369    !------------------------------------------------------------------- 
    370    !> @brief This function initialise file structure.<br/> 
     434   END FUNCTION file__copy_arr 
     435   !------------------------------------------------------------------- 
     436   !> @brief This function initialize file structure.<br/>  
     437   !> @details 
    371438   !> If cd_type is not specify, check if file name include '.nc' or 
    372    !> .'dimg'<br/> 
     439   !> '.dimg'<br/> 
     440   !> Optionally, you could specify:<br/> 
     441   !> - write mode (default .FALSE., ld_wrt) 
     442   !% - East-West overlap (id_ew) 
     443   !% - NEMO periodicity index (id_perio) 
     444   !% - NEMO pivot point index F(0),T(1) (id_pivot) 
     445   !> - grid type (default: 'ARAKAWA-C') 
    373446   ! 
    374447   !> @details 
    375448   ! 
    376449   !> @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.) 
     450   !> - November, 2013- Initial Version 
     451   ! 
     452   !> @param[in] cd_file   file name 
     453   !> @param[in] cd_type   file type ('cdf', 'dimg') 
     454   !> @param[in] ld_wrt    write mode (default .FALSE.) 
     455   !> @param[in] id_ew     east-west overlap 
     456   !> @param[in] id_perio  NEMO periodicity index 
     457   !> @param[in] id_pivot  NEMO pivot point index F(0),T(1) 
     458   !> @param[in] cd_grid   grid type (default 'ARAKAWA-C') 
    382459   !> @return file structure 
    383460   !------------------------------------------------------------------- 
    384    !> @code 
    385461   TYPE(TFILE) FUNCTION file_init( cd_file, cd_type, ld_wrt, & 
    386462   &                               id_ew, id_perio, id_pivot,& 
     
    397473 
    398474      ! local variable 
    399       TYPE(TATT) :: tl_att 
     475      TYPE(TATT)  :: tl_att 
    400476      !---------------------------------------------------------------- 
    401477 
     
    404480 
    405481      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) 
     482      CALL logger_trace("FILE INIT: initialize file "//TRIM(file_init%c_name)) 
    414483 
    415484      ! check type 
     
    421490               file_init%c_type='dimg' 
    422491            CASE DEFAULT 
    423                CALL logger_error( " INIT: can't initialise file "//& 
     492               CALL logger_error( " FILE INIT: can't initialize file "//& 
    424493               &               TRIM(file_init%c_name)//" : type unknown " ) 
    425494         END SELECT 
     
    427496         file_init%c_type=TRIM(file_get_type(cd_file)) 
    428497      ENDIF 
     498 
     499      ! create some global attribute 
     500      IF( TRIM(file_init%c_type) == 'cdf' )THEN 
     501         tl_att=att_init("Conventions","CF-1.5") 
     502         CALL file_add_att(file_init,tl_att) 
     503      ENDIF 
     504      
     505      tl_att=att_init("Grid",TRIM(file_init%c_grid)) 
     506      CALL file_add_att(file_init,tl_att) 
    429507 
    430508      IF( PRESENT(ld_wrt) )THEN 
     
    460538      ENDIF 
    461539 
     540      ! clean 
     541      CALL att_clean(tl_att) 
     542 
    462543   END FUNCTION file_init 
    463    !> @endcode 
    464544   !------------------------------------------------------------------- 
    465545   !> @brief  
     
    473553   ! 
    474554   !> @author J.Paul 
    475    !> - Nov, 2013- Initial Version 
    476    ! 
    477    !> @param[in] cd_file : file name 
     555   !> - November, 2013- Initial Version 
     556   ! 
     557   !> @param[in] cd_file   file name 
    478558   !> @return type of file 
    479559   !------------------------------------------------------------------- 
    480    !> @code 
    481560   CHARACTER(LEN=lc) FUNCTION file_get_type(cd_file) 
    482561      IMPLICIT NONE 
    483562      ! Argument       
    484563      CHARACTER(LEN=*), INTENT(IN) :: cd_file 
     564 
    485565      !local variable 
    486566      CHARACTER(LEN=lc) :: cl_suffix 
     
    490570      SELECT CASE( TRIM(fct_lower(cl_suffix)) ) 
    491571         CASE('.nc','.cdf') 
    492             CALL logger_debug(" GET TYPE: file "//TRIM(cd_file)//" is cdf") 
     572            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is cdf") 
    493573            file_get_type='cdf' 
    494574         CASE('.dimg') 
    495             CALL logger_debug(" GET TYPE: file "//TRIM(cd_file)//" is dimg" ) 
     575            CALL logger_debug(" FILE GET TYPE: file "//TRIM(cd_file)//" is dimg" ) 
    496576            file_get_type='dimg' 
    497577         CASE DEFAULT 
    498             CALL logger_warn(" GET TYPE: type unknown, we assume file: "//& 
     578            CALL logger_warn(" FILE GET TYPE: type unknown, we assume file: "//& 
    499579            &              TRIM(cd_file)//" is dimg ") 
    500580            file_get_type='dimg' 
     
    502582 
    503583   END FUNCTION file_get_type 
    504    !> @endcode 
    505584   !------------------------------------------------------------------- 
    506585   !> @brief This function check if variable dimension to be used  
     
    510589   ! 
    511590   !> @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 
     591   !> - November, 2013- Initial Version 
     592   ! 
     593   !> @param[in] td_file   file structure 
     594   !> @param[in] td_var    variable structure 
     595   !> @return true if dimension of variable and file structure agree 
     596   !------------------------------------------------------------------- 
    519597   LOGICAL FUNCTION file_check_var_dim(td_file, td_var) 
    520598      IMPLICIT NONE 
     
    524602 
    525603      ! local variable 
    526       INTEGER(i4) :: il_ndim 
     604      CHARACTER(LEN=lc) :: cl_dim 
     605      LOGICAL           :: ll_error 
     606 
     607      INTEGER(i4) :: il_ind 
    527608 
    528609      ! loop indices 
     
    530611      !---------------------------------------------------------------- 
    531612      file_check_var_dim=.TRUE. 
     613 
    532614      ! 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 
     615      ll_error=.FALSE. 
     616      DO ji=1,ip_maxdim 
     617         il_ind=dim_get_index( td_file%t_dim(:), & 
     618         &                     TRIM(td_var%t_dim(ji)%c_name), & 
     619         &                     TRIM(td_var%t_dim(ji)%c_sname)) 
     620         IF( il_ind /= 0 )THEN 
     621         IF( td_var%t_dim(ji)%l_use  .AND. & 
     622         &   td_file%t_dim(il_ind)%l_use .AND. & 
     623         &   td_var%t_dim(ji)%i_len /= td_file%t_dim(il_ind)%i_len )THEN 
     624            ll_error=.TRUE. 
     625         ENDIF 
     626         ENDIF 
     627      ENDDO 
     628 
     629      IF( ll_error )THEN 
    535630 
    536631         file_check_var_dim=.FALSE. 
     
    542637 
    543638 
    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))) 
     639         cl_dim='(/' 
     640         DO ji = 1, td_file%i_ndim 
     641            IF( td_file%t_dim(ji)%l_use )THEN 
     642               cl_dim=TRIM(cl_dim)//& 
     643               &  TRIM(fct_upper(td_file%t_dim(ji)%c_sname))//':'//& 
     644               &  TRIM(fct_str(td_file%t_dim(ji)%i_len))//',' 
     645            ENDIF 
    557646         ENDDO 
     647         cl_dim=TRIM(cl_dim)//'/)' 
     648         CALL logger_debug( " file dimension: "//TRIM(cl_dim) ) 
     649 
     650         cl_dim='(/' 
     651         DO ji = 1, td_var%i_ndim 
     652            IF( td_var%t_dim(ji)%l_use )THEN 
     653               cl_dim=TRIM(cl_dim)//& 
     654               &  TRIM(fct_upper(td_var%t_dim(ji)%c_sname))//':'//& 
     655               &  TRIM(fct_str(td_var%t_dim(ji)%i_len))//',' 
     656            ENDIF 
     657         ENDDO 
     658         cl_dim=TRIM(cl_dim)//'/)' 
     659         CALL logger_debug( " variable dimension: "//TRIM(cl_dim) ) 
     660 
    558661      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 
     662 
     663         IF( td_var%i_ndim >  td_file%i_ndim )THEN 
     664            CALL logger_info("FILE CHECK VAR DIM: variable "//& 
     665            &  TRIM(td_var%c_name)//" use more dimension than file "//& 
     666            &  TRIM(td_file%c_name)//" do until now.") 
     667         ENDIF 
     668 
    566669      ENDIF 
    567670 
    568671   END FUNCTION file_check_var_dim 
    569    !> @endcode    
    570672   !------------------------------------------------------------------- 
    571673   !> @brief This subroutine add a variable structure in a file structure.<br/> 
     
    577679   ! 
    578680   !> @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 
     681   !> - November, 2013- Initial Version 
     682   !> @date September, 2014 
     683   !> - add dimension to file if need be 
     684   !> - do not reorder dimension from variable, before put in file 
     685   ! 
     686   !> @param[inout] td_file   file structure 
     687   !> @param[in] td_var       variable structure 
     688   !------------------------------------------------------------------- 
    589689   SUBROUTINE file_add_var(td_file, td_var) 
    590690      IMPLICIT NONE 
     
    596696      ! local variable 
    597697      INTEGER(i4) :: il_status 
    598       INTEGER(i4) :: il_varid 
    599       INTEGER(i4) :: il_rec 
     698      !INTEGER(i4) :: il_rec 
    600699      INTEGER(i4) :: il_ind 
    601700 
     
    606705      !---------------------------------------------------------------- 
    607706      ! check if file opened 
    608       !IF( TRIM(td_file%c_name) == "unknown" )THEN 
    609707      IF( TRIM(td_file%c_name) == '' )THEN 
    610708 
    611          CALL logger_error( " ADD VAR: structure file unknown" ) 
    612          CALL logger_debug( " ADD VAR: you should have used file_init before "//& 
     709         CALL logger_error( " FILE ADD VAR: structure file unknown" ) 
     710         CALL logger_debug( " FILE ADD VAR: you should have used file_init before "//& 
    613711         & "running file_add_var" ) 
    614712 
     
    617715         IF( TRIM(td_var%c_name) == '' .AND. & 
    618716         &   TRIM(td_var%c_stdname) == '' )THEN 
    619             CALL logger_error(" ADD VAR: variable not define ") 
     717            CALL logger_error(" FILE ADD VAR: variable without name ") 
    620718         ELSE 
    621719            ! check if variable already in file structure 
    622             il_varid=0 
     720            il_ind=0 
    623721            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 ) 
     722               il_ind=var_get_index( td_file%t_var(:), td_var%c_name,   & 
     723               &                                       td_var%c_stdname ) 
    626724            ENDIF 
    627725 
    628             IF( il_varid /= 0 )THEN 
     726            IF( il_ind /= 0 )THEN 
    629727 
    630728               CALL logger_error( & 
    631                &  " ADD VAR: variable "//TRIM(td_var%c_name)//& 
     729               &  " FILE ADD VAR: variable "//TRIM(td_var%c_name)//& 
    632730               &  ", standard name "//TRIM(td_var%c_stdname)//& 
    633731               &  ", already in file "//TRIM(td_file%c_name) ) 
     
    641739            ELSE 
    642740 
    643                CALL logger_info( & 
    644                &  " ADD VAR: add variable "//TRIM(td_var%c_name)//& 
     741               CALL logger_trace( & 
     742               &  " FILE ADD VAR: add variable "//TRIM(td_var%c_name)//& 
    645743               &  ", standard name "//TRIM(td_var%c_stdname)//& 
    646744               &  ", in file "//TRIM(td_file%c_name) ) 
    647745 
    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  
    653746               ! check used dimension  
    654747               IF( file_check_var_dim(td_file, td_var) )THEN 
    655748 
     749                  ! update dimension if need be 
     750                  DO ji=1,ip_maxdim 
     751                     IF( td_var%t_dim(ji)%l_use .AND. & 
     752                     &   .NOT. td_file%t_dim(ji)%l_use )THEN 
     753                        CALL file_add_dim(td_file,td_var%t_dim(ji)) 
     754                     ENDIF 
     755                  ENDDO 
     756 
     757                  ! get index of new variable 
    656758                  SELECT CASE(td_var%i_ndim) 
    657759                     CASE(0) 
    658760                        il_ind=td_file%i_n0d+1 
    659                         il_rec=0 
     761                        !il_rec=0 
    660762                     CASE(1) 
    661763                        il_ind=td_file%i_n0d+td_file%i_n1d+1 
    662                         il_rec=1 
     764                        !il_rec=1 
    663765                     CASE(2) 
    664766                        il_ind=td_file%i_n0d+td_file%i_n1d+td_file%i_n2d+1 
    665                         il_rec=1 
     767                        !il_rec=1 
    666768                     CASE(3,4) 
    667769                        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 
     770                        !il_rec=td_file%t_dim(3)%i_len 
    669771                  END SELECT 
     772                  CALL logger_info( & 
     773                     &  " FILE ADD VAR: variable index "//TRIM(fct_str(il_ind))) 
    670774 
    671775                  IF( td_file%i_nvar > 0 )THEN 
     
    675779 
    676780                        CALL logger_error( & 
    677                         &  " ADD VAR: not enough space to put variables "//& 
     781                        &  " FILE ADD VAR: not enough space to put variables "//& 
    678782                        &  "from "//TRIM(td_file%c_name)//& 
    679783                        &  " in variable structure") 
     
    682786 
    683787                        ! save temporary variable of file structure 
    684                         tl_var(:)=td_file%t_var(:) 
    685  
    686                         DEALLOCATE( td_file%t_var ) 
     788                        tl_var(:)=var_copy(td_file%t_var(:)) 
     789 
     790                        CALL var_clean( td_file%t_var(:) ) 
     791                        DEALLOCATE(td_file%t_var) 
    687792                        ALLOCATE( td_file%t_var(td_file%i_nvar+1), & 
    688793                        &         stat=il_status) 
     
    690795 
    691796                           CALL logger_error( & 
    692                            &  " ADD VAR: not enough space to put variable "//& 
     797                           &  " FILE ADD VAR: not enough space to put variable "//& 
    693798                           &  "in file structure "//TRIM(td_file%c_name) ) 
    694799 
     
    697802                        ! copy variable in file before 
    698803                        ! 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  
     804                        IF( il_ind > 1 )THEN 
     805                           td_file%t_var( 1:il_ind-1 ) = var_copy(tl_var(1:il_ind-1)) 
     806                        ENDIF 
     807 
     808                        IF( il_ind < td_file%i_nvar )THEN 
     809                           ! variable with more dimension than new variable 
     810                           td_file%t_var( il_ind+1 : td_file%i_nvar+1 ) = & 
     811                           &        var_copy( tl_var(il_ind : td_file%i_nvar) ) 
     812                        ENDIF 
     813 
     814                        ! clean 
     815                        CALL var_clean(tl_var(:)) 
    713816                        DEALLOCATE(tl_var) 
    714817                     ENDIF 
     
    717820                  ! no variable in file structure 
    718821                     IF( ASSOCIATED(td_file%t_var) )THEN 
     822                        CALL var_clean(td_file%t_var(:)) 
    719823                        DEALLOCATE(td_file%t_var) 
    720824                     ENDIF 
     
    723827 
    724828                        CALL logger_error( & 
    725                         &  " ADD VAR: not enough space to put variable "//& 
     829                        &  " FILE ADD VAR: not enough space to put variable "//& 
    726830                        &  "in file structure "//TRIM(td_file%c_name) ) 
    727831 
     
    730834                  ENDIF 
    731835 
     836                  ! add new variable in array of variable 
    732837                  ALLOCATE( tl_var(1), stat=il_status ) 
    733838                  IF(il_status /= 0 )THEN 
    734839 
    735840                     CALL logger_error( & 
    736                      &  " ADD VAR: not enough space to put variables from "//& 
     841                     &  " FILE ADD VAR: not enough space to put variables from "//& 
    737842                     &  TRIM(td_var%c_name)//" in variable structure") 
    738843 
    739844                  ELSE 
    740                      tl_var(1)=td_var 
     845                     tl_var(1)=var_copy(td_var) 
    741846 
    742847                     ! update dimension name in new variable 
     
    744849                   
    745850                     ! add new variable 
    746                      td_file%t_var(il_ind)=tl_var(1) 
     851                     td_file%t_var(il_ind)=var_copy(tl_var(1)) 
    747852 
    748853                     ! update number of variable 
     
    755860                        CASE(2) 
    756861                           td_file%i_n2d=td_file%i_n2d+1 
    757                         CASE(3) 
     862                        CASE(3,4) 
    758863                           td_file%i_n3d=td_file%i_n3d+1 
    759864                     END SELECT 
    760865 
    761866                     ! 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 
     867                     td_file%t_var(il_ind)%i_id=var_get_unit(td_file%t_var(:)) 
    774868 
    775869                     ! update dimension used 
     
    780874                        ENDIF 
    781875                     ENDDO 
    782                      CALL dim_reorder(td_file%t_dim(:)) 
     876 
    783877                     ! update number of dimension 
    784878                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use) 
    785879 
    786                      DEALLOCATE( tl_var ) 
     880                     ! clean 
     881                     CALL var_clean( tl_var(:) ) 
     882                     DEALLOCATE(tl_var) 
    787883                  ENDIF 
    788  
    789884               ENDIF 
    790885            ENDIF 
     
    793888 
    794889   END SUBROUTINE file_add_var 
    795    !> @endcode 
    796890   !------------------------------------------------------------------- 
    797891   !> @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 
     892   !> in file structure, given variable name or standard name. 
     893   ! 
     894   !> @author J.Paul 
     895   !> - November, 2013- Initial Version 
     896   ! 
     897   !> @param[inout] td_file   file structure 
     898   !> @param[in] cd_name      variable name or standard name 
     899   !------------------------------------------------------------------- 
    809900   SUBROUTINE file__del_var_name(td_file, cd_name ) 
    810901      IMPLICIT NONE 
     
    815906 
    816907      ! local variable 
    817       INTEGER(i4)       :: il_varid 
     908      INTEGER(i4)       :: il_ind 
    818909      !---------------------------------------------------------------- 
    819910 
     
    821912      IF( TRIM(td_file%c_name) == '' )THEN 
    822913 
    823          CALL logger_error( " DEL VAR NAME: file structure unknown ") 
    824          CALL logger_debug( " DEL VAR NAME: you should have used file_init before "//& 
     914         CALL logger_error( " FILE DEL VAR NAME: file structure unknown ") 
     915         CALL logger_debug( " FILE DEL VAR NAME: you should have used file_init before "//& 
    825916         & "running file_del_var" ) 
    826917 
     
    829920         IF( td_file%i_nvar /= 0 )THEN 
    830921 
    831             ! get the variable id, in file variable structure 
    832             il_varid=0 
     922            ! get the variable index, in file variable structure 
     923            il_ind=0 
    833924            IF( ASSOCIATED(td_file%t_var) )THEN 
    834                il_varid=var_get_id(td_file%t_var(:), cd_name ) 
     925               il_ind=var_get_index(td_file%t_var(:), cd_name ) 
    835926            ENDIF 
    836             IF( il_varid /= 0 )THEN 
     927 
     928            IF( il_ind /= 0 )THEN 
    837929    
    838                CALL file_del_var(td_file, td_file%t_var(il_varid)) 
     930               CALL file_del_var(td_file, td_file%t_var(il_ind)) 
    839931 
    840932            ELSE 
    841933 
    842934               CALL logger_warn( & 
    843                &  " DEL VAR NAME: there is no variable with name or "//& 
     935               &  " FILE DEL VAR NAME: there is no variable with name or "//& 
    844936               &  "standard name "//TRIM(cd_name)//" in file "//& 
    845937               &  TRIM(td_file%c_name)) 
     
    848940 
    849941         ELSE 
    850             CALL logger_debug( " DEL VAR NAME: no variable associated to file "//& 
    851             &               TRIM(td_file%c_name) ) 
     942            CALL logger_debug( " FILE DEL VAR NAME: "//& 
     943            &        "no variable associated to file "//& 
     944            &        TRIM(td_file%c_name) ) 
    852945         ENDIF 
    853946 
     
    855948 
    856949   END SUBROUTINE file__del_var_name 
    857    !> @endcode 
    858950   !------------------------------------------------------------------- 
    859951   !> @brief This subroutine delete a variable structure  
    860952   !> 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 
     953   !> 
     954   !> @author J.Paul 
     955   !> - November, 2013- Initial Version 
     956   !> 
     957   !> @param[inout] td_file   file structure 
     958   !> @param[in] td_var       variable structure 
     959   !------------------------------------------------------------------- 
    873960   SUBROUTINE file__del_var_str(td_file, td_var) 
    874961      IMPLICIT NONE 
     
    880967      ! local variable 
    881968      INTEGER(i4) :: il_status 
    882       INTEGER(i4) :: il_varid 
     969      INTEGER(i4) :: il_ind 
    883970      INTEGER(i4) :: il_rec 
    884971      TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tl_var 
     
    889976 
    890977      ! check if file opened 
    891       !IF( TRIM(td_file%c_name) == "unknown" )THEN 
    892978      IF( TRIM(td_file%c_name) == '' )THEN 
    893979 
    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" )       
     980         CALL logger_error( " FILE DEL VAR: file structure unknown ") 
     981         CALL logger_debug( " FILE DEL VAR: you should have used "//& 
     982         &  "file_init before running file_del_var" )       
    897983 
    898984      ELSE 
    899985 
    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  
     986         ! check if variable is member of a file 
     987         IF( td_var%l_file )THEN 
     988            CALL logger_warn( & 
     989            &  " FILE DEL VAR: variable "//TRIM(td_var%c_name)//& 
     990            &  ", belong to file "//TRIM(td_file%c_name)//& 
     991            &  " and can not be removed.") 
     992         ELSE 
     993            ! check if variable already in file structure 
     994            il_ind=0 
     995            IF( ASSOCIATED(td_file%t_var) )THEN 
     996               il_ind=var_get_index( td_file%t_var(:), td_var%c_name, & 
     997               &                                       td_var%c_stdname ) 
     998            ENDIF 
     999 
     1000            IF( il_ind == 0 )THEN 
     1001 
     1002               CALL logger_warn( "FILE DEL VAR: no variable "//& 
     1003               &     TRIM(td_var%c_name)//", in file "//TRIM(td_file%c_name) ) 
     1004 
     1005               DO ji=1,td_file%i_nvar 
     1006                  CALL logger_debug( "FILE DEL VAR: in file "//& 
     1007                  &  TRIM(td_file%t_var(ji)%c_name)//", standard name "//& 
     1008                  &  TRIM(td_file%t_var(ji)%c_stdname) ) 
     1009               ENDDO 
     1010 
     1011            ELSE 
     1012                
     1013               CALL logger_trace( "FILE DEL VAR: delete variable "//& 
     1014               &  TRIM(td_var%c_name)//", from file "//TRIM(td_file%c_name) ) 
     1015 
     1016               ALLOCATE( tl_var(td_file%i_nvar-1), stat=il_status ) 
     1017               IF(il_status /= 0 )THEN 
     1018 
     1019                  CALL logger_error( & 
     1020                  &  " FILE DEL VAR: not enough space to put variables from "//& 
     1021                  &  TRIM(td_file%c_name)//" in temporary variable structure") 
     1022 
     1023               ELSE 
     1024 
     1025                  ! save temporary variable's file structure 
     1026                  IF( il_ind > 1 )THEN 
     1027                     tl_var(1:il_ind-1)=var_copy(td_file%t_var(1:il_ind-1)) 
     1028                  ENDIF 
     1029 
     1030                  IF( il_ind < td_file%i_nvar )THEN 
     1031                     tl_var(il_ind:)=var_copy(td_file%t_var(il_ind+1:)) 
     1032                  ENDIF 
     1033 
     1034                  ! new number of variable in file 
     1035                  td_file%i_nvar=td_file%i_nvar-1 
     1036 
     1037                  SELECT CASE(td_var%i_ndim) 
     1038                     CASE(0) 
     1039                        td_file%i_n0d=td_file%i_n0d-1 
     1040                        il_rec=0 
     1041                     CASE(1) 
     1042                        td_file%i_n1d=td_file%i_n1d-1 
     1043                        il_rec=1 
     1044                     CASE(2) 
     1045                        td_file%i_n2d=td_file%i_n2d-1 
     1046                        il_rec=1 
     1047                     CASE(3,4) 
     1048                        td_file%i_n3d=td_file%i_n3d-1 
     1049                        il_rec=td_file%t_dim(3)%i_len 
     1050                  END SELECT 
     1051 
     1052                  CALL var_clean( td_file%t_var(:) ) 
     1053                  DEALLOCATE(td_file%t_var) 
     1054 
     1055                  IF( td_file%i_nvar > 0 )THEN 
     1056                     ALLOCATE( td_file%t_var(td_file%i_nvar), stat=il_status ) 
     1057                     IF(il_status /= 0 )THEN 
     1058 
     1059                        CALL logger_error( " FILE DEL VAR: not enough space"//& 
     1060                        &  "to put variables in file structure "//& 
     1061                        &  TRIM(td_file%c_name) ) 
     1062 
     1063                     ENDIF 
     1064 
     1065                     ! copy attribute in file before 
     1066                     td_file%t_var(:)=var_copy(tl_var(:)) 
     1067 
     1068                     ! update dimension used 
     1069                     td_file%t_dim(:)%l_use=.FALSE. 
     1070                     DO ji=1,ip_maxdim 
     1071                        IF( ANY(td_file%t_var(:)%t_dim(ji)%l_use) )THEN 
     1072                           td_file%t_dim(ji)%l_use=.TRUE. 
     1073                        ENDIF 
     1074                     ENDDO 
     1075 
     1076                     ! update number of dimension 
     1077                     td_file%i_ndim=COUNT(td_file%t_dim(:)%l_use) 
     1078 
     1079                  ENDIF 
     1080 
     1081                  ! clean 
     1082                  CALL var_clean(tl_var(:)) 
     1083                  DEALLOCATE(tl_var) 
     1084                   
     1085               ENDIF  
     1086            ENDIF 
     1087         ENDIF 
     1088      ENDIF 
     1089 
     1090   END SUBROUTINE file__del_var_str 
     1091   !------------------------------------------------------------------- 
     1092   !> @brief This subroutine overwrite variable structure  
     1093   !> in file structure. 
     1094   ! 
     1095   !> @warning change variable id in file structure. 
     1096   ! 
     1097   !> @author J.Paul 
     1098   !> - November, 2013- Initial Version 
     1099   ! 
     1100   !> @param[inout] td_file   file structure 
     1101   !> @param[in] td_var       variable structure 
     1102   !------------------------------------------------------------------- 
     1103   SUBROUTINE file_move_var(td_file, td_var) 
     1104      IMPLICIT NONE 
     1105 
     1106      ! Argument       
     1107      TYPE(TFILE), INTENT(INOUT) :: td_file 
     1108      TYPE(TVAR),  INTENT(IN)    :: td_var 
     1109 
     1110      ! local variable 
     1111      TYPE(TVAR) :: tl_var 
     1112      !---------------------------------------------------------------- 
     1113 
     1114      ! copy variable 
     1115      tl_var=var_copy(td_var) 
     1116 
     1117      ! remove variable with same name or standard name 
     1118      CALL file_del_var(td_file, tl_var) 
     1119 
     1120      ! add new variable 
     1121      CALL file_add_var(td_file, tl_var) 
     1122 
     1123      ! clean 
     1124      CALL var_clean(tl_var) 
     1125 
     1126   END SUBROUTINE file_move_var 
     1127   !------------------------------------------------------------------- 
     1128   !> @brief This subroutine add a global attribute  
     1129   !> in a file structure.<br/> 
     1130   !> Do not overwrite, if attribute already in file structure. 
     1131   ! 
     1132   !> @author J.Paul 
     1133   !> - November, 2013- Initial Version 
     1134   ! 
     1135   !> @param[inout] td_file   file structure 
     1136   !> @param[in] td_att       attribute structure 
     1137   !------------------------------------------------------------------- 
     1138   SUBROUTINE file_add_att(td_file, td_att) 
     1139      IMPLICIT NONE 
     1140 
     1141      ! Argument       
     1142      TYPE(TFILE), INTENT(INOUT) :: td_file 
     1143      TYPE(TATT),  INTENT(IN)    :: td_att 
     1144 
     1145      ! local variable 
     1146      INTEGER(i4) :: il_status 
     1147      INTEGER(i4) :: il_ind 
     1148      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
     1149 
     1150      ! loop indices 
     1151      INTEGER(i4) :: ji 
     1152      !---------------------------------------------------------------- 
     1153 
     1154      ! check if file opened 
     1155      IF( TRIM(td_file%c_name) == '' )THEN 
     1156 
     1157         CALL logger_error( " FILE ADD ATT: file structure unknown ") 
     1158         CALL logger_debug( " FILE ADD ATT: you should have used file_init before "//& 
     1159         & "running file_add_att" )       
     1160 
     1161      ELSE 
     1162 
     1163         ! check if attribute already in file structure 
     1164         il_ind=0 
     1165         IF( ASSOCIATED(td_file%t_att) )THEN 
     1166            il_ind=att_get_index( td_file%t_att(:), td_att%c_name ) 
     1167         ENDIF 
     1168 
     1169         IF( il_ind /= 0 )THEN 
     1170          
    9041171            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 
     1172            &  " FILE ADD ATT: attribute "//TRIM(td_att%c_name)//& 
     1173            &  ", already in file "//TRIM(td_file%c_name) ) 
     1174 
     1175            DO ji=1,td_file%i_natt 
    9091176               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) ) 
     1177               &  " FILE ADD ATT: in file "//TRIM(td_file%t_att(ji)%c_name) ) 
    9121178            ENDDO 
    9131179 
     
    9151181             
    9161182            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)//& 
     1183            &  " FILE ADD ATT: add attribute "//TRIM(td_att%c_name)//& 
    11021184            &  ", in file "//TRIM(td_file%c_name) ) 
    11031185 
     
    11081190 
    11091191                  CALL logger_error( & 
    1110                   &  " ADD ATT: not enough space to put attributes from "//& 
     1192                  &  " FILE ADD ATT: not enough space to put attributes from "//& 
    11111193                  &  TRIM(td_file%c_name)//" in temporary attribute structure") 
    11121194 
     
    11141196 
    11151197                  ! save temporary global attribute's file structure 
    1116                   tl_att(:)=td_file%t_att(:) 
    1117  
    1118                   DEALLOCATE( td_file%t_att ) 
     1198                  tl_att(:)=att_copy(td_file%t_att(:)) 
     1199 
     1200                  CALL att_clean( td_file%t_att(:) ) 
     1201                  DEALLOCATE(td_file%t_att) 
    11191202                  ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status ) 
    11201203                  IF(il_status /= 0 )THEN 
    11211204 
    11221205                     CALL logger_error( & 
    1123                      &  " ADD ATT: not enough space to put attributes "//& 
     1206                     &  " FILE ADD ATT: not enough space to put attributes "//& 
    11241207                     &  "in file structure "//TRIM(td_file%c_name) ) 
    11251208 
     
    11271210 
    11281211                  ! copy attribute in file before 
    1129                   td_file%t_att(1:td_file%i_natt)=tl_att(:) 
    1130  
     1212                  td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:)) 
     1213 
     1214                   ! clean 
     1215                  CALL att_clean(tl_att(:)) 
    11311216                  DEALLOCATE(tl_att) 
     1217 
    11321218               ENDIF 
    11331219            ELSE 
    11341220            ! no attribute in file structure 
    11351221               IF( ASSOCIATED(td_file%t_att) )THEN 
     1222                  CALL att_clean(td_file%t_att(:)) 
    11361223                  DEALLOCATE(td_file%t_att) 
    11371224               ENDIF 
    1138                CALL logger_debug(" natt "//TRIM(fct_str(td_file%i_natt)) ) 
     1225 
    11391226               ALLOCATE( td_file%t_att(td_file%i_natt+1), stat=il_status ) 
    11401227               IF(il_status /= 0 )THEN 
    11411228 
    11421229                  CALL logger_error( & 
    1143                   &  " ADD ATT: not enough space to put attributes "//& 
     1230                  &  " FILE ADD ATT: not enough space to put attributes "//& 
    11441231                  &  "in file structure "//TRIM(td_file%c_name) ) 
    11451232 
    11461233               ENDIF 
    11471234            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 
     1235            ! add new attribute 
     1236            td_file%t_att(td_file%i_natt+1)=att_copy(td_att) 
    11531237 
    11541238            ! update number of attribute 
     
    11581242 
    11591243   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 
     1244   !------------------------------------------------------------------- 
     1245   !> @brief This subroutine delete a global attribute structure  
     1246   !> in file structure, given attribute name. 
     1247   ! 
     1248   !> @author J.Paul 
     1249   !> - November, 2013- Initial Version 
     1250   ! 
     1251   !> @param[inout] td_file   file structure 
     1252   !> @param[in] cd_name      attribute name 
     1253   !------------------------------------------------------------------- 
    11741254   SUBROUTINE file__del_att_name(td_file, cd_name ) 
    11751255      IMPLICIT NONE 
     
    11801260 
    11811261      ! local variable 
    1182       INTEGER(i4)       :: il_attid 
     1262      INTEGER(i4)       :: il_ind 
    11831263      !---------------------------------------------------------------- 
    11841264 
     
    11861266      IF( TRIM(td_file%c_name) == '' )THEN 
    11871267 
    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" ) 
     1268         CALL logger_error( " FILE DEL ATT NAME: file structure unknown ") 
     1269         CALL logger_debug( " FILE DEL ATT NAME: you should have "//& 
     1270         &  "used file_init before running file_del_att" ) 
    11911271 
    11921272      ELSE 
     
    11951275 
    11961276            ! get the variable id, in file variable structure 
    1197             il_attid=0 
     1277            il_ind=0 
    11981278            IF( ASSOCIATED(td_file%t_att) )THEN 
    1199                il_attid=att_get_id(td_file%t_att(:), cd_name ) 
     1279               il_ind=att_get_index(td_file%t_att(:), cd_name ) 
    12001280            ENDIF 
    1201             IF( il_attid /= 0 )THEN 
     1281 
     1282            IF( il_ind /= 0 )THEN 
    12021283    
    1203                CALL file_del_att(td_file, td_file%t_att(il_attid)) 
     1284               CALL file_del_att(td_file, td_file%t_att(il_ind)) 
    12041285 
    12051286            ELSE 
    12061287 
    12071288               CALL logger_warn( & 
    1208                &  " DEL ATT NAME: there is no attribute with name "//& 
     1289               &  " FILE DEL ATT NAME: there is no attribute with name "//& 
    12091290               &  TRIM(cd_name)//" in file "//TRIM(td_file%c_name)) 
    12101291 
     
    12121293 
    12131294         ELSE 
    1214             CALL logger_debug( " DEL ATT NAME: no attribute associated to file "//& 
    1215             &               TRIM(td_file%c_name) ) 
     1295            CALL logger_debug( " FILE DEL ATT NAME: no attribute "//& 
     1296            &  "associated to file "//TRIM(td_file%c_name) ) 
    12161297         ENDIF 
    12171298 
     
    12191300 
    12201301   END SUBROUTINE file__del_att_name 
    1221    !> @endcode 
    12221302   !------------------------------------------------------------------- 
    12231303   !> @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 
     1304   !> from file structure, given attribute structure. 
     1305   ! 
     1306   !> @author J.Paul 
     1307   !> - November, 2013- Initial Version 
     1308   ! 
     1309   !> @param[inout] td_file   file structure 
     1310   !> @param[in] td_att       attribute structure 
     1311   !------------------------------------------------------------------- 
    12351312   SUBROUTINE file__del_att_str(td_file, td_att) 
    12361313      IMPLICIT NONE 
     
    12421319      ! local variable 
    12431320      INTEGER(i4) :: il_status 
    1244       INTEGER(i4) :: il_attid 
     1321      INTEGER(i4) :: il_ind 
    12451322      TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att 
    12461323 
    12471324      ! loop indices 
    1248       INTEGER(i4) :: ji 
    12491325      !---------------------------------------------------------------- 
    12501326 
    12511327      ! check if file opened 
    1252       !IF( TRIM(td_file%c_name) == "unknown" )THEN 
    12531328      IF( TRIM(td_file%c_name) == '' )THEN 
    12541329 
    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" )       
     1330         CALL logger_error( " FILE DEL ATT: file structure unknown ") 
     1331         CALL logger_debug( " FILE DEL ATT: you should have used "//& 
     1332         &  "file_init before running file_del_att" )       
    12581333 
    12591334      ELSE 
    12601335 
    12611336         ! check if attribute already in file structure 
    1262          il_attid=0 
     1337         il_ind=0 
    12631338         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 
     1339            il_ind=att_get_index( td_file%t_att(:), td_att%c_name ) 
     1340         ENDIF 
     1341 
     1342         IF( il_ind == 0 )THEN 
    12681343 
    12691344            CALL logger_error( & 
    1270             &  " DEL ATT: no attribute "//TRIM(td_att%c_name)//& 
     1345            &  " FILE DEL ATT: no attribute "//TRIM(td_att%c_name)//& 
    12711346            &  ", in file "//TRIM(td_file%c_name) ) 
    12721347 
    12731348         ELSE 
    12741349             
    1275             CALL logger_debug( & 
    1276             &  " DEL ATT: del attribute "//TRIM(td_att%c_name)//& 
     1350            CALL logger_trace( & 
     1351            &  " FILE DEL ATT: del attribute "//TRIM(td_att%c_name)//& 
    12771352            &  ", in file "//TRIM(td_file%c_name) ) 
    12781353 
     
    12811356 
    12821357               CALL logger_error( & 
    1283                &  " ADD ATT: not enough space to put attributes from "//& 
     1358               &  " FILE ADD ATT: not enough space to put attributes from "//& 
    12841359               &  TRIM(td_file%c_name)//" in temporary attribute structure") 
    12851360 
     
    12871362 
    12881363               ! 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 ) 
     1364               IF( il_ind > 1 )THEN 
     1365                  tl_att(1:il_ind-1)=att_copy(td_file%t_att(1:il_ind-1)) 
     1366               ENDIF 
     1367 
     1368               IF( il_ind < td_file%i_natt )THEN 
     1369                  tl_att(il_ind:)=att_copy(td_file%t_att(il_ind+1:)) 
     1370               ENDIF 
     1371 
     1372               CALL att_clean( td_file%t_att(:) ) 
     1373               DEALLOCATE(td_file%t_att) 
    12931374 
    12941375               ! new number of attribute in file 
     
    12991380 
    13001381                  CALL logger_error( & 
    1301                   &  " ADD ATT: not enough space to put attributes "//& 
     1382                  &  " FILE ADD ATT: not enough space to put attributes "//& 
    13021383                  &  "in file structure "//TRIM(td_file%c_name) ) 
    13031384 
     
    13051386 
    13061387               ! 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  
     1388               td_file%t_att(1:td_file%i_natt)=att_copy(tl_att(:)) 
     1389 
     1390               ! clean  
     1391               CALL att_clean(tl_att(:)) 
    13141392               DEALLOCATE(tl_att) 
     1393 
    13151394            ENDIF  
    13161395         ENDIF 
     
    13181397 
    13191398   END SUBROUTINE file__del_att_str 
    1320    !> @endcode 
    13211399   !------------------------------------------------------------------- 
    13221400   !> @brief This subroutine move a global attribute structure  
    13231401   !> 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 
     1402   !> @warning change attribute id in file structure. 
     1403   ! 
     1404   !> @author J.Paul 
     1405   !> - November, 2013- Initial Version 
     1406   ! 
     1407   !> @param[inout] td_file   file structure 
     1408   !> @param[in] td_att       attribute structure 
     1409   !------------------------------------------------------------------- 
    13361410   SUBROUTINE file_move_att(td_file, td_att) 
    13371411      IMPLICIT NONE 
     
    13431417      ! local variable 
    13441418      TYPE(TATT)  :: tl_att 
    1345       INTEGER(i4) :: il_attid 
     1419      INTEGER(i4) :: il_ind 
    13461420      !---------------------------------------------------------------- 
    13471421 
    13481422      ! copy attribute 
    1349       tl_att=td_att 
     1423      tl_att=att_copy(td_att) 
    13501424 
    13511425      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 
     1426         il_ind=att_get_index(td_file%t_att(:),TRIM(tl_att%c_name)) 
     1427         IF( il_ind /= 0 )THEN 
    13541428            ! remove attribute with same name 
    13551429            CALL file_del_att(td_file, tl_att) 
     
    13601434      CALL file_add_att(td_file, tl_att) 
    13611435 
     1436       ! clean 
     1437       CALL att_clean(tl_att) 
     1438 
    13621439   END SUBROUTINE file_move_att 
    1363    !> @endcode 
    13641440   !------------------------------------------------------------------- 
    13651441   !> @brief This subroutine add a dimension structure in file  
     
    13671443   !> Do not overwrite, if dimension already in file structure. 
    13681444   ! 
    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 
     1445   !> @author J.Paul 
     1446   !> - November, 2013- Initial Version 
     1447   !> @date September, 2014 
     1448   !> - do not reorder dimension, before put in file 
     1449   ! 
     1450   !> @param[inout] td_file   file structure 
     1451   !> @param[in] td_dim       dimension structure 
     1452   !------------------------------------------------------------------- 
    13801453   SUBROUTINE file_add_dim(td_file, td_dim) 
    13811454      IMPLICIT NONE 
    13821455 
    13831456      ! Argument       
    1384       TYPE(TFILE), INTENT(INOUT) :: td_file 
    1385       TYPE(TDIM),  INTENT(IN)    :: td_dim 
    1386  
    1387       ! local variable 
    1388       INTEGER(i4) :: il_dimid 
     1457      TYPE(TFILE)     , INTENT(INOUT) :: td_file 
     1458      TYPE(TDIM)      , INTENT(IN   ) :: td_dim 
     1459 
     1460      ! local variable 
     1461      INTEGER(i4) :: il_ind 
     1462 
     1463      ! loop indices 
     1464      INTEGER(i4) :: ji 
    13891465      !---------------------------------------------------------------- 
    13901466      ! check if file opened 
    1391       !IF( TRIM(td_file%c_name) == "unknown" )THEN 
    13921467      IF( TRIM(td_file%c_name) == '' )THEN 
    13931468 
    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" )       
     1469         CALL logger_error( " FILE ADD DIM: file structure unknown ") 
     1470         CALL logger_debug( " FILE ADD DIM: you should have used "//& 
     1471         &  "file_init before running file_add_dim" )       
    13971472 
    13981473      ELSE 
    13991474 
    1400          IF( td_file%i_ndim <= 4 )THEN 
     1475         IF( td_file%i_ndim <= ip_maxdim )THEN 
    14011476 
    14021477            ! 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 
     1478            il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname) 
     1479            IF( il_ind /= 0 )THEN 
     1480               IF( td_file%t_dim(il_ind)%l_use )THEN 
    14111481                  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 ") 
     1482                  &  "FILE ADD DIM: dimension "//TRIM(td_dim%c_name)//& 
     1483                  &  ", short name "//TRIM(td_dim%c_sname)//& 
     1484                  &  ", already used in file "//TRIM(td_file%c_name) ) 
     1485               ELSE 
     1486                  ! replace dimension 
     1487                  td_file%t_dim(il_ind)=dim_copy(td_dim) 
     1488                  td_file%t_dim(il_ind)%i_id=il_ind 
     1489                  td_file%t_dim(il_ind)%l_use=.TRUE. 
    14151490               ENDIF 
    1416  
    14171491            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 
     1492               IF( td_file%i_ndim == ip_maxdim )THEN 
     1493                  CALL logger_error( & 
     1494                  &  "FILE ADD DIM: can not add dimension "//TRIM(td_dim%c_name)//& 
     1495                  &  ", short name "//TRIM(td_dim%c_sname)//& 
     1496                  &  ", in file "//TRIM(td_file%c_name)//". Already "//& 
     1497                  &  TRIM(fct_str(ip_maxdim))//" dimensions." ) 
     1498               ELSE 
    14251499                  ! 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. 
     1500                  DO ji=1,ip_maxdim 
     1501                     IF( td_file%t_dim(ji)%i_id == 0 )THEN 
     1502                        il_ind=ji  
     1503                        EXIT 
     1504                     ENDIF 
     1505                  ENDDO 
     1506  
     1507                  ! add new dimension     
     1508                  td_file%t_dim(il_ind)=dim_copy(td_dim) 
    14391509                  ! update number of attribute 
    14401510                  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                 
     1511 
     1512                  td_file%t_dim(il_ind)%i_id=td_file%i_ndim 
     1513                  td_file%t_dim(il_ind)%l_use=.TRUE. 
     1514               ENDIF                
    14461515            ENDIF 
     1516 
    14471517         ELSE 
    14481518            CALL logger_error( & 
    1449             &  " ADD DIM: too much dimension in file "//& 
     1519            &  " FILE ADD DIM: too much dimension in file "//& 
    14501520            &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")") 
    14511521         ENDIF 
     
    14541524 
    14551525   END SUBROUTINE file_add_dim 
    1456    !> @endcode 
    14571526   !------------------------------------------------------------------- 
    14581527   !> @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 
     1528   !> structure. 
     1529   !> 
     1530   !> @author J.Paul 
     1531   !> - November, 2013- Initial Version 
     1532   ! 
     1533   !> @param[inout] td_file   file structure 
     1534   !> @param[in] td_dim       dimension structure 
     1535   !------------------------------------------------------------------- 
    14721536   SUBROUTINE file_del_dim(td_file, td_dim) 
    14731537      IMPLICIT NONE 
    14741538 
    14751539      ! Argument       
    1476       TYPE(TFILE), INTENT(INOUT) :: td_file 
    1477       TYPE(TDIM),  INTENT(IN)    :: td_dim 
     1540      TYPE(TFILE)     , INTENT(INOUT) :: td_file 
     1541      TYPE(TDIM)      , INTENT(IN   ) :: td_dim 
    14781542 
    14791543      ! local variable 
    14801544      INTEGER(i4) :: il_status 
    1481       INTEGER(i4) :: il_dimid 
     1545      INTEGER(i4) :: il_ind 
     1546 
    14821547      TYPE(TDIM), DIMENSION(:), ALLOCATABLE  :: tl_dim 
     1548 
     1549      ! loop indices 
     1550      INTEGER(i4) :: ji 
    14831551      !---------------------------------------------------------------- 
    14841552      ! check if file opened 
    1485       !IF( TRIM(td_file%c_name) == "unknown" )THEN 
    14861553      IF( TRIM(td_file%c_name) == '' )THEN 
    14871554 
    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" )       
     1555         CALL logger_error( " FILE DEL DIM: file structure unknown ") 
     1556         CALL logger_debug( " FILE DEL DIM: you should have used "//& 
     1557         &  "file_init before running file_del_dim" )       
    14911558 
    14921559      ELSE 
    14931560 
    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 
     1561         ! check if dimension already in file structure 
     1562         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_sname) 
     1563         IF( il_ind == 0 )THEN 
     1564 
     1565            CALL logger_error( & 
     1566            &  "FILE DEL DIM: no dimension "//TRIM(td_dim%c_name)//& 
     1567            &  ", short name "//TRIM(td_dim%c_sname)//& 
     1568            &  ", in file "//TRIM(td_file%c_name) ) 
     1569 
     1570         ELSE 
     1571            ALLOCATE( tl_dim(td_file%i_ndim-1), stat=il_status ) 
     1572            IF(il_status /= 0 )THEN 
    14991573 
    15001574               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  
     1575               &  "FILE DEL DIM: not enough space to put dimensions from "//& 
     1576               &  TRIM(td_file%c_name)//" in temporary dimension structure") 
     1577 
     1578            ELSE             
     1579               ! save temporary dimension's mpp structure 
     1580               tl_dim( 1 : il_ind-1 ) = dim_copy(td_file%t_dim(1 : il_ind-1)) 
     1581               tl_dim( il_ind : td_file%i_ndim-1 ) = & 
     1582               &      dim_copy(td_file%t_dim(il_ind+1 : td_file%i_ndim)) 
     1583 
     1584               ! remove dimension from file 
     1585               CALL dim_clean(td_file%t_dim(:)) 
     1586               ! copy dimension in file, except one 
     1587               td_file%t_dim(1:td_file%i_ndim)=dim_copy(tl_dim(:)) 
     1588 
     1589               ! update number of dimension 
     1590               td_file%i_ndim=td_file%i_ndim-1 
     1591 
     1592               ! update dimension id 
     1593               DO ji=1,td_file%i_ndim 
     1594                  td_file%t_dim(ji)%i_id=ji 
     1595               ENDDO 
     1596 
     1597               ! clean 
     1598               CALL dim_clean(tl_dim(:)) 
     1599               DEALLOCATE(tl_dim) 
    15621600            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  
     1601         ENDIF 
    15691602      ENDIF 
    15701603 
    15711604   END SUBROUTINE file_del_dim 
    1572    !> @endcode 
    15731605   !------------------------------------------------------------------- 
    15741606   !> @brief This subroutine move a dimension structure  
    15751607   !> 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 
     1608   !> @warning change dimension order in file structure.  
     1609   ! 
     1610   !> @author J.Paul 
     1611   !> - November, 2013- Initial Version 
     1612   ! 
     1613   !> @param[inout] td_file   file structure 
     1614   !> @param[in] td_dim       dimension structure 
     1615   !------------------------------------------------------------------- 
    15881616   SUBROUTINE file_move_dim(td_file, td_dim) 
    15891617      IMPLICIT NONE 
    15901618 
    15911619      ! Argument       
    1592       TYPE(TFILE), INTENT(INOUT) :: td_file 
    1593       TYPE(TDIM),  INTENT(IN)    :: td_dim 
    1594  
    1595       ! local variable 
    1596       TYPE(TDIM)  :: tl_dim 
     1620      TYPE(TFILE)     , INTENT(INOUT) :: td_file 
     1621      TYPE(TDIM)      , INTENT(IN   ) :: td_dim 
     1622 
     1623      ! local variable 
     1624      INTEGER(i4) :: il_ind 
    15971625      INTEGER(i4) :: il_dimid 
    15981626      !---------------------------------------------------------------- 
    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) 
     1627      IF( td_file%i_ndim <= ip_maxdim )THEN 
     1628 
     1629         ! check if dimension already in mpp structure 
     1630         il_ind=dim_get_index(td_file%t_dim(:), td_dim%c_name, td_dim%c_sname) 
     1631         IF( il_ind /= 0 )THEN 
     1632 
     1633            il_dimid=td_file%t_dim(il_ind)%i_id 
     1634            ! replace dimension 
     1635            td_file%t_dim(il_ind)=dim_copy(td_dim) 
     1636            td_file%t_dim(il_ind)%i_id=il_dimid 
     1637            td_file%t_dim(il_ind)%l_use=.TRUE. 
     1638 
     1639         ELSE 
     1640            CALL file_add_dim(td_file, td_dim) 
     1641         ENDIF 
     1642 
     1643      ELSE 
     1644         CALL logger_error( & 
     1645         &  "FILE MOVE DIM: too much dimension in mpp "//& 
     1646         &  TRIM(td_file%c_name)//" ("//TRIM(fct_str(td_file%i_ndim))//")") 
     1647      ENDIF 
    16121648 
    16131649   END SUBROUTINE file_move_dim 
    1614    !> @endcode 
    16151650   !------------------------------------------------------------------- 
    16161651   !> @brief This subroutine print some information about file strucutre. 
    16171652   ! 
    16181653   !> @author J.Paul 
    1619    !> - Nov, 2013- Initial Version 
    1620    ! 
    1621    !> @param[in] td_file : file structure 
    1622    !------------------------------------------------------------------- 
    1623    !> @code 
     1654   !> - November, 2013- Initial Version 
     1655   ! 
     1656   !> @param[in] td_file   file structure 
     1657   !------------------------------------------------------------------- 
    16241658   SUBROUTINE file_print(td_file) 
    16251659      IMPLICIT NONE 
     
    16881722 
    16891723   END SUBROUTINE file_print 
    1690    !> @endcode 
    16911724   !------------------------------------------------------------------- 
    16921725   !> @brief This function get suffix of file name. 
    16931726   !> @details 
    16941727   !> we assume suffix is define as alphanumeric character following the 
    1695    !> last '.' in file name 
     1728   !> last '.' in file name.<br/> 
    16961729   !> If no suffix is found, return empty character. 
    16971730   ! 
    16981731   !> @author J.Paul 
    1699    !> - Nov, 2013- Initial Version 
    1700    ! 
    1701    !> @param[in] cd_file : file structure 
     1732   !> - November, 2013- Initial Version 
     1733   ! 
     1734   !> @param[in] cd_file   file structure 
    17021735   !> @return suffix 
    17031736   !------------------------------------------------------------------- 
    1704    !> @code 
    17051737   CHARACTER(LEN=lc) FUNCTION file__get_suffix(cd_file) 
    17061738      IMPLICIT NONE 
     
    17131745      !---------------------------------------------------------------- 
    17141746 
    1715       CALL logger_trace( "GET SUFFIX: look for suffix in file name "//& 
     1747      CALL logger_trace( "FILE GET SUFFIX: look for suffix in file name "//& 
    17161748      &               TRIM(cd_file) ) 
    17171749 
     
    17211753         READ( cd_file(il_ind:),'(a)' ) file__get_suffix 
    17221754 
    1723          IF( fct_is_num(file__get_suffix) )THEN 
     1755         IF( fct_is_num(file__get_suffix(2:)) )THEN 
    17241756            file__get_suffix='' 
    17251757         ENDIF 
     
    17301762 
    17311763   END FUNCTION file__get_suffix 
    1732    !> @endcode 
    17331764   !------------------------------------------------------------------- 
    17341765   !> @brief This function get number in file name without suffix. 
    17351766   !> @details 
    17361767   !> 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 
     1768   !> separator could be '.' or '_'. 
     1769   ! 
     1770   !> @author J.Paul 
     1771   !> - November, 2013- Initial Version 
     1772   ! 
     1773   !> @param[in] cd_file   file name (without suffix) 
     1774   !> @return character file number. 
     1775   !------------------------------------------------------------------- 
    17461776   CHARACTER(LEN=lc) FUNCTION file__get_number(cd_file) 
    17471777      IMPLICIT NONE 
     
    17601790      ! get number position in file name 
    17611791      il_indmax=0 
    1762       DO ji=1,ig_nsep 
    1763          il_ind=INDEX(TRIM(cd_file),TRIM(cg_sep(ji)),BACK=.TRUE.) 
     1792      DO ji=1,ip_nsep 
     1793         il_ind=INDEX(TRIM(cd_file),TRIM(cp_sep(ji)),BACK=.TRUE.) 
    17641794         IF( il_ind > il_indmax )THEN 
    17651795            il_indmax=il_ind 
     
    17791809 
    17801810   END FUNCTION file__get_number 
    1781    !> @endcode 
    1782    !------------------------------------------------------------------- 
    1783    !> @brief This function rename file name. 
     1811   !------------------------------------------------------------------- 
     1812   !> @brief This function rename file name, given processor number. 
    17841813   !> @details 
    17851814   !> If no processor number is given, return file name without number 
     
    17871816   ! 
    17881817   !> @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 
     1818   !> - November, 2013- Initial Version 
     1819   ! 
     1820   !> @param[in] td_file   file structure 
     1821   !> @param[in] id_num    processor number (start to 1) 
     1822   !> @return file name 
     1823   !------------------------------------------------------------------- 
    17961824   CHARACTER(LEN=lc) FUNCTION file__rename_char(cd_file, id_num) 
    17971825      IMPLICIT NONE 
     
    18411869         WRITE(file__rename_char,'(a,a)') TRIM(cl_base),TRIM(cl_suffix) 
    18421870      ENDIF 
    1843       CALL logger_trace(" RENAME : "//TRIM(file__rename_char)) 
     1871      CALL logger_trace(" FILE RENAME : "//TRIM(file__rename_char)) 
    18441872 
    18451873   END FUNCTION file__rename_char 
    1846    !> @endcode 
    18471874   !------------------------------------------------------------------- 
    18481875   !> @brief This function rename file name, given file structure. 
     
    18521879   ! 
    18531880   !> @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) 
     1881   !> - November, 2013- Initial Version 
     1882   ! 
     1883   !> @param[in] td_file   file structure 
     1884   !> @param[in] id_num   processor number (start to 1) 
    18581885   !> @return file structure 
    18591886   !------------------------------------------------------------------- 
    1860    !> @code 
    18611887   TYPE(TFILE) FUNCTION file__rename_str(td_file, id_num) 
    18621888      IMPLICIT NONE 
     
    18761902 
    18771903   END FUNCTION file__rename_str 
    1878    !> @endcode 
    18791904   !------------------------------------------------------------------- 
    18801905   !> @brief This function add suffix to file name. 
    18811906   ! 
    18821907   !> @author J.Paul 
    1883    !> - Nov, 2013- Initial Version 
    1884    ! 
    1885    !> @param[in] td_file : file structure 
    1886    !> @return file structure 
    1887    !------------------------------------------------------------------- 
    1888    !> @code 
     1908   !> - November, 2013- Initial Version 
     1909   ! 
     1910   !> @param[in] td_file   file structure 
     1911   !> @return file name 
     1912   !------------------------------------------------------------------- 
    18891913   CHARACTER(LEN=lc) FUNCTION file_add_suffix(cd_file, cd_type) 
    18901914      IMPLICIT NONE 
     
    19181942            ENDIF 
    19191943         CASE DEFAULT 
    1920             CALL logger_error( " ADD SUFFIX: type unknown "//TRIM(cd_type) ) 
     1944            CALL logger_error(" FILE ADD SUFFIX: type unknown "//TRIM(cd_type)) 
    19211945      END SELECT 
    19221946 
    19231947   END FUNCTION file_add_suffix 
    1924    !> @endcode 
    19251948   !------------------------------------------------------------------- 
    19261949   !> @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 ) 
     1950   !>  This subroutine clean file strcuture. 
     1951   ! 
     1952   !> @author J.Paul 
     1953   !> @date November, 2013 - Inital version 
     1954   ! 
     1955   !> @param[inout] td_file   file strcuture 
     1956   !------------------------------------------------------------------- 
     1957   SUBROUTINE file__clean_unit( td_file ) 
    19361958      IMPLICIT NONE 
    19371959      ! Argument 
     
    19421964 
    19431965      ! loop indices 
    1944       INTEGER(i4) :: ji 
    1945       !---------------------------------------------------------------- 
    1946  
    1947       CALL logger_info( & 
    1948       &  " CLEAN: reset file "//TRIM(td_file%c_name) ) 
     1966      !---------------------------------------------------------------- 
     1967 
     1968      CALL logger_trace( & 
     1969      &  " FILE CLEAN: reset file "//TRIM(td_file%c_name) ) 
    19491970 
    19501971      ! del attribute 
    19511972      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 ) 
     1973         CALL att_clean( td_file%t_att(:) ) 
     1974         DEALLOCATE(td_file%t_att) 
    19561975      ENDIF 
    19571976 
    19581977      ! del dimension 
    19591978      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 
     1979         CALL dim_clean( td_file%t_dim(:) ) 
    19631980      ENDIF 
    19641981 
    19651982      ! del variable 
    19661983      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 ) 
     1984         CALL var_clean( td_file%t_var(:) ) 
     1985         DEALLOCATE(td_file%t_var) 
    19711986      ENDIF 
    19721987 
    19731988      ! 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 
     1989      td_file=file_copy(tl_file) 
     1990 
     1991   END SUBROUTINE file__clean_unit 
     1992   !------------------------------------------------------------------- 
     1993   !> @brief  
     1994   !>  This subroutine clean file array of file strcuture. 
     1995   ! 
     1996   !> @author J.Paul 
     1997   !> @date Marsh, 2014 - Inital version 
     1998   ! 
     1999   !> @param[inout] td_file   array file strcuture 
     2000   !------------------------------------------------------------------- 
     2001   SUBROUTINE file__clean_arr( td_file ) 
     2002      IMPLICIT NONE 
     2003      ! Argument 
     2004      TYPE(TFILE), DIMENSION(:), INTENT(INOUT) :: td_file 
     2005 
     2006      ! local variable 
     2007      ! loop indices 
     2008      INTEGER(i4) :: ji 
     2009      !---------------------------------------------------------------- 
     2010 
     2011      DO ji=SIZE(td_file(:)),1,-1 
     2012         CALL file_clean(td_file(ji)) 
     2013      ENDDO 
     2014 
     2015   END SUBROUTINE file__clean_arr 
     2016   !------------------------------------------------------------------- 
     2017   !> @brief This function return the file id, in a array of file 
     2018   !> structure,  given file name.  
     2019   ! 
     2020   !> @author J.Paul 
     2021   !> - November, 2013- Initial Version 
     2022   ! 
     2023   !> @param[in] td_file   array of file structure 
     2024   !> @param[in] cd_name   file name 
     2025   !> @return file id in array of file structure (0 if not found) 
     2026   !------------------------------------------------------------------- 
    19902027   INTEGER(i4) FUNCTION file_get_id(td_file, cd_name) 
    19912028      IMPLICIT NONE 
     
    20032040      il_size=SIZE(td_file(:)) 
    20042041 
    2005       ! check if file is in table of file structure 
     2042      ! check if file is in array of file structure 
    20062043      DO ji=1,il_size 
    20072044         ! look for file name 
    2008          CALL logger_debug(" cd_name "//TRIM(fct_lower(cd_name)) ) 
    20092045         IF( fct_lower(td_file(ji)%c_name) == fct_lower(cd_name) )THEN 
    20102046          
    2011             file_get_id=ji 
     2047            file_get_id=td_file(ji)%i_id 
    20122048            EXIT 
    20132049 
     
    20162052 
    20172053   END FUNCTION file_get_id 
    2018    !> @endcode 
     2054   !------------------------------------------------------------------- 
     2055   !> @brief 
     2056   !> This function get the next unused unit in array of file structure. 
     2057   !>  
     2058   !> @author J.Paul 
     2059   !> - September, 2014- Initial Version 
     2060   ! 
     2061   !> @param[in] td_file   array of file  
     2062   !------------------------------------------------------------------- 
     2063   FUNCTION file_get_unit(td_file) 
     2064      IMPLICIT NONE 
     2065      ! Argument 
     2066      TYPE(TFILE), DIMENSION(:), INTENT(IN   ) :: td_file 
     2067 
     2068      ! function 
     2069      INTEGER(i4) :: file_get_unit 
     2070 
     2071      ! local variable 
     2072      ! loop indices 
     2073      !---------------------------------------------------------------- 
     2074 
     2075      file_get_unit=MAXVAL(td_file(:)%i_id)+1 
     2076 
     2077   END FUNCTION file_get_unit 
    20192078END MODULE file 
    20202079 
Note: See TracChangeset for help on using the changeset viewer.