Changeset fb0d416 in flexpart.git for src/mpi_mod.f90

Timestamp:

Apr 20, 2015, 10:35:26 AM (9 years ago)

Author:

Espen Sollum ATMOS <eso@…>

Branches:

master, 10.4.1_pesei, GFS_025, bugfixes+enhancements, dev, release-10, release-10.4.1, scaling-bug, univie

Children:

5f42c27

Parents:

b5d0e7e

Message:

OH change suggested by Xuekun

File:

• src/mpi_mod.f90 (modified) (9 diffs)

src/mpi_mod.f90

@@ -90 +90 @@
   integer :: tm1
   integer, parameter :: nvar_async=27 !29 :DBG:
-  !integer, dimension(:), allocatable :: tags
+!integer, dimension(:), allocatable :: tags
   integer, dimension(:), allocatable :: reqs
 
@@ -1243 +1243 @@
 
     do dest=0,mp_np-1 ! mp_np-2 will also work if last proc reserved for reading
-                      ! TODO: use mp_partgroup_np here
+! TODO: use mp_partgroup_np here
       if (dest.eq.id_read) cycle
       i=dest*nvar_async
@@ -1339 +1339 @@
              &MPI_COMM_WORLD,reqs(i),mp_ierr)
         if (mp_ierr /= 0) goto 600
-      ! else
-      !   i=i+2
+! else
+!   i=i+2
       end if
 
@@ -1389 +1389 @@
 
 ! :TODO: don't need these
-    ! d3s1=d3_size1
-    ! d3s2=d3_size2
-    ! d2s1=d2_size1 
-    ! d2s2=d2_size2
+! d3s1=d3_size1
+! d3s2=d3_size2
+! d2s1=d2_size1 
+! d2s2=d2_size2
 
 ! At the time this immediate receive is posted, memstat is the state of
@@ -1593 +1593 @@
     call MPI_Waitall(n_req,reqs,MPI_STATUSES_IGNORE,mp_ierr)
 !    endif
-    ! else
-    !   do i = 0, nvar_async*mp_np-1
-    !     if (mod(i,27).eq.0 .or. mod(i,28).eq.0) then
-    !       call MPI_Cancel(reqs(i),mp_ierr)
-    !       cycle
-    !     end if
-    !     call MPI_Wait(reqs(i),MPI_STATUS_IGNORE,mp_ierr)
-    !   end do
-    ! end if
+! else
+!   do i = 0, nvar_async*mp_np-1
+!     if (mod(i,27).eq.0 .or. mod(i,28).eq.0) then
+!       call MPI_Cancel(reqs(i),mp_ierr)
+!       cycle
+!     end if
+!     call MPI_Wait(reqs(i),MPI_STATUS_IGNORE,mp_ierr)
+!   end do
+! end if
 
     if (mp_ierr /= 0) goto 600 
@@ -1909 +1909 @@
 !***********************************************************************
 
-    if (mp_measure_time) then
+    IF (mp_measure_time) THEN
       do ip=0, mp_np-1
         call MPI_BARRIER(MPI_COMM_WORLD, mp_ierr)
@@ -1962 +1962 @@
     end if
 
+! This call to barrier is for correctly formatting output
+    call MPI_BARRIER(MPI_COMM_WORLD, mp_ierr)
+
+    if (lroot) then
+      write(*,FMT='(72("#"))')
+      WRITE(*,*) "To turn off output of time measurements, set "
+      WRITE(*,*) "    mp_measure_time=.false."
+      WRITE(*,*) "in file mpi_mod.f90"
+      write(*,FMT='(72("#"))')
+    end if
+
 ! j=mp_pid*nvar_async
 ! In the implementation with 3 fields, the processes may have posted
 ! MPI_Irecv requests that should be cancelled here
 !! TODO:
