Changeset 78e62dc in flexpart.git for src/mpi_mod.f90

Timestamp:

May 12, 2015, 12:28:19 PM (9 years ago)

Author:

flexpart <>

Branches:

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

Children:

0f20c31

Parents:

2f8635b

Message:

New OH parameter in SPECIES files (now 3 instead of 2). New path to OH binariy files.

File:

• src/mpi_mod.f90 (modified) (16 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
 
@@ -117 +117 @@
   logical, parameter :: mp_dbg_out = .false.
   logical, parameter :: mp_time_barrier=.true.
-  logical, parameter :: mp_measure_time=.true. 
+  logical, parameter :: mp_measure_time=.false. 
 
 ! for measuring CPU/Wall time
@@ -139 +139 @@
   real(dp) :: mp_conccalc_time_beg, mp_conccalc_time_end, mp_conccalc_time_total=0.
   real(dp) :: mp_total_wtime_beg, mp_total_wtime_end, mp_total_wtime_total=0.
+  real(dp) :: mp_vt_wtime_beg, mp_vt_wtime_end, mp_vt_wtime_total
+  real(sp) :: mp_vt_time_beg, mp_vt_time_end, mp_vt_time_total
 
 ! dat_lun           logical unit number for i/o
@@ -418 +420 @@
 
 
-
 ! redefine numpart as 'numpart per process' throughout the code
 !**************************************************************
@@ -438 +439 @@
 
     integer :: i
-
-
-!***********************************************************************
-
 
 ! Time for MPI communications
@@ -1243 +1240 @@
 
     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 +1336 @@
              &MPI_COMM_WORLD,reqs(i),mp_ierr)
         if (mp_ierr /= 0) goto 600
-      ! else
-      !   i=i+2
+! else
+!   i=i+2
       end if
 
@@ -1389 +1386 @@
 
 ! :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 +1590 @@
     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 
@@ -1733 +1730 @@
            & mp_comm_used, mp_ierr)
     end if
-
 
     if ((WETDEP).and.(ldirect.gt.0)) then
@@ -1854 +1850 @@
       end if
 
+    case ('verttransform')
+      if (imode.eq.0) then
+        mp_vt_wtime_beg = mpi_wtime()
+        call cpu_time(mp_vt_time_beg)
+      else
+        mp_vt_wtime_end = mpi_wtime()
+        call cpu_time(mp_vt_time_end)
+
+        mp_vt_wtime_total = mp_vt_wtime_total + (mp_vt_wtime_end - &
+             & mp_vt_wtime_beg)
+        mp_vt_time_total = mp_vt_time_total + (mp_vt_time_end - &
+             & mp_vt_time_beg)
+      end if
+
     case ('readwind')
       if (imode.eq.0) then
@@ -1909 +1919 @@
 !***********************************************************************
 
-    if (mp_measure_time) then
+    IF (mp_measure_time) THEN
       do ip=0, mp_np-1
         call MPI_BARRIER(MPI_COMM_WORLD, mp_ierr)
@@ -1956 +1966 @@
           write(*,FMT='(A60,TR1,F9.2)') 'TOTAL WALL TIME FOR CONCCALC:',&
                & mp_conccalc_time_total
+          ! write(*,FMT='(A60,TR1,F9.2)') 'TOTAL WALL TIME FOR VERTTRANSFORM:',&
+          !      & mp_vt_wtime_total
+          ! write(*,FMT='(A60,TR1,F9.2)') 'TOTAL CPU TIME FOR VERTTRANSFORM:',&
+          !      & mp_vt_time_total
 ! NB: the 'flush' function is possibly a gfortran-specific extension
           call flush()
@@ -1962 +1976 @@
     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 +2006 @@
 
 
-  end subroutine mpif_finalize
-
-
-  subroutine get_lun(my_lun)
+    end subroutine mpif_finalize
+
+
+    subroutine get_lun(my_lun)
 !***********************************************************************
 ! get_lun: 
@@ -1990 +2015 @@
 !***********************************************************************
 
-    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
+
+      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 file (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