Commit 5629a446 authored by Miriam Hinzen's avatar Miriam Hinzen

Fix small bug, extend to mpi, add ctest

parent ed4b8751
......@@ -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
......
This diff is collapsed.
......@@ -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
)
......
!--------------------------------------------------------------------------------
! 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
......@@ -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)
......
Start testing: Jun 08 16:47 CEST
----------------------------------------------------------
End testing: Jun 08 16:47 CEST
......@@ -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");
......@@ -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), &
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment