Changeset 364

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

Location:

codes/icosagcm/trunk/src

Files:

• advect_tracer.f90 (modified) (1 diff)
• observable.f90 (modified) (1 diff)
• timeloop_gcm.f90 (modified) (8 diffs)
• transfert_mpi.f90 (modified) (11 diffs)

codes/icosagcm/trunk/src/advect_tracer.f90

@@ -82 +82 @@
     IF (first) THEN
       first=.FALSE.
-      CALL init_message(f_u,req_e1_vect,req_u)
-      CALL init_message(f_cc,req_e1_scal,req_cc)
-      CALL init_message(f_wfluxt,req_i1,req_wfluxt)
-      CALL init_message(f_q,req_i1,req_q)
-      CALL init_message(f_rhodz,req_i1,req_rhodz)
-      CALL init_message(f_gradq3d,req_i1,req_gradq3d)
+      CALL init_message(f_u,req_e1_vect,req_u, 'req_u')
+      CALL init_message(f_cc,req_e1_scal,req_cc, 'req_cc')
+      CALL init_message(f_wfluxt,req_i1,req_wfluxt, 'req_wfluxt')
+      CALL init_message(f_q,req_i1,req_q, 'req_q')
+      CALL init_message(f_rhodz,req_i1,req_rhodz, 'req_rhodz')
+      CALL init_message(f_gradq3d,req_i1,req_gradq3d, 'req_gradq3d')
     ENDIF
     
 !!$OMP BARRIER
 
+    IF(nqtot<1) RETURN
     CALL trace_start("advect_tracer") 
 

codes/icosagcm/trunk/src/observable.f90

@@ -32 +32 @@
     USE omp_para
     TYPE(t_field),POINTER :: f_ps(:), f_u(:), f_q(:)
-    IF (is_master) PRINT *,'CALL write_output_fields_basic'
+!    IF (is_master) PRINT *,'CALL write_output_fields_basic'
     CALL un2ulonlat(f_u, f_buf_ulon, f_buf_ulat)
     CALL output_field("ulon",f_buf_ulon)

codes/icosagcm/trunk/src/timeloop_gcm.f90

@@ -195 +195 @@
     !$OMP MASTER
     CALL SYSTEM_CLOCK(start_clock)
+    CALL SYSTEM_CLOCK(count_rate=rate_clock)
     !$OMP END MASTER   
 
@@ -203 +204 @@
     DO it=itau0+1,itau0+itaumax
 
-       CALL check_conserve_detailed('detailed_budget 0', &
-            f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)
-
-       IF (xios_output) CALL xios_update_calendar(it)
+       IF (is_master) CALL print_iteration(it, itau0, itaumax, start_clock, rate_clock)
+       IF (xios_output) THEN
+          CALL xios_update_calendar(it)
+       ELSE
+          CALL update_time_counter(dt*it)
+       END IF
+
        IF (it==itau0+1 .OR. MOD(it,itau_sync)==0) THEN
           CALL send_message(f_ps,req_ps0)
@@ -220 +224 @@
        ENDIF
 
-       IF (is_master) PRINT *,"It No :",It,"   t :",dt*It
-
        IF (mod(it,itau_out)==0 ) THEN
-          CALL update_time_counter(dt*it)
           CALL write_output_fields_basic(f_ps, f_u, f_q)
        ENDIF
+
+       CALL check_conserve_detailed('detailed_budget 0', &
+            f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)
 
        CALL guided(it*dt,f_ps,f_theta_rhodz,f_u,f_q)
@@ -235 +239 @@
           CALL HEVI_scheme(it, fluxt_zero)
        END SELECT
-
+       
        CALL check_conserve_detailed('detailed_budget 1', &
             f_ps,f_dps,f_u,f_theta_rhodz,f_phis,it)
@@ -266 +270 @@
        
        IF(MOD(it,itau_adv)==0) THEN
-          IF(nqtot>0) CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step
+          CALL advect_tracer(f_hfluxt,f_wfluxt,f_u, f_q,f_rhodz)  ! update q and rhodz after RK step
           fluxt_zero=.TRUE.
           ! FIXME : check that rhodz is consistent with ps
@@ -278 +282 @@
              END DO
           ENDIF
-          
        END IF
        
@@ -301 +304 @@
     !$OMP MASTER
     CALL SYSTEM_CLOCK(stop_clock)
-    CALL SYSTEM_CLOCK(count_rate=rate_clock)
     
     IF (mpi_rank==0) THEN 
@@ -310 +312 @@
     ! CONTAINS
   END SUBROUTINE timeloop
-  
+
+  SUBROUTINE print_iteration(it,itau0,itaumax,start_clock,rate_clock)
+    INTEGER :: it, itau0, itaumax, start_clock, stop_clock, rate_clock, throughput
+    REAL :: per_step,total, elapsed
+    WRITE(*,'(A,I7,A,F8.1)') "It No :",it,"   t :",dt*it
+    IF(MOD(it,10)==0) THEN
+       CALL SYSTEM_CLOCK(stop_clock)
+       elapsed = (stop_clock-start_clock)*1./rate_clock
+       per_step = elapsed/(it-itau0)
+       throughput = dt/per_step
+       total = per_step*(itaumax-itau0)
+       WRITE(*,'(A,I5,A,F6.2,A,I6)') 'Time spent (s):',INT(elapsed), &
+            '  -- ms/step : ', 1000*per_step, &
+            '  -- Throughput :', throughput
+       WRITE(*,'(A,I5,A,I5)') 'Whole job (min) :', INT(total/60.), &
+            '  -- Completion in (min) : ', INT((total-elapsed)/60.)
+    END IF
+  END SUBROUTINE print_iteration
+
 END MODULE timeloop_gcm_mod

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