The ABINIT Users Mailing List ( CLOSED )

[Eric Roman <ESRoman@berkeley.edu>]

All

I've assembled some patches that allow abinit to run in parallel on IBM SP,
and LAM MPI.

These are patches against version 4.3.2 (w/ M. Veithen's original parallel
Berry's phase).  I've been able to run the Test_paral tests successfully.
Also, I've been able to do my own production calculations, on both IBM and LAM
in parallel.  

I've tested 1,2,4, and 10 processors successfully with LAM, and 1,2.4,10,15,
and 30 on IBM.

(Strangely, 16 processor polarization calculations on IBM and LAM do not work
correctly.  I suspect this is a problem with the Berry's phase 
parallelization,
since I see a segmentation violation, or some sort of lockup/deadlock, on 
entry
into berryphase_new, but only on 16 or 32 processors, not with 2,4,15,30...
In any case, I believe this is unrelated to the patches I've provided here.
I think this is a problem inherent to berryphase_new.  Any ideas?)

(If anyone is interested, I have a few other patches, to the makefiles and
test scripts, that make it slightly easier to run the tests.)

There are 6 patches attached to this e-mail.

1.  mpi-comm-free.diff
abinit does not free MPI communicators in between data sets.  This patch
modifies clnmpi_gs and clnmpi_fft to free MPI communicators.  gstate.f has
been modified to call clnmpi_fft at the end of a ground state calculation.
initmpi_fft was always called, but clnmpi_fft was only called if MPI_FFT
was defined, resulting in leaks of MPI communicators, and a small memory leak.

This bug was unrelated to the IBM, but IBM showed it first, since the IBM
has a limit of 2000 MPI communicators.

There is a corresponding problem with MPI groups.  I have NOT fixed this
problem.  This is a bug, and should be fixed.

2.  pstate-compiler-warning.diff
Fixes a compiler warning in pstate.f.  It looks like certain calls to gstate.f
were not updated with the pawang argument.

3.  stop-space.diff
Fixes a compile-time error in the use of the stop statement.  IBM won't accept
stop'foo'

4.  no-mpi2-types.diff
changes xmax_mpi_i8b to use the nonstandard MPI_INTEGER8 type (8 bytes),
rather than the MPI-2 only MPI_OFFSET_TYPE (not guaranteed to be 8 bytes, and
only defined on platforms with MPI FILE IO).

Also a similar change to WffOffset.  This function is never called, so I
can't tell if the WffOffset change broke anything.  Then again, it's never
called...  So how could it?  :)

5.  comm-world-zero.diff and 
6. skip-comm-self-reduce.diff
This is a fix for the problem discussed last week on the HITACHI and LAM
systems.  I renamed abinit_comm_self to abinit_comm_serial, and only use the
constant in one source file, and then only if MPI is NOT defined.  This
will, hopefully, prevent further confusion.

The skip-comm-self-reduce.diff changes xfuncmpi.f to skip reduction operations
over the local processor.  (Probably unnecessary, but it seems sensible.)
This was necessary again to remove the assumption that MPI_COMM_WORLD != 0.


This last two patches are the most important.  They allowed abinit to compile
and complete Test_paral tests under both IBM MPI and LAM MPI on a PC cluster.

I would be grateful to the abinit developer community if they were to consider
these patches for the next stable release of abinit.

Sincerely,
Eric Roman

