Changeset 6436 for branches/UKMO/nemo_v3_6_STABLE_copy/NEMOGCM/TOOLS/SIREN/src/dimension.f90

Timestamp:

2016-04-07T15:33:32+02:00 (8 years ago)

Author:

timgraham

Message:

Updated to r6424 of nemo_v3_6_STABLE

File:

• branches/UKMO/nemo_v3_6_STABLE_copy/NEMOGCM/TOOLS/SIREN/src/dimension.f90 (modified) (6 diffs)

branches/UKMO/nemo_v3_6_STABLE_copy/NEMOGCM/TOOLS/SIREN/src/dimension.f90

@@ -154 +154 @@
 ! REVISION HISTORY:
 !> @date November, 2013 - Initial Version
+!> @date Spetember, 2015
+!> - manage useless (dummy) dimension
 !>
 !> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
@@ -167 +169 @@
    ! type and variable
    PUBLIC :: TDIM              !< dimension structure
+
+   PRIVATE :: cm_dumdim        !< dummy dimension array
 
    ! function and subroutine
@@ -182 +186 @@
    PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure
    PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure
+   PUBLIC :: dim_get_dummy     !< fill dummy dimension array
+   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension
 
    PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
@@ -209 +215 @@
    END TYPE
 
+   CHARACTER(LEN=lc), DIMENSION(ip_maxdum), SAVE :: cm_dumdim !< dummy dimension
+
    INTERFACE dim_print
       MODULE PROCEDURE dim__print_unit ! print information on one dimension
@@ -518 +526 @@
    !> @param[in] ld_uld    dimension unlimited
    !> @param[in] cd_sname  dimension short name
-   !> @param[in] ld_uld    dimension use or not
+   !> @param[in] ld_use    dimension use or not
    !> @return dimension structure
    !-------------------------------------------------------------------
-   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
+   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use )
       IMPLICIT NONE
 
@@ -1401 +1409 @@
 
    END SUBROUTINE dim__clean_arr
+   !-------------------------------------------------------------------
+   !> @brief This subroutine fill dummy dimension array
+   !
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] cd_dummy dummy configuration file
+   !-------------------------------------------------------------------
+   SUBROUTINE dim_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_dumdim(:)=''
+
+      ! 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_dumdim(:)=cn_dumdim(:)
+
+         CLOSE( il_fileid )
+
+      ENDIF
+
+   END SUBROUTINE dim_get_dummy
+   !-------------------------------------------------------------------
+   !> @brief This function check if dimension is defined as dummy dimension
+   !> in configuraton file
+   !>
+   !> @author J.Paul
+   !> @date September, 2015 - Initial Version
+   !
+   !> @param[in] td_dim dimension structure
+   !> @return true if dimension is dummy dimension 
+   !-------------------------------------------------------------------
+   FUNCTION dim_is_dummy(td_dim)
+      IMPLICIT NONE
+
+      ! Argument      
+      TYPE(TDIM), INTENT(IN) :: td_dim
+      
+      ! function
+      LOGICAL :: dim_is_dummy
+      
+      ! loop indices
+      INTEGER(i4) :: ji
+      !----------------------------------------------------------------
+
+      dim_is_dummy=.FALSE.
+      DO ji=1,ip_maxdum
+         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN
+            dim_is_dummy=.TRUE.
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION dim_is_dummy
 END MODULE dim