Fix small bug, extend to mpi, add ctest

main/fleur.F90

@@ -118,6 +118,8 @@ CONTAINS
          oneD,coreSpecInput,wann,l_opti)
     CALL timestop("Initialization")
 
+    if( input%preconditioning_param /= 0 .and. input%film ) call juDFT_error('Currently no preconditioner for films', calledby = 'fleur' )
+
     IF (l_opti) CALL optional(mpi,atoms,sphhar,vacuum,dimension,&
                               stars,input,sym,cell,sliceplot,obsolete,xcpot,noco,oneD)
  
@@ -422,22 +424,21 @@ CONTAINS
        CALL forcetheo%postprocess()
        
        CALL enpara%mix(mpi,atoms,vacuum,input,vTot%mt(:,0,:,:),vtot%vacz)
-       IF (mpi%irank.EQ.0) THEN
-          field2 = field
-               !          ----> mix input and output densities
-          CALL timestart("mixing")
-          CALL mix( field2, xcpot, dimension, obsolete, sliceplot, mpi, &
-                    stars, atoms, sphhar, vacuum, input, sym, cell, noco, &
-                    oneD, hybrid, archiveType, inDen, outDen, results )
-          CALL timestop("mixing")
-          
-          WRITE (6,FMT=8130) it
-          WRITE (16,FMT=8130) it
-8130      FORMAT (/,5x,'******* it=',i3,'  is completed********',/,/)
-          WRITE(*,*) "Iteration:",it," Distance:",results%last_distance
-          CALL timestop("Iteration")
-          !+t3e
-       ENDIF ! mpi%irank.EQ.0
+       field2 = field
+       !          ----> mix input and output densities
+       CALL timestart("mixing")
+       CALL mix( field2, xcpot, dimension, obsolete, sliceplot, mpi, &
+                 stars, atoms, sphhar, vacuum, input, sym, cell, noco, &
+                 oneD, hybrid, archiveType, inDen, outDen, results )
+       CALL timestop("mixing")
+       
+       if( mpi%irank == 0 ) then   
+         WRITE (6,FMT=8130) it
+         WRITE (16,FMT=8130) it
+8130     FORMAT (/,5x,'******* it=',i3,'  is completed********',/,/)
+         WRITE(*,*) "Iteration:",it," Distance:",results%last_distance
+         CALL timestop("Iteration")
+       end if ! mpi%irank.EQ.0
        
           
 #ifdef CPP_MPI

mpi/CMakeLists.txt

@@ -11,6 +11,7 @@ if (${FLEUR_USE_MPI})
    mpi/mpi_bc_st.F90
    mpi/mpi_bc_pot.F90
    mpi/mpi_col_den.F90
+   mpi/mpi_reduce_potden.F90
    mpi/mpi_make_groups.F90
    mpi/mpi_dist_forcetheorem.F90
 )

mpi/mpi_reduce_potden.F90

+!--------------------------------------------------------------------------------
+! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
+! This file is part of FLEUR and available as free software under the conditions
+! of the MIT license as expressed in the LICENSE file in more detail.
+!--------------------------------------------------------------------------------
+
+MODULE m_mpi_reduce_potden
+
+CONTAINS
+
+  SUBROUTINE mpi_reduce_potden( mpi, stars, sphhar, atoms, input, vacuum, oneD, noco, potden )
+
+    ! It is assumed that, if some quantity is allocated for some mpi rank, that it is also allocated on mpi rank 0. 
+
+#include"cpp_double.h"
+    USE m_types
+    USE m_constants
+    USE m_juDFT
+    IMPLICIT NONE
+
+    TYPE(t_mpi),     INTENT(IN)     :: mpi
+    TYPE(t_oneD),    INTENT(IN)     :: oneD
+    TYPE(t_input),   INTENT(IN)     :: input
+    TYPE(t_vacuum),  INTENT(IN)     :: vacuum
+    TYPE(t_noco),    INTENT(IN)     :: noco
+    TYPE(t_stars),   INTENT(IN)     :: stars
+    TYPE(t_sphhar),  INTENT(IN)     :: sphhar
+    TYPE(t_atoms),   INTENT(IN)     :: atoms
+    TYPE(t_potden),  INTENT(INOUT)  :: potden
+    INCLUDE 'mpif.h'
+    
+    INTEGER              :: n
+    INTEGER              :: ierr(3)
+    REAL,    ALLOCATABLE :: r_b(:)
+    
+    EXTERNAL CPP_BLAS_scopy,CPP_BLAS_ccopy,MPI_REDUCE
+
+    ! reduce pw
+    n = stars%ng3 * size( potden%pw, 2 )
+    allocate( r_b(n) )
+    call MPI_REDUCE( potden%pw, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
+    if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%pw, 1 )
+    deallocate( r_b )
+
+    ! reduce mt
+    n = atoms%jmtd * ( sphhar%nlhd + 1 ) * atoms%ntype * input%jspins
+    allocate( r_b(n) )
+    call MPI_REDUCE( potden%mt, r_b, n, MPI_DOUBLE, MPI_SUM, 0, mpi%mpi_comm, ierr )
+    if( mpi%irank == 0 ) call CPP_BLAS_scopy( n, r_b, 1, potden%mt, 1 )
+    deallocate( r_b )
+
+    ! reduce pw_w
+    if( allocated( potden%pw_w ) ) then
+      n = stars%ng3 * size( potden%pw_w, 2 )
+      allocate( r_b(n) )
+      call MPI_REDUCE( potden%pw_w, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
+      if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%pw_w, 1 )
+      deallocate( r_b )
+    end if
+
+    ! reduce vacz
+    if( allocated( potden%vacz ) ) then
+      n = vacuum%nmzd * 2 * size( potden%vacz, 3 )
+      allocate( r_b(n) )
+      call MPI_REDUCE( potden%vacz, r_b, n, MPI_DOUBLE, MPI_SUM, 0, mpi%mpi_comm, ierr )
+      if( mpi%irank == 0 ) call CPP_BLAS_scopy( n, r_b, 1, potden%vacz, 1 )
+      deallocate( r_b )
+    end if
+
+    ! reduce vacxy
+    if( allocated( potden%vacxy ) ) then
+      n = vacuum%nmzxyd * ( stars%ng2 - 1 ) * 2 * size( potden%vacxy, 4 )
+      allocate( r_b(n) )
+      call MPI_REDUCE( potden%vacxy, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
+      if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%vacxy, 1 )
+      deallocate( r_b )
+    end if
+
+    ! reduce mmpMat
+    if( allocated( potden%mmpMat ) ) then
+      n = size( potden%mmpMat, 1 ) * size( potden%mmpMat, 2 ) * size( potden%mmpMat, 3 ) * size( potden%mmpMat, 4 )
+      allocate( r_b(n) )
+      call MPI_REDUCE( potden%mmpMat, r_b, n, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, mpi%mpi_comm, ierr )
+      if( mpi%irank == 0 ) call CPP_BLAS_ccopy( n, r_b, 1, potden%mmpMat, 1 )
+      deallocate( r_b )
+    end if
+
+  END SUBROUTINE mpi_reduce_potden
+
+END MODULE m_mpi_reduce_potden

