Commit d6750fc9 authored by Uliana Alekseeva's avatar Uliana Alekseeva

MPI optinality removed in stepf

parent 3178c177
......@@ -27,7 +27,7 @@
TYPE(t_input),INTENT(IN) :: input
TYPE(t_cell),INTENT(INOUT) :: cell
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_mpi),INTENT(IN),optional :: mpi
TYPE(t_mpi),INTENT(IN) :: mpi
! ..
! .. Local Scalars ..
COMPLEX c_c,c_phs
......@@ -42,7 +42,7 @@
REAL g(3),gm(3),fJ
REAL, ALLOCATABLE :: bfft(:)
INTEGER, ALLOCATABLE :: icm(:,:,:)
INTEGER :: mpi_id, i3_start, i3_end, chunk_size,leftover_size
INTEGER :: i3_start, i3_end, chunk_size,leftover_size
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER ierr
......@@ -55,25 +55,20 @@
#endif
ifftd = 27*stars%mx1*stars%mx2*stars%mx3
IF (PRESENT(mpi)) THEN
mpi_id = mpi%irank
ELSE
mpi_id = 0
ENDIF
! ..
! ..
!---> if step function stored on disc, then just read it in
!
l_error = .FALSE.
IF (mpi_id == 0) CALL readStepfunction(stars, atoms, cell, vacuum, l_error)
IF (mpi%irank == 0) CALL readStepfunction(stars, atoms, cell, vacuum, l_error)
#ifdef CPP_MPI
IF (PRESENT(mpi)) CALL MPI_BCAST(l_error,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_error,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
#endif
IF(.NOT.l_error) THEN
RETURN
END IF
IF (mpi_id == 0) THEN
IF (mpi%irank == 0) THEN
IF (input%film) THEN
dd = vacuum%dvac*cell%area/cell%omtil
......@@ -140,35 +135,33 @@
stars%ustep(k) = stars%ustep(k) - (c* (SIN(gs)/gs-COS(gs))/ (gs*gs))* sf(k)
ENDDO
ENDDO
ENDIF ! (mpi_id == 0)
ENDIF ! (mpi%irank == 0)
!
! --> set up stepfunction on fft-grid:
!
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%omtil,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%invs,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%d1,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%film,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%z1,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%vol,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
IF(.NOT.ALLOCATED(atoms%neq)) ALLOCATE(atoms%neq(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%volmts)) ALLOCATE(atoms%volmts(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%taual)) ALLOCATE(atoms%taual(3,atoms%nat))
IF(.NOT.ALLOCATED(atoms%rmt)) ALLOCATE(atoms%rmt(atoms%ntype))
IF(.NOT.ALLOCATED(stars%ufft)) ALLOCATE(stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1))
CALL MPI_BCAST(atoms%neq,size(atoms%neq),MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,size(atoms%volmts),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%taual,size(atoms%taual),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,size(atoms%rmt),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
ALLOCATE ( bfft_local(0:ifftd-1), ufft_local(0:ifftd-1) )
bfft_local = 0.0
ufft_local = 0.0
ENDIF
CALL MPI_BCAST(atoms%ntype,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%nat,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%omtil,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%invs,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%d1,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%film,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%z1,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%vol,1,CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
IF(.NOT.ALLOCATED(atoms%neq)) ALLOCATE(atoms%neq(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%volmts)) ALLOCATE(atoms%volmts(atoms%ntype))
IF(.NOT.ALLOCATED(atoms%taual)) ALLOCATE(atoms%taual(3,atoms%nat))
IF(.NOT.ALLOCATED(atoms%rmt)) ALLOCATE(atoms%rmt(atoms%ntype))
IF(.NOT.ALLOCATED(stars%ufft)) ALLOCATE(stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1))
CALL MPI_BCAST(atoms%neq,size(atoms%neq),MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,size(atoms%volmts),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%taual,size(atoms%taual),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,size(atoms%rmt),CPP_MPI_REAL,0,mpi%mpi_comm,ierr)
ALLOCATE ( bfft_local(0:ifftd-1), ufft_local(0:ifftd-1) )
bfft_local = 0.0
ufft_local = 0.0
#endif
ALLOCATE ( bfft(0:ifftd-1) )
......@@ -176,10 +169,8 @@
ALLOCATE ( icm(-im1:im1,-im2:im2,-im3:im3) )
icm = 0
#ifdef CPP_MPI
IF ( PRESENT(mpi) ) THEN
ALLOCATE ( icm_local(-im1:im1,-im2:im2,-im3:im3) )
icm_local = 0
ENDIF
ALLOCATE ( icm_local(-im1:im1,-im2:im2,-im3:im3) )
icm_local = 0
#endif
inv_omtil=1.0/cell%omtil
......@@ -189,18 +180,11 @@
bfft=0.0
#ifdef CPP_MPI
IF ( PRESENT(mpi) ) THEN
IF ( mpi%irank == 0 ) THEN
IF ( mpi%irank == 0 ) THEN
DO n=1,atoms%ntype
ufft_local(0)=ufft_local(0)+atoms%neq(n)*atoms%volmts(n)
ENDDO
ufft_local(0)=1.0-ufft_local(0)*inv_omtil
ENDIF
ELSE
DO n=1,atoms%ntype
stars%ufft(0)=stars%ufft(0)+atoms%neq(n)*atoms%volmts(n)
ENDDO
stars%ufft(0)=1.0-stars%ufft(0)*inv_omtil
ENDIF
#else
DO n=1,atoms%ntype
......@@ -209,20 +193,17 @@
stars%ufft(0)=1.0-stars%ufft(0)*inv_omtil
#endif
CALL timestart("stepf_loop")
i3_start = 0
i3_end = im3
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
chunk_size = im3/mpi%isize
leftover_size = modulo(im3,mpi%isize)
IF (mpi%irank < leftover_size ) THEN
i3_start = mpi%irank * (chunk_size + 1)
i3_end = (mpi%irank + 1) * (chunk_size + 1) - 1
ELSE
i3_start = leftover_size * (chunk_size + 1) + (mpi%irank - leftover_size) * chunk_size
i3_end = (i3_start + chunk_size) - 1
ENDIF
chunk_size = im3/mpi%isize
leftover_size = modulo(im3,mpi%isize)
IF (mpi%irank < leftover_size ) THEN
i3_start = mpi%irank * (chunk_size + 1)
i3_end = (mpi%irank + 1) * (chunk_size + 1) - 1
ELSE
i3_start = leftover_size * (chunk_size + 1) + (mpi%irank - leftover_size) * chunk_size
i3_end = (i3_start + chunk_size) - 1
ENDIF
#endif
DO i3=i3_start,i3_end
......@@ -244,17 +225,10 @@
!
ic1 = NINT(gm(1)) ; ic2 = NINT(gm(2)) ; ic3 = NINT(gm(3))
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
icm_local(ic1,ic2,ic3) = ic
IF (ic1 == im1) icm_local(-ic1,ic2,ic3) = ic
IF (ic2 == im2) icm_local(ic1,-ic2,ic3) = ic
IF ((ic1 == im1).AND.(ic2 == im2)) icm_local(-ic1,-ic2,ic3) = ic
ELSE
icm(ic1,ic2,ic3) = ic
IF (ic1 == im1) icm(-ic1,ic2,ic3) = ic
IF (ic2 == im2) icm(ic1,-ic2,ic3) = ic
IF ((ic1 == im1).AND.(ic2 == im2)) icm(-ic1,-ic2,ic3) = ic
ENDIF
icm_local(ic1,ic2,ic3) = ic
IF (ic1 == im1) icm_local(-ic1,ic2,ic3) = ic
IF (ic2 == im2) icm_local(ic1,-ic2,ic3) = ic
IF ((ic1 == im1).AND.(ic2 == im2)) icm_local(-ic1,-ic2,ic3) = ic
#else
icm(ic1,ic2,ic3) = ic
IF (ic1 == im1) icm(-ic1,ic2,ic3) = ic
......@@ -278,11 +252,7 @@
r_c=r_c+atoms%rmt(n)*(SIN(g_rmt)/g_rmt-COS(g_rmt))*r_phs
ENDDO
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
ufft_local(ic) = help * r_c
ELSE
stars%ufft(ic) = help * r_c
ENDIF
ufft_local(ic) = help * r_c
#else
stars%ufft(ic) = help * r_c
#endif
......@@ -299,13 +269,8 @@
c_c=c_c+atoms%rmt(n)*(SIN(g_rmt)/g_rmt-COS(g_rmt))*c_phs
ENDDO
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
ufft_local(ic) = help * REAL(c_c)
bfft_local(ic) = help * AIMAG(c_c)
ELSE
stars%ufft(ic) = help * REAL(c_c)
bfft(ic) = help * AIMAG(c_c)
ENDIF
ufft_local(ic) = help * REAL(c_c)
bfft_local(ic) = help * AIMAG(c_c)
#else
stars%ufft(ic) = help * REAL(c_c)
bfft(ic) = help * AIMAG(c_c)
......@@ -315,13 +280,8 @@
IF (((i3.EQ.3*stars%mx3/2).OR. (i2.EQ.3*stars%mx2/2)).OR. (i1.EQ.3*stars%mx1/2)) THEN
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
ufft_local(ic)=0.0
bfft_local(ic)=0.0
ELSE
stars%ufft(ic)=0.0
bfft(ic)=0.0
ENDIF
ufft_local(ic)=0.0
bfft_local(ic)=0.0
#else
stars%ufft(ic)=0.0
bfft(ic)=0.0
......@@ -335,11 +295,7 @@
gr = SQRT(gx**2 + gy**2)
CALL od_cylbes(1,gr*cell%z1,fJ)
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
ufft_local(ic) = ufft_local(ic) +2*cell%vol*fJ/(gr*cell%z1*cell%omtil)
ELSE
stars%ufft(ic) = stars%ufft(ic) +2*cell%vol*fJ/(gr*cell%z1*cell%omtil)
ENDIF
ufft_local(ic) = ufft_local(ic) +2*cell%vol*fJ/(gr*cell%z1*cell%omtil)
#else
stars%ufft(ic) = stars%ufft(ic) +2*cell%vol*fJ/(gr*cell%z1*cell%omtil)
#endif
......@@ -351,15 +307,12 @@
ENDDO
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
CALL MPI_REDUCE(ufft_local,stars%ufft,ifftd,CPP_MPI_REAL, MPI_SUM,0,mpi%mpi_comm,ierr)
CALL MPI_REDUCE(bfft_local,bfft,ifftd,CPP_MPI_REAL, MPI_SUM,0,mpi%mpi_comm,ierr)
CALL MPI_REDUCE(icm_local,icm,size(icm),MPI_INTEGER, MPI_SUM,0,mpi%mpi_comm,ierr)
ENDIF
CALL MPI_REDUCE(ufft_local,stars%ufft,ifftd,CPP_MPI_REAL, MPI_SUM,0,mpi%mpi_comm,ierr)
CALL MPI_REDUCE(bfft_local,bfft,ifftd,CPP_MPI_REAL, MPI_SUM,0,mpi%mpi_comm,ierr)
CALL MPI_REDUCE(icm_local,icm,size(icm),MPI_INTEGER, MPI_SUM,0,mpi%mpi_comm,ierr)
#endif
CALL timestop("stepf_loop")
IF (mpi_id == 0) THEN
IF (mpi%irank == 0) THEN
ic = 9*stars%mx1*stars%mx2*(im3+1)
DO i3=im3+1,3*stars%mx3-1
gm(3)=REAL(i3)
......@@ -412,12 +365,10 @@
DEALLOCATE ( bfft , icm )
#ifdef CPP_MPI
IF (PRESENT(mpi)) THEN
DEALLOCATE ( bfft_local, ufft_local , icm_local )
ENDIF
DEALLOCATE ( bfft_local, ufft_local , icm_local )
#endif
CALL writeStepfunction(stars)
ENDIF ! (mpi_id == 0)
ENDIF ! (mpi%irank == 0)
END SUBROUTINE stepf
END MODULE m_stepf
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