-    ! if (.not.lmp_sync) then
-    !   r=mp_pid*nvar_async
-    !   do j=r,r+nvar_async-1
-    !     call MPI_Cancel(j,mp_ierr)
-    !     if (mp_ierr /= 0) write(*,*) '#### mpif_finalize::MPI_Cancel> ERROR ####'
-    !   end do
-    ! end if
+! if (.not.lmp_sync) then
+!   r=mp_pid*nvar_async
+!   do j=r,r+nvar_async-1
+!     call MPI_Cancel(j,mp_ierr)
+!     if (mp_ierr /= 0) write(*,*) '#### mpif_finalize::MPI_Cancel> ERROR ####'
+!   end do
+! end if
 
     call MPI_FINALIZE(mp_ierr)
@@ -1981 +1992 @@
 
 
-  end subroutine mpif_finalize
-
-
-  subroutine get_lun(my_lun)
+    end subroutine mpif_finalize
+
+
+    subroutine get_lun(my_lun)
 !***********************************************************************
 ! get_lun: 
@@ -1990 +2001 @@
 !***********************************************************************
 
-    implicit none
-
-    integer, intent(inout) :: my_lun
-    integer, save :: free_lun=100
-    logical :: exists, iopen
-
-!***********************************************************************
-
-    loop1: do
-      inquire(UNIT=free_lun, EXIST=exists, OPENED=iopen)
-      if (exists .and. .not.iopen) exit loop1
-      free_lun = free_lun+1
-    end do loop1
-    my_lun = free_lun
-
-  end subroutine get_lun
-
-
-  subroutine write_data_dbg(array_in, array_name, tstep, ident)
+      implicit none
+
+      integer, intent(inout) :: my_lun
+      integer, save :: free_lun=100
+      logical :: exists, iopen
+
+!***********************************************************************
+
+      loop1: do
+        inquire(UNIT=free_lun, EXIST=exists, OPENED=iopen)
+        if (exists .and. .not.iopen) exit loop1
+        free_lun = free_lun+1
+      end do loop1
+      my_lun = free_lun
+
+    end subroutine get_lun
+
+
+    subroutine write_data_dbg(array_in, array_name, tstep, ident)
 !***********************************************************************
 ! Write one-dimensional arrays to disk (for debugging purposes)
 !***********************************************************************
-    implicit none 
-
-    real, intent(in), dimension(:) :: array_in
-    integer, intent(in) :: tstep
-    integer :: lios
-    character(LEN=*), intent(in) :: ident, array_name
-
-    character(LEN=8) :: c_ts
-    character(LEN=40) :: fn_1, fn_2
-
-!***********************************************************************
-
-    write(c_ts, FMT='(I8.8,BZ)') tstep
-    fn_1='-'//trim(adjustl(c_ts))//'-'//trim(ident)
-    write(c_ts, FMT='(I2.2,BZ)') mp_np
-    fn_2= trim(adjustl(array_name))//trim(adjustl(fn_1))//'-np'//trim(adjustl(c_ts))//'.dat'
-
-    call get_lun(dat_lun)
-    open(UNIT=dat_lun, FILE=fn_2, IOSTAT=lios, ACTION='WRITE', &
-         FORM='UNFORMATTED', STATUS='REPLACE')
-    write(UNIT=dat_lun, IOSTAT=lios) array_in
-    close(UNIT=dat_lun)
-
-  end subroutine write_data_dbg
+      implicit none 
+
+      real, intent(in), dimension(:) :: array_in
+      integer, intent(in) :: tstep
+      integer :: lios
+      character(LEN=*), intent(in) :: ident, array_name
+
+      character(LEN=8) :: c_ts
+      character(LEN=40) :: fn_1, fn_2
+
+!***********************************************************************
+
+      write(c_ts, FMT='(I8.8,BZ)') tstep
+      fn_1='-'//trim(adjustl(c_ts))//'-'//trim(ident)
+      write(c_ts, FMT='(I2.2,BZ)') mp_np
+      fn_2= trim(adjustl(array_name))//trim(adjustl(fn_1))//'-np'//trim(adjustl(c_ts))//'.dat'
+
+      call get_lun(dat_lun)
+      open(UNIT=dat_lun, FILE=fn_2, IOSTAT=lios, ACTION='WRITE', &
+           FORM='UNFORMATTED', STATUS='REPLACE')
+      write(UNIT=dat_lun, IOSTAT=lios) array_in
+      close(UNIT=dat_lun)
+
+    end subroutine write_data_dbg