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

Ignore:
Timestamp:
2015-11-30T20:55:41+01:00 (8 years ago)
Author:
mathiot
Message:

ISF : merged trunk (5936) into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/TOOLS/SIREN/src/attribute.f90

    r5037 r5956  
    8181! REVISION HISTORY: 
    8282!> @date November, 2013 - Initial Version 
    83 !> @date November, 2014 - Fix memory leaks bug 
     83!> @date November, 2014  
     84!> - Fix memory leaks bug 
    8485! 
    8586!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    130131      INTEGER(i4)       :: i_type = 0        !< attribute type 
    131132      INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute 
    132       CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR 
     133      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR 
    133134      REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE 
    134135   END TYPE TATT 
    135136 
    136137   INTERFACE att_init 
    137       MODULE PROCEDURE att__init_c 
     138      MODULE PROCEDURE att__init_c     
    138139      MODULE PROCEDURE att__init_dp 
    139140      MODULE PROCEDURE att__init_dp_0d 
     
    181182   !> @date November, 2013 - Initial Version 
    182183   !> @date November, 2014 
    183    !>    - use function instead of overload assignment operator  
     184   !> - use function instead of overload assignment operator  
    184185   !> (to avoid memory leak)  
    185186   ! 
     
    234235 
    235236      ! local variable 
    236       REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value 
     237      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value 
    237238      !---------------------------------------------------------------- 
    238239 
     
    300301   !> @author J.Paul 
    301302   !> @date November, 2013 - Initial Version 
    302    !> @date September, 2014 - bug fix with use of id read from attribute structure 
    303    ! 
     303   !> @date September, 2014  
     304   !> - bug fix with use of id read from attribute structure 
     305   !> 
    304306   !> @param[in] td_att    array of attribute structure 
    305307   !> @param[in] cd_name   attribute name 
     
    355357 
    356358      att__init_c%c_name=TRIM(ADJUSTL(cd_name)) 
    357  
    358359      att__init_c%i_type=NF90_CHAR 
     360 
    359361      att__init_c%c_value=TRIM(ADJUSTL(cd_value)) 
    360362      att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) ) 
     
    368370   !> 
    369371   !> @author J.Paul 
    370    !> @dtae November, 2013 - Initial Version 
     372   !> @date November, 2013 - Initial Version 
    371373   ! 
    372374   !> @param[in] cd_name   attribute name 
     
    10681070   !> @author J.Paul 
    10691071   !> @date November, 2013 - Initial Version 
    1070    !> @date September, 2014 - take into account type of attribute. 
     1072   !> @date September, 2014  
     1073   !> - take into account type of attribute. 
    10711074   ! 
    10721075   !> @param[in] td_att attribute structure 
     
    11141117 
    11151118            CASE(NF90_CHAR) 
     1119 
    11161120               cl_value=td_att%c_value 
    11171121 
Note: See TracChangeset for help on using the changeset viewer.