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 13369 for utils/tools/SIREN/src/attribute.f90 – NEMO

Ignore:
Timestamp:
2020-07-31T10:50:52+02:00 (4 years ago)
Author:
jpaul
Message:

update: cf changelog inside documentation

File:
1 edited

Legend:

Unmodified
Added
Removed

  • utils/tools/SIREN/src/attribute.f90

    r12080 r13369  
    44! 
    55! DESCRIPTION: 
    6 !> @brief  
     6!> @brief 
    77!> This module manage attribute of variable or file. 
    88!> 
    … …  
    2828!>    to print attribute information of one or array of attribute structure:<br/> 
    2929!> @code 
    30 !>    CALL att_print(td_att)  
     30!>    CALL att_print(td_att) 
    3131!> @endcode 
    3232!> 
    3333!>    to clean attribute structure:<br/> 
    3434!> @code 
    35 !>    CALL att_clean(td_att)  
     35!>    CALL att_clean(td_att) 
    3636!> @endcode 
    3737!> 
    3838!>    to copy attribute structure in another one (using different memory cell):<br/> 
    3939!> @code 
    40 !>    tl_att2=att_copy(tl_att1)  
     40!>    tl_att2=att_copy(tl_att1) 
    4141!> @endcode 
    4242!>    @note as we use pointer for the value array of the attribute structure, 
    43 !>    the use of the assignment operator (=) to copy attribute structure  
    44 !>    create a pointer on the same array.  
     43!>    the use of the assignment operator (=) to copy attribute structure 
     44!>    create a pointer on the same array. 
    4545!>    This is not the case with this copy function. 
    4646!> 
    … …  
    5151!>    - td_att array of attribute structure 
    5252!>    - cd_name attribute name 
    53 !>  
     53!> 
    5454!>    to get attribute id, read from a file:<br/> 
    5555!>@code 
    … …  
    6161!>    to get attribute name 
    6262!>    - tl_att\%c_name 
    63 !>  
     63!> 
    6464!>    to get character length or the number of value store in attribute 
    6565!>    - tl_att\%i_len 
    … …  
    6868!>    - tl_att\%c_value    (for character attribute) 
    6969!>    - tl_att\%d_value(i) (otherwise) 
    70 !>     
    71 !>    to get the type number (based on NETCDF type constants) of the  
     70!> 
     71!>    to get the type number (based on NETCDF type constants) of the 
    7272!>    attribute:<br/> 
    7373!>    - tl_att\%i_type 
    … …  
    7979!> 
    8080!> @date November, 2013 - Initial Version 
    81 !> @date November, 2014  
     81!> @date November, 2014 
    8282!> - Fix memory leaks bug 
    8383!> @date September, 2015 
    … …  
    149149 
    150150   INTERFACE att_init 
    151       MODULE PROCEDURE att__init_c     
     151      MODULE PROCEDURE att__init_c 
    152152      MODULE PROCEDURE att__init_dp 
    153153      MODULE PROCEDURE att__init_dp_0d 
    … …  
    170170 
    171171   INTERFACE att_clean 
    172       MODULE PROCEDURE att__clean_unit   
    173       MODULE PROCEDURE att__clean_arr    
     172      MODULE PROCEDURE att__clean_unit 
     173      MODULE PROCEDURE att__clean_arr 
    174174   END INTERFACE 
    175175 
    … …  
    182182   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    183183   FUNCTION att__copy_arr(td_att) & 
    184          & RESULT(tf_att)       
     184         & RESULT(tf_att) 
    185185   !------------------------------------------------------------------- 
    186186   !> @brief 
    187187   !> This subroutine copy a array of attribute structure in another one 
    188    !> @details  
     188   !> @details 
    189189   !> see att__copy_unit 
    190190   !> 
    … …  
    192192   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
    193193   !> This will create memory leaks. 
    194    !> @warning to avoid infinite loop, do not use any function inside  
     194   !> @warning to avoid infinite loop, do not use any function inside 
    195195   !> this subroutine 
    196196   !> 
    … …  
    198198   !> @date November, 2013 - Initial Version 
    199199   !> @date November, 2014 
    200    !> - use function instead of overload assignment operator  
    201    !> (to avoid memory leak)  
    202    ! 
     200   !> - use function instead of overload assignment operator 
     201   !> (to avoid memory leak) 
     202   !> 
    203203   !> @param[in] td_att   array of attribute structure 
    204204   !> @return copy of input array of attribute structure 
    … …  
    228228   !> @brief 
    229229   !> This subroutine copy an attribute structure in another one. 
    230    !> @details  
     230   !> @details 
    231231   !> attribute value are copied in a temporary array, so input and output 
    232232   !> attribute structure value do not point on the same "memory cell", and so 
    233    !> on are independant.  
     233   !> on are independant. 
    234234   !> 
    235235   !> @warning do not use on the output of a function who create or read an 
    236236   !> attribute (ex: tl_att=att_copy(att_init()) is forbidden). 
    237237   !> This will create memory leaks. 
    238    !> @warning to avoid infinite loop, do not use any function inside  
     238   !> @warning to avoid infinite loop, do not use any function inside 
    239239   !> this subroutine 
    240240   !> 
    … …  
    242242   !> @date November, 2013 - Initial Version 
    243243   !> @date November, 2014 
    244    !> - use function instead of overload assignment operator (to avoid memory leak)  
     244   !> - use function instead of overload assignment operator (to avoid memory leak) 
    245245   !> 
    246246   !> @param[in] td_att   attribute structure 
    … …  
    333333   !> @author J.Paul 
    334334   !> @date November, 2013 - Initial Version 
    335    !> @date September, 2014  
     335   !> @date September, 2014 
    336336   !> - bug fix with use of id read from attribute structure 
    337337   !> 
    … …  
    372372   !------------------------------------------------------------------- 
    373373   !> @brief This function initialize an attribute structure with character 
    374    !> value.  
     374   !> value. 
    375375   !> 
    376376   !> @author J.Paul 
    … …  
    391391      TYPE(TATT)                   :: tf_att 
    392392      !---------------------------------------------------------------- 
    393   
     393 
    394394      ! clean attribute 
    395395      CALL att_clean(tf_att) 
    … …  
    410410         & RESULT (tf_att) 
    411411   !------------------------------------------------------------------- 
    412    !> @brief This function initialize an attribute structure with array  
     412   !> @brief This function initialize an attribute structure with array 
    413413   !> of real(8) value. 
    414414   !> @details 
    … …  
    479479         & RESULT (tf_att) 
    480480   !------------------------------------------------------------------- 
    481    !> @brief This function initialize an attribute structure with  
    482    !> real(8) value  
     481   !> @brief This function initialize an attribute structure with 
     482   !> real(8) value 
    483483   !> @details 
    484484   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    509509      ! clean attribute 
    510510      CALL att_clean(tf_att) 
    511        
     511 
    512512      cl_value="(/"//TRIM(fct_str(dd_value))//"/)" 
    513513 
    … …  
    537537         & RESULT (tf_att) 
    538538   !------------------------------------------------------------------- 
    539    !> @brief This function initialize an attribute structure with array  
     539   !> @brief This function initialize an attribute structure with array 
    540540   !> of real(4) value. 
    541541   !> @details 
    … …  
    571571      ! clean attribute 
    572572      CALL att_clean(tf_att) 
    573        
     573 
    574574      ! array size 
    575575      il_len=size(rd_value(:)) 
    … …  
    586586      CALL logger_trace( & 
    587587      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    588       &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
     588      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    589589 
    590590      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    609609         & RESULT (tf_att) 
    610610   !------------------------------------------------------------------- 
    611    !> @brief This function initialize an attribute structure with  
    612    !> real(4) value.  
     611   !> @brief This function initialize an attribute structure with 
     612   !> real(4) value. 
    613613   !> @details 
    614614   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    639639      ! clean attribute 
    640640      CALL att_clean(tf_att) 
    641        
     641 
    642642      cl_value="(/"//TRIM(fct_str(rd_value))//"/)" 
    643643 
    644644      CALL logger_trace( & 
    645645      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    646       &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
     646      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    647647 
    648648      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    667667         & RESULT (tf_att) 
    668668   !------------------------------------------------------------------- 
    669    !> @brief This function initialize an attribute structure with array  
     669   !> @brief This function initialize an attribute structure with array 
    670670   !> of integer(1) value. 
    671671   !> @details 
    … …  
    701701      ! clean attribute 
    702702      CALL att_clean(tf_att) 
    703        
     703 
    704704      ! array size 
    705705      il_len=size(bd_value(:)) 
    … …  
    713713      CALL logger_trace( & 
    714714      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    715       &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
     715      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    716716 
    717717      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    736736         & RESULT (tf_att) 
    737737   !------------------------------------------------------------------- 
    738    !> @brief This function initialize an attribute structure with  
    739    !> integer(1) value.  
     738   !> @brief This function initialize an attribute structure with 
     739   !> integer(1) value. 
    740740   !> @details 
    741741   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    766766      ! clean attribute 
    767767      CALL att_clean(tf_att) 
    768        
     768 
    769769      cl_value="(/"//TRIM(fct_str(bd_value))//"/)" 
    770770 
    771771      CALL logger_trace( & 
    772772      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    773       &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
     773      &  " attibute value "//TRIM(ADJUSTL(cl_value)) ) 
    774774 
    775775      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    779779      ELSE 
    780780         tf_att%i_type=NF90_BYTE 
    781       ENDIF       
     781      ENDIF 
    782782 
    783783      IF( ASSOCIATED(tf_att%d_value) )THEN 
    … …  
    794794         & RESULT (tf_att) 
    795795   !------------------------------------------------------------------- 
    796    !> @brief This function initialize an attribute structure with array  
     796   !> @brief This function initialize an attribute structure with array 
    797797   !> of integer(2) value. 
    798798   !> @details 
    … …  
    828828      ! clean attribute 
    829829      CALL att_clean(tf_att) 
    830        
     830 
    831831      ! array size 
    832832      il_len=size(sd_value(:)) 
    … …  
    840840      CALL logger_trace( & 
    841841      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    842       &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
     842      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    843843 
    844844      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    863863         & RESULT (tf_att) 
    864864   !------------------------------------------------------------------- 
    865    !> @brief This function initialize an attribute structure with  
    866    !> integer(2) value.  
     865   !> @brief This function initialize an attribute structure with 
     866   !> integer(2) value. 
    867867   !> @details 
    868868   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    893893      ! clean attribute 
    894894      CALL att_clean(tf_att) 
    895        
     895 
    896896      cl_value="(/"//TRIM(fct_str(sd_value))//"/)" 
    897897 
    898898      CALL logger_trace( & 
    899899      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    900       &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
     900      &  " attibute value "//TRIM(ADJUSTL(cl_value)) ) 
    901901 
    902902      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    921921         & RESULT(tf_att) 
    922922   !------------------------------------------------------------------- 
    923    !> @brief This function initialize an attribute structure with array  
     923   !> @brief This function initialize an attribute structure with array 
    924924   !> of integer(4) value. 
    925925   !> @details 
    … …  
    955955      ! clean attribute 
    956956      CALL att_clean(tf_att) 
    957        
     957 
    958958      ! array size 
    959959      il_len=size(id_value(:)) 
    … …  
    967967      CALL logger_trace( & 
    968968      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    969       &  " attribute value "//TRIM(ADJUSTL(cl_value)) )       
     969      &  " attribute value "//TRIM(ADJUSTL(cl_value)) ) 
    970970 
    971971      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    990990         & RESULT (tf_att) 
    991991   !------------------------------------------------------------------- 
    992    !> @brief This function initialize an attribute structure with  
    993    !> integer(4) value.  
     992   !> @brief This function initialize an attribute structure with 
     993   !> integer(4) value. 
    994994   !> @details 
    995995   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    10201020      ! clean attribute 
    10211021      CALL att_clean(tf_att) 
    1022        
     1022 
    10231023      cl_value="(/"//TRIM(fct_str(id_value))//"/)" 
    10241024 
    10251025      CALL logger_trace( & 
    10261026      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    1027       &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
     1027      &  " attibute value "//TRIM(ADJUSTL(cl_value)) ) 
    10281028 
    10291029      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    10481048         & RESULT (tf_att) 
    10491049   !------------------------------------------------------------------- 
    1050    !> @brief This function initialize an attribute structure with array  
     1050   !> @brief This function initialize an attribute structure with array 
    10511051   !> of integer(8) value. 
    10521052   !> @details 
    … …  
    10821082      ! clean attribute 
    10831083      CALL att_clean(tf_att) 
    1084        
     1084 
    10851085      ! array size 
    10861086      il_len=size(kd_value(:)) 
    … …  
    10941094      CALL logger_trace( & 
    10951095      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    1096       &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
     1096      &  " attibute value "//TRIM(ADJUSTL(cl_value)) ) 
    10971097 
    10981098      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    11171117         & RESULT (tf_att) 
    11181118   !------------------------------------------------------------------- 
    1119    !> @brief This function initialize an attribute structure with  
    1120    !> integer(8) value.  
     1119   !> @brief This function initialize an attribute structure with 
     1120   !> integer(8) value. 
    11211121   !> @details 
    11221122   !> Optionaly you could specify the type of the variable to be saved. 
    … …  
    11471147      ! clean attribute 
    11481148      CALL att_clean(tf_att) 
    1149        
     1149 
    11501150      cl_value="(/"//TRIM(fct_str(kd_value))//"/)" 
    11511151 
    11521152      CALL logger_trace( & 
    11531153      &  " ATT INIT: attribute name: "//TRIM(ADJUSTL(cd_name))//& 
    1154       &  " attibute value "//TRIM(ADJUSTL(cl_value)) )       
     1154      &  " attibute value "//TRIM(ADJUSTL(cl_value)) ) 
    11551155 
    11561156      tf_att%c_name=TRIM(ADJUSTL(cd_name)) 
    … …  
    11741174   SUBROUTINE att__print_arr(td_att) 
    11751175   !------------------------------------------------------------------- 
    1176    !> @brief This subroutine print informations of an array of attribute.  
     1176   !> @brief This subroutine print informations of an array of attribute. 
    11771177   !> 
    11781178   !> @author J.Paul 
    … …  
    11841184      IMPLICIT NONE 
    11851185 
    1186       ! Argument       
     1186      ! Argument 
    11871187      TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att 
    11881188 
    … …  
    12031203   !> @author J.Paul 
    12041204   !> @date November, 2013 - Initial Version 
    1205    !> @date September, 2014  
     1205   !> @date September, 2014 
    12061206   !> - take into account type of attribute. 
    12071207   ! 
    … …  
    12111211      IMPLICIT NONE 
    12121212 
    1213       ! Argument       
     1213      ! Argument 
    12141214      TYPE(TATT), INTENT(IN) :: td_att 
    12151215 
    … …  
    12531253               cl_value=td_att%c_value 
    12541254 
    1255             CASE(NF90_BYTE)    
     1255            CASE(NF90_BYTE) 
    12561256               IF( td_att%i_len > 1 )THEN 
    12571257                  cl_value='(/' 
    … …  
    12661266               ENDIF 
    12671267 
    1268             CASE(NF90_SHORT)    
     1268            CASE(NF90_SHORT) 
    12691269               IF( td_att%i_len > 1 )THEN 
    12701270                  cl_value='(/' 
    … …  
    12791279               ENDIF 
    12801280 
    1281             CASE(NF90_INT)    
     1281            CASE(NF90_INT) 
    12821282               IF( td_att%i_len > 1 )THEN 
    12831283                  cl_value='(/' 
    … …  
    12921292               ENDIF 
    12931293 
    1294             CASE(NF90_FLOAT)    
     1294            CASE(NF90_FLOAT) 
    12951295               IF( td_att%i_len > 1 )THEN 
    12961296                  cl_value='(/' 
    … …  
    13051305               ENDIF 
    13061306 
    1307             CASE(NF90_DOUBLE)    
     1307            CASE(NF90_DOUBLE) 
    13081308               IF( td_att%i_len > 1 )THEN 
    13091309                  cl_value='(/' 
    … …  
    13331333   SUBROUTINE att__clean_unit(td_att) 
    13341334   !------------------------------------------------------------------- 
    1335    !> @brief  
     1335   !> @brief 
    13361336   !>  This subroutine clean attribute strcuture. 
    13371337   ! 
    13381338   !> @author J.Paul 
    13391339   !> @date November, 2013 - Initial Version 
    1340    !> @date January, 2019  
     1340   !> @date January, 2019 
    13411341   !> - nullify array inside attribute structure 
    13421342   !> 
    … …  
    13691369   SUBROUTINE att__clean_arr(td_att) 
    13701370   !------------------------------------------------------------------- 
    1371    !> @brief  
     1371   !> @brief 
    13721372   !>  This subroutine clean array of attribute strcuture. 
    13731373   ! 
    … …  
    14031403   !> - close file (bugfix) 
    14041404   !> @date May, 2019 
    1405    !> - read number of dummy element  
     1405   !> - read number of dummy element 
    14061406   !> 
    14071407   !> @param[in] cd_dummy dummy configuration file 
    … …  
    14421442      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist) 
    14431443      IF( ll_exist )THEN 
    1444      
     1444 
    14451445         il_fileid=fct_getunit() 
    1446     
     1446 
    14471447         OPEN( il_fileid, FILE=TRIM(cd_dummy), & 
    14481448         &                FORM='FORMATTED',       & 
    … …  
    14551455            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy)) 
    14561456         ENDIF 
    1457     
     1457 
    14581458         READ( il_fileid, NML = namdum ) 
    14591459         im_ndumatt  = in_ndumatt 
    … …  
    14691469 
    14701470      ENDIF 
    1471     
     1471 
    14721472   END SUBROUTINE att_get_dummy 
    14731473   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    … …  
    14891489      IMPLICIT NONE 
    14901490 
    1491       ! Argument       
     1491      ! Argument 
    14921492      TYPE(TATT), INTENT(IN) :: td_att 
    1493        
     1493 
    14941494      ! function 
    14951495      LOGICAL                :: lf_dummy 
    1496        
     1496 
    14971497      ! loop indices 
    14981498      INTEGER(i4) :: ji 
Note: See TracChangeset for help on using the changeset viewer.