Changeset 364 for codes/icosagcm/trunk/src/transfert_mpi.f90

Timestamp:

10/09/15 16:13:43 (9 years ago)

Author:

dubos

Message:

Bugfix : memory leak in transfert_mpi / New : detect send_message not paired with wait_message

File:

• codes/icosagcm/trunk/src/transfert_mpi.f90 (modified) (11 diffs)

codes/icosagcm/trunk/src/transfert_mpi.f90

@@ -61 +61 @@
   
   TYPE t_message
+    CHARACTER(LEN=100) :: name ! for debug
     TYPE(t_request), POINTER :: request(:)
     INTEGER :: nreq
@@ -72 +73 @@
     LOGICAL :: completed
     LOGICAL :: pending
+    LOGICAL :: open      ! for debug
     INTEGER :: number
   END TYPE t_message
@@ -816 +818 @@
 
 
-  SUBROUTINE init_message_seq(field, request, message)
+  SUBROUTINE init_message_seq(field, request, message, name)
   USE field_mod
   USE domain_mod
@@ -826 +828 @@
     TYPE(t_request),POINTER :: request(:)
     TYPE(t_message) :: message
-
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
 !$OMP MASTER    
     message%request=>request
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
 !$OMP END MASTER    
 !$OMP BARRIER    
@@ -879 +886 @@
 
     
-  SUBROUTINE init_message_mpi(field,request, message)
+  SUBROUTINE init_message_mpi(field,request, message, name)
   USE field_mod
   USE domain_mod
@@ -890 +897 @@
     TYPE(t_request),POINTER :: request(:)
     TYPE(t_message) :: message
+    CHARACTER(LEN=*), INTENT(IN),OPTIONAL :: name
 
     TYPE(ARRAY),POINTER :: recv,send 
@@ -904 +912 @@
 !$OMP BARRIER
 !$OMP MASTER
+    IF(PRESENT(name)) THEN
+       message%name = TRIM(name)
+    ELSE
+       message%name = 'unknown'
+    END IF
     message%number=message_number
     message_number=message_number+1
@@ -921 +934 @@
     message%pending=.FALSE.
     message%completed=.FALSE.
-  
+    message%open=.FALSE.
+
     DO ind=1,ndomain
       req=>request(ind)
@@ -1046 +1060 @@
     ENDIF
     
-
+    DEALLOCATE(message%mpi_req)
+    DEALLOCATE(message%buffers)
+    DEALLOCATE(message%status)
 
 !$OMP END MASTER
@@ -1112 +1128 @@
 
 !$OMP MASTER
+    IF(message%open) THEN
+       PRINT *, 'send_message_mpi : message ' // TRIM(message%name) // &
+            ' is still open, no call to wait_message_mpi after last send_message_mpi'
+       CALL ABORT
+    END IF
+    message%open=.TRUE. ! will be set to .FALSE. by wait_message_mpi
+
     message%field=>field
 
@@ -1461 +1484 @@
     INTEGER :: offset
 
+    message%open=.FALSE.
     IF (.NOT. message%pending) RETURN