Make ref_count and owns_group private

This member variables should never be accessed from the outside. Use retain and free instead.

src/common/cp_log_handling.F

@@ -344,9 +344,9 @@ SUBROUTINE cp_logger_create(logger, para_env, print_level, &
       IF (PRESENT(para_env)) logger%para_env => para_env
       IF (.NOT. ASSOCIATED(logger%para_env)) &
          CPABORT(routineP//" para env not associated")
-      IF (logger%para_env%ref_count < 1) &
+      IF (.NOT. logger%para_env%is_valid()) &
          CPABORT(routineP//" para_env%ref_count<1")
-      logger%para_env%ref_count = logger%para_env%ref_count + 1
+      CALL logger%para_env%retain()
 
       IF (PRESENT(print_level)) logger%print_level = print_level
 
@@ -682,16 +682,11 @@ SUBROUTINE my_cp_para_env_release(para_env)
          routineP = moduleN//':'//routineN
 
       IF (ASSOCIATED(para_env)) THEN
-         IF (para_env%ref_count < 1) THEN
+         IF (.NOT. para_env%is_valid()) THEN
             CPABORT(routineP//" para_env%ref_count<1")
          END IF
-         para_env%ref_count = para_env%ref_count - 1
-         IF (para_env%ref_count < 1) THEN
-            IF (para_env%owns_group) THEN
-               CALL para_env%free()
-            END IF
-            DEALLOCATE (para_env)
-         END IF
+         CALL para_env%free()
+         IF (.NOT. para_env%is_valid()) DEALLOCATE (para_env)
       END IF
       NULLIFY (para_env)
    END SUBROUTINE my_cp_para_env_release

src/common/cp_para_env.F

@@ -45,7 +45,6 @@ SUBROUTINE cp_para_env_create(para_env, group)
       CPASSERT(.NOT. ASSOCIATED(para_env))
       ALLOCATE (para_env)
       para_env%mp_comm_type = group
-      para_env%owns_group = .TRUE.
       CALL para_env%init()
    END SUBROUTINE cp_para_env_create
 
@@ -64,12 +63,9 @@ SUBROUTINE cp_para_env_release(para_env)
       TYPE(cp_para_env_type), POINTER                    :: para_env
 
       IF (ASSOCIATED(para_env)) THEN
-         CPASSERT(para_env%ref_count > 0)
-         para_env%ref_count = para_env%ref_count - 1
-         IF (para_env%ref_count < 1) THEN
-            CALL para_env%free()
-            DEALLOCATE (para_env)
-         END IF
+         CPASSERT(para_env%is_valid())
+         CALL para_env%free()
+         IF (.NOT. para_env%is_valid()) DEALLOCATE (para_env)
       END IF
       NULLIFY (para_env)
    END SUBROUTINE cp_para_env_release
@@ -87,7 +83,8 @@ SUBROUTINE cp_cart_create(cart, group)
 
       CPASSERT(.NOT. ASSOCIATED(cart))
       ALLOCATE (cart)
-      cart = group
+      cart%mp_comm_type = group
+      CALL cart%init()
 
    END SUBROUTINE cp_cart_create
 
@@ -100,12 +97,9 @@ SUBROUTINE cp_cart_release(cart)
       TYPE(cp_para_cart_type), POINTER                   :: cart
 
       IF (ASSOCIATED(cart)) THEN
-         CPASSERT(cart%ref_count > 0)
-         cart%ref_count = cart%ref_count - 1
-         IF (cart%ref_count == 0) THEN
-            CALL cart%free()
-            DEALLOCATE (cart)
-         END IF
+         CPASSERT(cart%is_valid())
+         CALL cart%free()
+         IF (.NOT. cart%is_valid()) DEALLOCATE (cart)
       END IF
       NULLIFY (cart)
    END SUBROUTINE cp_cart_release

src/common/cp_para_types.F

@@ -40,15 +40,17 @@ MODULE cp_para_types
 !> \author Fawzi Mohamed
 ! **************************************************************************************************
    TYPE, EXTENDS(mp_comm_type) :: cp_para_env_type
+      PRIVATE
       ! We set it to true because to have less initialization steps in case we create a new communicator
       LOGICAL :: owns_group = .TRUE.
-      INTEGER :: mepos = -1, source = -1, num_pe = -1, ref_count = -1
+      INTEGER, PUBLIC :: mepos = -1, source = -1, num_pe = -1
+      INTEGER :: ref_count = -1
    CONTAINS
       PROCEDURE, PRIVATE, PASS(comm), NON_OVERRIDABLE :: mp_comm_init => cp_para_env_init
-      PROCEDURE, PRIVATE, PASS(comm_new), NON_OVERRIDABLE :: mp_comm_assign => cp_para_env_assign
       PROCEDURE, PRIVATE, PASS(comm), NON_OVERRIDABLE :: mp_comm_free => cp_para_env_free
       PROCEDURE, PUBLIC, PASS(para_env), NON_OVERRIDABLE :: retain => cp_para_env_retain
       PROCEDURE, PUBLIC, PASS(para_env), NON_OVERRIDABLE :: is_source => cp_para_env_is_source
+      PROCEDURE, PUBLIC, PASS(para_env), NON_OVERRIDABLE :: is_valid => cp_para_env_is_valid
    END TYPE cp_para_env_type
 
 ! **************************************************************************************************
@@ -79,25 +81,31 @@ MODULE cp_para_types
 !> \author Fawzi Mohamed
 ! **************************************************************************************************
    TYPE, EXTENDS(mp_cart_type) :: cp_para_cart_type
+      PRIVATE
       ! We set it to true because to have less initialization steps in case we create a new communicator
       LOGICAL :: owns_group = .TRUE.
-      INTEGER :: rank = -1, ntask = -1
-      INTEGER, DIMENSION(:), POINTER :: mepos => NULL(), source => NULL(), num_pe => NULL()
-      LOGICAL, DIMENSION(:), POINTER :: periodic => NULL()
+      INTEGER, PUBLIC :: rank = -1, ntask = -1
+      INTEGER, DIMENSION(:), POINTER, PUBLIC :: mepos => NULL(), source => NULL(), num_pe => NULL()
+      LOGICAL, DIMENSION(:), POINTER, PUBLIC :: periodic => NULL()
       INTEGER :: ref_count = -1
    CONTAINS
       PROCEDURE, PRIVATE, PASS(comm), NON_OVERRIDABLE :: mp_comm_free => cp_para_cart_free
       PROCEDURE, PRIVATE, PASS(comm), NON_OVERRIDABLE :: mp_comm_init => cp_para_cart_init
       PROCEDURE, PUBLIC, PASS(cart), NON_OVERRIDABLE :: retain => cp_para_cart_retain
+      PROCEDURE, PUBLIC, PASS(cart), NON_OVERRIDABLE :: is_valid => cp_para_cart_is_valid
    END TYPE cp_para_cart_type
 
 CONTAINS
 ! **************************************************************************************************
-!> \brief ...
+!> \brief initialize the environment
 !> \param comm ...
+!> \param owns_group ...
 ! **************************************************************************************************
-   ELEMENTAL IMPURE SUBROUTINE cp_para_env_init(comm)
+   ELEMENTAL IMPURE SUBROUTINE cp_para_env_init(comm, owns_group)
       CLASS(cp_para_env_type), INTENT(INOUT)                  :: comm
+      LOGICAL, INTENT(IN), OPTIONAL :: owns_group
+
+      IF (PRESENT(owns_group)) comm%owns_group = owns_group
 
       comm%source = 0
       comm%ref_count = 1
@@ -106,35 +114,31 @@ ELEMENTAL IMPURE SUBROUTINE cp_para_env_init(comm)
    END SUBROUTINE cp_para_env_init
 
 ! **************************************************************************************************
-!> \brief ...
-!> \param comm_new ...
-!> \param comm_old ...
+!> \brief check whether the local process is the source process
+!> \param para_env ...
+!> \return ...
 ! **************************************************************************************************
-   ELEMENTAL IMPURE SUBROUTINE cp_para_env_assign(comm_new, comm_old)
-      CLASS(cp_para_env_type), INTENT(OUT) :: comm_new
-      CLASS(mp_comm_type), INTENT(IN) :: comm_old
-
-      comm_new%mp_comm_type = comm_old
-      comm_new%owns_group = .FALSE.
+   ELEMENTAL LOGICAL FUNCTION cp_para_env_is_source(para_env)
+      CLASS(cp_para_env_type), INTENT(IN) :: para_env
 
-      CALL comm_new%init()
+      cp_para_env_is_source = para_env%source == para_env%mepos
 
-   END SUBROUTINE cp_para_env_assign
+   END FUNCTION cp_para_env_is_source
 
 ! **************************************************************************************************
-!> \brief ...
+!> \brief check whether the environment exists
 !> \param para_env ...
 !> \return ...
 ! **************************************************************************************************
-   ELEMENTAL LOGICAL FUNCTION cp_para_env_is_source(para_env)
+   ELEMENTAL LOGICAL FUNCTION cp_para_env_is_valid(para_env)
       CLASS(cp_para_env_type), INTENT(IN) :: para_env
 
-      cp_para_env_is_source = para_env%source == para_env%mepos
+      cp_para_env_is_valid = para_env%ref_count > 0
 
-   END FUNCTION cp_para_env_is_source
+   END FUNCTION cp_para_env_is_valid
 
 ! **************************************************************************************************
-!> \brief ...
+!> \brief increase the reference counter but ensure that you free it later
 !> \param para_env ...
 ! **************************************************************************************************
    ELEMENTAL SUBROUTINE cp_para_env_retain(para_env)
@@ -145,27 +149,32 @@ ELEMENTAL SUBROUTINE cp_para_env_retain(para_env)
    END SUBROUTINE cp_para_env_retain
 
 ! **************************************************************************************************
-!> \brief ...
+!> \brief free the communicator
 !> \param comm ...
 ! **************************************************************************************************
    SUBROUTINE cp_para_env_free(comm)
       CLASS(cp_para_env_type), INTENT(INOUT) :: comm
 
-      IF (comm%owns_group) CALL comm%mp_comm_type%free()
+      comm%ref_count = comm%ref_count - 1
+      IF (comm%ref_count <= 0) THEN
+         IF (comm%owns_group) CALL comm%mp_comm_type%free()
+      END IF
 
    END SUBROUTINE cp_para_env_free
 
 ! **************************************************************************************************
 !> \brief intializes a cart (multidimensional parallel environment)
 !> \param comm ...
+!> \param owns_group ...
 !> \author fawzi
 ! **************************************************************************************************
-   ELEMENTAL IMPURE SUBROUTINE cp_para_cart_init(comm)
+   ELEMENTAL IMPURE SUBROUTINE cp_para_cart_init(comm, owns_group)
       CLASS(cp_para_cart_type), INTENT(INOUT)             :: comm
+      LOGICAL, INTENT(IN), OPTIONAL :: owns_group
 
       INTEGER :: ndims
 
-      comm%owns_group = .TRUE.
+      IF (PRESENT(owns_group)) comm%owns_group = owns_group
       ndims = comm%get_ndims()
 
       ALLOCATE (comm%source(ndims), comm%periodic(ndims), comm%mepos(ndims), &
@@ -183,7 +192,19 @@ ELEMENTAL IMPURE SUBROUTINE cp_para_cart_init(comm)
    END SUBROUTINE cp_para_cart_init
 
 ! **************************************************************************************************
-!> \brief ...
+!> \brief check whether the given environment is valid, i.e. existent
+!> \param cart ...
+!> \return ...
+! **************************************************************************************************
+   ELEMENTAL LOGICAL FUNCTION cp_para_cart_is_valid(cart)
+      CLASS(cp_para_cart_type), INTENT(IN) :: cart
+
+      cp_para_cart_is_valid = cart%ref_count > 0
+
+   END FUNCTION cp_para_cart_is_valid
+
+! **************************************************************************************************
+!> \brief increase the reference counter, don't forget to free it later
 !> \param cart ...
 ! **************************************************************************************************
    ELEMENTAL SUBROUTINE cp_para_cart_retain(cart)
@@ -194,15 +215,18 @@ ELEMENTAL SUBROUTINE cp_para_cart_retain(cart)
    END SUBROUTINE cp_para_cart_retain
 
 ! **************************************************************************************************
-!> \brief ...
+!> \brief free the communicator
 !> \param comm ...
 ! **************************************************************************************************
    SUBROUTINE cp_para_cart_free(comm)
       CLASS(cp_para_cart_type), INTENT(INOUT) :: comm
 
-      IF (comm%owns_group) CALL comm%mp_cart_type%free()
+      comm%ref_count = comm%ref_count - 1
+      IF (comm%ref_count <= 0) THEN
+         IF (comm%owns_group) CALL comm%mp_cart_type%free()
 
-      DEALLOCATE (comm%source, comm%periodic, comm%mepos, comm%num_pe)
+         DEALLOCATE (comm%source, comm%periodic, comm%mepos, comm%num_pe)
+      END IF
 
    END SUBROUTINE cp_para_cart_free
 

src/motion/pint_methods.F

@@ -800,7 +800,7 @@ SUBROUTINE pint_test(para_env, input, input_declaration)
 
       CPASSERT(ASSOCIATED(para_env))
       CPASSERT(ASSOCIATED(input))
-      CPASSERT(para_env%ref_count > 0)
+      CPASSERT(para_env%is_valid())
       CPASSERT(input%ref_count > 0)
       unit_nr = cp_logger_get_default_io_unit()
       CALL pint_create(pint_env, input, input_declaration, para_env)
@@ -874,7 +874,7 @@ SUBROUTINE do_pint_run(para_env, input, input_declaration, globenv)
 
       CPASSERT(ASSOCIATED(para_env))
       CPASSERT(ASSOCIATED(input))
-      CPASSERT(para_env%ref_count > 0)
+      CPASSERT(para_env%is_valid())
       CPASSERT(input%ref_count > 0)
 
       ! check if helium solvent is present

src/mpiwrap/message_passing.F

@@ -522,7 +522,7 @@ MODULE message_passing
       PROCEDURE, PRIVATE, PASS(sub_comm), NON_OVERRIDABLE :: mp_comm_split, mp_comm_split_direct
       GENERIC, PUBLIC :: from_split => mp_comm_split, mp_comm_split_direct
       PROCEDURE, PUBLIC, PASS(mp_new_comm), NON_OVERRIDABLE :: from_reordering => mp_reordering
-      PROCEDURE, PRIVATE, PASS(comm_new) :: mp_comm_assign
+      PROCEDURE, PRIVATE, PASS(comm_new), NON_OVERRIDABLE :: mp_comm_assign
       GENERIC, PUBLIC :: ASSIGNMENT(=) => mp_comm_assign
    END TYPE
 
@@ -1704,18 +1704,21 @@ ELEMENTAL IMPURE SUBROUTINE mp_comm_assign(comm_new, comm_old)
 
          comm_new%handle = comm_old%handle
          comm_new%ndims = comm_old%ndims
-         CALL comm_new%init()
+         CALL comm_new%init(.FALSE.)
       END SUBROUTINE
 
 ! **************************************************************************************************
 !> \brief Initializes the communicator (mostly relevant for its derived classes)
 !> \param comm ...
 ! **************************************************************************************************
-      ELEMENTAL IMPURE SUBROUTINE mp_comm_init(comm)
+      ELEMENTAL IMPURE SUBROUTINE mp_comm_init(comm, owns_group)
          CLASS(mp_comm_type), INTENT(INOUT) :: comm
+         LOGICAL, INTENT(IN), OPTIONAL :: owns_group
 
 ! No initialization necessary for mp_comm_type
          MARK_USED(comm)
+! The mp_comm_type do not care about ownership yet, this is just relevant for cp_para_*_type
+         MARK_USED(owns_group)
 
       END SUBROUTINE