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 5075 for branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90 – NEMO

Ignore:
Timestamp:
2015-02-11T11:50:34+01:00 (9 years ago)
Author:
timgraham
Message:

Upgraded branch to current head of trunk (r5072) so it can be used with the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/TOOLS/SIREN/src/iom_cdf.f90

    r4213 r5075  
    66! 
    77! DESCRIPTION: 
    8 !> @brief 
    9 !> This module is a library to read/write Netcdf file. 
     8!> @brief NETCDF Input/Output manager :  Library to read Netcdf input files 
    109!> 
    1110!> @details 
    12 !> 
    1311!>    to open netcdf file:<br/> 
     12!> @code 
    1413!>    CALL iom_cdf_open(td_file) 
    15 !>       - td_file is file structure (see file.f90) 
     14!> @endcode 
     15!>       - td_file is file structure (see @ref file) 
    1616!> 
    1717!>    to write in netcdf file:<br/> 
     18!> @code 
    1819!>    CALL  iom_cdf_write_file(td_file) 
     20!> @endcode 
    1921!> 
    2022!>    to close netcdf file:<br/> 
     23!> @code 
    2124!>    CALL iom_cdf_close(tl_file) 
     25!> @endcode 
    2226!> 
    2327!>    to read one dimension in netcdf file:<br/> 
    24 !>    tl_dim = iom_cdf_read_dim(tl_file, id_dimid)<br/> 
    25 !>    or<br/> 
     28!> @code 
     29!>    tl_dim = iom_cdf_read_dim(tl_file, id_dimid) 
     30!> @endcode 
     31!>    or 
     32!> @code 
    2633!>    tl_dim = iom_cdf_read_dim(tl_file, cd_name) 
     34!> @endcode 
    2735!>       - id_dimid is dimension id<br/> 
    2836!>       - cd_name is dimension name 
    2937!> 
    30 !>    to read one global attribute in netcdf file:<br/> 
    31 !>    tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid)<br/> 
    32 !>    or<br/> 
     38!>    to read one attribute in netcdf file:<br/> 
     39!> @code 
     40!>    tl_att = iom_cdf_read_att(tl_file, id_varid, id_attid) 
     41!> @endcode 
     42!>    or 
     43!> @code 
    3344!>    tl_att = iom_cdf_read_att(tl_file, id_varid, cd_name) 
     45!> @endcode 
    3446!>       - id_varid is variable id 
    3547!>       - id_attid is attribute id<br/> 
     
    3749!>     
    3850!>    to read one variable in netcdf file:<br/> 
    39 !>    tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count])<br/> 
    40 !>    or<br/> 
    41 !>    tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]] [cd_stdname]) 
     51!> @code 
     52!>    tl_var = iom_cdf_read_var(td_file, id_varid, [id_start, id_count]) 
     53!> @endcode 
     54!>    or 
     55!> @code 
     56!>    tl_var = iom_cdf_read_var(td_file, cd_name, [id_start, [id_count,]]) 
     57!> @endcode 
    4258!>       - id_varid is variabale id 
    4359!>       - cd_name is variabale name 
    44 !>       - id_start is a integer(4) 1D table of index from which the data  
    45 !>          values will be read (optional) 
    46 !>       - id_count is a integer(4) 1D table of the number of indices selected 
    47 !>          along each dimension (optional) 
    48 !>       - cd_stdname is variable standard name (optional) 
     60!>       - id_start is a integer(4) 1D array of index from which the data  
     61!>          values will be read [optional] 
     62!>       - id_count is a integer(4) 1D array of the number of indices selected 
     63!>          along each dimension [optional] 
    4964!> 
    5065!> @author 
    5166!> J.Paul 
    5267! REVISION HISTORY: 
    53 !> @date Nov, 2013 - Initial Version 
    54 ! 
    55 !> @param MyModule_type : brief_description 
     68!> @date November, 2013 - Initial Version 
    5669! 
    5770!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    58 ! 
    59 !> @todo  
    60 !> - inform variable pni, pnj, pnij, area, iglo, jglo  
    61 !> - use var_init when read new variable 
    62 !> - use dim_init when read new dimension 
    63 !> - use att_init when read new attribute 
    64 !> - add read td_dom 
    65 !> @todo 
    66 !> - voir si il ne faut pas redefinir (__copy) variable si elle vient de mpp 
    67 !> exemple CALL  mpp_move_var( td_mpp, td_mpp%t_var ) 
    6871!---------------------------------------------------------------------- 
    6972MODULE iom_cdf 
     
    7275   USE kind                            ! F90 kind parameter 
    7376   USE fct                             ! basic useful function 
    74    USE logger                             ! log file manager 
     77   USE logger                          ! log file manager 
    7578   USE att                             ! attribute manage 
    7679   USE dim                             ! dimension manager 
    7780   USE var                             ! variable manager 
    7881   USE file                            ! file manager 
    79    USE dom                             ! domain manager 
    80 !   USE proc                            ! processor manager 
    8182   IMPLICIT NONE 
    82    PRIVATE 
    8383   ! NOTE_avoid_public_variables_if_possible 
    8484 
     
    9191   PUBLIC :: iom_cdf_fill_var    !< fill variable value in an opened netcdf file 
    9292   PUBLIC :: iom_cdf_write_file  !< write file structure contents in an opened netcdf file 
    93    ! PUBLIC :: iom_cdf_get_mpp     ! get sub domain decomposition in a netcdf file 
    94  
    95    PRIVATE :: iom_cdf__check           !< provides a simple interface to netcdf error message 
    96    PRIVATE :: iom_cdf__get_info        !< get global information in an opened netcdf file 
    97    PRIVATE :: iom_cdf__get_file_dim    !< read dimension on an opened netcdf file, and reorder it 
    98    PRIVATE :: iom_cdf__get_file_att    !< read global attribute on an opened netcdf file 
    99    PRIVATE :: iom_cdf__get_file_var    !< read information about variable on an opened netcdf file 
    100    PRIVATE :: iom_cdf__read_dim_id     !< read one dimension in an opened netcdf file, given dimension id. 
    101    PRIVATE :: iom_cdf__read_dim_name   !< read one dimension in an opened netcdf file, given dimension name. 
    102    PRIVATE :: iom_cdf__read_att_name   !< read variable or global attribute in an opened netcdf file, given attribute name.  
    103    PRIVATE :: iom_cdf__read_att_id     !< read variable or global attribute in an opened netcdf file, given attribute id. 
    104    PRIVATE :: iom_cdf__read_var_id     !< read variable value in an opened netcdf file, given variable id. 
    105    PRIVATE :: iom_cdf__read_var_name   !< read variable value in an opened netcdf file, given variable name or standard name. 
    106    PRIVATE :: iom_cdf__read_var_meta   !< read metadata of a variable in an opened netcdf file. 
    107    PRIVATE :: iom_cdf__read_var_dim    !< read variable dimension in an opened netcdf file. 
    108    PRIVATE :: iom_cdf__read_var_att    !< read variable attributes in an opened netcdf file. 
    109    PRIVATE :: iom_cdf__read_var_value  !< read variable value in an opened netcdf file. 
    110    PRIVATE :: iom_cdf__write_dim       !< write one dimension in an opened netcdf file in write mode. 
    111    PRIVATE :: iom_cdf__write_att       !< write a variable attribute in an opened netcdf file. 
    112    PRIVATE :: iom_cdf__write_var       !< write a variable in an opened netcdf file. 
    113    PRIVATE :: iom_cdf__write_var_def   !< define variable in an opened netcdf file. 
    114    PRIVATE :: iom_cdf__write_var_value !< put variable value in an opened netcdf file. 
    115    PRIVATE :: iom_cdf__fill_var_id     !< fill variable value in an opened netcdf file, given variable id 
    116    PRIVATE :: iom_cdf__fill_var_name   !< fill variable value in an opened netcdf file, given variable name 
    117    PRIVATE :: iom_cdf__fill_var_all    !< fill all variable value in an opened netcdf file 
    118    PRIVATE :: iom_cdf__del_var_dim     !< remove variable dimension from an opened netcdf file 
     93 
     94   PRIVATE :: iom_cdf__check           ! provides a simple interface to netcdf error message 
     95   PRIVATE :: iom_cdf__get_info        ! get global information in an opened netcdf file 
     96   PRIVATE :: iom_cdf__get_file_dim    ! read dimension on an opened netcdf file, and reorder it 
     97   PRIVATE :: iom_cdf__get_file_att    ! read global attribute on an opened netcdf file 
     98   PRIVATE :: iom_cdf__get_file_var    ! read information about variable on an opened netcdf file 
     99   PRIVATE :: iom_cdf__read_dim_id     ! read one dimension in an opened netcdf file, given dimension id. 
     100   PRIVATE :: iom_cdf__read_dim_name   ! read one dimension in an opened netcdf file, given dimension name. 
     101   PRIVATE :: iom_cdf__read_att_name   ! read variable or global attribute in an opened netcdf file, given attribute name.  
     102   PRIVATE :: iom_cdf__read_att_id     ! read variable or global attribute in an opened netcdf file, given attribute id. 
     103   PRIVATE :: iom_cdf__read_var_id     ! read variable value in an opened netcdf file, given variable id. 
     104   PRIVATE :: iom_cdf__read_var_name   ! read variable value in an opened netcdf file, given variable name or standard name. 
     105   PRIVATE :: iom_cdf__read_var_meta   ! read metadata of a variable in an opened netcdf file. 
     106   PRIVATE :: iom_cdf__read_var_dim    ! read variable dimension in an opened netcdf file. 
     107   PRIVATE :: iom_cdf__read_var_att    ! read variable attributes in an opened netcdf file. 
     108   PRIVATE :: iom_cdf__read_var_value  ! read variable value in an opened netcdf file. 
     109   PRIVATE :: iom_cdf__write_dim       ! write one dimension in an opened netcdf file in write mode. 
     110   PRIVATE :: iom_cdf__write_att       ! write a variable attribute in an opened netcdf file. 
     111   PRIVATE :: iom_cdf__write_var       ! write a variable in an opened netcdf file. 
     112   PRIVATE :: iom_cdf__write_var_def   ! define variable in an opened netcdf file. 
     113   PRIVATE :: iom_cdf__write_var_value ! put variable value in an opened netcdf file. 
     114   PRIVATE :: iom_cdf__fill_var_id     ! fill variable value in an opened netcdf file, given variable id 
     115   PRIVATE :: iom_cdf__fill_var_name   ! fill variable value in an opened netcdf file, given variable name 
     116   PRIVATE :: iom_cdf__fill_var_all    ! fill all variable value in an opened netcdf file 
     117   PRIVATE :: iom_cdf__del_coord_var   ! remove coordinate variable from an opened netcdf file 
    119118 
    120119   INTERFACE iom_cdf_read_var 
     
    145144   !> 
    146145   !> @author J.Paul 
    147    !> - Nov, 2013- Initial Version 
    148    ! 
    149    !> @param[in] id_status : error status 
    150    !------------------------------------------------------------------- 
    151    !> @code 
     146   !> - November, 2013- Initial Version 
     147   ! 
     148   !> @param[in] id_status error status 
     149   !------------------------------------------------------------------- 
    152150   SUBROUTINE iom_cdf__check(id_status) 
    153151      IMPLICIT NONE 
     
    161159 
    162160   END SUBROUTINE iom_cdf__check 
    163    !> @endcode 
    164    !------------------------------------------------------------------- 
    165    !> @brief This subroutine open a netcdf file in read or write mode<br/> 
     161   !------------------------------------------------------------------- 
     162   !> @brief This subroutine open a netcdf file in read or write mode. 
     163   !> @details 
    166164   !> if try to open a file in write mode that did not exist, create it.<br/> 
    167    !> if file already exist, get information about: 
     165   !> if file already exist, get information about0:<br/> 
    168166   !> - the number of variables 
    169167   !> - the number of dimensions 
     
    171169   !> - the ID of the unlimited dimension 
    172170   !> - the file format 
    173    !> and finally read dimensions. 
     171   !> Finally it read dimensions, and 'longitude' variable to compute East-West 
     172   !> overlap. 
    174173   !> 
    175174   !> @author J.Paul 
    176    !> - Nov, 2013- Initial Version 
    177    ! 
    178    !> @param[inout] td_file : file structure 
    179    !------------------------------------------------------------------- 
    180    !> @code 
     175   !> - November, 2013- Initial Version 
     176   ! 
     177   !> @param[inout] td_file   file structure 
     178   !------------------------------------------------------------------- 
    181179   SUBROUTINE iom_cdf_open(td_file) 
    182180      IMPLICIT NONE 
     
    189187 
    190188      INTEGER(i4) :: il_status 
    191  
    192       TYPE(TVAR)  :: tl_lon 
    193       ! loop indices 
    194       INTEGER(i4) :: ji 
    195189      !---------------------------------------------------------------- 
    196190 
     
    202196         IF( .NOT. td_file%l_wrt )THEN 
    203197 
    204             CALL logger_fatal( " OPEN: can not open file "//& 
     198            CALL logger_fatal( " IOM CDF OPEN: can not open file "//& 
    205199            &               TRIM(td_file%c_name) ) 
    206             td_file%i_id=-1 
    207           
     200  
    208201         ELSE 
    209202 
    210             CALL logger_info( " CREATE: file "//TRIM(td_file%c_name) ) 
     203            CALL logger_info( " IOM CDF CREATE: file "//TRIM(td_file%c_name) ) 
    211204 
    212205            il_status = NF90_CREATE( TRIM(td_file%c_name),& 
     
    220213 
    221214      ELSE 
    222  
    223215         IF( td_file%i_id /= 0 )THEN 
    224216 
    225             CALL logger_error( " OPEN: file "//& 
     217            CALL logger_error( " IOM CDF OPEN: file "//& 
    226218            &               TRIM(td_file%c_name)//" already opened") 
    227219 
    228220         ELSE 
    229  
     221  
    230222            IF( .NOT. td_file%l_wrt )THEN 
    231223 
    232                CALL logger_info( " OPEN: file "//& 
     224               CALL logger_info( " IOM CDF OPEN: file "//& 
    233225               &              TRIM(td_file%c_name)//" in read only mode" ) 
    234226 
    235227               il_status = NF90_OPEN( TRIM(td_file%c_name), & 
    236                &                      NF90_NOWRITE,              & 
     228               &                      NF90_NOWRITE,         & 
    237229               &                      td_file%i_id) 
    238230               CALL iom_cdf__check(il_status) 
    239231 
    240                CALL logger_debug("OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id))) 
     232               CALL logger_trace("IOM CDF OPEN "//TRIM(td_file%c_name)//" "//TRIM(fct_str(td_file%i_id))) 
    241233            ELSE 
    242234 
    243                CALL logger_info( " OPEN: file "//& 
     235               CALL logger_info( "IOM CDF OPEN: file "//& 
    244236               &              TRIM(td_file%c_name)//" in write mode" ) 
    245237 
     
    263255            CALL iom_cdf__get_file_var(td_file) 
    264256 
    265             ! get ew overlap 
    266             tl_lon=iom_cdf_read_var(td_file,'longitude') 
    267             td_file%i_ew=dom_get_ew_overlap(tl_lon) 
    268             CALL logger_debug(" IOM OPEN EW "//TRIM(fct_str(td_file%i_ew)) ) 
    269             WHERE( td_file%t_var(:)%t_dim(1)%l_use ) 
    270                td_file%t_var(:)%i_ew=td_file%i_ew 
    271             END WHERE 
    272             CALL var_clean(tl_lon) 
    273  
    274             DO ji=1,td_file%i_nvar 
    275                CALL logger_debug(TRIM(td_file%t_var(ji)%c_name)//": "//TRIM(fct_str(td_file%t_var(ji)%i_ew)) ) 
    276             ENDDO 
    277   
    278257            ! remove dimension variable from list of variable 
    279             CALL iom_cdf__del_var_dim(td_file) 
     258            CALL iom_cdf__del_coord_var(td_file) 
    280259 
    281260         ENDIF 
     
    284263 
    285264   END SUBROUTINE iom_cdf_open 
    286    !> @endcode 
    287    !------------------------------------------------------------------- 
    288    !> @brief This subroutine close netcdf file 
     265   !------------------------------------------------------------------- 
     266   !> @brief This subroutine close netcdf file. 
    289267   !> 
    290268   !> @author J.Paul 
    291    !> - Nov, 2013- Initial Version 
    292    ! 
    293    !> @param[inout] td_file : file structure 
    294    !------------------------------------------------------------------- 
    295    !> @code 
     269   !> - November, 2013- Initial Version 
     270   ! 
     271   !> @param[inout] td_file   file structure 
     272   !------------------------------------------------------------------- 
    296273   SUBROUTINE iom_cdf_close(td_file) 
    297274      IMPLICIT NONE 
     
    307284 
    308285         CALL logger_error( & 
    309          &  " CLOSE: no id associated to file "//TRIM(td_file%c_name)) 
     286         &  " IOM CDF CLOSE: no id associated to file "//TRIM(td_file%c_name)) 
    310287 
    311288      ELSE 
    312289         CALL logger_info( & 
    313          &  " CLOSE: file "//TRIM(td_file%c_name)) 
     290         &  " IOM CDF CLOSE: file "//TRIM(td_file%c_name)) 
    314291 
    315292         il_status = NF90_CLOSE(td_file%i_id) 
     
    321298 
    322299   END SUBROUTINE iom_cdf_close 
    323    !> @endcode 
    324300   !------------------------------------------------------------------- 
    325301   !> @brief This subroutine get global information in an opened netcdf  
    326    !> file.<br/> 
     302   !> file. 
    327303   !> @details 
    328304   !> It gets the number of variables, the number of dimensions,  
     
    331307   !> 
    332308   !> @author J.Paul 
    333    !> - Nov, 2013- Initial Version 
    334    ! 
    335    !> @param[inout] td_file : file structure 
    336    !> @return file structure completed  
    337    !------------------------------------------------------------------- 
    338    !> @code 
     309   !> - November, 2013- Initial Version 
     310   ! 
     311   !> @param[inout] td_file   file structure 
     312   !------------------------------------------------------------------- 
    339313   SUBROUTINE iom_cdf__get_info(td_file) 
    340314      IMPLICIT NONE 
     
    348322 
    349323      CALL logger_trace( & 
    350       &  " GET INFO: about netcdf file "//TRIM(td_file%c_name)) 
     324      &  " IOM CDF GET INFO: about netcdf file "//TRIM(td_file%c_name)) 
    351325 
    352326      il_status=NF90_INQUIRE(td_file%i_id, td_file%i_ndim, & 
     
    365339 
    366340   END SUBROUTINE iom_cdf__get_info 
    367    !> @endcode 
    368341   !------------------------------------------------------------------- 
    369342   !> @brief This subroutine read dimension on an opened netcdf file, and 
    370    !> reorder dimension to ('x', 'y', 'z', 't').<br/> 
     343   !> reorder dimension to ('x', 'y', 'z', 't'). 
    371344   !> The dimension structure inside file structure is then completed. 
    372345   ! 
    373346   !> @author J.Paul 
    374    !> - Nov, 2013- Initial Version 
    375    ! 
    376    !> @param[inout] td_file : file structure 
    377    !> @return file structure completed  
    378    !------------------------------------------------------------------- 
    379    !> @code 
     347   !> - November, 2013- Initial Version 
     348   ! 
     349   !> @param[inout] td_file   file structure 
     350   !------------------------------------------------------------------- 
    380351   SUBROUTINE iom_cdf__get_file_dim(td_file) 
    381352      IMPLICIT NONE 
     
    401372         IF( td_file%i_uldid == -1 )THEN 
    402373            CALL logger_warn( & 
    403             &  " GET FILE DIM: there is no unlimited dimension in file "//& 
     374            &  " IOM CDF GET FILE DIM: there is no unlimited dimension in file "//& 
    404375            &  TRIM(td_file%c_name)) 
    405376         ELSE 
     
    410381 
    411382         CALL logger_warn( & 
    412          &  " GET FILE DIM: there is no dimension in file "//& 
     383         &  " IOM CDF GET FILE DIM: there is no dimension in file "//& 
    413384         &  TRIM(td_file%c_name)) 
    414385 
     
    419390 
    420391   END SUBROUTINE iom_cdf__get_file_dim 
    421    !> @endcode 
    422392   !------------------------------------------------------------------- 
    423393   !> @brief This subroutine read global attribute on an opened netcdf  
    424    !> file.<br/> 
     394   !> file. 
    425395   !> The attribute structure inside file structure is then completed. 
    426396   ! 
    427397   !> @author J.Paul 
    428    !> - Nov, 2013- Initial Version 
    429    ! 
    430    !> @param[inout] td_file : file structure 
    431    !> @return file structure completed  
    432    !------------------------------------------------------------------- 
    433    !> @code 
     398   !> - November, 2013- Initial Version 
     399   !> @date September, 2014 
     400   !> - use attribute periodicity read from the file if present. 
     401   ! 
     402   !> @param[inout] td_file   file structure 
     403   !------------------------------------------------------------------- 
    434404   SUBROUTINE iom_cdf__get_file_att(td_file) 
    435405      IMPLICIT NONE 
     
    437407      TYPE(TFILE), INTENT(INOUT) :: td_file 
    438408 
     409      ! local variable 
    439410      ! loop indices 
    440411      INTEGER(i4) :: ji 
     
    443414      IF( td_file%i_natt > 0 )THEN 
    444415         IF(ASSOCIATED(td_file%t_att))THEN 
     416            CALL att_clean(td_file%t_att(:)) 
    445417            DEALLOCATE(td_file%t_att) 
    446418         ENDIF 
     
    451423            td_file%t_att(ji)=iom_cdf_read_att( td_file, NF90_GLOBAL, ji) 
    452424             
    453             SELECT CASE(TRIM(td_file%t_att(ji)%c_name)) 
    454                CASE('periodicity') 
    455                   td_file%i_perio=INT(td_file%t_att(ji)%d_value(1),i4) 
    456                CASE('pivot_point') 
    457                   td_file%i_pivot=INT(td_file%t_att(ji)%d_value(1),i4) 
    458                CASE('ew_overlap') 
    459                   td_file%i_ew=INT(td_file%t_att(ji)%d_value(1),i4) 
    460             END SELECT 
    461  
    462425         ENDDO 
    463426 
    464427      ELSE 
    465428         CALL logger_debug( & 
    466          &  " GET FILE ATT: there is no global attribute in file "//& 
     429         &  " IOM CDF GET FILE ATT: there is no global attribute in file "//& 
    467430         &  TRIM(td_file%c_name)) 
    468431      ENDIF 
    469432 
    470433   END SUBROUTINE iom_cdf__get_file_att 
    471    !> @endcode    
    472434   !------------------------------------------------------------------- 
    473435   !> @brief This subroutine read information about variable of an  
    474    !> opened netcdf file.<br/> 
     436   !> opened netcdf file. 
    475437   !> The variable structure inside file structure is then completed. 
    476438   !> @note variable value are not read ! 
    477439   ! 
    478440   !> @author J.Paul 
    479    !> - Nov, 2013- Initial Version 
    480    ! 
    481    !> @param[inout] td_file : file structure 
    482    !> @return file structure completed  
    483    !------------------------------------------------------------------- 
    484    !> @code 
     441   !> - November, 2013- Initial Version 
     442   ! 
     443   !> @param[inout] td_file   file structure 
     444   !------------------------------------------------------------------- 
    485445   SUBROUTINE iom_cdf__get_file_var(td_file) 
    486446      IMPLICIT NONE 
     
    497457      IF( td_file%i_nvar > 0 )THEN 
    498458         IF(ASSOCIATED(td_file%t_var))THEN 
     459            CALL var_clean(td_file%t_var(:)) 
    499460            DEALLOCATE(td_file%t_var) 
    500461         ENDIF 
     
    504465            ! read dimension information 
    505466            td_file%t_var(ji)=iom_cdf__read_var_meta( td_file, ji) 
    506  
    507467            SELECT CASE(td_file%t_var(ji)%i_ndim) 
    508468               CASE(0) 
     
    524484                  td_file%i_depthid=ji 
    525485               ELSE 
    526                   CALL logger_error("IOM OPEN: find more than one "//& 
    527                   &                 "depth variable in file "//& 
    528                   &                 TRIM(td_file%c_name) ) 
     486                  IF( td_file%i_depthid /= ji )THEN 
     487                     CALL logger_error("IOM CDF GET FILE VAR: find more than one "//& 
     488                     &                 "depth variable in file "//& 
     489                     &                 TRIM(td_file%c_name) ) 
     490                  ENDIF 
    529491               ENDIF 
    530492            ENDIF 
     
    554516      ELSE 
    555517         CALL logger_debug( & 
    556          &  " GET FILE VAR: there is no variable in file "//& 
     518         &  " IOM CDF GET FILE VAR: there is no variable in file "//& 
    557519         &  TRIM(td_file%c_name)) 
    558520      ENDIF 
    559521 
    560522   END SUBROUTINE iom_cdf__get_file_var 
    561    !> @endcode 
    562    !------------------------------------------------------------------- 
    563    !> @brief This subroutine delete variable dimension from an  
    564    !> opened netcdf file.<br/> 
    565    ! 
    566    !> @author J.Paul 
    567    !> - 2013- Initial Version 
    568    ! 
    569    !> @param[inout] td_file : file structure 
    570    !------------------------------------------------------------------- 
    571    !> @code 
    572    SUBROUTINE iom_cdf__del_var_dim(td_file) 
     523   !------------------------------------------------------------------- 
     524   !> @brief This subroutine delete coordinate variable from an  
     525   !> opened netcdf file if present. 
     526   ! 
     527   !> @author J.Paul 
     528   !> - November, 2013- Initial Version 
     529   ! 
     530   !> @param[inout] td_file   file structure 
     531   !------------------------------------------------------------------- 
     532   SUBROUTINE iom_cdf__del_coord_var(td_file) 
    573533      IMPLICIT NONE 
    574534      ! Argument       
     
    598558      ELSE 
    599559         CALL logger_debug( & 
    600          &  " DEL VAR DIM: there is no variable in file "//& 
     560         &  " IOM CDF DEL VAR DIM: there is no variable in file "//& 
    601561         &  TRIM(td_file%c_name)) 
    602562      ENDIF 
    603    END SUBROUTINE iom_cdf__del_var_dim 
    604    !> @endcode 
    605 !   !------------------------------------------------------------------- 
    606 !   !> @brief This subroutine get variable time from an  
    607 !   !> opened netcdf file.<br/> 
    608 !   ! 
    609 !   !> @author J.Paul 
    610 !   !> - 2013- Initial Version 
    611 !   ! 
    612 !   !> @param[inout] td_file : file structure 
    613 !   !------------------------------------------------------------------- 
    614 !   !> @code 
    615 !   SUBROUTINE iom_cdf__get_var_time(td_file) 
    616 !      IMPLICIT NONE 
    617 !      ! Argument       
    618 !      TYPE(TFILE), INTENT(INOUT) :: td_file 
    619 ! 
    620 !      ! local variable 
    621 !      CHARACTER(LEN=lc) :: cl_name 
    622 ! 
    623 !      ! loop indices 
    624 !      INTEGER(i4) :: ji 
    625 !      !---------------------------------------------------------------- 
    626 !      IF( td_file%i_nvar > 0 )THEN 
    627 !         DO ji=1,td_file%i_nvar 
    628 !            cl_name=TRIM(td_file%t_var(ji)%c_name) 
    629 !            IF( INDEX(cl_name,'time') /= 0 )THEN 
    630 !               ! read time variable 
    631 !               td_file%t_time=iom_cdf_read_var(td_file,ji) 
    632 !               ! remove time variable from variable list 
    633 !               CALL file_del_ver(td_file,TRIM(cl_name)) 
    634 !               EXIT 
    635 !            ENDIF 
    636 !         ENDDO 
    637 !      ELSE 
    638 !         CALL logger_debug( & 
    639 !         &  " GET VAR TIME: there is no variable in file "//& 
    640 !         &  TRIM(td_file%c_name)) 
    641 !      ENDIF 
    642 !   END SUBROUTINE iom_cdf__get_var_time 
    643 !   !> @endcode 
    644 !   !------------------------------------------------------------------- 
    645 !   !> @brief This subroutine get variable depth from an  
    646 !   !> opened netcdf file.<br/> 
    647 !   ! 
    648 !   !> @author J.Paul 
    649 !   !> - 2013- Initial Version 
    650 !   ! 
    651 !   !> @param[inout] td_file : file structure 
    652 !   !------------------------------------------------------------------- 
    653 !   !> @code 
    654 !   SUBROUTINE iom_cdf__get_var_depth(td_file) 
    655 !      IMPLICIT NONE 
    656 !      ! Argument       
    657 !      TYPE(TFILE), INTENT(INOUT) :: td_file 
    658 ! 
    659 !      ! local variable 
    660 !      CHARACTER(LEN=lc) :: cl_name 
    661 ! 
    662 !      ! loop indices 
    663 !      INTEGER(i4) :: ji 
    664 !      !---------------------------------------------------------------- 
    665 !      IF( td_file%i_nvar > 0 )THEN 
    666 !         DO ji=1,td_file%i_nvar 
    667 !            cl_name=TRIM(td_file%t_var(ji)%c_name) 
    668 !            IF( INDEX(cl_name,'depth') /= 0 )THEN 
    669 !               ! read depth variable 
    670 !               td_file%t_depth=iom_cdf_read_var(td_file,ji) 
    671 !               ! remove depth variable from variable list 
    672 !               CALL file_del_ver(td_file,TRIM(cl_name)) 
    673 !               EXIT 
    674 !            ENDIF 
    675 !         ENDDO 
    676 !      ELSE 
    677 !         CALL logger_debug( & 
    678 !         &  " GET VAR TIME: there is no variable in file "//& 
    679 !         &  TRIM(td_file%c_name)) 
    680 !      ENDIF 
    681 !   END SUBROUTINE iom_cdf__get_var_depth 
    682 !   !> @endcode 
     563   END SUBROUTINE iom_cdf__del_coord_var 
    683564   !------------------------------------------------------------------- 
    684565   !> @brief This function read one dimension in an opened netcdf file,  
     
    686567   ! 
    687568   !> @author J.Paul 
    688    !> - Nov, 2013- Initial Version 
    689    ! 
    690    !> @param[in] td_file : file structure 
    691    !> @param[in] id_dimid : dimension id 
     569   !> - November, 2013- Initial Version 
     570   ! 
     571   !> @param[in] td_file   file structure 
     572   !> @param[in] id_dimid dimension id 
    692573   !> @return  dimension structure  
    693574   !------------------------------------------------------------------- 
    694    !> @code 
    695575   TYPE(TDIM) FUNCTION iom_cdf__read_dim_id(td_file, id_dimid) 
    696576      IMPLICIT NONE 
     
    709589 
    710590         CALL logger_error( & 
    711          &  " READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
     591         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
    712592 
    713593      ELSE       
     
    715595         iom_cdf__read_dim_id%i_id=id_dimid 
    716596 
    717          CALL logger_debug( & 
    718          &  " READ DIM: dimension "//TRIM(fct_str(id_dimid))//& 
     597         CALL logger_trace( & 
     598         &  " IOM CDF READ DIM: dimension "//TRIM(fct_str(id_dimid))//& 
    719599         &  " in file "//TRIM(td_file%c_name)) 
    720600 
     
    728608 
    729609   END FUNCTION iom_cdf__read_dim_id 
    730    !> @endcode 
    731610   !------------------------------------------------------------------- 
    732611   !> @brief This function read one dimension in an opened netcdf file,  
     
    734613   ! 
    735614   !> @author J.Paul 
    736    !> - Nov, 2013- Initial Version 
    737    ! 
    738    !> @param[in] td_file : file structure 
    739    !> @param[in] cd_name : dimension name 
     615   !> - November, 2013- Initial Version 
     616   ! 
     617   !> @param[in] td_file   file structure 
     618   !> @param[in] cd_name   dimension name 
    740619   !> @return  dimension structure  
    741620   !------------------------------------------------------------------- 
    742    !> @code 
    743621   TYPE(TDIM) FUNCTION iom_cdf__read_dim_name(td_file, cd_name) 
    744622      IMPLICIT NONE 
     
    756634 
    757635         CALL logger_error( & 
    758          &  " READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
     636         &  " IOM CDF READ DIM: no id associated to file "//TRIM(td_file%c_name)) 
    759637 
    760638      ELSE       
     
    769647 
    770648   END FUNCTION iom_cdf__read_dim_name 
    771    !> @endcode    
    772649   !------------------------------------------------------------------- 
    773650   !> @brief This function read variable or global attribute in an opened  
     
    775652   ! 
    776653   !> @author J.Paul 
    777    !> - Nov, 2013- Initial Version 
    778    ! 
    779    !> @param[in] td_file : file structure 
    780    !> @param[in] id_varid : variable id. use NF90_GLOBAL to read global 
     654   !> - November, 2013- Initial Version 
     655   ! 
     656   !> @param[in] td_file   file structure 
     657   !> @param[in] id_varid variable id. use NF90_GLOBAL to read global 
    781658   !> attribute in a file 
    782    !> @param[in] cd_name : attribute name 
     659   !> @param[in] cd_name   attribute name 
    783660   !> @return  attribute structure  
    784661   !------------------------------------------------------------------- 
    785    !> @code 
    786662   TYPE(TATT) FUNCTION iom_cdf__read_att_name(td_file, id_varid, cd_name) 
    787663      IMPLICIT NONE 
     
    800676 
    801677      CHARACTER(LEN=lc) :: cl_value 
     678       
    802679      INTEGER(i1), DIMENSION(:), ALLOCATABLE :: bl_value 
    803680      INTEGER(i2), DIMENSION(:), ALLOCATABLE :: sl_value 
     
    810687 
    811688         CALL logger_error( & 
    812          &  " READ ATT: no id associated to file "//TRIM(td_file%c_name)) 
     689         &  " IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name)) 
    813690 
    814691      ELSE       
     
    819696         IF( id_varid == NF90_GLOBAL )THEN 
    820697 
    821             CALL logger_debug( & 
    822             &  " READ ATT: inquire global attribute "//& 
     698            CALL logger_trace( & 
     699            &  " IOM CDF READ ATT: inquire global attribute "//& 
    823700            &  " in file "//TRIM(td_file%c_name)) 
    824701 
    825702         ELSE 
    826703 
    827             CALL logger_debug( & 
    828             &  " READ ATT: inquire attribute "//& 
     704            CALL logger_trace( & 
     705            &  " IOM CDF READ ATT: inquire attribute "//& 
    829706            &  " of variable "//TRIM(fct_str(id_varid))//& 
    830707            &  " in file "//TRIM(td_file%c_name)) 
     
    840717 
    841718         !! get attribute value 
    842          CALL logger_debug( " READ ATT: get attribute "//TRIM(cl_name)//& 
     719         CALL logger_debug( " IOM CDF READ ATT: get attribute "//TRIM(cl_name)//& 
    843720         &               " in file "//TRIM(td_file%c_name)) 
    844721 
     
    851728 
    852729                  CALL logger_error( & 
    853                   &  " READ ATT: not enough space to put attribute "//& 
     730                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    854731                  &  TRIM(cl_name) ) 
    855732 
     
    872749               IF(il_status /= 0 )THEN 
    873750 
    874                   CALL logger_error( & 
    875                   &  " READ ATT: not enough space to put attribute "//& 
    876                   &  TRIM(cl_name) ) 
     751                  CALL logger_error( "IOM CDF READ ATT: "//& 
     752                  &  "not enough space to put attribute "//TRIM(cl_name) ) 
    877753 
    878754               ELSE 
     
    897773 
    898774                  CALL logger_error( & 
    899                   &  " READ ATT: not enough space to put attribute "//& 
     775                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    900776                  &  TRIM(cl_name) ) 
    901777 
     
    921797 
    922798                  CALL logger_error( & 
    923                   &  " READ ATT: not enough space to put attribute "//& 
     799                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    924800                  &  TRIM(cl_name) ) 
    925801 
     
    944820 
    945821                  CALL logger_error( & 
    946                   &  " READ ATT: not enough space to put attribute "//& 
     822                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    947823                  &  TRIM(cl_name) ) 
    948824 
     
    968844 
    969845                  CALL logger_error( & 
    970                   &  " READ ATT: not enough space to put attribute "//& 
     846                  &  " IOM CDF READ ATT: not enough space to put attribute "//& 
    971847                  &  TRIM(cl_name) ) 
    972848 
     
    992868 
    993869   END FUNCTION iom_cdf__read_att_name 
    994    !> @endcode    
    995870   !------------------------------------------------------------------- 
    996871   !> @brief This function read variable or global attribute in an opened  
     
    998873   ! 
    999874   !> @author J.Paul 
    1000    !> - Nov, 2013- Initial Version 
    1001    ! 
    1002    !> @param[in] td_file : file structure 
    1003    !> @param[in] id_varid : variable id. use NF90_GLOBAL to read global  
     875   !> - November, 2013- Initial Version 
     876   ! 
     877   !> @param[in] td_file   file structure 
     878   !> @param[in] id_varid variable id. use NF90_GLOBAL to read global  
    1004879   !> attribute in a file 
    1005    !> @param[in] id_attid : attribute id 
     880   !> @param[in] id_attid attribute id 
    1006881   !> @return  attribute structure  
    1007882   !------------------------------------------------------------------- 
    1008    !> @code 
    1009883   TYPE(TATT) FUNCTION iom_cdf__read_att_id(td_file, id_varid, id_attid) 
    1010884      IMPLICIT NONE 
     
    1022896 
    1023897         CALL logger_error( & 
    1024          &  " READ ATT: no id associated to file "//TRIM(td_file%c_name)) 
    1025  
    1026       ELSE       
     898         &  "IOM CDF READ ATT: no id associated to file "//TRIM(td_file%c_name)) 
     899 
     900      ELSE 
    1027901 
    1028902         ! get attribute name 
     
    1036910 
    1037911   END FUNCTION iom_cdf__read_att_id 
    1038    !> @endcode    
    1039912   !------------------------------------------------------------------- 
    1040913   !> @brief This function read variable value in an opened  
    1041    !> netcdf file, given variable id.</br/> 
    1042    !> start indices and number of indices selected along each dimension  
    1043    !> could be specify in a 4 dimension table (/'x','y','z','t'/) 
    1044    ! 
    1045    !> @author J.Paul 
    1046    !> - Nov, 2013- Initial Version 
    1047    ! 
    1048    !> @param[in] td_file : file structure 
    1049    !> @param[in] id_varid : variable id 
    1050    !> @param[in] id_start : index in the variable from which the data values  
     914   !> netcdf file, given variable id. 
     915   !> @details 
     916   !> Optionaly, start indices and number of indices selected along each dimension  
     917   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     918   ! 
     919   !> @author J.Paul 
     920   !> - November, 2013- Initial Version 
     921   ! 
     922   !> @param[in] td_file   file structure 
     923   !> @param[in] id_varid  variable id 
     924   !> @param[in] id_start  index in the variable from which the data values  
    1051925   !> will be read 
    1052    !> @param[in] id_count : number of indices selected along each dimension 
     926   !> @param[in] id_count number of indices selected along each dimension 
    1053927   !> @return  variable structure  
    1054928   !------------------------------------------------------------------- 
    1055    !> @code 
    1056929   TYPE(TVAR) FUNCTION iom_cdf__read_var_id(td_file, id_varid,& 
    1057930   &                                        id_start, id_count) 
     
    1070943 
    1071944         CALL logger_error( & 
    1072          &  " IOM READ VAR: no id associated to file "//TRIM(td_file%c_name)) 
     945         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name)) 
    1073946 
    1074947      ELSE 
    1075948 
    1076          ! look for variable id 
     949         ! look for variable index 
    1077950         il_ind(:)=MINLOC(td_file%t_var(:)%i_id,mask=(td_file%t_var(:)%i_id==id_varid)) 
    1078951         IF( il_ind(1) /= 0 )THEN 
    1079952 
    1080             iom_cdf__read_var_id=td_file%t_var(il_ind(1)) 
    1081  
    1082             print *,"iom_cdf__read_var_id ",trim(iom_cdf__read_var_id%c_name)," ",iom_cdf__read_var_id%i_ew 
     953            iom_cdf__read_var_id=var_copy(td_file%t_var(il_ind(1))) 
     954 
    1083955            !!! read variable value 
    1084956            CALL iom_cdf__read_var_value(td_file, iom_cdf__read_var_id, & 
     
    1086958 
    1087959         ELSE 
    1088             print *,"iom_cdf__read_var_id " 
    1089960            CALL logger_error( & 
    1090             &  " IOM READ VAR: there is no variable with id "//& 
     961            &  " IOM CDF READ VAR: there is no variable with id "//& 
    1091962            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name)) 
    1092963         ENDIF 
     
    1094965      ENDIF 
    1095966   END FUNCTION iom_cdf__read_var_id 
    1096    !> @endcode    
    1097967   !------------------------------------------------------------------- 
    1098968   !> @brief This function read variable value in an opened  
    1099    !> netcdf file, given variable name or standard name.</br/> 
    1100    !> start indices and number of indices selected along each dimension  
    1101    !> could be specify in a 4 dimension table (/'x','y','z','t'/) 
    1102    ! 
     969   !> netcdf file, given variable name or standard name. 
    1103970   !> @details 
     971   !> Optionaly, start indices and number of indices selected along each dimension  
     972   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     973   !> 
    1104974   !> look first for variable name. If it doesn't 
    1105975   !> exist in file, look for variable standard name.<br/> 
    1106    !> If variable name is not present, check variable standard name.<br/> 
    1107    ! 
    1108    !> @author J.Paul 
    1109    !> - Nov, 2013- Initial Version 
    1110    ! 
    1111    !> @param[in] td_file : file structure 
    1112    !> @param[in] cd_name  : variable name 
    1113    !> @param[in] id_start : index in the variable from which the data values will be read 
    1114    !> @param[in] id_count : number of indices selected along each dimension 
    1115    !> @param[in] cd_stdname : variable standard name 
     976   ! 
     977   !> @author J.Paul 
     978   !> - November, 2013- Initial Version 
     979   ! 
     980   !> @param[in] td_file   file structure 
     981   !> @param[in] cd_name   variable name or standard name. 
     982   !> @param[in] id_start  index in the variable from which the data values will be read 
     983   !> @param[in] id_count  number of indices selected along each dimension 
    1116984   !> @return  variable structure  
    1117985   !------------------------------------------------------------------- 
    1118    !> @code 
    1119986   TYPE(TVAR) FUNCTION iom_cdf__read_var_name(td_file, cd_name,  & 
    1120987   &                                          id_start, id_count ) 
     
    1127994 
    1128995      ! local variable 
    1129       INTEGER(i4)       :: il_ind 
     996      INTEGER(i4)       :: il_varid 
    1130997      !---------------------------------------------------------------- 
    1131998      ! check if file opened 
     
    11331000 
    11341001         CALL logger_error( & 
    1135          &  " IOM READ VAR: no id associated to file "//TRIM(td_file%c_name)) 
     1002         &  " IOM CDF READ VAR: no id associated to file "//TRIM(td_file%c_name)) 
    11361003 
    11371004      ELSE 
     
    11401007 
    11411008            CALL logger_error( & 
    1142             &  " IOM READ VAR: you must specify a variable to read "//& 
     1009            &  " IOM CDF READ VAR: you must specify a variable to read "//& 
    11431010            &  " in file "//TRIM(td_file%c_name)) 
    11441011 
    11451012         ELSE 
    11461013 
    1147             il_ind=var_get_id(td_file%t_var(:), cd_name) 
    1148             IF( il_ind /= 0 )THEN 
    1149  
    1150                iom_cdf__read_var_name=td_file%t_var(il_ind) 
     1014            il_varid=var_get_index(td_file%t_var(:), cd_name) 
     1015            IF( il_varid /= 0 )THEN 
     1016 
     1017               iom_cdf__read_var_name=var_copy(td_file%t_var(il_varid)) 
    11511018 
    11521019               !!! read variable value 
     
    11581025 
    11591026               CALL logger_error( & 
    1160                &  " IOM READ VAR: there is no variable with "//& 
     1027               &  " IOM CDF READ VAR: there is no variable with "//& 
    11611028               &  " name or standard name "//TRIM(cd_name)//& 
    11621029               &  " in file "//TRIM(td_file%c_name) ) 
     
    11681035       
    11691036   END FUNCTION iom_cdf__read_var_name 
    1170    !> @endcode 
    1171    !------------------------------------------------------------------- 
    1172    !> @brief This subroutine fill variable value in an opened  
    1173    !> netcdf file, given variable id.</br/> 
    1174    !> start indices and number of indices selected along each dimension  
    1175    !> could be specify in a 4 dimension table (/'x','y','z','t'/) 
    1176    ! 
    1177    !> @note ne peut pas marcher qd on fait boucle sur les variable d'un 
    1178    !> fichier. puisque change id. 
    1179  
    1180    !> @author J.Paul 
    1181    !> - Nov, 2013- Initial Version 
    1182    ! 
    1183    !> @param[inout] td_file : file structure 
    1184    !> @param[in] id_start : index in the variable from which the data values  
     1037   !------------------------------------------------------------------- 
     1038   !> @brief This subroutine fill all variable value from an opened  
     1039   !> netcdf file. 
     1040   !> @details 
     1041   !> Optionaly, start indices and number of indices selected along each dimension  
     1042   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     1043   ! 
     1044   !> @author J.Paul 
     1045   !> - November, 2013- Initial Version 
     1046   ! 
     1047   !> @param[inout] td_file   file structure 
     1048   !> @param[in] id_start     index in the variable from which the data values  
    11851049   !> will be read 
    1186    !> @param[in] id_count : number of indices selected along each dimension 
    1187    !------------------------------------------------------------------- 
    1188    !> @code 
     1050   !> @param[in] id_count     number of indices selected along each dimension 
     1051   !------------------------------------------------------------------- 
    11891052   SUBROUTINE iom_cdf__fill_var_all(td_file, id_start, id_count) 
    11901053      IMPLICIT NONE 
     
    12031066 
    12041067         CALL logger_error( & 
    1205          &  " FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
     1068         &  " IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
    12061069 
    12071070      ELSE 
    12081071 
    12091072         DO ji=1,td_file%i_nvar 
    1210             CALL iom_cdf_fill_var(td_file, ji, id_start, id_count) 
     1073            CALL iom_cdf_fill_var(td_file, td_file%t_var(ji)%i_id, & 
     1074            &                     id_start, id_count) 
    12111075         ENDDO 
    12121076 
    12131077      ENDIF 
    12141078   END SUBROUTINE iom_cdf__fill_var_all 
    1215    !> @endcode 
    12161079   !------------------------------------------------------------------- 
    12171080   !> @brief This subroutine fill variable value in an opened  
    1218    !> netcdf file, given variable id.</br/> 
    1219    !> start indices and number of indices selected along each dimension  
    1220    !> could be specify in a 4 dimension table (/'x','y','z','t'/) 
    1221    ! 
    1222    !> @note ne peut pas marcher qd on fait boucle sur les variable d'un 
    1223    !> fichier. puisque change id. 
    1224  
    1225    !> @author J.Paul 
    1226    !> - Nov, 2013- Initial Version 
    1227    ! 
    1228    !> @param[inout] td_file : file structure 
    1229    !> @param[in] id_varid : variable id 
    1230    !> @param[in] id_start : index in the variable from which the data values  
     1081   !> netcdf file, given variable id. 
     1082   !> @details 
     1083   !> Optionaly, start indices and number of indices selected along each dimension  
     1084   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     1085   ! 
     1086   !> @author J.Paul 
     1087   !> - November, 2013- Initial Version 
     1088   ! 
     1089   !> @param[inout] td_file   file structure 
     1090   !> @param[in] id_varid     variable id 
     1091   !> @param[in] id_start     index in the variable from which the data values  
    12311092   !> will be read 
    1232    !> @param[in] id_count : number of indices selected along each dimension 
    1233    !------------------------------------------------------------------- 
    1234    !> @code 
     1093   !> @param[in] id_count     number of indices selected along each dimension 
     1094   !------------------------------------------------------------------- 
    12351095   SUBROUTINE iom_cdf__fill_var_id(td_file, id_varid, id_start, id_count) 
    12361096      IMPLICIT NONE 
     
    12421102 
    12431103      ! local variable 
    1244       INTEGER(i4), DIMENSION(1) :: il_ind 
     1104      INTEGER(i4), DIMENSION(1) :: il_varid 
    12451105 
    12461106      ! loop indices 
     
    12511111 
    12521112         CALL logger_error( & 
    1253          &  " FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
     1113         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
    12541114 
    12551115      ELSE 
    12561116 
    12571117         ! look for variable id 
    1258          il_ind(:)=MINLOC( td_file%t_var(:)%i_id, & 
     1118         il_varid(:)=MINLOC( td_file%t_var(:)%i_id, & 
    12591119         &                 mask=(td_file%t_var(:)%i_id==id_varid)) 
    1260          IF( il_ind(1) /= 0 )THEN 
     1120         IF( il_varid(1) /= 0 )THEN 
    12611121 
    12621122            !!! read variable value 
    1263             CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_ind(1)), & 
     1123            CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid(1)), & 
    12641124            &                            id_start, id_count) 
    12651125 
    12661126            DO ji=1,td_file%i_nvar 
    1267                CALL logger_debug(" var id "//TRIM(td_file%t_var(ji)%c_name)//" "//TRIM(fct_str(td_file%t_var(ji)%i_id)) ) 
     1127               CALL logger_debug(" IOM CDF FILL VAR: var id "//& 
     1128               &     TRIM(td_file%t_var(ji)%c_name)//" "//& 
     1129               &     TRIM(fct_str(td_file%t_var(ji)%i_id)) ) 
    12681130            ENDDO 
    12691131         ELSE 
    12701132            CALL logger_error( & 
    1271             &  " FILL VAR: there is no variable with id "//& 
     1133            &  " IOM CDF FILL VAR: there is no variable with id "//& 
    12721134            &  TRIM(fct_str(id_varid))//" in file "//TRIM(td_file%c_name)) 
    12731135         ENDIF 
     
    12751137      ENDIF 
    12761138   END SUBROUTINE iom_cdf__fill_var_id 
    1277    !> @endcode 
    12781139   !------------------------------------------------------------------- 
    12791140   !> @brief This subroutine fill variable value in an opened  
    1280    !> netcdf file, given variable name or standard name.</br/> 
    1281    !> start indices and number of indices selected along each dimension  
    1282    !> could be specify in a 4 dimension table (/'x','y','z','t'/) 
    1283    ! 
     1141   !> netcdf file, given variable name or standard name. 
    12841142   !> @details 
     1143   !> Optionaly, start indices and number of indices selected along each dimension  
     1144   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     1145   !> 
    12851146   !> look first for variable name. If it doesn't 
    12861147   !> exist in file, look for variable standard name.<br/> 
    1287    !> If variable name is not present, check variable standard name.<br/> 
    1288    ! 
    1289    !> @author J.Paul 
    1290    !> - Nov, 2013- Initial Version 
    1291    ! 
    1292    !> @param[inout] td_file : file structure 
    1293    !> @param[in] cd_name  : variable name or standard name 
    1294    !> @param[in] id_start : index in the variable from which the data values will be read 
    1295    !> @param[in] id_count : number of indices selected along each dimension 
    1296    !------------------------------------------------------------------- 
    1297    !> @code 
     1148   ! 
     1149   !> @author J.Paul 
     1150   !> - November, 2013- Initial Version 
     1151   ! 
     1152   !> @param[inout] td_file   file structure 
     1153   !> @param[in] cd_name      variable name or standard name 
     1154   !> @param[in] id_start     index in the variable from which the data values will be read 
     1155   !> @param[in] id_count     number of indices selected along each dimension 
     1156   !------------------------------------------------------------------- 
    12981157   SUBROUTINE iom_cdf__fill_var_name(td_file, cd_name, id_start, id_count ) 
    12991158      IMPLICIT NONE 
     
    13051164 
    13061165      ! local variable 
    1307       INTEGER(i4)       :: il_ind 
     1166      INTEGER(i4)       :: il_varid 
    13081167      !---------------------------------------------------------------- 
    13091168      ! check if file opened 
     
    13111170 
    13121171         CALL logger_error( & 
    1313          &  " FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
     1172         &  "IOM CDF FILL VAR: no id associated to file "//TRIM(td_file%c_name)) 
    13141173 
    13151174      ELSE 
    13161175 
    1317             il_ind=var_get_id(td_file%t_var(:), cd_name) 
    1318             IF( il_ind /= 0 )THEN 
     1176            il_varid=var_get_index(td_file%t_var(:), cd_name) 
     1177            IF( il_varid /= 0 )THEN 
    13191178 
    13201179               !!! read variable value 
    1321                CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_ind), & 
     1180               CALL iom_cdf__read_var_value(td_file, td_file%t_var(il_varid), & 
    13221181               &                            id_start, id_count) 
    13231182 
     
    13251184 
    13261185               CALL logger_error( & 
    1327                &  " FILL VAR: there is no variable with "//& 
     1186               &  "IOM CDF FILL VAR: there is no variable with "//& 
    13281187               &  "name or standard name"//TRIM(cd_name)//& 
    13291188               &  " in file "//TRIM(td_file%c_name)) 
     
    13331192       
    13341193   END SUBROUTINE iom_cdf__fill_var_name 
    1335    !> @endcode 
    13361194   !------------------------------------------------------------------- 
    13371195   !> @brief This function read metadata of a variable in an opened  
    1338    !> netcdf file.</br/> 
     1196   !> netcdf file. 
    13391197   ! 
    13401198   !> @note variable value are not read 
    13411199   ! 
    13421200   !> @author J.Paul 
    1343    !> - Nov, 2013- Initial Version 
    1344    ! 
    1345    !> @param[in] id_fileid : file id 
    1346    !> @param[in] id_varid : variable id 
     1201   !> - November, 2013- Initial Version 
     1202   !> @date September, 2014 
     1203   !> - force to use FillValue=1.e20 if no FillValue for coordinate variable. 
     1204   ! 
     1205   !> @param[in] td_file   file structure 
     1206   !> @param[in] id_varid  variable id 
    13471207   !> @return  variable structure  
    13481208   !------------------------------------------------------------------- 
    1349    !> @code 
    13501209   TYPE(TVAR) FUNCTION iom_cdf__read_var_meta(td_file, id_varid) 
    13511210      IMPLICIT NONE 
     
    13751234 
    13761235         CALL logger_error( & 
    1377          &  " READ ATT: no id associated to file "//TRIM(td_file%c_name)) 
     1236         &  " IOM CDF READ VAR META: no id associated to file "//& 
     1237         &   TRIM(td_file%c_name)) 
    13781238 
    13791239      ELSE 
     
    13811241         ! inquire variable 
    13821242         CALL logger_trace( & 
    1383          &  " READ VAR: inquire variable "//TRIM(fct_str(id_varid))//& 
     1243         &  " IOM CDF READ VAR META: inquire variable "//& 
     1244         &  TRIM(fct_str(id_varid))//& 
    13841245         &  " in file "//TRIM(td_file%c_name)) 
    13851246          
     
    13931254         &                                il_natt ) 
    13941255         CALL iom_cdf__check(il_status) 
    1395  
    13961256         !!! fill variable dimension structure 
    13971257         tl_dim(:)=iom_cdf__read_var_dim( td_file, il_ndim, il_dimid(:) ) 
    1398  
    13991258         IF( il_natt /= 0 )THEN 
    14001259            ALLOCATE( tl_att(il_natt) ) 
     
    14051264            il_attid=att_get_id(tl_att(:),'_FillValue') 
    14061265            IF( il_attid == 0 )THEN 
    1407                CALL logger_warn("IOM READ VAR: no _FillValue for variable "//& 
     1266               CALL logger_info("IOM CDF READ VAR META: no _FillValue for variable "//& 
    14081267               &  TRIM(cl_name)//" in file "//TRIM(td_file%c_name) ) 
    14091268 
     
    14111270               IF( il_attid /= 0 )THEN 
    14121271                  ! create attribute _FillValue 
    1413                   CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//& 
     1272                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
    14141273                  &                "missing_value for variable "//TRIM(cl_name) ) 
    1415                   tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:)) 
     1274                  tl_fill=att_init('_FillValue',tl_att(il_attid)%d_value(:), & 
     1275                  &                 id_type=tl_att(il_attid)%i_type) 
    14161276               ELSE 
    14171277                  ! create attribute _FillValue 
    1418                   CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//& 
    1419                   &                "zero for variable "//TRIM(cl_name) ) 
    1420                   tl_fill=att_init('_FillValue',0.) 
    1421                   !tl_fill=att_init('_FillValue',1.e20) 
     1278                  SELECT CASE(TRIM(cl_name)) 
     1279                     CASE DEFAULT 
     1280                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
     1281                        &                "zero for variable "//TRIM(cl_name) ) 
     1282                        tl_fill=att_init('_FillValue',0.) 
     1283                     CASE('nav_lon','nav_lat', & 
     1284                        &  'glamt','glamu','glamv','glamf', & 
     1285                        &  'gphit','gphiu','gphiv','gphif') 
     1286                        CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
     1287                        &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) ) 
     1288                        tl_fill=att_init('_FillValue',1.e20) 
     1289                  END SELECT 
    14221290               ENDIF 
    14231291 
    14241292               ALLOCATE( tl_tmp(il_natt) ) 
    14251293               ! save read attribut 
    1426                tl_tmp(:)=tl_att(:) 
    1427                ! change number of attribute in table 
     1294               tl_tmp(:)=att_copy(tl_att(:)) 
     1295               ! change number of attribute in array 
     1296               CALL att_clean(tl_att(:)) 
    14281297               DEALLOCATE( tl_att ) 
    14291298               ALLOCATE( tl_att(il_natt+1) ) 
    14301299               ! copy read attribut 
    1431                tl_att(1:il_natt)=tl_tmp(:) 
     1300               tl_att(1:il_natt)=att_copy(tl_tmp(:)) 
     1301               ! clean 
     1302               CALL att_clean(tl_tmp(:)) 
    14321303               DEALLOCATE( tl_tmp ) 
    14331304 
    14341305               ! create attribute _FillValue 
    1435                tl_att(il_natt+1)=tl_fill 
     1306               tl_att(il_natt+1)=att_copy(tl_fill) 
    14361307 
    14371308            ENDIF 
     
    14401311            ALLOCATE(tl_att(il_natt+1) ) 
    14411312            ! create attribute _FillValue 
    1442             CALL logger_warn("IOM READ VAR: assume _FillValue is equal to "//& 
    1443             &                "zero for variable "//TRIM(cl_name) ) 
    1444             tl_fill=att_init('_FillValue',0.) 
     1313            SELECT CASE(TRIM(cl_name)) 
     1314               CASE DEFAULT 
     1315                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
     1316                  &                "zero for variable "//TRIM(cl_name) ) 
     1317                  tl_fill=att_init('_FillValue',0.) 
     1318               CASE('nav_lon','nav_lat', & 
     1319                  &  'glamt','glamu','glamv','glamf', & 
     1320                  &  'gphit','gphiu','gphiv','gphif') 
     1321                  CALL logger_info("IOM CDF READ VAR META: assume _FillValue is equal to "//& 
     1322                  &                "dummy fillValue (1.e20) for variable "//TRIM(cl_name) ) 
     1323                  tl_fill=att_init('_FillValue',1.e20) 
     1324            END SELECT             
    14451325            ! create attribute _FillValue 
    1446             tl_att(il_natt+1)=tl_fill 
     1326            tl_att(il_natt+1)=att_copy(tl_fill) 
    14471327         ENDIF 
    14481328 
     
    14511331         &                                tl_att(:), id_id=id_varid ) 
    14521332 
     1333         ! clean 
     1334         CALL dim_clean(tl_dim(:)) 
     1335         CALL att_clean(tl_fill) 
     1336         CALL att_clean(tl_att(:)) 
    14531337         DEALLOCATE( tl_att ) 
    14541338 
     
    14561340 
    14571341   END FUNCTION iom_cdf__read_var_meta 
    1458    !> @endcode 
    14591342   !------------------------------------------------------------------- 
    14601343   !> @brief This subroutine read variable dimension 
    14611344   !> in an opened netcdf file. 
    1462    ! 
     1345   !> 
    14631346   !> @details 
    14641347   !> the number of dimension can't exceed 4,  
    14651348   !> and should be 'x', 'y', 'z', 't' (whatever their order).<br/> 
    1466    !> If the number of dimension read is less than 4, the table of dimension 
     1349   !> If the number of dimension read is less than 4, the array of dimension 
    14671350   !> strucure is filled with unused dimension.<br/> 
    1468    !> So the table of dimension structure of a variable is always compose of 4 
     1351   !> So the array of dimension structure of a variable is always compose of 4 
    14691352   !> dimension (use or not).  
    14701353   ! 
    14711354   !> @author J.Paul 
    1472    !> - Nov, 2013- Initial Version 
    1473    ! 
    1474    !> @param[inout] td_file : file structure 
    1475    !> @return file structure completed  
    1476    !------------------------------------------------------------------- 
    1477    !> @code 
     1355   !> - November, 2013- Initial Version 
     1356   ! 
     1357   !> @param[in] td_file   file structure 
     1358   !> @param[in] id_ndim   number of dimension 
     1359   !> @param[in] id_dimid  array of dimension id 
     1360   !> @return array dimension structure  
     1361   !------------------------------------------------------------------- 
    14781362   FUNCTION iom_cdf__read_var_dim(td_file, id_ndim, id_dimid) 
    14791363      IMPLICIT NONE 
     
    15021386         CALL dim_reorder(tl_dim(:)) 
    15031387 
    1504          iom_cdf__read_var_dim(:)=tl_dim(:) 
     1388         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:)) 
     1389 
     1390         ! clean 
     1391         CALL dim_clean(tl_dim(:)) 
    15051392 
    15061393      ELSE IF( id_ndim > 0 .AND. id_ndim <= 4 )THEN 
     
    15081395 
    15091396         DO ji = 1, id_ndim 
    1510             CALL logger_debug( " READ VAR DIM: get variable dimension "//& 
     1397            CALL logger_trace( " IOM CDF READ VAR DIM: get variable dimension "//& 
    15111398            &               TRIM(fct_str(ji)) ) 
    15121399 
     
    15211408         CALL dim_reorder(tl_dim(:)) 
    15221409       
    1523          iom_cdf__read_var_dim(:)=tl_dim(:) 
     1410         iom_cdf__read_var_dim(:)=dim_copy(tl_dim(:)) 
     1411 
     1412         ! clean 
     1413         CALL dim_clean(tl_dim(:)) 
    15241414 
    15251415      ELSE 
    15261416 
    1527          CALL logger_error(" READ VAR DIM: can't manage "//& 
     1417         CALL logger_error(" IOM CDF READ VAR DIM: can't manage "//& 
    15281418         &              TRIM(fct_str(id_ndim))//" dimension(s)" ) 
    15291419 
     
    15311421 
    15321422   END FUNCTION iom_cdf__read_var_dim 
    1533    !> @endcode    
    15341423   !------------------------------------------------------------------- 
    15351424   !> @brief This subroutine read variable attributes 
     
    15371426   ! 
    15381427   !> @author J.Paul 
    1539    !> - Nov, 2013- Initial Version 
    1540    ! 
    1541    !> @param[in] td_file : file structure 
    1542    !> @param[inout] td_var : variable structure 
    1543    !> @return filled variable attribute structure  
    1544    !------------------------------------------------------------------- 
    1545    !> @code 
     1428   !> - November, 2013- Initial Version 
     1429   ! 
     1430   !> @param[in] td_file   file structure 
     1431   !> @param[in] id_varid  variable id 
     1432   !> @param[in] id_natt   number of attributes 
     1433   !> @return array of attribute structure 
     1434   !------------------------------------------------------------------- 
    15461435   FUNCTION iom_cdf__read_var_att(td_file, id_varid, id_natt) 
    15471436      IMPLICIT NONE 
     
    15551444 
    15561445      ! local variable 
    1557       TYPE(TATT), DIMENSION(id_natt) :: tl_att 
    15581446 
    15591447      ! loop indices 
     
    15621450 
    15631451      IF( id_natt > 0 )THEN 
    1564  
     1452       
    15651453         ! read attributes 
    15661454         DO ji = 1, id_natt 
    1567             CALL logger_debug( " READ VAR ATT: get attribute "//& 
     1455            CALL logger_trace( " IOM CDF READ VAR ATT: get attribute "//& 
    15681456            &               TRIM(fct_str(ji)) ) 
    15691457 
    1570             tl_att(ji)=iom_cdf_read_att(td_file, id_varid, ji) 
     1458            iom_cdf__read_var_att(ji)=iom_cdf_read_att(td_file, id_varid, ji) 
    15711459 
    15721460         ENDDO 
    15731461 
    1574          iom_cdf__read_var_att(:)=tl_att(:) 
    1575  
    15761462      ELSE 
    15771463 
    1578          CALL logger_debug( " READ VAR ATT: no attribute for variable " ) 
     1464         CALL logger_debug( " IOM CDF READ VAR ATT: no attribute for variable " ) 
    15791465 
    15801466      ENDIF 
    15811467 
    15821468   END FUNCTION iom_cdf__read_var_att 
    1583    !> @endcode    
    15841469   !------------------------------------------------------------------- 
    15851470   !> @brief This subroutine read variable value 
    15861471   !> in an opened netcdf file. 
    1587    ! 
    1588    !> @author J.Paul 
    1589    !> - Nov, 2013- Initial Version 
    1590    ! 
    1591    !> @param[in] td_file : file structure 
    1592    !> @param[inout] td_var : variable structure 
    1593    !> @param[in] id_start : index in the variable from which the data values will be read 
    1594    !> @param[in] id_count : number of indices selected along each dimension 
     1472   !> @details 
     1473   !> Optionaly, start indices and number of indices selected along each dimension  
     1474   !> could be specify in a 4 dimension array (/'x','y','z','t'/) 
     1475   ! 
     1476   !> @author J.Paul 
     1477   !> - November, 2013- Initial Version 
     1478   ! 
     1479   !> @param[in] td_file   file structure 
     1480   !> @param[inout] td_var variable structure 
     1481   !> @param[in] id_start  index in the variable from which the data values will be read 
     1482   !> @param[in] id_count  number of indices selected along each dimension 
    15951483   !> @return variable structure completed  
    15961484   ! 
     
    15981486   !> - warning do not change fill value when use scale factor.. 
    15991487   !------------------------------------------------------------------- 
    1600    !> @code 
    16011488   SUBROUTINE iom_cdf__read_var_value(td_file, td_var, & 
    16021489   &                                  id_start, id_count ) 
     
    16101497      ! local variable 
    16111498      INTEGER(i4)                       :: il_status 
    1612       INTEGER(i4)                       :: il_tmp1, il_tmp2, il_varid 
     1499      INTEGER(i4)                       :: il_tmp1 
     1500      INTEGER(i4)                       :: il_tmp2 
     1501      INTEGER(i4)                       :: il_varid 
    16131502      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start 
    16141503      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count 
    16151504      INTEGER(i4), DIMENSION(ip_maxdim) :: il_start_ord 
    16161505      INTEGER(i4), DIMENSION(ip_maxdim) :: il_count_ord 
    1617       REAL(dp)   , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value 
    1618  
    1619       TYPE(TDIM),  DIMENSION(ip_maxdim) :: tl_dim 
     1506      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_value 
     1507      REAL(dp)   , DIMENSION(:,:,:,:)  , ALLOCATABLE :: dl_tmp 
     1508 
    16201509      ! loop indices 
    16211510      INTEGER(i4) :: ji 
    16221511      !---------------------------------------------------------------- 
    16231512 
    1624       ! check id_count and id_start optionals parameters... 
    1625       IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. & 
    1626           ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN 
    1627          CALL logger_warn( & 
    1628          &  " READ VAR VALUE: id_start and id_count should be both specify") 
    1629       ENDIF 
    1630  
    1631       IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN 
    1632  
    1633          IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 
    1634          &   SIZE(id_count(:)) /= ip_maxdim )THEN 
    1635             CALL logger_error("READ VAR: dimension of table start or count "//& 
    1636             &      " are invalid to read variable "//TRIM(td_var%c_name)//& 
    1637             &      " in file "//TRIM(td_file%c_name) ) 
    1638          ENDIF 
    1639  
    1640          ! change dimension order from ('x','y','z','t') 
    1641          il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:)) 
    1642          il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:)) 
    1643  
    1644          ! keep ordered table ('x','y','z','t') 
    1645          il_start_ord(:)=il_start(:) 
    1646          il_count_ord(:)=il_count(:) 
    1647  
     1513      ! check if variable in file structure 
     1514      il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name)) 
     1515      IF( il_varid /= 0 )THEN 
     1516 
     1517         ! check id_count and id_start optionals parameters... 
     1518         IF( (       PRESENT(id_start)  .AND. (.NOT. PRESENT(id_count))) .OR. & 
     1519             ((.NOT. PRESENT(id_start)) .AND.        PRESENT(id_count) ) )THEN 
     1520            CALL logger_warn( & 
     1521            &  "IOM CDF READ VAR VALUE: id_start and id_count should be both specify") 
     1522         ENDIF 
     1523         IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN 
     1524 
     1525            IF( SIZE(id_start(:)) /= ip_maxdim .OR. & 
     1526            &   SIZE(id_count(:)) /= ip_maxdim )THEN 
     1527               CALL logger_error("IOM CDF READ VAR: dimension of array start or count "//& 
     1528               &      " are invalid to read variable "//TRIM(td_var%c_name)//& 
     1529               &      " in file "//TRIM(td_file%c_name) ) 
     1530            ENDIF 
     1531 
     1532            ! change dimension order from ('x','y','z','t') 
     1533            il_start(:)=dim_reorder_xyzt2(td_var%t_dim, id_start(:)) 
     1534            il_count(:)=dim_reorder_xyzt2(td_var%t_dim, id_count(:)) 
     1535 
     1536            ! keep ordered array ('x','y','z','t') 
     1537            il_start_ord(:)=id_start(:) 
     1538            il_count_ord(:)=id_count(:) 
     1539 
     1540         ELSE 
     1541 
     1542            ! change dimension order from ('x','y','z','t') 
     1543            il_start(:)=(/1,1,1,1/) 
     1544            il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len) 
     1545 
     1546            ! keep ordered array ('x','y','z','t') 
     1547            il_start_ord(:)=(/1,1,1,1/) 
     1548            il_count_ord(:)=td_var%t_dim(:)%i_len 
     1549 
     1550         ENDIF 
     1551 
     1552         ! check dimension 
     1553         IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN 
     1554 
     1555            CALL logger_error( "IOM CDF READ VAR VALUE: start indices should"//& 
     1556            &  " be greater than or equal to 1") 
     1557 
     1558         ENDIF 
     1559 
     1560         IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1 <= & 
     1561            &  (/td_var%t_dim( 1 )%i_len,& 
     1562            &    td_var%t_dim( 2 )%i_len,& 
     1563            &    td_var%t_dim( 3 )%i_len,& 
     1564            &    td_var%t_dim( 4 )%i_len & 
     1565            &                                            /)) )THEN 
     1566 
     1567            CALL logger_error( "IOM CDF READ VAR VALUE: start + count exceed "//& 
     1568            &  "variable dimension for "//TRIM(td_var%c_name) ) 
     1569 
     1570            DO ji = 1, ip_maxdim 
     1571               il_tmp1=il_start_ord(ji)+il_count_ord(ji)-1 
     1572               il_tmp2=td_var%t_dim(ji)%i_len 
     1573               CALL logger_debug( "IOM CDF READ VAR VALUE: start + count -1:"//& 
     1574               &  TRIM(fct_str(il_tmp1))//" variable dimension"//& 
     1575               &  TRIM(fct_str(il_tmp2))) 
     1576            ENDDO 
     1577 
     1578         ELSE 
     1579 
     1580            ! Allocate space to hold variable value (unorder) 
     1581            ALLOCATE(dl_value( il_count(1), & 
     1582               &               il_count(2), & 
     1583               &               il_count(3), & 
     1584               &               il_count(4)),& 
     1585               &               stat=il_status) 
     1586            IF( il_status /= 0 )THEN 
     1587 
     1588              CALL logger_error( & 
     1589               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//& 
     1590               &  TRIM(td_var%c_name)) 
     1591 
     1592            ENDIF 
     1593 
     1594            ! read values 
     1595            CALL logger_debug( & 
     1596            &  "IOM CDF READ VAR VALUE: get variable "//TRIM(td_var%c_name)//& 
     1597            &  " in file "//TRIM(td_file%c_name)) 
     1598 
     1599            il_status = NF90_GET_VAR( td_file%i_id, il_varid,           & 
     1600            &                                       dl_value(:,:,:,:),  & 
     1601            &                                       start = il_start(:),& 
     1602            &                                       count = il_count(:) ) 
     1603            CALL iom_cdf__check(il_status) 
     1604 
     1605            ! Allocate space to hold variable value in structure 
     1606            IF( ASSOCIATED(td_var%d_value) )THEN 
     1607               DEALLOCATE(td_var%d_value)    
     1608            ENDIF 
     1609   
     1610            ! new dimension length 
     1611            td_var%t_dim(:)%i_len=il_count_ord(:) 
     1612 
     1613!>   dummy patch for pgf95 
     1614            ALLOCATE( dl_tmp( td_var%t_dim(1)%i_len, & 
     1615            &                 td_var%t_dim(2)%i_len, & 
     1616            &                 td_var%t_dim(3)%i_len, & 
     1617            &                 td_var%t_dim(4)%i_len),& 
     1618            &        stat=il_status) 
     1619            IF(il_status /= 0 )THEN 
     1620 
     1621               CALL logger_error( & 
     1622               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//& 
     1623               &  TRIM(td_var%c_name)//& 
     1624               &  " in variable structure") 
     1625            ENDIF 
     1626            dl_tmp(:,:,:,:)=td_var%d_fill 
     1627 
     1628            ! reshape values to be ordered as ('x','y','z','t') 
     1629            dl_tmp(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), & 
     1630            &                                 dl_value(:,:,:,:)) 
     1631 
     1632            DEALLOCATE(dl_value) 
     1633 
     1634            ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, & 
     1635            &                        td_var%t_dim(2)%i_len, & 
     1636            &                        td_var%t_dim(3)%i_len, & 
     1637            &                        td_var%t_dim(4)%i_len),& 
     1638            &        stat=il_status) 
     1639            IF(il_status /= 0 )THEN 
     1640 
     1641               CALL logger_error( & 
     1642               &  "IOM CDF READ VAR VALUE: not enough space to put variable "//& 
     1643               &  TRIM(td_var%c_name)//& 
     1644               &  " in variable structure") 
     1645 
     1646            ENDIF 
     1647!            ! FillValue by default 
     1648!            td_var%d_value(:,:,:,:)=td_var%d_fill 
     1649! 
     1650!            ! reshape values to be ordered as ('x','y','z','t') 
     1651!            td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(td_var%t_dim(:), & 
     1652!            &                                         dl_value(:,:,:,:)) 
     1653! 
     1654!            DEALLOCATE(dl_value) 
     1655 
     1656            td_var%d_value(:,:,:,:)=dl_tmp(:,:,:,:) 
     1657            DEALLOCATE(dl_tmp) 
     1658!<   dummy patch for pgf95 
     1659 
     1660            ! force to change _FillValue to avoid mistake  
     1661            ! with dummy zero _FillValue 
     1662            IF( td_var%d_fill == 0._dp )THEN 
     1663               CALL var_chg_FillValue(td_var) 
     1664            ENDIF 
     1665         ENDIF 
    16481666      ELSE 
    1649  
    1650          ! change dimension order from ('x','y','z','t') 
    1651          il_start(:)=(/1,1,1,1/) 
    1652          il_count(:)=dim_reorder_xyzt2(td_var%t_dim(:),td_var%t_dim(:)%i_len) 
    1653  
    1654          ! keep ordered table ('x','y','z','t') 
    1655          il_start_ord(:)=(/1,1,1,1/) 
    1656          il_count_ord(:)=td_var%t_dim(:)%i_len 
    1657  
    1658       ENDIF 
    1659  
    1660       ! check dimension 
    1661       IF( .NOT. ALL(il_start_ord(:)>=(/1,1,1,1/)) )THEN 
    1662  
    16631667         CALL logger_error( & 
    1664          &" READ VAR VALUE: start indices should be greater than or equal to 1") 
    1665  
    1666       ENDIF 
    1667  
    1668       IF(.NOT.ALL(il_start_ord(:)+il_count_ord(:)-1<=(/td_var%t_dim(1)%i_len,& 
    1669          &                                             td_var%t_dim(2)%i_len,& 
    1670          &                                             td_var%t_dim(3)%i_len,& 
    1671          &                                             td_var%t_dim(4)%i_len & 
    1672          &                                            /)) )THEN 
    1673  
    1674          CALL logger_error( & 
    1675          &  " READ VAR VALUE: start + count exceed variable dimension" ) 
    1676  
    1677          DO ji = 1, ip_maxdim 
    1678             il_tmp1=il_start_ord(ji)+il_count_ord(ji) 
    1679             il_tmp2=td_var%t_dim(ji)%i_len 
    1680             CALL logger_debug( & 
    1681             &  " READ VAR VALUE: start + count -1 "//TRIM(fct_str(il_tmp1))//& 
    1682             &  " variable dimension"//TRIM(fct_str(il_tmp2))) 
    1683          ENDDO 
    1684  
    1685       ELSE 
    1686  
    1687          ! Allocate space to hold variable value (unorder) 
    1688          ALLOCATE(dl_value( il_count(1), & 
    1689             &               il_count(2), & 
    1690             &               il_count(3), & 
    1691             &               il_count(4)),& 
    1692             &               stat=il_status) 
    1693          IF( il_status /= 0 )THEN 
    1694  
    1695            CALL logger_error( & 
    1696             &  " READ VAR VALUE: not enough space to put variable "//& 
    1697             &  TRIM(td_var%c_name)) 
    1698  
    1699          ENDIF 
    1700  
    1701          ! read values 
    1702          CALL logger_debug( & 
    1703          &  " READ VAR VALUE: get variable "//TRIM(td_var%c_name)//& 
    1704          &  " in file "//TRIM(td_file%c_name)) 
    1705          CALL logger_debug("start "//TRIM(fct_str(il_start(1)))//','//& 
    1706          &                           TRIM(fct_str(il_start(2)))//','//& 
    1707          &                           TRIM(fct_str(il_start(3)))//','//& 
    1708          &                           TRIM(fct_str(il_start(4)))//')'  ) 
    1709          CALL logger_debug("count "//TRIM(fct_str(il_count(1)))//','//& 
    1710          &                           TRIM(fct_str(il_count(2)))//','//& 
    1711          &                           TRIM(fct_str(il_count(3)))//','//& 
    1712          &                           TRIM(fct_str(il_count(4)))//')'  ) 
    1713          CALL logger_debug("dim "//TRIM(fct_str(td_file%t_dim(1)%i_len))//','//& 
    1714          &                         TRIM(fct_str(td_file%t_dim(2)%i_len))//','//& 
    1715          &                         TRIM(fct_str(td_file%t_dim(3)%i_len))//','//& 
    1716          &                         TRIM(fct_str(td_file%t_dim(4)%i_len))//')'  ) 
    1717          CALL logger_debug("shape "//TRIM(fct_str(SIZE(dl_value,DIM=1)))//","//& 
    1718          &                           TRIM(fct_str(SIZE(dl_value,DIM=2)))//","//& 
    1719          &                           TRIM(fct_str(SIZE(dl_value,DIM=3)))//","//& 
    1720          &                           TRIM(fct_str(SIZE(dl_value,DIM=4)))//")" ) 
    1721          CALL logger_debug("var "//TRIM(td_var%c_name)) 
    1722          il_varid=var_get_id(td_file%t_var(:),TRIM(td_var%c_name)) 
    1723          CALL logger_debug("var id "//TRIM(fct_str(il_varid))//' '//TRIM(fct_str(td_var%i_id))) 
    1724          CALL logger_debug("file id "//TRIM(fct_str(td_file%i_id))) 
    1725          il_status = NF90_GET_VAR( td_file%i_id, td_var%i_id,        & 
    1726          &                                       dl_value(:,:,:,:),  & 
    1727          &                                       start = il_start(:),& 
    1728          &                                       count = il_count(:) ) 
    1729          CALL iom_cdf__check(il_status) 
    1730  
    1731          ! Allocate space to hold variable value in structure 
    1732          IF( ASSOCIATED(td_var%d_value) )THEN 
    1733             DEALLOCATE(td_var%d_value)    
    1734          ENDIF 
    1735    
    1736          ! new dimension length 
    1737          td_var%t_dim(:)%i_len=il_count_ord(:) 
    1738  
    1739          ALLOCATE(td_var%d_value( il_count_ord(1), & 
    1740          &                        il_count_ord(2), & 
    1741          &                        il_count_ord(3), & 
    1742          &                        il_count_ord(4)),& 
    1743          &        stat=il_status) 
    1744          IF(il_status /= 0 )THEN 
    1745  
    1746             CALL logger_error( & 
    1747             &  " READ VAR VALUE: not enough space to put variable "//& 
    1748             &  TRIM(td_var%c_name)//& 
    1749             &  " in variable structure") 
    1750  
    1751          ENDIF 
    1752          ! FillValue by default 
    1753          td_var%d_value(:,:,:,:)=td_var%d_fill 
    1754  
    1755          ! reshape values to be ordered as ('x','y','z','t') 
    1756          tl_dim(:)=td_var%t_dim(:) 
    1757          td_var%d_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim,dl_value(:,:,:,:)) 
    1758  
    1759          DEALLOCATE(dl_value) 
    1760  
    1761          ! force to change _FillValue to avoid mistake  
    1762          ! with dummy zero _FillValue 
    1763          IF( td_var%d_fill == 0._dp )THEN 
    1764             CALL var_chg_FillValue(td_var) 
    1765          ENDIF 
     1668         &  "IOM CDF READ VAR VALUE: no variable "//TRIM(td_var%c_name)//& 
     1669         &  " in file structure "//TRIM(td_file%c_name)) 
    17661670      ENDIF 
    17671671 
    17681672   END SUBROUTINE iom_cdf__read_var_value 
    1769    !> @endcode    
    17701673   !------------------------------------------------------------------- 
    17711674   !> @brief This subroutine write file structure in an opened netcdf file. 
    17721675   ! 
    1773    !> @details 
    1774    ! 
    1775    !> @author J.Paul 
    1776    !> - Nov, 2013- Initial Version 
    1777    ! 
    1778    !> @param[in] td_file : file structure 
    1779    !------------------------------------------------------------------- 
    1780    !> @code 
     1676   !> @author J.Paul 
     1677   !> - November, 2013- Initial Version 
     1678   ! 
     1679   !> @param[inout] td_file   file structure 
     1680   !------------------------------------------------------------------- 
    17811681   SUBROUTINE iom_cdf_write_file(td_file) 
    17821682      IMPLICIT NONE 
     
    18001700 
    18011701         CALL logger_error( & 
    1802          &  " WRITE FILE: no id associated to file "//TRIM(td_file%c_name)) 
     1702         &  " IOM CDF WRITE FILE: no id associated to file "//TRIM(td_file%c_name)) 
    18031703 
    18041704      ELSE 
    18051705         IF( td_file%l_wrt )THEN 
    18061706 
    1807             ! delete dummy variable 
    1808             CALL file_del_var( td_file, 'no0d' ) 
    1809             CALL file_del_var( td_file, 'no1d' ) 
    1810             CALL file_del_var( td_file, 'no2d' ) 
    1811             CALL file_del_var( td_file, 'no3d' ) 
     1707            ! remove dummy variable 
     1708            CALL file_del_var(td_file,'no0d') 
     1709            CALL file_del_var(td_file,'no1d') 
     1710            CALL file_del_var(td_file,'no2d') 
     1711            CALL file_del_var(td_file,'no3d') 
    18121712 
    18131713            DO ji = 1, td_file%i_nvar 
     
    18161716 
    18171717            ! save usefull dimension 
    1818             tl_dim(:)=var_max_dim(td_file%t_var(:)) 
    1819  
    1820             DO ji=1,ip_maxdim 
    1821                IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji)) 
    1822             ENDDO 
     1718            IF( ASSOCIATED(td_file%t_var) )THEN 
     1719               tl_dim(:)=var_max_dim(td_file%t_var(:)) 
     1720 
     1721               DO ji=1,ip_maxdim 
     1722                  IF( tl_dim(ji)%l_use ) CALL file_move_dim(td_file, tl_dim(ji)) 
     1723               ENDDO 
     1724               ! clean 
     1725               CALL dim_clean(tl_dim(:)) 
     1726            ENDIF 
    18231727 
    18241728            ! write dimension in file 
     
    18361740 
    18371741                  DEALLOCATE(il_value) 
     1742 
     1743                  ! do not use FillValue for dimension variable 
     1744                  CALL var_del_att(tl_var, "_FillValue") 
    18381745                    
    18391746                  CALL iom_cdf__write_var(td_file,tl_var) 
     1747                  ! clean 
    18401748                  CALL var_clean(tl_var) 
    18411749 
     
    18561764 
    18571765            CALL logger_error( & 
    1858             &  " WRITE FILE: try to write in file "//TRIM(td_file%c_name)//& 
     1766            &  "IOM CDF WRITE FILE: try to write in file "//TRIM(td_file%c_name)//& 
    18591767            &  ", not opened in write mode") 
    18601768 
     
    18631771 
    18641772   END SUBROUTINE iom_cdf_write_file 
    1865    !> @endcode 
    18661773   !------------------------------------------------------------------- 
    18671774   !> @brief This subroutine write one dimension in an opened netcdf  
     
    18691776   ! 
    18701777   !> @author J.Paul 
    1871    !> - Nov, 2013- Initial Version 
    1872    ! 
    1873    !> @param[inout] td_file : file structure 
    1874    !> @param[inout] td_dim : dimension structure 
    1875    !------------------------------------------------------------------- 
    1876    !> @code 
     1778   !> - November, 2013- Initial Version 
     1779   ! 
     1780   !> @param[inout] td_file   file structure 
     1781   !> @param[inout] td_dim    dimension structure 
     1782   !------------------------------------------------------------------- 
    18771783   SUBROUTINE iom_cdf__write_dim(td_file, td_dim) 
    18781784      IMPLICIT NONE 
     
    18871793      IF( .NOT. td_file%l_def )THEN 
    18881794 
    1889          CALL logger_debug( & 
    1890          &  " WRITE FILE DIM: Enter define mode, file "//TRIM(td_file%c_name)) 
     1795         CALL logger_trace( & 
     1796         &  " IOM CDF WRITE FILE DIM: Enter define mode, file "//TRIM(td_file%c_name)) 
    18911797 
    18921798         ! Enter define mode 
     
    19011807         IF( td_dim%l_uld )THEN 
    19021808            ! write unlimited dimension 
    1903             CALL logger_debug( & 
    1904             &  " WRITE FILE DIM: write unlimited dimension "//& 
     1809            CALL logger_trace( & 
     1810            &  "IOM CDF WRITE FILE DIM: write unlimited dimension "//& 
    19051811            &  TRIM(td_dim%c_name)//" in file "//TRIM(td_file%c_name)) 
    19061812 
     
    19111817         ELSE 
    19121818            ! write not unlimited dimension 
    1913             CALL logger_debug( & 
    1914             &  " WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//& 
     1819            CALL logger_trace( & 
     1820            &  "IOM CDF WRITE FILE DIM: write dimension "//TRIM(td_dim%c_name)//& 
    19151821            &  " in file "//TRIM(td_file%c_name)) 
    19161822             
     
    19231829 
    19241830   END SUBROUTINE iom_cdf__write_dim 
    1925    !> @endcode    
    19261831   !------------------------------------------------------------------- 
    19271832   !> @brief This subroutine write a variable attribute in 
     
    19291834   ! 
    19301835   !> @author J.Paul 
    1931    !> - Nov, 2013- Initial Version 
    1932    ! 
    1933    !> @param[inout] td_file : file structure 
    1934    !> @param[in] id_varid : variable id. use NF90_GLOBAL to write global attribute 
    1935    !> in a file 
    1936    !> @param[in] td_att : attribute structure 
    1937    !------------------------------------------------------------------- 
    1938    !> @code 
     1836   !> - November, 2013- Initial Version 
     1837   ! 
     1838   !> @param[inout] td_file   file structure 
     1839   !> @param[in] id_varid     variable id. use NF90_GLOBAL to write  
     1840   !> global attribute in a file 
     1841   !> @param[in] td_att       attribute structure 
     1842   !------------------------------------------------------------------- 
    19391843   SUBROUTINE iom_cdf__write_att(td_file, id_varid, td_att) 
    19401844      IMPLICIT NONE 
     
    19501854      IF( .NOT. td_file%l_def )THEN 
    19511855 
    1952          CALL logger_debug( & 
    1953          &  " WRITE FILE ATT: Enter define mode, file "//TRIM(td_file%c_name)) 
     1856         CALL logger_trace( & 
     1857         &  "IOM CDF WRITE FILE ATT: Enter define mode, file "//TRIM(td_file%c_name)) 
    19541858 
    19551859         ! Enter define mode 
     
    19621866 
    19631867      !! put attribute value 
    1964       CALL logger_debug( & 
    1965       &  " WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//& 
     1868      CALL logger_trace( & 
     1869      &  "IOM CDF WRITE FILE ATT: write attribute "//TRIM(td_att%c_name)//& 
    19661870      &  " of variable "//TRIM(fct_str(id_varid))//& 
    19671871      &  " in file "//TRIM(td_file%c_name)) 
     
    19831887 
    19841888   END SUBROUTINE iom_cdf__write_att 
    1985    !> @endcode    
    1986    !------------------------------------------------------------------- 
    1987    !> @brief This subroutine write a variable in an opened netcdf file.</br/> 
    1988    ! 
    1989    !> @author J.Paul 
    1990    !> - Nov, 2013- Initial Version 
    1991    ! 
    1992    !> @param[inout] td_file : file structure 
    1993    !> @param[inout] td_var : variable structure 
    1994    !------------------------------------------------------------------- 
    1995    !> @code 
     1889   !------------------------------------------------------------------- 
     1890   !> @brief This subroutine write a variable in an opened netcdf file. 
     1891   ! 
     1892   !> @author J.Paul 
     1893   !> - November, 2013- Initial Version 
     1894   ! 
     1895   !> @param[inout] td_file   file structure 
     1896   !> @param[inout] td_var    variable structure 
     1897   !------------------------------------------------------------------- 
    19961898   SUBROUTINE iom_cdf__write_var(td_file, td_var) 
    19971899      IMPLICIT NONE 
     
    20021904      ! local variable 
    20031905      INTEGER(i4) :: il_status 
     1906      LOGICAL     :: ll_chg 
     1907      ! loop indices 
     1908      INTEGER(i4) :: ji 
    20041909      !---------------------------------------------------------------- 
    20051910 
    20061911      IF( .NOT. td_file%l_def )THEN 
    20071912 
    2008          CALL logger_debug( & 
    2009          &  " WRITE FILE VAR: Enter define mode, file "//TRIM(td_file%c_name)) 
     1913         CALL logger_trace( & 
     1914         &  " IOM CDF WRITE VAR: Enter define mode, file "//& 
     1915         &  TRIM(td_file%c_name)) 
    20101916 
    20111917         ! Enter define mode 
     
    20231929         CALL var_check_dim(td_var) 
    20241930 
    2025          ! change fill value to NETCDF standard 
    2026          CALL var_chg_FillValue(td_var) 
     1931         ll_chg=.TRUE. 
     1932         DO ji=1,ip_maxdim 
     1933            IF( TRIM(fct_lower(cp_dimorder(ji:ji))) == & 
     1934            &   TRIM(fct_lower(td_var%c_name)) )THEN 
     1935               ll_chg=.FALSE. 
     1936               CALL logger_trace(TRIM(fct_lower(td_var%c_name))//' is var dimension') 
     1937               EXIT 
     1938            ENDIF 
     1939         ENDDO 
     1940         IF( ll_chg )THEN 
     1941            ! not a dimension variable 
     1942            ! change FillValue 
     1943 
     1944            ! ugly patch until NEMO do not force to use 0. as FillValue  
     1945            CALL var_chg_FillValue(td_var,0._dp) 
     1946         ENDIF 
    20271947 
    20281948         ! define variable in file 
     
    20311951         IF( td_file%l_def )THEN 
    20321952 
    2033             CALL logger_debug( & 
    2034             &  " WRITE FILE VAR: Leave define mode, file "//TRIM(td_file%c_name)) 
     1953            CALL logger_trace( & 
     1954            &  " IOM CDF WRITE VAR: Leave define mode, file "//& 
     1955            &  TRIM(td_file%c_name)) 
    20351956 
    20361957            ! Leave define mode 
     
    20501971 
    20511972   END SUBROUTINE iom_cdf__write_var 
    2052    !> @endcode    
    20531973   !------------------------------------------------------------------- 
    20541974   !> @brief This function define variable in an opened netcdf file. 
    20551975   ! 
    20561976   !> @author J.Paul 
    2057    !> - Nov, 2013- Initial Version 
    2058    ! 
    2059    !> @param[in] td_file : file structure 
    2060    !> @param[in] td_var : variable structure 
     1977   !> - November, 2013- Initial Version 
     1978   ! 
     1979   !> @param[in] td_file   file structure 
     1980   !> @param[in] td_var   variable structure 
    20611981   !> @return  variable id 
    20621982   !------------------------------------------------------------------- 
    2063    !> @code 
    20641983   INTEGER(i4) FUNCTION iom_cdf__write_var_def(td_file, td_var) 
    20651984      IMPLICIT NONE 
     
    20701989      ! local variable 
    20711990      INTEGER(i4)                       :: il_status 
     1991      INTEGER(i4)                       :: il_ind 
    20721992      INTEGER(i4), DIMENSION(ip_maxdim) :: il_dimid 
     1993 
     1994      TYPE(TVAR)                        :: tl_var 
    20731995 
    20741996      ! loop indices 
     
    20771999      !---------------------------------------------------------------- 
    20782000 
    2079       CALL logger_debug( & 
    2080       &  " WRITE FILE VAR DEF: get dimension to be used for variable "//& 
    2081       &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    2082  
    2083       IF( ALL( .NOT. td_var%t_dim(:)%l_use ) )THEN 
     2001      ! copy structure 
     2002      tl_var=var_copy(td_var) 
     2003 
     2004      IF( ALL( .NOT. tl_var%t_dim(:)%l_use ) )THEN 
    20842005         ! scalar value 
    2085          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(td_var%c_name), & 
    2086          &                        td_var%i_type, varid=iom_cdf__write_var_def)  
     2006         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name), & 
     2007         &                        tl_var%i_type, varid=iom_cdf__write_var_def)  
    20872008         CALL iom_cdf__check(il_status) 
    20882009      ELSE 
     
    20932014         ! reorder dimension, so unused dimension won't be written 
    20942015         DO ji = 1,  ip_maxdim 
    2095             IF( td_var%t_dim(ji)%l_use )THEN 
     2016            IF( tl_var%t_dim(ji)%l_use )THEN 
    20962017               jj=jj+1 
    2097                CALL logger_debug(" get dim id for dimension "//TRIM(td_var%t_dim(ji)%c_name)) 
    2098                il_dimid(jj)=dim_get_id(td_file%t_dim(:),td_var%t_dim(ji)%c_name) 
     2018               il_dimid(jj)=dim_get_id(td_file%t_dim(:),tl_var%t_dim(ji)%c_name) 
    20992019            ENDIF 
    21002020         ENDDO 
    21012021 
    2102          CALL logger_debug( & 
    2103          &  " WRITE FILE VAR DEF: define dimension to be used for variable "//& 
    2104          &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name)) 
     2022         CALL logger_trace( & 
     2023         &  "IOM CDF WRITE VAR DEF: define dimension to be used for variable "//& 
     2024         &  TRIM(tl_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    21052025 
    21062026         DO ji=1,jj 
    2107             CALL logger_debug(" WRITE FILE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
     2027            CALL logger_trace("IOM CDF WRITE VAR DEF: dimid "//TRIM(fct_str(il_dimid(ji))) ) 
    21082028         ENDDO 
    2109          il_status = NF90_DEF_VAR(td_file%i_id, TRIM(td_var%c_name),     & 
    2110          &                        td_var%i_type,                         & 
     2029         il_status = NF90_DEF_VAR(td_file%i_id, TRIM(tl_var%c_name),     & 
     2030         &                        tl_var%i_type,                         & 
    21112031         &                        il_dimid(1:jj),                        & 
    21122032         &                        varid=iom_cdf__write_var_def           ) 
     
    21142034      ENDIF 
    21152035 
    2116       DO ji = 1, td_var%i_natt 
    2117          CALL logger_debug( & 
    2118          &  " WRITE FILE VAR DEF: put attribute "//TRIM(td_var%t_att(ji)%c_name)//& 
    2119          &  " for variable "//TRIM(td_var%c_name)//& 
     2036      ! remove unuseful attribute 
     2037      il_ind=att_get_index( tl_var%t_att(:), "ew_overlap" ) 
     2038      IF( il_ind /= 0 )THEN 
     2039         IF( tl_var%t_att(il_ind)%d_value(1) == -1 )THEN 
     2040            CALL var_del_att(tl_var, tl_var%t_att(il_ind)) 
     2041         ENDIF 
     2042      ENDIF 
     2043 
     2044      DO ji = 1, tl_var%i_natt 
     2045         CALL logger_trace( & 
     2046         &  " IOM CDF WRITE VAR DEF: put attribute "//TRIM(tl_var%t_att(ji)%c_name)//& 
     2047         &  " for variable "//TRIM(tl_var%c_name)//& 
    21202048         &  " in file "//TRIM(td_file%c_name) ) 
    21212049 
    2122          IF( td_var%t_att(ji)%i_type == NF90_CHAR )THEN 
    2123             !IF( TRIM(td_var%t_att(ji)%c_value) /= 'unknown' )THEN 
    2124             IF( TRIM(td_var%t_att(ji)%c_value) /= '' )THEN 
     2050         IF( tl_var%t_att(ji)%i_type == NF90_CHAR )THEN 
     2051            IF( TRIM(tl_var%t_att(ji)%c_value) /= '' )THEN 
    21252052               il_status = NF90_PUT_ATT(td_file%i_id, iom_cdf__write_var_def, & 
    2126                &                        TRIM(td_var%t_att(ji)%c_name),        & 
    2127                &                        TRIM(td_var%t_att(ji)%c_value)        ) 
     2053               &                        TRIM(tl_var%t_att(ji)%c_name),        & 
     2054               &                        TRIM(tl_var%t_att(ji)%c_value)        ) 
    21282055               CALL iom_cdf__check(il_status) 
    21292056            ENDIF 
    21302057         ELSE 
    2131             SELECT CASE(td_var%t_att(ji)%i_type) 
     2058            SELECT CASE(tl_var%t_att(ji)%i_type) 
    21322059               CASE(NF90_BYTE) 
    21332060                  il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    21342061                  &                        iom_cdf__write_var_def,         & 
    2135                   &                        TRIM(td_var%t_att(ji)%c_name),  & 
    2136                   &                        INT(td_var%t_att(ji)%d_value(:),i1)) 
     2062                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2063                  &                        INT(tl_var%t_att(ji)%d_value(:),i1)) 
    21372064               CASE(NF90_SHORT) 
    21382065                  il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    21392066                  &                        iom_cdf__write_var_def,         & 
    2140                   &                        TRIM(td_var%t_att(ji)%c_name),  & 
    2141                   &                        INT(td_var%t_att(ji)%d_value(:),i2)) 
     2067                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2068                  &                        INT(tl_var%t_att(ji)%d_value(:),i2)) 
    21422069               CASE(NF90_INT) 
    21432070                  il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    21442071                  &                        iom_cdf__write_var_def,         & 
    2145                   &                        TRIM(td_var%t_att(ji)%c_name),  & 
    2146                   &                        INT(td_var%t_att(ji)%d_value(:),i4)) 
     2072                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2073                  &                        INT(tl_var%t_att(ji)%d_value(:),i4)) 
    21472074               CASE(NF90_FLOAT) 
    21482075                  il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    21492076                  &                        iom_cdf__write_var_def,         & 
    2150                   &                        TRIM(td_var%t_att(ji)%c_name),  & 
    2151                   &                        REAL(td_var%t_att(ji)%d_value(:),sp)) 
     2077                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2078                  &                        REAL(tl_var%t_att(ji)%d_value(:),sp)) 
    21522079               CASE(NF90_DOUBLE) 
    21532080                  il_status = NF90_PUT_ATT(td_file%i_id,                   & 
    21542081                  &                        iom_cdf__write_var_def,         & 
    2155                   &                        TRIM(td_var%t_att(ji)%c_name),  & 
    2156                   &                        REAL(td_var%t_att(ji)%d_value(:),dp)) 
     2082                  &                        TRIM(tl_var%t_att(ji)%c_name),  & 
     2083                  &                        REAL(tl_var%t_att(ji)%d_value(:),dp)) 
    21572084               END SELECT 
    21582085            CALL iom_cdf__check(il_status) 
     
    21612088 
    21622089   END FUNCTION iom_cdf__write_var_def 
    2163    !> @endcode 
    21642090   !------------------------------------------------------------------- 
    21652091   !> @brief This subroutine put variable value in an opened netcdf file. 
     
    21672093   !> @details 
    21682094   !> The variable is written in the type define in variable structure. 
    2169    !> Only dimension used are printed, and fillValue in table are 
     2095   !> Only dimension used are printed, and fillValue in array are 
    21702096   !> replaced by default fill values defined in module netcdf for each type.  
    21712097   ! 
    21722098   !> @author J.Paul 
    2173    !> - Nov, 2013- Initial Version 
    2174    ! 
    2175    !> @param[in] td_file : file structure 
    2176    !> @param[in] td_var : variable structure 
    2177    !------------------------------------------------------------------- 
    2178    !> @code 
     2099   !> - November, 2013- Initial Version 
     2100   ! 
     2101   !> @param[in] td_file   file structure 
     2102   !> @param[in] td_var    variable structure 
     2103   !------------------------------------------------------------------- 
    21792104   SUBROUTINE iom_cdf__write_var_value(td_file, td_var) 
    21802105      IMPLICIT NONE 
     
    21942119 
    21952120      ! check which dimension use 
    2196       CALL logger_debug( & 
    2197       &  " WRITE FILE VAR VALUE: get dimension to be used for variable "//& 
     2121      CALL logger_trace( & 
     2122      &  "IOM CDF WRITE VAR VALUE: get dimension to be used for variable "//& 
    21982123      &  TRIM(td_var%c_name)//" in file "//TRIM(td_file%c_name)) 
    21992124 
     
    22022127         IF( td_var%t_dim(ji)%l_use )THEN 
    22032128            jj=jj+1 
    2204             !il_order(ji)=jj 
    2205             !il_shape(ji)=td_var%t_dim(jj)%i_len 
    22062129            il_order(jj)=ji 
    22072130            il_shape(jj)=td_var%t_dim(ji)%i_len 
     
    22122135         IF( .NOT. td_var%t_dim(ji)%l_use )THEN 
    22132136            jj=jj+1 
    2214             !il_order(ji)=jj 
    2215             !il_shape(ji)=td_var%t_dim(jj)%i_len 
    22162137            il_order(jj)=ji 
    22172138            il_shape(jj)=td_var%t_dim(ji)%i_len 
     
    22212142      ALLOCATE( dl_value( il_shape(1),il_shape(2),il_shape(3),il_shape(4) ) ) 
    22222143 
    2223       ! reshape table, so unused dimension won't be written 
     2144      ! reshape array, so unused dimension won't be written 
    22242145      dl_value(:,:,:,:)=RESHAPE(source=td_var%d_value(:,:,:,:),& 
    22252146      &                         SHAPE = il_shape(:), & 
     
    22272148 
    22282149      ! put value 
    2229       CALL logger_debug( & 
    2230       &  " WRITE FILE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//& 
     2150      CALL logger_trace( & 
     2151      &  "IOM CDF WRITE VAR VALUE: put "//TRIM(td_var%c_name)//" value "//& 
    22312152      &  "in file "//TRIM(td_file%c_name)) 
    22322153 
     
    22372158 
    22382159   END SUBROUTINE iom_cdf__write_var_value 
    2239    !> @endcode 
    22402160END MODULE iom_cdf 
Note: See TracChangeset for help on using the changeset viewer.