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 5602 for branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/attribute.f90 – NEMO

Ignore:
Timestamp:
2015-07-16T13:55:15+02:00 (9 years ago)
Author:
cbricaud
Message:

merge change from trunk rev 5003 to 5519 ( rev where branche 3.6_stable were created )

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r4213 r5602  
    88!> @brief  
    99!> This module manage attribute of variable or file. 
    10 ! 
     10!> 
    1111!> @details 
    1212!>    define type TATT:<br/> 
    13 !>    TYPE(TATT) :: tl_att<br/> 
     13!> @code 
     14!>    TYPE(TATT) :: tl_att 
     15!> @endcode 
    1416!> 
    1517!>    the attribute value inside attribute structure will be 
    16 !>    character or real(8) 1D table.<br/> 
    17 !>    However the attribute value could be initialised with:<br/> 
     18!>    character or real(8) 1D array.<br/> 
     19!>    However the attribute value could be initialized with:<br/> 
    1820!>    - character 
    1921!>    - scalar (real(4), real(8), integer(4) or integer(8)) 
    20 !>    - table 1D (real(4), real(8), integer(4) or integer(8)) 
     22!>    - array 1D (real(4), real(8), integer(4) or integer(8)) 
    2123!> 
    22 !>    to initialise an attribute structure :<br/> 
    23 !>    tl_att=att_init('attname',value)<br/> 
    24 !>    tl_att=att_init('attname',tab_value)<br/> 
     24!>    to initialize an attribute structure :<br/> 
     25!> @code 
     26!>    tl_att=att_init('attname',value) 
     27!> @endcode 
     28!>    - value is a character, scalar value or table of value 
    2529!> 
    26 !>    to print attribute information of one attribute structure:<br/> 
     30!>    to print attribute information of one or array of attribute structure:<br/> 
     31!> @code 
    2732!>    CALL att_print(td_att)  
     33!> @endcode 
    2834!> 
     35!>    to clean attribute structure:<br/> 
     36!> @code 
     37!>    CALL att_clean(td_att)  
     38!> @endcode 
     39!> 
     40!>    to copy attribute structure in another one (using different memory cell):<br/> 
     41!> @code 
     42!>    tl_att2=att_copy(tl_att1)  
     43!> @endcode 
     44!>    @note as we use pointer for the value array of the attribute structure, 
     45!>    the use of the assignment operator (=) to copy attribute structure  
     46!>    create a pointer on the same array.  
     47!>    This is not the case with this copy function. 
     48!> 
     49!>    to get attribute index, in an array of attribute structure:<br/> 
     50!> @code 
     51!>   il_index=att_get_index( td_att, cd_name ) 
     52!> @endcode 
     53!>    - td_att array of attribute structure 
     54!>    - cd_name attribute name 
     55!>  
     56!>    to get attribute id, read from a file:<br/> 
     57!>@code 
     58!>  il_id=att_get_id( td_att, cd_name ) 
     59!>@endcode 
     60!>    - td_att array of attribute structure 
     61!>    - cd_name attribute name 
     62!> 
     63!>    to get attribute name 
     64!>    - tl_att\%c_name 
     65!>  
    2966!>    to get character length or the number of value store in attribute 
    3067!>    - tl_att\%i_len 
    … …  
    3875!>    - tl_att\%i_type 
    3976!> 
    40 !>    to get attribute id (affected when attributes will be added to  
    41 !>    variable or file):<br/> 
     77!>    to get attribute id (read from file):<br/> 
    4278!>    - tl_att\%i_id 
    4379!> 
    44 !> @author 
    45 !> J.Paul 
     80!> @author J.Paul 
    4681! REVISION HISTORY: 
    47 !> @date Nov, 2013 - Initial Version 
     82!> @date November, 2013 - Initial Version 
     83!> @date November, 2014 - Fix memory leaks bug 
    4884! 
    4985!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    50 !> @todo 
    5186!---------------------------------------------------------------------- 
    5287MODULE att 
    … …  
    5489   USE global                          ! global variable 
    5590   USE kind                            ! F90 kind parameter 
    56    USE logger                             ! log file manager 
     91   USE logger                          ! log file manager 
    5792   USE fct                             ! basic useful function 
    5893   IMPLICIT NONE 
    59    PRIVATE 
    6094   ! NOTE_avoid_public_variables_if_possible 
    6195 
    6296   ! type and variable 
    63    PUBLIC :: TATT       ! attribute structure 
     97   PUBLIC :: TATT       !< attribute structure 
    6498 
    6599   ! function and subroutine 
    66    PUBLIC :: ASSIGNMENT(=)  ! copy attribute structure 
    67    PUBLIC :: att_init     ! initialize attribute structure 
    68    PUBLIC :: att_print    ! print attribute structure 
    69    PUBLIC :: att_get_id   ! get attribute id in table of attribute structure 
    70    PUBLIC :: att_clean    ! clean attribute strcuture 
    71  
    72    PRIVATE :: att__init_c     ! initialise an attribute structure with character value 
    73    PRIVATE :: att__init_dp    ! initialise an attribute structure with table of real(8) value 
    74    PRIVATE :: att__init_dp_0d ! initialise an attribute structure with real(8) value 
    75    PRIVATE :: att__init_sp    ! initialise an attribute structure with table of real(4) value 
    76    PRIVATE :: att__init_sp_0d ! initialise an attribute structure with real(4) value 
    77    PRIVATE :: att__init_i1    ! initialise an attribute structure with table of integer(1) value 
    78    PRIVATE :: att__init_i1_0d ! initialise an attribute structure with integer(1) value 
    79    PRIVATE :: att__init_i2    ! initialise an attribute structure with table of integer(2) value 
    80    PRIVATE :: att__init_i2_0d ! initialise an attribute structure with integer(2) value 
    81    PRIVATE :: att__init_i4    ! initialise an attribute structure with table of integer(4) value 
    82    PRIVATE :: att__init_i4_0d ! initialise an attribute structure with integer(4) value 
    83    PRIVATE :: att__init_i8    ! initialise an attribute structure with table of integer(8) value 
    84    PRIVATE :: att__init_i8_0d ! initialise an attribute structure with integer(8) value 
    85    PRIVATE :: att__copy_unit   ! copy attribute structure 
    86    PRIVATE :: att__copy_tab    ! copy attribute structure 
    87  
    88    !> @struct TATT 
    89    TYPE TATT 
    90       !CHARACTER(LEN=lc) :: c_name = 'unknown'  !< attribute name 
    91       CHARACTER(LEN=lc) :: c_name = ''  !< attribute name 
    92       INTEGER(i4)       :: i_id = 0          !< attribute id 
    93       INTEGER(i4)       :: i_type  = 0       !< attribute type 
     100   PUBLIC :: att_init       !< initialize attribute structure 
     101   PUBLIC :: att_print      !< print attribute structure 
     102   PUBLIC :: att_clean      !< clean attribute strcuture 
     103   PUBLIC :: att_copy       !< copy attribute structure 
     104   PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure 
     105   PUBLIC :: att_get_id     !< get attribute id, read from file 
     106 
     107   PRIVATE :: att__clean_unit ! clean attribute strcuture 
     108   PRIVATE :: att__clean_arr  ! clean array of attribute strcuture 
     109   PRIVATE :: att__print_unit ! print information on one attribute 
     110   PRIVATE :: att__print_arr  ! print information on a array of attribute 
     111   PRIVATE :: att__init_c     ! initialize an attribute structure with character value 
     112   PRIVATE :: att__init_dp    ! initialize an attribute structure with array of real(8) value 
     113   PRIVATE :: att__init_dp_0d ! initialize an attribute structure with real(8) value 
     114   PRIVATE :: att__init_sp    ! initialize an attribute structure with array of real(4) value 
     115   PRIVATE :: att__init_sp_0d ! initialize an attribute structure with real(4) value 
     116   PRIVATE :: att__init_i1    ! initialize an attribute structure with array of integer(1) value 
     117   PRIVATE :: att__init_i1_0d ! initialize an attribute structure with integer(1) value 
     118   PRIVATE :: att__init_i2    ! initialize an attribute structure with array of integer(2) value 
     119   PRIVATE :: att__init_i2_0d ! initialize an attribute structure with integer(2) value 
     120   PRIVATE :: att__init_i4    ! initialize an attribute structure with array of integer(4) value 
     121   PRIVATE :: att__init_i4_0d ! initialize an attribute structure with integer(4) value 
     122   PRIVATE :: att__init_i8    ! initialize an attribute structure with array of integer(8) value 
     123   PRIVATE :: att__init_i8_0d ! initialize an attribute structure with integer(8) value 
     124   PRIVATE :: att__copy_unit  ! copy attribute structure 
     125   PRIVATE :: att__copy_arr   ! copy array of attribute structure 
     126 
     127   TYPE TATT !< attribute structure 
     128      CHARACTER(LEN=lc) :: c_name = ''       !< attribute name 
     129      INTEGER(i4)       :: i_id   = 0        !< attribute id 
     130      INTEGER(i4)       :: i_type = 0        !< attribute type 
    94131      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute 
    95132      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR 
    … …  
    113150   END INTERFACE att_init 
    114151 
    115    INTERFACE ASSIGNMENT(=) 
    116       MODULE PROCEDURE att__copy_unit   ! copy attribute structure 
    117       MODULE PROCEDURE att__copy_tab   ! copy attribute structure 
     152   INTERFACE att_print 
     153      MODULE PROCEDURE att__print_unit ! print information on one attribute 
     154      MODULE PROCEDURE att__print_arr  ! print information on a array of attribute 
     155   END INTERFACE att_print 
     156 
     157   INTERFACE att_clean 
     158      MODULE PROCEDURE att__clean_unit   
     159      MODULE PROCEDURE att__clean_arr    
    118160   END INTERFACE 
    119161 
     162   INTERFACE att_copy 
     163      MODULE PROCEDURE att__copy_unit  ! copy attribute structure 
     164      MODULE PROCEDURE att__copy_arr   ! copy array of attribute structure 
     165   END INTERFACE 
     166 
    120167CONTAINS 
    121168   !------------------------------------------------------------------- 
    122169   !> @brief 
    123    !> This function copy attribute structure in another attribute 
    124    !> structure 
     170   !> This subroutine copy a array of attribute structure in another one 
    125171   !> @details  
    126    !> attribute value are copied in a temporary table, so input and output 
    127    !> attribute structure value do not point on the same "memory cell", and so 
    128    !> on are independant.  
    129    !> 
     172   !> see att__copy_unit 
     173   !> 
     174   !> @warning do not use on the output of a function who create or read an 
     175   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
     176   !> This will create memory leaks. 
    130177   !> @warning to avoid infinite loop, do not use any function inside  
    131178   !> this subroutine 
    132179   !> 
    133180   !> @author J.Paul 
    134    !> - Nov, 2013- Initial Version 
    135    ! 
    136    !> @param[out] td_att1  : attribute structure 
    137    !> @param[in] td_att2  : attribute structure 
    138    !------------------------------------------------------------------- 
    139    ! @code 
    140    SUBROUTINE att__copy_tab( td_att1, td_att2 ) 
    141       IMPLICIT NONE 
    142       ! Argument 
    143       TYPE(TATT), DIMENSION(:)               , INTENT(IN) :: td_att2 
    144       TYPE(TATT), DIMENSION(SIZE(td_att2(:))),INTENT(OUT) :: td_att1 
     181   !> @date November, 2013 - Initial Version 
     182   !> @date November, 2014 
     183   !>    - use function instead of overload assignment operator  
     184   !> (to avoid memory leak)  
     185   ! 
     186   !> @param[in] td_att   array of attribute structure 
     187   !> @return copy of input array of attribute structure 
     188   !------------------------------------------------------------------- 
     189   FUNCTION att__copy_arr( td_att ) 
     190      IMPLICIT NONE 
     191      ! Argument 
     192      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 
     193      ! function 
     194      TYPE(TATT), DIMENSION(SIZE(td_att(:))) :: att__copy_arr 
    145195 
    146196      ! local variable 
    … …  
    149199      !---------------------------------------------------------------- 
    150200 
    151       DO ji=1,SIZE(td_att2(:)) 
    152          td_att1(ji)=td_att2(ji) 
     201      DO ji=1,SIZE(td_att(:)) 
     202         att__copy_arr(ji)=att_copy(td_att(ji)) 
    153203      ENDDO 
    154204 
    155    END SUBROUTINE att__copy_tab 
    156    ! @endcode 
     205   END FUNCTION att__copy_arr 
    157206   !------------------------------------------------------------------- 
    158207   !> @brief 
    159    !> This function copy attribute structure in another attribute 
    160    !> structure 
     208   !> This subroutine copy an attribute structure in another one. 
    161209   !> @details  
    162    !> attribute value are copied in a temporary table, so input and output 
     210   !> attribute value are copied in a temporary array, so input and output 
    163211   !> attribute structure value do not point on the same "memory cell", and so 
    164212   !> on are independant.  
    165213   !> 
     214   !> @warning do not use on the output of a function who create or read an 
     215   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
     216   !> This will create memory leaks. 
    166217   !> @warning to avoid infinite loop, do not use any function inside  
    167218   !> this subroutine 
    168219   !> 
    169220   !> @author J.Paul 
    170    !> - Nov, 2013- Initial Version 
    171    ! 
    172    !> @param[out] td_att1  : attribute structure 
    173    !> @param[in] td_att2  : attribute structure 
    174    !------------------------------------------------------------------- 
    175    ! @code 
    176    SUBROUTINE att__copy_unit( td_att1, td_att2 ) 
    177       IMPLICIT NONE 
    178       ! Argument 
    179       TYPE(TATT), INTENT(OUT) :: td_att1 
    180       TYPE(TATT), INTENT(IN)  :: td_att2 
     221   !> @date November, 2013 - Initial Version 
     222   !> @date November, 2014 
     223   !> - use function instead of overload assignment operator (to avoid memory leak)  
     224   !> 
     225   !> @param[in] td_att   attribute structure 
     226   !> @return copy of input attribute structure 
     227   !------------------------------------------------------------------- 
     228   FUNCTION att__copy_unit( td_att ) 
     229      IMPLICIT NONE 
     230      ! Argument 
     231      TYPE(TATT), INTENT(IN)  :: td_att 
     232      ! function 
     233      TYPE(TATT) :: att__copy_unit 
    181234 
    182235      ! local variable 
    … …  
    184237      !---------------------------------------------------------------- 
    185238 
    186       CALL logger_trace("COPY: attribute "//TRIM(td_att2%c_name) ) 
    187  
    188239      ! copy attribute variable 
    189       td_att1%c_name  = TRIM(td_att2%c_name) 
    190       td_att1%i_id    = td_att2%i_id 
    191       td_att1%i_type  = td_att2%i_type 
    192       td_att1%i_len   = td_att2%i_len 
    193       td_att1%c_value = TRIM(td_att2%c_value) 
     240      att__copy_unit%c_name  = TRIM(td_att%c_name) 
     241      att__copy_unit%i_id    = td_att%i_id 
     242      att__copy_unit%i_type  = td_att%i_type 
     243      att__copy_unit%i_len   = td_att%i_len 
     244      att__copy_unit%c_value = TRIM(td_att%c_value) 
    194245 
    195246      ! copy attribute pointer in an independant variable 
    196       IF( ASSOCIATED(td_att1%d_value) ) DEALLOCATE(td_att1%d_value) 
    197       IF( ASSOCIATED(td_att2%d_value) )THEN 
    198          ALLOCATE( dl_value(td_att2%i_len) ) 
    199          dl_value(:) = td_att2%d_value(:) 
    200  
    201          ALLOCATE( td_att1%d_value(td_att1%i_len) ) 
    202          td_att1%d_value(:) = dl_value(:) 
     247      IF( ASSOCIATED(att__copy_unit%d_value) ) DEALLOCATE(att__copy_unit%d_value) 
     248      IF( ASSOCIATED(td_att%d_value) )THEN 
     249         ALLOCATE( dl_value(td_att%i_len) ) 
     250         dl_value(:) = td_att%d_value(:) 
     251 
     252         ALLOCATE( att__copy_unit%d_value(att__copy_unit%i_len) ) 
     253         att__copy_unit%d_value(:) = dl_value(:) 
    203254 
    204255         DEALLOCATE( dl_value ) 
    205256      ENDIF 
    206257 
    207    END SUBROUTINE att__copy_unit 
    208    ! @endcode 
    209    !------------------------------------------------------------------- 
    210    !> @brief This function get attribute id, in a table of attribute structure, 
    211    !> given attribute name 
    212    !> 
    213    !> @author J.Paul 
    214    !> - Nov, 2013- Initial Version 
    215    ! 
    216    !> @param[in] td_att  : attribute structure 
    217    !> @param[in] cd_name : attribute name 
    218    !> @return attribute id 
    219    !------------------------------------------------------------------- 
    220    ! @code 
    221    INTEGER(i4) FUNCTION att_get_id( td_att, cd_name ) 
     258   END FUNCTION att__copy_unit 
     259   !------------------------------------------------------------------- 
     260   !> @brief This function return attribute index, in a array of attribute structure, 
     261   !> given attribute name.<br/> 
     262   !> @details 
     263   !> if attribute name do not exist, return 0. 
     264   !> 
     265   !> @author J.Paul 
     266   !> @date Septempber, 2014 - Initial Version 
     267   ! 
     268   !> @param[in] td_att    array of attribute structure 
     269   !> @param[in] cd_name   attribute name 
     270   !> @return attribute index 
     271   !------------------------------------------------------------------- 
     272   INTEGER(i4) FUNCTION att_get_index( td_att, cd_name ) 
    222273      IMPLICIT NONE 
    223274      ! Argument 
    … …  
    231282      INTEGER(i4) :: ji 
    232283      !---------------------------------------------------------------- 
    233       att_get_id=0 
     284      att_get_index=0 
    234285 
    235286      il_size=SIZE(td_att(:)) 
    236287      DO ji=1,il_size 
    237288         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN 
    238             att_get_id=ji 
     289            att_get_index=ji 
    239290            EXIT 
    240291         ENDIF 
    241292      ENDDO 
    242293 
     294   END FUNCTION att_get_index 
     295   !------------------------------------------------------------------- 
     296   !> @brief This function return attribute id, read from a file.<br/> 
     297   !> @details 
     298   !> if attribute name do not exist, return 0. 
     299   !> 
     300   !> @author J.Paul 
     301   !> @date November, 2013 - Initial Version 
     302   !> @date September, 2014 - bug fix with use of id read from attribute structure 
     303   ! 
     304   !> @param[in] td_att    array of attribute structure 
     305   !> @param[in] cd_name   attribute name 
     306   !> @return attribute id 
     307   !------------------------------------------------------------------- 
     308   INTEGER(i4) FUNCTION att_get_id( td_att, cd_name ) 
     309      IMPLICIT NONE 
     310      ! Argument 
     311      TYPE(TATT),       DIMENSION(:), INTENT(IN) :: td_att 
     312      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
     313 
     314      ! local variable 
     315      INTEGER(i4) :: il_size 
     316 
     317      ! loop indices 
     318      INTEGER(i4) :: ji 
     319      !---------------------------------------------------------------- 
     320      att_get_id=0 
     321 
     322      il_size=SIZE(td_att(:)) 
     323      DO ji=1,il_size 
     324         IF( TRIM(td_att(ji)%c_name) == TRIM(cd_name) )THEN 
     325            att_get_id=td_att(ji)%i_id 
     326            EXIT 
     327         ENDIF 
     328      ENDDO 
     329 
    243330   END FUNCTION att_get_id 
    244    !> @endcode 
    245    !------------------------------------------------------------------- 
    246    !> @brief This function initialise an attribute structure with character 
    247    !> value  
    248    !> 
    249    !> @author J.Paul 
    250    !> - Nov, 2013- Initial Version 
    251    ! 
    252    !> @param[in] cd_name : attribute name 
    253    !> @param[in] cd_value: attribute value 
     331   !------------------------------------------------------------------- 
     332   !> @brief This function initialize an attribute structure with character 
     333   !> value.  
     334   !> 
     335   !> @author J.Paul 
     336   !> @date November, 2013 - Initial Version 
     337   ! 
     338   !> @param[in] cd_name   attribute name 
     339   !> @param[in] cd_value  attribute value 
    254340   !> @return attribute structure 
    255341   !------------------------------------------------------------------- 
    256    !> @code 
    257342   TYPE(TATT) FUNCTION att__init_c( cd_name, cd_value ) 
    258343      IMPLICIT NONE 
    … …  
    265350      CALL att_clean(att__init_c) 
    266351 
    267       CALL logger_info( & 
     352      CALL logger_trace( & 
    268353      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    269354      &  " attribute value "//TRIM(ADJUSTL(cd_value)) ) 
    … …  
    276361 
    277362   END FUNCTION att__init_c 
    278    !> @endcode 
    279    !------------------------------------------------------------------- 
    280    !> @brief This function initialise an attribute structure with table  
    281    !> of real(8) value 
    282    !> 
    283    !> @author J.Paul 
    284    !> - Nov, 2013- Initial Version 
    285    ! 
    286    !> @param[in] cd_name : attribute name 
    287    !> @param[in] dd_value: attribute value 
     363   !------------------------------------------------------------------- 
     364   !> @brief This function initialize an attribute structure with array  
     365   !> of real(8) value. 
     366   !> @details 
     367   !> Optionaly you could specify the type of the variable to be saved. 
     368   !> 
     369   !> @author J.Paul 
     370   !> @dtae November, 2013 - Initial Version 
     371   ! 
     372   !> @param[in] cd_name   attribute name 
     373   !> @param[in] dd_value  attribute value 
     374   !> @param[in] id_type   type of the variable to be saved 
    288375   !> @return attribute structure 
    289376   !------------------------------------------------------------------- 
    290    !> @code 
    291    TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value ) 
     377   TYPE(TATT) FUNCTION att__init_dp( cd_name, dd_value, id_type ) 
    292378      IMPLICIT NONE 
    293379 
    … …  
    295381      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    296382      REAL(dp),         DIMENSION(:), INTENT(IN) :: dd_value 
     383      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    297384 
    298385      ! local value 
    … …  
    307394      CALL att_clean(att__init_dp) 
    308395 
    309       ! table size 
     396      ! array size 
    310397      il_len=size(dd_value(:)) 
    311398 
    … …  
    316403      cl_value=TRIM(cl_value)//TRIM(fct_str(dd_value(il_len)))//"/)" 
    317404 
    318       CALL logger_info( & 
     405      CALL logger_trace( & 
    319406      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    320407      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    … …  
    322409      att__init_dp%c_name=TRIM(ADJUSTL(cd_name)) 
    323410 
    324       att__init_dp%i_type=NF90_DOUBLE 
     411      IF( PRESENT(id_type) )THEN 
     412         att__init_dp%i_type=id_type 
     413      ELSE 
     414         att__init_dp%i_type=NF90_DOUBLE 
     415      ENDIF 
    325416 
    326417      IF( ASSOCIATED(att__init_dp%d_value) )THEN 
    … …  
    333424 
    334425   END FUNCTION att__init_dp 
    335    !> @endcode 
    336    !------------------------------------------------------------------- 
    337    !> @brief This function initialise an attribute structure with  
     426   !------------------------------------------------------------------- 
     427   !> @brief This function initialize an attribute structure with  
    338428   !> real(8) value  
    339    !> 
    340    !> @author J.Paul 
    341    !> - Nov, 2013- Initial Version 
    342    ! 
    343    !> @param[in] cd_name : attribute name 
    344    !> @param[in] dd_value: attribute value 
     429   !> @details 
     430   !> Optionaly you could specify the type of the variable to be saved. 
     431   !> 
     432   !> @author J.Paul 
     433   !> @date November, 2013 - Initial Version 
     434   ! 
     435   !> @param[in] cd_name   attribute name 
     436   !> @param[in] dd_value  attribute value 
     437   !> @param[in] id_type   type of the variable to be saved 
    345438   !> @return attribute structure 
    346439   !------------------------------------------------------------------- 
    347    !> @code 
    348    TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value ) 
     440   TYPE(TATT) FUNCTION att__init_dp_0d( cd_name, dd_value, id_type ) 
    349441      IMPLICIT NONE 
    350442      ! Argument 
    351443      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    352444      REAL(dp),         INTENT(IN) :: dd_value 
     445      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    353446 
    354447      ! local value 
    … …  
    361454      cl_value="(/"//TRIM(fct_str(dd_value))//"/)" 
    362455 
    363       CALL logger_info( & 
     456      CALL logger_trace( & 
    364457      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    365458      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    … …  
    367460      att__init_dp_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    368461 
    369       att__init_dp_0d%i_type=NF90_DOUBLE 
     462      IF( PRESENT(id_type) )THEN 
     463         att__init_dp_0d%i_type=id_type 
     464      ELSE 
     465         att__init_dp_0d%i_type=NF90_DOUBLE 
     466      ENDIF 
    370467 
    371468      IF( ASSOCIATED(att__init_dp_0d%d_value) )THEN 
    … …  
    378475 
    379476   END FUNCTION att__init_dp_0d 
    380    !> @endcode 
    381    !------------------------------------------------------------------- 
    382    !> @brief This function initialise an attribute structure with table  
    383    !> of real(4) value 
    384    !> 
    385    !> @author J.Paul 
    386    !> - Nov, 2013- Initial Version 
    387    ! 
    388    !> @param[in] cd_name : attribute name 
    389    !> @param[in] rd_value: attribute value 
     477   !------------------------------------------------------------------- 
     478   !> @brief This function initialize an attribute structure with array  
     479   !> of real(4) value. 
     480   !> @details 
     481   !> Optionaly you could specify the type of the variable to be saved. 
     482   !> 
     483   !> @author J.Paul 
     484   !> @date November, 2013 - Initial Version 
     485   ! 
     486   !> @param[in] cd_name   attribute name 
     487   !> @param[in] rd_value  attribute value 
     488   !> @param[in] id_type   type of the variable to be saved 
    390489   !> @return attribute structure 
    391490   !------------------------------------------------------------------- 
    392    !> @code 
    393    TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value ) 
     491   TYPE(TATT) FUNCTION att__init_sp( cd_name, rd_value, id_type ) 
    394492      IMPLICIT NONE 
    395493      ! Argument 
    396494      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    397495      REAL(sp),         DIMENSION(:), INTENT(IN) :: rd_value 
     496      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    398497 
    399498      ! local value 
    … …  
    408507      CALL att_clean(att__init_sp) 
    409508       
    410       ! table size 
     509      ! array size 
    411510      il_len=size(rd_value(:)) 
    412511 
    … …  
    417516      cl_value=TRIM(cl_value)//TRIM(fct_str(rd_value(il_len)))//"/)" 
    418517 
    419       CALL logger_info( & 
     518      CALL logger_trace( & 
    420519      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    421520      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    423522      att__init_sp%c_name=TRIM(ADJUSTL(cd_name)) 
    424523 
    425       att__init_sp%i_type=NF90_FLOAT 
     524      IF( PRESENT(id_type) )THEN 
     525         att__init_sp%i_type=id_type 
     526      ELSE 
     527         att__init_sp%i_type=NF90_FLOAT 
     528      ENDIF 
    426529 
    427530      IF( ASSOCIATED(att__init_sp%d_value) )THEN 
    … …  
    434537 
    435538   END FUNCTION att__init_sp 
    436    !> @endcode 
    437    !------------------------------------------------------------------- 
    438    !> @brief This function initialise an attribute structure with  
    439    !> real(4) value  
    440    !> 
    441    !> @author J.Paul 
    442    !> - Nov, 2013- Initial Version 
    443    ! 
    444    !> @param[in] cd_name : attribute name 
    445    !> @param[in] rd_value: attribute value 
     539   !------------------------------------------------------------------- 
     540   !> @brief This function initialize an attribute structure with  
     541   !> real(4) value.  
     542   !> @details 
     543   !> Optionaly you could specify the type of the variable to be saved. 
     544   !> 
     545   !> @author J.Paul 
     546   !> @date November, 2013 - Initial Version 
     547   ! 
     548   !> @param[in] cd_name   attribute name 
     549   !> @param[in] rd_value  attribute value 
     550   !> @param[in] id_type   type of the variable to be saved 
    446551   !> @return attribute structure 
    447552   !------------------------------------------------------------------- 
    448    !> @code 
    449    TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value ) 
     553   TYPE(TATT) FUNCTION att__init_sp_0d( cd_name, rd_value, id_type ) 
    450554      IMPLICIT NONE 
    451555      ! Argument 
    452556      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    453557      REAL(sp),         INTENT(IN) :: rd_value 
     558      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    454559 
    455560      ! local value 
    … …  
    462567      cl_value="(/"//TRIM(fct_str(rd_value))//"/)" 
    463568 
    464       CALL logger_info( & 
     569      CALL logger_trace( & 
    465570      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    466571      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    468573      att__init_sp_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    469574 
    470       att__init_sp_0d%i_type=NF90_FLOAT 
     575      IF( PRESENT(id_type) )THEN 
     576         att__init_sp_0d%i_type=id_type 
     577      ELSE 
     578         att__init_sp_0d%i_type=NF90_FLOAT 
     579      ENDIF 
    471580 
    472581      IF( ASSOCIATED(att__init_sp_0d%d_value) )THEN 
    … …  
    479588 
    480589   END FUNCTION att__init_sp_0d 
    481    !> @endcode 
    482    !------------------------------------------------------------------- 
    483    !> @brief This function initialise an attribute structure with table  
    484    !> of integer(1) value 
    485    !> 
    486    !> @author J.Paul 
    487    !> - Nov, 2013- Initial Version 
    488    ! 
    489    !> @param[in] cd_name : attribute name 
    490    !> @param[in] bd_value: attribute value 
     590   !------------------------------------------------------------------- 
     591   !> @brief This function initialize an attribute structure with array  
     592   !> of integer(1) value. 
     593   !> @details 
     594   !> Optionaly you could specify the type of the variable to be saved. 
     595   !> 
     596   !> @author J.Paul 
     597   !> @date November, 2013 - Initial Version 
     598   ! 
     599   !> @param[in] cd_name   attribute name 
     600   !> @param[in] bd_value  attribute value 
     601   !> @param[in] id_type   type of the variable to be saved 
    491602   !> @return attribute structure 
    492603   !------------------------------------------------------------------- 
    493    !> @code 
    494    TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value ) 
     604   TYPE(TATT) FUNCTION att__init_i1( cd_name, bd_value, id_type ) 
    495605      IMPLICIT NONE 
    496606      ! Argument 
    497607      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    498608      INTEGER(i1),      DIMENSION(:), INTENT(IN) :: bd_value 
     609      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    499610 
    500611      ! local value 
    … …  
    509620      CALL att_clean(att__init_i1) 
    510621       
    511       ! table size 
     622      ! array size 
    512623      il_len=size(bd_value(:)) 
    513624 
    … …  
    518629      cl_value=TRIM(cl_value)//TRIM(fct_str(bd_value(il_len)))//"/)" 
    519630 
    520       CALL logger_info( & 
     631      CALL logger_trace( & 
    521632      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    522633      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    524635      att__init_i1%c_name=TRIM(ADJUSTL(cd_name)) 
    525636 
    526       att__init_i1%i_type=NF90_BYTE 
     637      IF( PRESENT(id_type) )THEN 
     638         att__init_i1%i_type=id_type 
     639      ELSE 
     640         att__init_i1%i_type=NF90_BYTE 
     641      ENDIF 
    527642 
    528643      IF( ASSOCIATED(att__init_i1%d_value) )THEN 
    … …  
    535650 
    536651   END FUNCTION att__init_i1 
    537    !> @endcode 
    538    !------------------------------------------------------------------- 
    539    !> @brief This function initialise an attribute structure with  
    540    !> integer(1) value  
    541    !> 
    542    !> @author J.Paul 
    543    !> - Nov, 2013- Initial Version 
    544    ! 
    545    !> @param[in] cd_name : attribute name 
    546    !> @param[in] bd_value: attribute value 
     652   !------------------------------------------------------------------- 
     653   !> @brief This function initialize an attribute structure with  
     654   !> integer(1) value.  
     655   !> @details 
     656   !> Optionaly you could specify the type of the variable to be saved. 
     657   !> 
     658   !> @author J.Paul 
     659   !> @date November, 2013 - Initial Version 
     660   ! 
     661   !> @param[in] cd_name   attribute name 
     662   !> @param[in] bd_value  attribute value 
     663   !> @param[in] id_type   type of the variable to be saved 
    547664   !> @return attribute structure 
    548665   !------------------------------------------------------------------- 
    549    !> @code 
    550    TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value ) 
     666   TYPE(TATT) FUNCTION att__init_i1_0d( cd_name, bd_value, id_type ) 
    551667      IMPLICIT NONE 
    552668      ! Argument 
    553669      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    554670      INTEGER(i1),      INTENT(IN) :: bd_value 
     671      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    555672 
    556673      !local value 
    … …  
    563680      cl_value="(/"//TRIM(fct_str(bd_value))//"/)" 
    564681 
    565       CALL logger_info( & 
     682      CALL logger_trace( & 
    566683      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    567684      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    569686      att__init_i1_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    570687 
    571       att__init_i1_0d%i_type=NF90_BYTE 
     688      IF( PRESENT(id_type) )THEN 
     689         att__init_i1_0d%i_type=id_type 
     690      ELSE 
     691         att__init_i1_0d%i_type=NF90_BYTE 
     692      ENDIF       
    572693 
    573694      IF( ASSOCIATED(att__init_i1_0d%d_value) )THEN 
    … …  
    580701 
    581702   END FUNCTION att__init_i1_0d 
    582    !> @endcode 
    583    !------------------------------------------------------------------- 
    584    !> @brief This function initialise an attribute structure with table  
    585    !> of integer(2) value 
    586    !> 
    587    !> @author J.Paul 
    588    !> - Nov, 2013- Initial Version 
    589    ! 
    590    !> @param[in] cd_name : attribute name 
    591    !> @param[in] sd_value: attribute value 
     703   !------------------------------------------------------------------- 
     704   !> @brief This function initialize an attribute structure with array  
     705   !> of integer(2) value. 
     706   !> @details 
     707   !> Optionaly you could specify the type of the variable to be saved. 
     708   !> 
     709   !> @author J.Paul 
     710   !> @date November, 2013 - Initial Version 
     711   ! 
     712   !> @param[in] cd_name   attribute name 
     713   !> @param[in] sd_value  attribute value 
     714   !> @param[in] id_type   type of the variable to be saved 
    592715   !> @return attribute structure 
    593716   !------------------------------------------------------------------- 
    594    !> @code 
    595    TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value ) 
     717   TYPE(TATT) FUNCTION att__init_i2( cd_name, sd_value, id_type ) 
    596718      IMPLICIT NONE 
    597719      ! Argument 
    598720      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    599721      INTEGER(i2),      DIMENSION(:), INTENT(IN) :: sd_value 
     722      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    600723 
    601724      ! local value 
    … …  
    610733      CALL att_clean(att__init_i2) 
    611734       
    612       ! table size 
     735      ! array size 
    613736      il_len=size(sd_value(:)) 
    614737 
    … …  
    619742      cl_value=TRIM(cl_value)//TRIM(fct_str(sd_value(il_len)))//"/)" 
    620743 
    621       CALL logger_info( & 
     744      CALL logger_trace( & 
    622745      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    623746      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    625748      att__init_i2%c_name=TRIM(ADJUSTL(cd_name)) 
    626749 
    627       att__init_i2%i_type=NF90_SHORT 
     750      IF( PRESENT(id_type) )THEN 
     751         att__init_i2%i_type=id_type 
     752      ELSE 
     753         att__init_i2%i_type=NF90_SHORT 
     754      ENDIF 
    628755 
    629756      IF( ASSOCIATED(att__init_i2%d_value) )THEN 
    … …  
    636763 
    637764   END FUNCTION att__init_i2 
    638    !> @endcode 
    639    !------------------------------------------------------------------- 
    640    !> @brief This function initialise an attribute structure with  
    641    !> integer(2) value  
    642    !> 
    643    !> @author J.Paul 
    644    !> - Nov, 2013- Initial Version 
    645    ! 
    646    !> @param[in] cd_name : attribute name 
    647    !> @param[in] sd_value: attribute value 
     765   !------------------------------------------------------------------- 
     766   !> @brief This function initialize an attribute structure with  
     767   !> integer(2) value.  
     768   !> @details 
     769   !> Optionaly you could specify the type of the variable to be saved. 
     770   !> 
     771   !> @author J.Paul 
     772   !> @date November, 2013 - Initial Version 
     773   ! 
     774   !> @param[in] cd_name   attribute name 
     775   !> @param[in] sd_value  attribute value 
     776   !> @param[in] id_type   type of the variable to be saved 
    648777   !> @return attribute structure 
    649778   !------------------------------------------------------------------- 
    650    !> @code 
    651    TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value ) 
     779   TYPE(TATT) FUNCTION att__init_i2_0d( cd_name, sd_value, id_type ) 
    652780      IMPLICIT NONE 
    653781      ! Argument 
    654782      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    655783      INTEGER(i2),      INTENT(IN) :: sd_value 
     784      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    656785 
    657786      !local value 
    … …  
    664793      cl_value="(/"//TRIM(fct_str(sd_value))//"/)" 
    665794 
    666       CALL logger_info( & 
     795      CALL logger_trace( & 
    667796      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    668797      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    670799      att__init_i2_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    671800 
    672       att__init_i2_0d%i_type=NF90_SHORT 
     801      IF( PRESENT(id_type) )THEN 
     802         att__init_i2_0d%i_type=id_type 
     803      ELSE 
     804         att__init_i2_0d%i_type=NF90_SHORT 
     805      ENDIF 
    673806 
    674807      IF( ASSOCIATED(att__init_i2_0d%d_value) )THEN 
    … …  
    681814 
    682815   END FUNCTION att__init_i2_0d 
    683    !> @endcode 
    684    !------------------------------------------------------------------- 
    685    !> @brief This function initialise an attribute structure with table  
    686    !> of integer(4) value 
    687    !> 
    688    !> @author J.Paul 
    689    !> - Nov, 2013- Initial Version 
    690    ! 
    691    !> @param[in] cd_name : attribute name 
    692    !> @param[in] id_value: attribute value 
     816   !------------------------------------------------------------------- 
     817   !> @brief This function initialize an attribute structure with array  
     818   !> of integer(4) value. 
     819   !> @details 
     820   !> Optionaly you could specify the type of the variable to be saved. 
     821   !> 
     822   !> @author J.Paul 
     823   !> @date November, 2013 - Initial Version 
     824   ! 
     825   !> @param[in] cd_name   attribute name 
     826   !> @param[in] id_value  attribute value 
     827   !> @param[in] id_type   type of the variable to be saved 
    693828   !> @return attribute structure 
    694829   !------------------------------------------------------------------- 
    695    !> @code 
    696    TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value ) 
     830   TYPE(TATT) FUNCTION att__init_i4( cd_name, id_value, id_type ) 
    697831      IMPLICIT NONE 
    698832      ! Argument 
    699833      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    700834      INTEGER(i4),      DIMENSION(:), INTENT(IN) :: id_value 
     835      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    701836 
    702837      ! local value 
    … …  
    711846      CALL att_clean(att__init_i4) 
    712847       
    713       ! table size 
     848      ! array size 
    714849      il_len=size(id_value(:)) 
    715850 
    … …  
    720855      cl_value=TRIM(cl_value)//TRIM(fct_str(id_value(il_len)))//"/)" 
    721856 
    722       CALL logger_info( & 
     857      CALL logger_trace( & 
    723858      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    724859      &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    726861      att__init_i4%c_name=TRIM(ADJUSTL(cd_name)) 
    727862 
    728       att__init_i4%i_type=NF90_INT 
     863      IF( PRESENT(id_type) )THEN 
     864         att__init_i4%i_type=id_type 
     865      ELSE 
     866         att__init_i4%i_type=NF90_INT 
     867      ENDIF 
    729868 
    730869      IF( ASSOCIATED(att__init_i4%d_value) )THEN 
    … …  
    737876 
    738877   END FUNCTION att__init_i4 
    739    !> @endcode 
    740    !------------------------------------------------------------------- 
    741    !> @brief This function initialise an attribute structure with  
    742    !> integer(4) value  
    743    !> 
    744    !> @author J.Paul 
    745    !> - Nov, 2013- Initial Version 
    746    ! 
    747    !> @param[in] cd_name : attribute name 
    748    !> @param[in] id_value: attribute value 
     878   !------------------------------------------------------------------- 
     879   !> @brief This function initialize an attribute structure with  
     880   !> integer(4) value.  
     881   !> @details 
     882   !> Optionaly you could specify the type of the variable to be saved. 
     883   !> 
     884   !> @author J.Paul 
     885   !> @date November, 2013 - Initial Version 
     886   !> 
     887   !> @param[in] cd_name   attribute name 
     888   !> @param[in] id_value  attribute value 
     889   !> @param[in] id_type   type of the variable to be saved 
    749890   !> @return attribute structure 
    750891   !------------------------------------------------------------------- 
    751    !> @code 
    752    TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value ) 
     892   TYPE(TATT) FUNCTION att__init_i4_0d( cd_name, id_value, id_type ) 
    753893      IMPLICIT NONE 
    754894      ! Argument 
    755895      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    756896      INTEGER(i4),      INTENT(IN) :: id_value 
     897      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    757898 
    758899      !local value 
    … …  
    765906      cl_value="(/"//TRIM(fct_str(id_value))//"/)" 
    766907 
    767       CALL logger_info( & 
     908      CALL logger_trace( & 
    768909      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    769910      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    771912      att__init_i4_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    772913 
    773       att__init_i4_0d%i_type=NF90_INT 
     914      IF( PRESENT(id_type) )THEN 
     915         att__init_i4_0d%i_type=id_type 
     916      ELSE 
     917         att__init_i4_0d%i_type=NF90_INT 
     918      ENDIF 
    774919 
    775920      IF( ASSOCIATED(att__init_i4_0d%d_value) )THEN 
    … …  
    782927 
    783928   END FUNCTION att__init_i4_0d 
    784    !> @endcode 
    785    !------------------------------------------------------------------- 
    786    !> @brief This function initialise an attribute structure with table  
    787    !> of integer(8) value 
    788    !> 
    789    !> @author J.Paul 
    790    !> - Nov, 2013- Initial Version 
    791    ! 
    792    !> @param[in] cd_name : attribute name 
    793    !> @param[in] kd_value: attribute value 
     929   !------------------------------------------------------------------- 
     930   !> @brief This function initialize an attribute structure with array  
     931   !> of integer(8) value. 
     932   !> @details 
     933   !> Optionaly you could specify the type of the variable to be saved. 
     934   !> 
     935   !> @author J.Paul 
     936   !> @date November, 2013 - Initial Version 
     937   ! 
     938   !> @param[in] cd_name   attribute name 
     939   !> @param[in] kd_value  attribute value 
     940   !> @param[in] id_type   type of the variable to be saved 
    794941   !> @return attribute structure 
    795942   !------------------------------------------------------------------- 
    796    !> @code 
    797    TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value ) 
     943   TYPE(TATT) FUNCTION att__init_i8( cd_name, kd_value, id_type ) 
    798944      IMPLICIT NONE 
    799945      ! Argument 
    800946      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    801947      INTEGER(i8),      DIMENSION(:), INTENT(IN) :: kd_value 
     948      INTEGER(i4)                   , INTENT(IN), OPTIONAL :: id_type 
    802949 
    803950      ! local value 
    … …  
    812959      CALL att_clean(att__init_i8) 
    813960       
    814       ! table size 
     961      ! array size 
    815962      il_len=size(kd_value(:)) 
    816963 
    … …  
    821968      cl_value=TRIM(cl_value)//TRIM(fct_str(kd_value(il_len)))//"/)" 
    822969 
    823       CALL logger_info( & 
     970      CALL logger_trace( & 
    824971      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    825972      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    827974      att__init_i8%c_name=TRIM(ADJUSTL(cd_name)) 
    828975 
    829       att__init_i8%i_type=NF90_INT 
     976      IF( PRESENT(id_type) )THEN 
     977         att__init_i8%i_type=id_type 
     978      ELSE 
     979         att__init_i8%i_type=NF90_INT 
     980      ENDIF 
    830981 
    831982      IF( ASSOCIATED(att__init_i8%d_value) )THEN 
    … …  
    838989 
    839990   END FUNCTION att__init_i8 
    840    !> @endcode 
    841    !------------------------------------------------------------------- 
    842    !> @brief This function initialise an attribute structure with  
    843    !> integer(8) value  
    844    !> 
    845    !> @author J.Paul 
    846    !> - Nov, 2013- Initial Version 
    847    ! 
    848    !> @param[in] cd_name : attribute name 
    849    !> @param[in] kd_value: attribute value 
     991   !------------------------------------------------------------------- 
     992   !> @brief This function initialize an attribute structure with  
     993   !> integer(8) value.  
     994   !> @details 
     995   !> Optionaly you could specify the type of the variable to be saved. 
     996   !> 
     997   !> @author J.Paul 
     998   !> @date November, 2013 - Initial Version 
     999   ! 
     1000   !> @param[in] cd_name   attribute name 
     1001   !> @param[in] kd_value  attribute value 
     1002   !> @param[in] id_type   type of the variable to be saved 
    8501003   !> @return attribute structure 
    8511004   !------------------------------------------------------------------- 
    852    !> @code 
    853    TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value ) 
     1005   TYPE(TATT) FUNCTION att__init_i8_0d( cd_name, kd_value, id_type ) 
    8541006      IMPLICIT NONE 
    8551007      ! Argument 
    8561008      CHARACTER(LEN=*), INTENT(IN) :: cd_name 
    8571009      INTEGER(i8),      INTENT(IN) :: kd_value 
     1010      INTEGER(i4)     , INTENT(IN), OPTIONAL :: id_type 
    8581011 
    8591012      ! local value 
    … …  
    8661019      cl_value="(/"//TRIM(fct_str(kd_value))//"/)" 
    8671020 
    868       CALL logger_info( & 
     1021      CALL logger_trace( & 
    8691022      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    8701023      &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
    … …  
    8721025      att__init_i8_0d%c_name=TRIM(ADJUSTL(cd_name)) 
    8731026 
    874       att__init_i8_0d%i_type=NF90_INT 
     1027      IF( PRESENT(id_type) )THEN 
     1028         att__init_i8_0d%i_type=id_type 
     1029      ELSE 
     1030         att__init_i8_0d%i_type=NF90_INT 
     1031      ENDIF 
    8751032 
    8761033      IF( ASSOCIATED(att__init_i8_0d%d_value) )THEN 
    … …  
    8831040 
    8841041   END FUNCTION att__init_i8_0d 
    885    !> @endcode    
    886    !------------------------------------------------------------------- 
    887    !> @brief This subroutine print attribute information 
    888    !> 
    889    !> @author J.Paul 
    890    !> - Nov, 2013- Initial Version 
    891    ! 
    892    !> @param[in] td_att : attribute structure 
    893    !------------------------------------------------------------------- 
    894    !> @code 
    895    SUBROUTINE att_print(td_att) 
     1042   !------------------------------------------------------------------- 
     1043   !> @brief This subroutine print informations of an array of attribute.  
     1044   !> 
     1045   !> @author J.Paul 
     1046   !> @date June, 2014 - Initial Version 
     1047   !> 
     1048   !> @param[in] td_att array of attribute structure 
     1049   !------------------------------------------------------------------- 
     1050   SUBROUTINE att__print_arr(td_att) 
     1051      IMPLICIT NONE 
     1052 
     1053      ! Argument       
     1054      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 
     1055 
     1056      ! loop indices 
     1057      INTEGER(i4) :: ji 
     1058      !---------------------------------------------------------------- 
     1059 
     1060      DO ji=1,SIZE(td_att(:)) 
     1061         CALL att_print(td_att(ji)) 
     1062      ENDDO 
     1063 
     1064   END SUBROUTINE att__print_arr 
     1065   !------------------------------------------------------------------- 
     1066   !> @brief This subroutine print attribute information. 
     1067   !> 
     1068   !> @author J.Paul 
     1069   !> @date November, 2013 - Initial Version 
     1070   !> @date September, 2014 - take into account type of attribute. 
     1071   ! 
     1072   !> @param[in] td_att attribute structure 
     1073   !------------------------------------------------------------------- 
     1074   SUBROUTINE att__print_unit(td_att) 
    8961075      IMPLICIT NONE 
    8971076 
    … …  
    9021081      CHARACTER(LEN=lc) :: cl_type 
    9031082      CHARACTER(LEN=lc) :: cl_value 
    904       CHARACTER(LEN=lc) :: cl_tmp 
     1083 
     1084      INTEGER(i8)       :: kl_tmp 
     1085      INTEGER(i2)       :: sl_tmp 
     1086      INTEGER(i1)       :: bl_tmp 
     1087      REAL(sp)          :: rl_tmp 
     1088      REAL(dp)          :: dl_tmp 
    9051089 
    9061090      ! loop indices 
    … …  
    9241108            CASE DEFAULT 
    9251109               cl_type='' 
    926                !cl_type='unknown' 
     1110 
    9271111         END SELECT 
    9281112 
    … …  
    9321116               cl_value=td_att%c_value 
    9331117 
    934             CASE(NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE)    
     1118            CASE(NF90_BYTE)    
    9351119               IF( td_att%i_len > 1 )THEN 
    936  
    937                   cl_tmp=',' 
    9381120                  cl_value='(/' 
    9391121                  DO ji=1,td_att%i_len-1 
    940                      cl_value=TRIM(cl_value)//& 
    941                      &        TRIM(fct_str(td_att%d_value(ji)))//TRIM(cl_tmp) 
     1122                     bl_tmp=INT(td_att%d_value(ji),i1) 
     1123                     cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//',' 
    9421124                  ENDDO 
    943                   cl_value=TRIM(cl_value)//& 
    944                   &        TRIM(fct_str(td_att%d_value(td_att%i_len)))//'/)' 
    945  
     1125                  bl_tmp=INT(td_att%d_value(td_att%i_len),i1) 
     1126                  cl_value=TRIM(cl_value)//TRIM(fct_str(bl_tmp))//'/)' 
    9461127               ELSE 
    947  
    9481128                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 
    949  
    9501129               ENDIF 
     1130 
     1131            CASE(NF90_SHORT)    
     1132               IF( td_att%i_len > 1 )THEN 
     1133                  cl_value='(/' 
     1134                  DO ji=1,td_att%i_len-1 
     1135                     sl_tmp=INT(td_att%d_value(ji),i2) 
     1136                     cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//',' 
     1137                  ENDDO 
     1138                  sl_tmp=INT(td_att%d_value(td_att%i_len),i2) 
     1139                  cl_value=TRIM(cl_value)//TRIM(fct_str(sl_tmp))//'/)' 
     1140               ELSE 
     1141                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 
     1142               ENDIF 
     1143 
     1144            CASE(NF90_INT)    
     1145               IF( td_att%i_len > 1 )THEN 
     1146                  cl_value='(/' 
     1147                  DO ji=1,td_att%i_len-1 
     1148                     kl_tmp=INT(td_att%d_value(ji),i8) 
     1149                     cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//',' 
     1150                  ENDDO 
     1151                  kl_tmp=INT(td_att%d_value(td_att%i_len),i8) 
     1152                  cl_value=TRIM(cl_value)//TRIM(fct_str(kl_tmp))//'/)' 
     1153               ELSE 
     1154                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 
     1155               ENDIF 
     1156 
     1157            CASE(NF90_FLOAT)    
     1158               IF( td_att%i_len > 1 )THEN 
     1159                  cl_value='(/' 
     1160                  DO ji=1,td_att%i_len-1 
     1161                     rl_tmp=REAL(td_att%d_value(ji),sp) 
     1162                     cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//',' 
     1163                  ENDDO 
     1164                  rl_tmp=REAL(td_att%d_value(td_att%i_len),sp) 
     1165                  cl_value=TRIM(cl_value)//TRIM(fct_str(rl_tmp))//'/)' 
     1166               ELSE 
     1167                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 
     1168               ENDIF 
     1169 
     1170            CASE(NF90_DOUBLE)    
     1171               IF( td_att%i_len > 1 )THEN 
     1172                  cl_value='(/' 
     1173                  DO ji=1,td_att%i_len-1 
     1174                     dl_tmp=REAL(td_att%d_value(ji),dp) 
     1175                     cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//',' 
     1176                  ENDDO 
     1177                  dl_tmp=REAL(td_att%d_value(td_att%i_len),dp) 
     1178                  cl_value=TRIM(cl_value)//TRIM(fct_str(dl_tmp))//'/)' 
     1179               ELSE 
     1180                  cl_value='(/'//TRIM(fct_str(td_att%d_value(1)))//'/)' 
     1181               ENDIF 
     1182 
    9511183            CASE DEFAULT 
    9521184               cl_value="none" 
    … …  
    9601192         &        " value : ",TRIM(ADJUSTL(cl_value)) 
    9611193 
    962    END SUBROUTINE att_print 
    963    !> @endcode 
     1194   END SUBROUTINE att__print_unit 
    9641195   !------------------------------------------------------------------- 
    9651196   !> @brief  
    … …  
    9671198   ! 
    9681199   !> @author J.Paul 
    969    !> @date Nov, 2013 
    970    ! 
    971    !> @param[inout] td_att : attribute strcuture 
    972    !------------------------------------------------------------------- 
    973    !> @code 
    974    SUBROUTINE att_clean( td_att ) 
     1200   !> @date November, 2013 - Initial Version 
     1201   ! 
     1202   !> @param[inout] td_att attribute strcuture 
     1203   !------------------------------------------------------------------- 
     1204   SUBROUTINE att__clean_unit( td_att ) 
    9751205      IMPLICIT NONE 
    9761206      ! Argument 
    … …  
    9811211      !---------------------------------------------------------------- 
    9821212 
    983       CALL logger_info( & 
     1213      CALL logger_trace( & 
    9841214      &  " CLEAN: reset attribute "//TRIM(td_att%c_name) ) 
    9851215 
    … …  
    9901220 
    9911221      ! replace by empty structure 
    992       td_att=tl_att 
    993  
    994    END SUBROUTINE att_clean 
    995    !> @endcode 
     1222      td_att=att_copy(tl_att) 
     1223 
     1224   END SUBROUTINE att__clean_unit 
     1225   !------------------------------------------------------------------- 
     1226   !> @brief  
     1227   !>  This subroutine clean array of attribute strcuture. 
     1228   ! 
     1229   !> @author J.Paul 
     1230   !> @date September, 2014 - Initial Version 
     1231   ! 
     1232   !> @param[inout] td_att attribute strcuture 
     1233   !------------------------------------------------------------------- 
     1234   SUBROUTINE att__clean_arr( td_att ) 
     1235      IMPLICIT NONE 
     1236      ! Argument 
     1237      TYPE(TATT), DIMENSION(:), INTENT(INOUT) :: td_att 
     1238 
     1239      ! local variable 
     1240      ! loop indices 
     1241      INTEGER(i4) :: ji 
     1242      !---------------------------------------------------------------- 
     1243 
     1244      DO ji=SIZE(td_att(:)),1,-1 
     1245         CALL att_clean(td_att(ji) ) 
     1246      ENDDO 
     1247 
     1248   END SUBROUTINE att__clean_arr 
    9961249END MODULE att 
    9971250 
Note: See TracChangeset for help on using the changeset viewer.