Changeset 6440 for branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90

Timestamp:

2016-04-07T16:32:24+02:00 (8 years ago)

Author:

dancopsey

Message:

Merged in nemo_v3_6_STABLE_copy up to revision 6436.

File:

• branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90 (modified) (12 diffs)

branches/UKMO/dev_r5518_GC3p0_package/NEMOGCM/TOOLS/SIREN/src/attribute.f90

@@ -81 +81 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
-!> @date November, 2014 - Fix memory leaks bug
+!> @date November, 2014 
+!> - Fix memory leaks bug
+!> @date September, 2015
+!> - manage useless (dummy) attributes
 !
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -97 +100 @@
    PUBLIC :: TATT       !< attribute structure
 
+   PRIVATE :: cm_dumatt !< dummy attribute array
+
    ! function and subroutine
    PUBLIC :: att_init       !< initialize attribute structure
@@ -104 +109 @@
    PUBLIC :: att_get_index  !< get attribute index, in an array of attribute structure
    PUBLIC :: att_get_id     !< get attribute id, read from file
+   PUBLIC :: att_get_dummy  !< fill dummy attribute array
+   PUBLIC :: att_is_dummy   !< check if attribute is defined as dummy attribute
 
    PRIVATE :: att__clean_unit ! clean attribute strcuture
@@ -130 +137 @@
       INTEGER(i4)       :: i_type = 0        !< attribute type
       INTEGER(i4)       :: i_len  = 0        !< number of value store in attribute
-      CHARACTER(LEN=lc) :: c_value = "none"  !< attribute value if type CHAR
+      CHARACTER(LEN=lc) :: c_value = 'none'  !< attribute value if type CHAR
       REAL(dp), DIMENSION(:), POINTER :: d_value => NULL() !< attribute value if type SHORT,INT,FLOAT or DOUBLE
    END TYPE TATT
 
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumatt !< dummy attribute
+
    INTERFACE att_init
-      MODULE PROCEDURE att__init_c
+      MODULE PROCEDURE att__init_c    
       MODULE PROCEDURE att__init_dp
       MODULE PROCEDURE att__init_dp_0d
@@ -181 +190 @@
    !> @date November, 2013 - Initial Version
    !> @date November, 2014
-   !>    - use function instead of overload assignment operator 
+   !> - use function instead of overload assignment operator 
    !> (to avoid memory leak) 
    !
@@ -234 +243 @@
 
       ! local variable
-      REAL(dp), DIMENSION(:), ALLOCATABLE :: dl_value
+      REAL(dp)         , DIMENSION(:), ALLOCATABLE :: dl_value
       !----------------------------------------------------------------
 
@@ -300 +309 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - bug fix with use of id read from attribute structure
-   !
+   !> @date September, 2014 
+   !> - bug fix with use of id read from attribute structure
+   !>
    !> @param[in] td_att    array of attribute structure
    !> @param[in] cd_name   attribute name
@@ -355 +365 @@
 
       att__init_c%c_name=TRIM(ADJUSTL(cd_name))
-
       att__init_c%i_type=NF90_CHAR
+
       att__init_c%c_value=TRIM(ADJUSTL(cd_value))
       att__init_c%i_len=LEN( TRIM(ADJUSTL(cd_value)) )
@@ -368 +378 @@
    !>
    !> @author J.Paul
-   !> @dtae November, 2013 - Initial Version
+   !> @date November, 2013 - Initial Version
    !
    !> @param[in] cd_name   attribute name
@@ -1068 +1078 @@
    !> @author J.Paul
    !> @date November, 2013 - Initial Version
-   !> @date September, 2014 - take into account type of attribute.
+   !> @date September, 2014 
+   !> - take into account type of attribute.
    !
    !> @param[in] td_att attribute structure
@@ -1114 +1125 @@
 
             CASE(NF90_CHAR)
+
                cl_value=td_att%c_value
 
@@ -1247 +1259 @@
 
    END SUBROUTINE att__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy attribute array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !> @date Marsh, 2016
+   !> - close file (bugfix)
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE att_get_dummy( cd_dummy )
+      IMPLICIT NONE
+      ! Argument
+      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
+
+      ! local variable
+      INTEGER(i4)   :: il_fileid
+      INTEGER(i4)   :: il_status
+
+      LOGICAL       :: ll_exist
+
+      ! loop indices
+      ! namelist
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumvar
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumdim
+      CHARACTER(LEN=lc), DIMENSION(ip_maxdum) :: cn_dumatt
+
+      !----------------------------------------------------------------
+      NAMELIST /namdum/ &   !< dummy namelist
+      &  cn_dumvar, &       !< variable  name
+      &  cn_dumdim, &       !< dimension name
+      &  cn_dumatt          !< attribute name
+      !----------------------------------------------------------------
+
+      ! init
+      cm_dumatt(:)=''
+
+      ! read namelist
+      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
+      IF( ll_exist )THEN
+    
+         il_fileid=fct_getunit()
+   
+         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
+         &                FORM='FORMATTED',       &
+         &                ACCESS='SEQUENTIAL',    &
+         &                STATUS='OLD',           &
+         &                ACTION='READ',          &
+         &                IOSTAT=il_status)
+         CALL fct_err(il_status)
+         IF( il_status /= 0 )THEN
+            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
+         ENDIF
+   
+         READ( il_fileid, NML = namdum )
+         cm_dumatt(:)=cn_dumatt(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+   
+   END SUBROUTINE att_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if attribute is defined as dummy attribute
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_att attribute structure
+   !> @return true if attribute is dummy attribute
+   !-------------------------------------------------------------------
+   FUNCTION att_is_dummy(td_att)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TATT), INTENT(IN) :: td_att
+      
+      ! function
+      LOGICAL :: att_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      att_is_dummy=.FALSE.
+      DO ji=1,ip_maxdum
+         IF( fct_lower(td_att%c_name) == fct_lower(cm_dumatt(ji)) )THEN
+            att_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION att_is_dummy
 END MODULE att