-- 
Eric Roman                       Department of Physics
510-642-7302                     UC Berkeley
Index: Src_1managempi/xfuncmpi.f
===================================================================
--- Src_1managempi/xfuncmpi.f   (revision 7)
+++ Src_1managempi/xfuncmpi.f   (working copy)
@@ -39,7 +39,7 @@
  integer  :: ier,spaceComm
 #          if defined MPI || defined MPI_FFT
                integer , allocatable :: xsum(:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
           !Accumulate xval on all proc. in spaceComm
                n1 = size(xval)
                allocate(xsum(n1))
@@ -72,7 +72,7 @@
  integer  :: ier,spaceComm
 #          if defined MPI || defined MPI_FFT
                integer  :: xsum
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
           !Accumulate xval on all proc. in spaceComm
                call MPI_ALLREDUCE(xval,xsum,1,MPI_INTEGER,&
           &  MPI_SUM,spaceComm,ier)
@@ -101,7 +101,7 @@
  integer :: xval,xsum
  integer  :: ier,spaceComm
 #          if defined MPI || defined MPI_FFT
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
           !Accumulate xval on all proc. in spaceComm
                call MPI_ALLREDUCE(xval,xsum,1,MPI_INTEGER,&
           &  MPI_SUM,spaceComm,ier)
@@ -132,7 +132,7 @@
 #          if defined MPI || defined MPI_FFT
                integer , allocatable :: xsum(:)
           !Accumulate xval on all proc. in spaceComm
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
                allocate(xsum(n1))
                call MPI_ALLREDUCE(xval,xsum,n1,MPI_INTEGER,&
           &  MPI_SUM,spaceComm,ier)
@@ -164,7 +164,7 @@
  integer  :: ier,spaceComm
 #          if defined MPI || defined MPI_FFT
                integer , allocatable :: xsum(:,:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
           !Accumulate xval on all proc. in spaceComm
                n1 =size(xval,dim=1)
                n2 =size(xval,dim=2)
@@ -200,7 +200,7 @@
 #          if defined MPI || defined MPI_FFT
                integer , allocatable :: xsum(:,:,:)
           !Accumulate xval on all proc. in spaceComm
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
                n1 =size(xval,dim=1)
                n2 =size(xval,dim=2)
                n3 =size(xval,dim=3)
@@ -236,7 +236,7 @@
 
 #          if defined MPI || defined MPI_FFT
                real(dp) , allocatable :: xsum(:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
        !Accumulate xval on all proc. in spaceComm
                n1 = size(xval)
                allocate(xsum(n1))
@@ -272,7 +272,7 @@
 #          if defined MPI || defined MPI_FFT
                real(dp)  :: xsum
        !Accumulate xval on all proc. in spaceComm
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
                call MPI_ALLREDUCE(xval,xsum,1,MPI_DOUBLE_PRECISION,&
           &  MPI_SUM,spaceComm,ier)
                xval  = xsum
@@ -303,7 +303,7 @@
 
 #          if defined MPI || defined MPI_FFT
                real(dp) , allocatable :: xsum(:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
        !Accumulate xval on all proc. in spaceComm
                allocate(xsum(n1))
                call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,&
@@ -337,7 +337,7 @@
 
 #          if defined MPI || defined MPI_FFT
                real(dp) , allocatable :: xsum(:,:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
                n1 = size(xval,dim=1)
                n2 = size(xval,dim=2)
        !Accumulate xval on all proc. in spaceComm
@@ -373,7 +373,7 @@
 
 #          if defined MPI || defined MPI_FFT
                real(dp) , allocatable :: xsum(:,:,:)
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
                n1 = size(xval,dim=1)
                n2 = size(xval,dim=2)
                n3 = size(xval,dim=3)
@@ -409,7 +409,7 @@
  integer  :: ier,spaceComm
  
 #          if defined MPI || defined MPI_FFT
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
             !Accumulate xval on all proc. in spaceComm
                call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,&
           &  MPI_SUM,spaceComm,ier)
@@ -439,7 +439,7 @@
  integer  :: ier,spaceComm
 
 #          if defined MPI || defined MPI_FFT
-               if (spaceComm /= 0) then
+               if (spaceComm /= MPI_COMM_SELF) then
             !Accumulate xval on all proc. in spaceComm
                call MPI_ALLREDUCE(xval,xsum,n1,MPI_DOUBLE_PRECISION,&
           &  MPI_SUM,spaceComm,ier)
@@ -637,7 +637,7 @@
 #          if defined MPI
  integer(i8b):: xvalproc
                 xvalproc = xval
-                call MPI_ALLREDUCE(xvalproc,xval,1,MPI_OFFSET_KIND,&
+                call MPI_ALLREDUCE(xvalproc,xval,1,MPI_INTEGER8,&
           &  MPI_MAX,spaceComm,ier)
 #          endif
 
Index: Src_1managempi/xdef_comm.f
===================================================================
--- Src_1managempi/xdef_comm.f  (revision 7)
+++ Src_1managempi/xdef_comm.f  (working copy)
@@ -18,13 +18,16 @@
 !!
 !! SOURCE
 
-       ! xcomm_init  definition
+! xcomm_init  definition
 
+!Used to distinguish serial execution when performing reduction operations.
+
  subroutine xcomm_world(spaceComm)
 #          if defined MPI || defined MPI_FFT
 !         use mpi    
 #          endif
  implicit none
+ integer, parameter :: abinit_comm_serial = 12345
 #          if defined MPI || defined MPI_FFT
            include 'mpif.h'
 #          endif
@@ -33,7 +36,7 @@
 #          if defined MPI
                spaceComm = MPI_COMM_WORLD
 #          else
-               spaceComm = 0           
+               spaceComm = abinit_comm_serial
 #          endif
  end subroutine xcomm_world
 
@@ -43,6 +46,7 @@
 !          use mpi    
 #          endif
  implicit none
+ integer, parameter :: abinit_comm_serial = 12345
 #          if defined MPI || defined MPI_FFT
            include 'mpif.h'
 #          endif
@@ -56,14 +60,14 @@
                         if (mpi_enreg%num_group_fft /= 0) then
                                 spaceComm =  
mpi_enreg%fft_comm(mpi_enreg%num_group_fft)
                         else
-                                spaceComm = 0
+                                spaceComm = MPI_COMM_SELF
                         endif
                 endif
             else
                 spaceComm = mpi_enreg%kpt_comm_para(mpi_enreg%ipara)
            endif
 #          else
-                spaceComm = 0
+                spaceComm = abinit_comm_serial
 #          endif
  end subroutine xcomm_init
 
Index: Src_1managempi/WffOffset.f
===================================================================
--- Src_1managempi/WffOffset.f  (revision 14)
+++ Src_1managempi/WffOffset.f  (revision 16)
@@ -38,7 +38,7 @@
  type(wffile_type) :: wff
  integer  :: ier,spaceComm,sender
 
-#          if defined MPI || defined MPI_FFT
+#          if defined MPIO
            call MPI_BCAST(wff%offwff,1,MPI_OFFSET_KIND,sender,spaceComm,ier)
 #          endif
 
Index: Src_1managempi/xfuncmpi.f
===================================================================
--- Src_1managempi/xfuncmpi.f   (revision 14)
+++ Src_1managempi/xfuncmpi.f   (revision 16)
@@ -637,7 +637,7 @@
 #          if defined MPI
  integer(i8b):: xvalproc
                 xvalproc = xval
-                call MPI_ALLREDUCE(xvalproc,xval,1,MPI_OFFSET_KIND,&
+                call MPI_ALLREDUCE(xvalproc,xval,1,MPI_INTEGER8,&
           &  MPI_MAX,spaceComm,ier)
 #          endif
 
Index: Src_9drive/vtorhotf.f
===================================================================
--- Src_9drive/vtorhotf.f       (revision 16)
+++ Src_9drive/vtorhotf.f       (revision 17)
@@ -405,7 +405,7 @@
               3.6087389d-3, 2.3369894d-5/ ! \bar{V}_i
       data PI/3.14159265358979323846264d0/
       data KRUN/0/
-      if (K.lt.0.or.K.gt.2) stop'BLINW: K out of range'
+      if (K.lt.0.or.K.gt.2) stop 'BLINW: K out of range'
       KRUN=KRUN+1
       if (KRUN.eq.1) then ! initialize
         do J=0,2
@@ -491,7 +491,7 @@
       B0(0:3),B1(0:3),B2(0:3),B3(0:3), &
       C0(0:3),C1(0:3),d0(0:3),D1(0:3),D2(0:3)
       data KRUN/0/
-      if (N.lt.0.or.N.gt.3) stop'FERINV: Invalid subscript'
+      if (N.lt.0.or.N.gt.3) stop 'FERINV: Invalid subscript'
       if (KRUN.eq.0) then   ! Initialize
          KRUN=1
          I=0  ! X_{-1/2}
Index: Src_8seqpar/pstate.f
===================================================================
--- Src_8seqpar/pstate.f        (revision 17)
+++ Src_8seqpar/pstate.f        (revision 27)
@@ -179,8 +179,8 @@
    endif
    call gstate(acell,codvsn,cpui,dtfil,dtset,&
 &    iexit,mband,mgfft,mkmem,mpi_enreg,mpw,natom,nfft,nkpt,&
-&    
npwtot,nspden,nspinor,nsppol,nsym,occ,pawang,pawrad,pawtab,psps,results_gs,rprim,&
-&    vel,walli,xred)
+&    npwtot,nspden,nspinor,nsppol,nsym,occ,&
+&    pawang,pawrad,pawtab,psps,results_gs,rprim,vel,walli,xred)
 
   if (mpi_enreg%me == 0) then
      write(77,*) 'fine gs%etotal', results_gs%etotal
@@ -236,8 +236,8 @@
      
      call gstate(acell,codvsn,cpui,dtfil,dtset,&
 &    iexit,mband,mgfft,mkmem,mpi_enreg,mpw,natom,nfft,nkpt,&
-&    
npwtot,nspden,nspinor,nsppol,nsym,occ,pawrad,pawtab,psps,results_gs,rprim,&
-&    vel,walli,xred)
+&    npwtot,nspden,nspinor,nsppol,nsym,occ,pawang,&
+&    pawrad,pawtab,psps,results_gs,rprim,vel,walli,xred)
 #          if defined MPI || defined MPI_FFT
      else
      s_xred(:,:,ipara+1)=0.0d0
@@ -257,7 +257,7 @@
  s_vel(:,:,:)=s_vel_tot(:,:,:)
  call wrtout(0, message, 'INIT')
 #         endif
- call clnmpi_gs(mpi_enreg)
+ call clnmpi_gs(dtset, mpi_enreg)
 
 #          if defined MPI || defined MPI_FFT
     mpi_enreg%nproc_per_para=1
@@ -290,8 +290,8 @@
    endif
    call gstate(acell,codvsn,cpui,dtfil,dtset,&
 &    iexit,mband,mgfft,mkmem,mpi_enreg,mpw,natom,nfft,nkpt,&
-&    
npwtot,nspden,nspinor,nsppol,nsym,occ,pawrad,pawtab,psps,results_gs,rprim,&
-&    vel,walli,xred)
+&    npwtot,nspden,nspinor,nsppol,nsym,&
+&    occ,pawang,pawrad,pawtab,psps,results_gs,rprim,vel,walli,xred)
 
   if (mpi_enreg%me == 0) then
      write(77,*) 'coarse gs%etotal', results_gs%etotal
@@ -312,7 +312,7 @@
    enddo
    u_xred(:,:,:,0)=u_xred(:,:,:,1) 
    u_vel(:,:,:,0)=u_vel(:,:,:,1)
-   call clnmpi_gs(mpi_enreg)
+   call clnmpi_gs(dtset, mpi_enreg)
   enddo  
   xred(:,:)=u_xred(:,:,npara,1) 
   vel(:,:)=u_vel(:,:,npara,1)
Index: Src_3iovars/invars2m.f
===================================================================
--- Src_3iovars/invars2m.f      (revision 17)
+++ Src_3iovars/invars2m.f      (revision 27)
@@ -315,7 +315,7 @@
  enddo
 
  if(mpi_enreg%paral_compil_fft==1)then
-  call clnmpi_fft(mpi_enreg)
+  call clnmpi_fft(dtsets(idtset), mpi_enreg)
  endif 
 
 !DEBUG
Index: Src_1managempi/clnmpi_gs.f
===================================================================
--- Src_1managempi/clnmpi_gs.f  (revision 17)
+++ Src_1managempi/clnmpi_gs.f  (revision 27)
@@ -35,7 +35,7 @@
 !!
 !! SOURCE
 
- subroutine clnmpi_gs(mpi_enreg)
+ subroutine clnmpi_gs(dtset, mpi_enreg)
 
  use defs_basis
  use defs_datatypes
@@ -48,13 +48,15 @@
 #          endif
 !Arguments ------------------------------------
 
+ type(dataset_type) :: dtset
+
  type(MPI_type) :: mpi_enreg
  
 !Local variables-------------------------------
 !no_abirules
 #          if defined MPI
           !Variables introduced for MPI version
-           integer :: ierr
+           integer :: ierr,nkpt,iikpt,nsppol,iisppol,group,result
 #          endif
  
 ! ***********************************************************************
@@ -65,12 +67,30 @@
 !ENDDEBUG
 
 #          if defined MPI
+           nsppol=dtset%nsppol
+           nkpt=dtset%nkpt
            if (mpi_enreg%paralbd >= 1) then
+            do iisppol=1,nsppol
+             do iikpt=1,nkpt
+              group=iikpt+(iisppol-1)*nkpt
+              if (mpi_enreg%kpt_comm(group) /= MPI_COMM_NULL) then
+               call MPI_COMM_FREE(mpi_enreg%kpt_comm(group),ierr)
+              endif
+             enddo
+            enddo
             call MPI_GROUP_FREE(mpi_enreg%world_group,ierr)
             deallocate(mpi_enreg%proc_distrb)
             deallocate(mpi_enreg%kpt_comm,mpi_enreg%kpt_group)
            endif
            if (mpi_enreg%parareel == 1) then
+            do iisppol=1,nsppol
+             do iikpt=1,nkpt
+              group=iikpt+(iisppol-1)*nkpt
+              if (mpi_enreg%kpt_comm(group) /= MPI_COMM_NULL) then
+               call MPI_COMM_FREE(mpi_enreg%kpt_comm(group),ierr)
+              endif
+             enddo
+            enddo
             call MPI_GROUP_FREE(mpi_enreg%world_group,ierr)
             deallocate(mpi_enreg%proc_distrb_para)
             deallocate(mpi_enreg%kpt_comm_para,mpi_enreg%kpt_group_para)
Index: Src_1managempi/clnmpi_fft.f
===================================================================
--- Src_1managempi/clnmpi_fft.f (revision 17)
+++ Src_1managempi/clnmpi_fft.f (revision 27)
@@ -34,18 +34,24 @@
 !!
 !! SOURCE
 
- subroutine clnmpi_fft(mpi_enreg)
+ subroutine clnmpi_fft(dtset, mpi_enreg)
 
  use defs_basis
  use defs_datatypes
  
  implicit none
+
+#          if defined MPI || defined MPI_FFT
+           include 'mpif.h'
+#          endif
  
 !Arguments ------------------------------------
 
+ type(dataset_type) :: dtset
  type(MPI_type) :: mpi_enreg
  
 !Local variables-------------------------------
+         integer :: iisppol,nsppol,iikpt,nkpt,group,ierr,result
  
 ! ***********************************************************************
 
@@ -53,11 +59,37 @@
 ! write(6,*)' clnmpi_fft : enter'
 !ENDDEBUG
 
- if(mpi_enreg%paral_compil_fft == 1) then
-  deallocate(mpi_enreg%fft_comm)
-  deallocate(mpi_enreg%fft_group)
- endif
+#        if defined MPI || defined MPI_FFT
+          nkpt=dtset%nkpt
+          nsppol=dtset%nsppol
+#        endif
 
+#        if defined MPI || defined MPI_FFT
+          if (mpi_enreg%fft_master_comm /= MPI_COMM_NULL) then
+           call MPI_COMM_FREE(mpi_enreg%fft_master_comm,ierr)
+          endif
+#        endif
+
+#        if defined MPI
+          do iisppol=1,nsppol
+           do iikpt=1,nkpt
+            group=iikpt+(iisppol-1)*nkpt
+            if (mpi_enreg%fft_comm(group) /= MPI_COMM_NULL) then
+             call MPI_COMM_FREE(mpi_enreg%fft_comm(group),ierr)
+            endif
+           enddo
+          enddo
+#        endif
+
+#        if defined MPI_FFT
+          #error Please free fft_comm.
+#        endif
+
+#        if defined MPI || defined MPI_FFT
+          deallocate(mpi_enreg%fft_comm)
+          deallocate(mpi_enreg%fft_group)
+#        endif
+
 !DEBUG
 ! write(6,*)' clnmpi_fft : end'
 !ENDDEBUG
Index: Src_9drive/gstate.f
===================================================================
--- Src_9drive/gstate.f (revision 17)
+++ Src_9drive/gstate.f (revision 27)
@@ -992,13 +992,10 @@
 
 !Clean the MPI informations
  if (mpi_enreg%parareel == 0) then
-   call clnmpi_gs(mpi_enreg)
+   call clnmpi_gs(dtset, mpi_enreg)
  endif
 
-#         if defined MPI_FFT
-        call clnmpi_fft(mpi_enreg)
-        
-#         endif
+ call clnmpi_fft(dtset, mpi_enreg)
 
  write(message, '(a,a)' ) ch10,' gstate : exiting '
  call wrtout(06,message,'COLL')