tests/CMakeLists.txt

@@ -2,7 +2,7 @@ enable_testing()
 
 set(SerialParallelTests CuBulk CuBulkXML SiLOXML Fe_1l Fe_1lXML Fe-Atom CuBand CuBandXML CuDOS CuDOSXML
 Fe_bct Fe_bctXML PTO PTOXML Fe_1l_SOC Fe_1l_SOCXML PTO-SOC PTO-SOCXML Fe_bct_SOC Fe_bct_SOCXML Fe_fccXML
-GaAsMultiUForceXML SiFilmPlotXML SiFilmSlicePlotXML CoMCDXML)
+GaAsMultiUForceXML SiFilmPlotXML SiFilmSlicePlotXML CoMCDXML Fe_Kerker)
 
 set(SerialOnlyTests Fe_bct_LO Fe_bct_LOXML Fe_fcc TiO2eels TiO2eelsXML)
 set(InpgenTests Si_plain Si_plain_explicit Si_full_para)# Si_kpt Si_kden Si_round_trip) 

tests/Testing/Temporary/CTestCostData.txt

+---

tests/Testing/Temporary/LastTest.log

+Start testing: Jun 08 16:47 CEST
+----------------------------------------------------------
+End testing: Jun 08 16:47 CEST

tests/tests/Fe_Kerker/test.run1

@@ -7,6 +7,6 @@ jt::testrun("$executable",$workdir);
 
 #now test output
 $result=jt::test_grepexists("$workdir/out","it=  3  is completed");
-$result+=jt::test_grepnumber("$workdir/out","distance of charge densitie","3: *([^ ]*)",16.8,0.001);
+$result+=jt::test_grepnumber("$workdir/out","distance of charge densities for it,"3: *([^ ]*)",9.964,0.001);
 
 jt::stageresult($workdir,$result,"1");

vgen/vgen_coulomb.F90

@@ -10,7 +10,7 @@ module m_vgen_coulomb
 
 contains
 
-  subroutine vgen_coulomb( ispin, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, &
+  subroutine vgen_coulomb( ispin, mpi, dimension, oneD, input, field, vacuum, sym, stars, &
              cell, sphhar, atoms, den, vCoul, results )
     !----------------------------------------------------------------------------
     ! FLAPW potential generator                           
@@ -96,7 +96,8 @@ contains
              oneD, den%vacz(:,:,ispin), den%vacxy(:,:,:,ispin), psq, &
              vCoul%vacz(:,:,ispin), sym, vCoul%vacxy(:,:,:,ispin), vCoul%pw(:,ispin) )
         call timestop( "Vacuum" )
-        !---> generation of the vacuum warped potential components and       ELSEIF (input%film .AND. .NOT.oneD%odi%d1) THEN
+        !---> generation of the vacuum warped potential components and       
+      elseif ( input%film .and. .not. oneD%odi%d1 ) then
         !     ----> potential in the  vacuum  region
         call timestart( "Vacuum" ) 
         call vvac( vacuum, stars, cell, sym, input, field, psq, den%vacz(:,:,ispin), vCoul%vacz(:,:,ispin), rhobar, sig1dh, vz1dh )
@@ -175,6 +176,7 @@ contains
 
     ! MUFFIN-TIN POTENTIAL
     call timestart( "MT-spheres" )
+#ifdef CPP_MPI
     call MPI_BCAST( den%mt, atoms%jmtd * ( 1 + sphhar%nlhd ) * atoms%ntype * dimension%jspd, MPI_DOUBLE_PRECISION, 0, mpi%mpi_comm, ierr )
 #endif
     call vmts( input, mpi, stars, sphhar, atoms, sym, cell, oneD, vCoul%pw(:,ispin), &