Skip to content

GitLab

fleur
fleur
Commit f6681e04 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Fixed lots of bugs in MPI version. Compiles now for complex version, no testing done

parent 8cbe3b01
Hide whitespace changes
Inline Side-by-side
Showing with 194 additions and 215 deletions
cdn/cdnovlp.F90
View file @ f6681e04
......@@ -620,14 +620,7 @@
ENDIF ! mpi%irank ==0
#ifdef CPP_MPI
IF ( mpi%isize > 1 ) THEN
CALL mpi_bc_st(&
& mpi%mpi_comm,mpi%irank,sphhar%memd,sphhar%nlhd,sphhar%ntypsd,atoms%jmtd,atoms%ntypd,stars%n3d,&
& jspin,l_cutoff,stars%ng3,atoms%ntype,sym%nop,atoms%natd,sym%symor,&
& sphhar%clnu,qpwc,atoms%lmax,atoms%ntypsy,atoms%jri,sphhar%nmem,sphhar%nlh,sphhar%mlh,stars%nstr,&
& atoms%neq,stars%kv3,sym%mrot,sym%invtab,sphhar%llh,cell%bmat,sym%tau,atoms%taual,atoms%dx,&
& atoms%rmsh,stars%sk3)
ENDIF
IF ( mpi%isize > 1 ) CALL mpi_bc_st(mpi,stars,qpwc)
#endif
CALL qpw_to_nmt(&
......@@ -637,11 +630,7 @@
& rho)
#ifdef CPP_MPI
IF ( mpi%isize > 1 ) THEN
CALL mpi_col_st( ! Collect rho()&
& mpi,atoms,sphhar,&
& rho(1,0,1,jspin))
ENDIF
IF ( mpi%isize > 1) CALL mpi_col_st(mpi,atoms,sphhar,rho(1,0,1,jspin))
#endif
DEALLOCATE (qpwc,qf)
......
cdn/cdnval.F90
View file @ f6681e04
......@@ -86,7 +86,6 @@ CONTAINS
USE m_cdnread, ONLY : cdn_read0, cdn_read
#ifdef CPP_MPI
USE m_mpi_col_den ! collect density data from parallel nodes
USE m_mpi_col_dos ! collect DOS data from parallel nodes
#endif
USE m_types
IMPLICIT NONE
......@@ -850,23 +849,18 @@ enddo
#ifdef CPP_MPI
CALL timestart("cdnval: mpi_col_den")
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(&!TODO
mpi,sphhar,atoms,oneD,&
stars,vacuum,vacuum,&
input,&
noco,noco,l_fmpl,ispin,llpd,&
rhtxy(1,1,1,ispin),rht(1,1,ispin),qpw(1,ispin),&
ener(0,1,ispin),sqal(0,1,ispin),results(1,1,ispin),&
svac(1,ispin),pvac(1,ispin),uu(0,1,ispin),dd(0,1,ispin),&
du(0,1,ispin),uunmt(0,1,1,ispin),ddnmt(0,1,1,ispin),&
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input,noco,l_fmpl,ispin,llpd, rhtxy(1,1,1,ispin),&
rht(1,1,ispin),qpw(1,ispin), ener(0,1,ispin),sqal(0,1,ispin),&
results,svac(1,ispin),pvac(1,ispin),uu(0,1,ispin),&
dd(0,1,ispin),du(0,1,ispin),uunmt(0,1,1,ispin),ddnmt(0,1,1,ispin),&
udnmt(0,1,1,ispin),dunmt(0,1,1,ispin),sqlo(1,1,ispin),&
aclo(1,1,ispin),bclo(1,1,ispin),cclo(1,1,1,ispin),&
acnmt(0,1,1,1,ispin),bcnmt(0,1,1,1,ispin),&
ccnmt(1,1,1,1,ispin),enerlo(1,1,ispin),&
orb(0,-lmaxd,1,ispin),orbl(1,-llod,1,ispin),&
orblo(1,1,-llod,1,ispin),mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
cdom,cdomvz,cdomvxy,n_mmp)
orb(0,-atoms%lmaxd,1,ispin),orbl(1,-atoms%llod,1,ispin),&
orblo(1,1,-atoms%llod,1,ispin),mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,cdom,cdomvz,cdomvxy,n_mmp)
ENDDO
CALL timestop("cdnval: mpi_col_den")
#endif
......
diagonalization/ssubredist1.F90
View file @ f6681e04
......@@ -2,7 +2,7 @@
SUBROUTINE subredist1(achi,n,asca,lda,SUB_COMM,nprow,npcol,iam,ierr,nb)
use m_juDFT
#include"./cpp_double.h"
#include"cpp_arch.h"
!#include"cpp_arch.h"
IMPLICIT NONE
INCLUDE 'mpif.h'
......
diagonalization/ssubredist2.F90
View file @ f6681e04
......@@ -2,7 +2,7 @@
subroutine subredist2(achi,n,m,asca,lda,SUB_COMM,nprow,npcol,&
iam,ierr,nb)
#include"./cpp_double.h"
#include"cpp_arch.h"
!#include"cpp_arch.h"
use m_juDFT
IMPLICIT NONE
INCLUDE 'mpif.h'
......
eigen/apws.F90
View file @ f6681e04
......@@ -47,7 +47,7 @@ CONTAINS
#ifdef CPP_MPI
INTEGER :: n_inner,n_bound
REAL, ALLOCATABLE :: rk_help(:)
INTEGER, ALLOCATABLE :: k_help(: :)
INTEGER, ALLOCATABLE :: k_help(:,:) ,pos(:)
#endif
! ..
! ..
......@@ -173,7 +173,7 @@ CONTAINS
!
!---> order K's in sequence K_1,...K_n | K_0,... | K_-1,....K_-n
!
ALLOCATE (atoms%pos(lapw%nv(ispin)))
ALLOCATE (pos(lapw%nv(ispin)))
n_inner = lapw%nv(ispin) - nred
IF (mod(nred,n_size).EQ.0) THEN
n_bound = nred
......@@ -190,11 +190,11 @@ CONTAINS
j = 1
DO n = 1, nred
IF (matind(n,1).EQ.matind(n,2)) THEN
atoms%pos(matind(n,1)) = n_inner + i
pos(matind(n,1)) = n_inner + i
i = i + 1
ELSE
atoms%pos(matind(n,1)) = j
atoms%pos(matind(n,2)) = j + n_bound
pos(matind(n,1)) = j
pos(matind(n,2)) = j + n_bound
j = j + 1
ENDIF
ENDDO
......@@ -207,10 +207,10 @@ CONTAINS
k_help(3,n) = lapw%k3(n,ispin)
ENDDO
DO n = lapw%nv(ispin), 1, -1
lapw%rk(atoms%pos(n),ispin) = rk_help(n)
lapw%k1(atoms%pos(n),ispin) = k_help(1,n)
lapw%k2(atoms%pos(n),ispin) = k_help(2,n)
lapw%k3(atoms%pos(n),ispin) = k_help(3,n)
lapw%rk(pos(n),ispin) = rk_help(n)
lapw%k1(pos(n),ispin) = k_help(1,n)
lapw%k2(pos(n),ispin) = k_help(2,n)
lapw%k3(pos(n),ispin) = k_help(3,n)
ENDDO
DO n = nred + 1, n_bound
lapw%rk(n,ispin) = lapw%rk(lapw%nv(ispin),ispin)
......@@ -219,7 +219,7 @@ CONTAINS
lapw%k3(n,ispin) = lapw%k3(lapw%nv(ispin),ispin)
ENDDO
DEALLOCATE (rk_help,k_help)
DEALLOCATE (atoms%pos)
DEALLOCATE (pos)
lapw%nv(ispin) = lapw%nv(ispin) - nred + n_bound
ENDIF
#endif
......
eigen/eigen.F90
View file @ f6681e04
......@@ -58,7 +58,7 @@ CONTAINS
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_banddos),INTENT(IN) :: banddos
TYPE(t_jij),INTENT(IN) :: jij
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sym),INTENT(INOUT) :: sym !l_zref will be modified in EVP
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
......@@ -411,20 +411,20 @@ CONTAINS
ENDIF
!
# ifdef CPP_MPI
#ifdef CPP_MPI
! check that all sending operations are completed
IF ( hybrid%l_calhf ) CALL MPI_WAITALL(sndreqd,sndreq,MPI_STATUSES_IGNORE,ierr)
# endif
#endif
k_loop:DO nk = n_start,kpts%nkpt,n_stride
# ifdef CPP_MPI
#if defined(CPP_MPI)&&defined(CPP_NEVER)
IF ( hybrid%l_calhf ) THEN
! jump to next k-point if this process is not present in communicator
IF ( comm(nk) == MPI_COMM_NULL ) CYCLE
! allocate buffer for communication of the results
IF ( irank2(nk) /= 0 ) CALL work_dist_reserve_buffer( nbands(nk) )
END IF
# endif
#endif
nrec = kpts%nkpt*(jsp-1) + nk
nrec = n_size*(nrec-1) + n_rank + 1
......@@ -554,7 +554,7 @@ CONTAINS
atoms%nlotot,kveclo)
ENDIF
# ifdef CPP_MPI
#if defined(CPP_MPI)&&defined(CPP_NEVER)
IF ( hybrid%l_calhf ) THEN
IF ( isize2(nk) == 1 ) THEN
WRITE(*,'(a,i6,a,i6,a)') 'HF: kpt ', nk, ' was done by rank ', mpi%irank, '.'
......@@ -591,9 +591,9 @@ CONTAINS
DEALLOCATE( nindxc,core1,core2,nbasm,eig_c )
END IF
#endif
# ifdef CPP_MPI
#if defined(CPP_MPI)&&defined(CPP_NEVER)
IF ( hybrid%l_calhf ) DEALLOCATE (nkpt_EIBZ)
# endif
#endif
IF ( input%gw.eq.2.AND.(gwc==1) ) THEN ! go for another round
OPEN (nu,file='potcoul',form='unformatted',status='old')
......@@ -667,7 +667,7 @@ CONTAINS
DEALLOCATE ( vpw,vzxy,vz,vr,vr0 )
#ifdef CPP_MPI
CALL MPI_BARRIER(MPI_COMM,ierr)
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
if (l_hybrid.or.hybrid%l_calhf) CALL close_eig(eig_id_hf)
atoms%n_u=n_u_in
......
eigen/hsmt_hlptomat.F90
View file @ f6681e04
......@@ -58,9 +58,9 @@ module m_hsmt_hlptomat
ENDIF
#if (defined(CPP_MPI)&&!defined(CPP_INVERSION))
CALL mingeselle(SUB_COMM,n_size,n_rank,nv,&
size(aahlp),size(aa),aahlp,aa)
aahlp,aa)
IF (present(bb).and.nlotot>1) CALL mingeselle(SUB_COMM,n_size,n_rank,nv,&
size(aahlp),size(aa),bbhlp,bb)
bbhlp,bb)
#endif
ENDIF
......
eigen/hsmt_sph.F90
View file @ f6681e04
......@@ -561,8 +561,8 @@ CONTAINS
ELSE
#ifdef CPP_MPI
CALL mingeselle(SUB_COMM,n_size,n_rank,lapw, aahlp, aa)
CALL mingeselle(SUB_COMM,n_size,n_rank,lapw, bbhlp, bb)
CALL mingeselle(SUB_COMM,n_size,n_rank,lapw%nv, aahlp, aa)
CALL mingeselle(SUB_COMM,n_size,n_rank,lapw%nv, bbhlp, bb)
#endif
ENDIF
ENDIF
......
fermi/fermie.F90
View file @ f6681e04
......@@ -29,7 +29,7 @@ CONTAINS
USE m_eig66_io, ONLY : read_eig
#ifdef CPP_MPI
#if defined(CPP_MPI)&&defined(CPP_NEVER)
USE m_mpi_col_eigJ
#endif
USE m_sort
......@@ -102,10 +102,10 @@ CONTAINS
e = 0
!
IF (jij%l_J) THEN
#ifdef CPP_MPI
CALL mpi_col_eigJ(mpi%mpi_comm,mpi%irank,mpi%isize,kpts%nkptd,SIZE(results%w_iks,1),kpts%nkpt(1),&
#if defined(CPP_MPI)&&defined(CPP_NEVER)
CALL mpi_col_eigJ(mpi%mpi_comm,mpi%irank,mpi%isize,kpts%nkptd,SIZE(results%w_iks,1),kpts%nkpt,&
& jij%nkpt_l,jij%eig_l,&
& kpts%bk,kpts%wtkpt,ne(1,1),eig)!keep
& kpts%bk,kpts%wtkpt,ne(1,1),eig)
IF (mpi%irank.NE.0) THEN
DEALLOCATE( idxeig,idxjsp,idxkpt,index,e,eig,we )
RETURN
......
init/dimens.F90
View file @ f6681e04
......@@ -190,7 +190,7 @@
#ifdef CPP_MPI
CALL MPI_BARRIER(Mpi_comm,ierr)
CALL MPI_BARRIER(mpi%Mpi_comm,ierr)
#endif
201 IF (mpi%irank == 0) THEN
......@@ -211,7 +211,7 @@
i_vec = (/sym%nop,stars%k1d,stars%k2d,stars%k3d,stars%n3d,stars%n2d,stars%kq1d,stars%kq2d,stars%kq3d,stars%kxc1d,stars%kxc2d,stars%kxc3d&
& ,atoms%ntypd,atoms%natd,atoms%jmtd,sphhar%ntypsd,sphhar%nlhd,sphhar%memd,atoms%lmaxd,dimension%jspd,vacuum%nvacd,dimension%nvd,dimension%nv2d&
& ,obsolete%nwdd,kpts%nkptd,dimension%nstd,dimension%neigd,dimension%msh,dimension%ncvd,vacuum%layerd,atoms%nlod,atoms%llod,input%itmax/)
CALL MPI_BCAST(i_vec,33,MPI_INTEGER,0,Mpi_comm,ierr)
CALL MPI_BCAST(i_vec,33,MPI_INTEGER,0,mpi%Mpi_comm,ierr)
sym%nop=i_vec(1);stars%k1d=i_vec(2);stars%k2d=i_vec(3);stars%k3d=i_vec(4);stars%n3d=i_vec(5)
stars%n2d = i_vec(6);stars%kq1d=i_vec(7);stars%kq2d=i_vec(8);stars%kq3d=i_vec(9)
stars%kxc1d = i_vec(10);stars%kxc2d = i_vec(11);stars%kxc3d = i_vec(12)
......@@ -221,11 +221,11 @@
kpts%nkptd = i_vec(25); dimension%nstd=i_vec(26);dimension%neigd=i_vec(27);dimension%msh=i_vec(28)
dimension%ncvd=i_vec(29);vacuum%layerd=i_vec(30);atoms%nlod=i_vec(31);atoms%llod=i_vec(32)
input%itmax=i_vec(33)
CALL MPI_BCAST(oneD%odd%d1,1,MPI_LOGICAL,0,Mpi_comm,ierr)
CALL MPI_BCAST(oneD%odd%d1,1,MPI_LOGICAL,0,mpi%Mpi_comm,ierr)
! IF (odd%d1) THEN
i_vec(:7) = (/oneD%odd%mb,oneD%odd%M,oneD%odd%m_cyl,oneD%odd%chi,oneD%odd%rot,oneD%odd%nop&
& ,oneD%odd%n2d/)
CALL MPI_BCAST(i_vec,7,MPI_INTEGER,0,Mpi_comm,ierr)
CALL MPI_BCAST(i_vec,7,MPI_INTEGER,0,mpi%Mpi_comm,ierr)
oneD%odd%mb = i_vec(1);oneD%odd%M = i_vec(2);oneD%odd%m_cyl=i_vec(3)
oneD%odd%chi = i_vec(4);oneD%odd%rot = i_vec(5);oneD%odd%nop=i_vec(6)
oneD%odd%n2d= i_vec(7)
......
io/eig66_mpi.F90
View file @ f6681e04
......@@ -10,7 +10,7 @@ MODULE m_eig66_mpi
PUBLIC open_eig,read_eig,write_eig,close_eig
PUBLIC open_eig,read_eig,write_eig,close_eig,write_dos,read_dos
CONTAINS
SUBROUTINE priv_find_data(id,d)
......@@ -39,6 +39,7 @@ CONTAINS
INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
#ifdef CPP_MPI
INTEGER:: isize,e,slot_size,local_slots
INTEGER,PARAMETER::mcored=27 !there should not be more that 27 core states
TYPE(t_data_MPI),POINTER :: d
CALL priv_find_data(id,d)
......@@ -82,51 +83,51 @@ CONTAINS
!Window for neig
slot_size=1
CALL priv_create_memory(1,local_slots,d%neig_data,d%neig_handle)
CALL priv_create_memory(1,local_slots,d%neig_handle,d%neig_data)
d%neig_data=0
!The integer values
d%size_k=nmat
slot_size=(5+3*d%size_k+1+nlotot)
CALL priv_create_memory(slot_size,local_slots,d%int_data,d%int_handle)
CALL priv_create_memory(slot_size,local_slots,d%int_handle,d%int_data)
d%int_data=9999999
!The real values
d%size_el=(1+lmax)*ntype
d%size_ello=nlo*ntype
slot_size=(6+d%size_el+d%size_ello)
CALL priv_create_memory(slot_size,local_slots,d%real_data,d%real_handle)
CALL priv_create_memory(slot_size,local_slots,d%real_handle,real_data_ptr=d%real_data)
d%real_data=1E99
!The eigenvalues
d%size_eig=neig
CALL priv_create_memory(d%size_eig,local_slots,d%eig_data,d%eig_handle)
CALL priv_create_memory(d%size_eig,local_slots,d%eig_handle,real_data_ptr=d%eig_data)
d%eig_data=1E99
!The eigenvectors
local_slots=COUNT(d%pe_ev==d%irank)
slot_size=nmat
#if !defined(CPP_INVERSION)||defined(CPP_SOC)
CALL priv_create_memory(slot_size,local_slots,d%zr_data,d%zr_handle)
CALL priv_create_memory(slot_size,local_slots,d%zr_handle,real_data_ptr=d%zr_data)
#else
CALL priv_create_memory(slot_size,local_slots,d%zc_data,d%zc_handle)
CALL priv_create_memory(slot_size,local_slots,d%zc_handle,cmplx_data_ptr=d%zc_data)
#endif
!Data for DOS etc
IF (d%l_dos) THEN
local_slots=COUNT(d%pe_basis==d%irank)
CALL priv_create_memory(4*ntype*neig,local_slots,d%qal_data,d%qal_handle)
CALL priv_create_memory(neig*2,local_slots,d%qvac_data,d%qvac_handle)
CALL priv_create_memory(neig,local_slots,d%qis_data,d%qis_handle)
CALL priv_create_memory(neig*layers*2,local_slots,d%qvlay_data,d%qvlay_handle)
CALL priv_create_memory(nstars,neigd*layers*2,local_slots,d%qstars_data,d%qstars_handle)
CALL priv_create_memory(neig,local_slots,d%jsym_data,d%jsym_handle)
CALL priv_create_memory(neig,local_slots,d%ksym_data,d%ksym_handle)
IF (l_mcd) CALL priv_create_memory(3*ntype*mcored,neig,local_slots,d%mcd_data,d%mcd_handle)
CALL priv_create_memory(4*ntype*neig,local_slots,d%qal_handle,real_data_ptr=d%qal_data)
CALL priv_create_memory(neig*2,local_slots,d%qvac_handle,real_data_ptr=d%qvac_data)
CALL priv_create_memory(neig,local_slots,d%qis_handle,real_data_ptr=d%qis_data)
CALL priv_create_memory(neig*layers*2,local_slots,d%qvlay_handle,real_data_ptr=d%qvlay_data)
CALL priv_create_memory(nstars*neig*layers*2,local_slots,d%qstars_handle,cmplx_data_ptr=d%qstars_data)
CALL priv_create_memory(neig,local_slots,d%jsym_handle,d%jsym_data)
CALL priv_create_memory(neig,local_slots,d%ksym_handle,d%ksym_data)
IF (l_mcd) CALL priv_create_memory(3*ntype*mcored*neig,local_slots,d%mcd_handle,real_data_ptr=d%mcd_data)
IF (l_orb) THEN
CALL priv_create_memory(nsld*neig,local_slots,d%qintsl_data,d%qintsl_handle)
CALL priv_create_memory(nsld*neig,local_slots,d%qmtsl_data,d%qmtsl_handle)
CALL priv_create_memory(nat*neig,local_slots,d%qmtp_data,d%qmtp_handle)
CALL priv_create_memory(23*nat*neig,local_slots,d%orbcomp_data,d%orbcomp_handle)
CALL priv_create_memory(nsld*neig,local_slots,d%qintsl_handle,real_data_ptr=d%qintsl_data)
CALL priv_create_memory(nsld*neig,local_slots,d%qmtsl_handle,real_data_ptr=d%qmtsl_data)
CALL priv_create_memory(nat*neig,local_slots,d%qmtp_handle,real_data_ptr=d%qmtp_data)
CALL priv_create_memory(23*nat*neig,local_slots,d%orbcomp_handle,real_data_ptr=d%orbcomp_data)
ENDIF
ELSE
ALLOCATE(d%qal_data(1),d%qvac_data(1),d%qis_data(1),d%qvlay_data(1),d%qstars_data(1),&
......@@ -136,35 +137,53 @@ CONTAINS
IF (PRESENT(filename).AND..NOT.create) CALL priv_readfromfile()
CALL timestop("create data spaces in ei66_mpi")
CONTAINS
SUBROUTINE priv_create_memory(slot_size,local_slots,data_ptr,handle)
SUBROUTINE priv_create_memory(slot_size,local_slots,handle,int_data_ptr,real_data_ptr,cmplx_data_ptr)
IMPLICIT NONE
INTEGER,INTENT(IN) :: slot_size,local_slots
CLASS(*),POINTER,INTENT(OUT) :: data_ptr
INTEGER,POINTER,INTENT(OUT),OPTIONAL :: int_data_ptr(:)
REAL ,POINTER,INTENT(OUT),OPTIONAL :: real_data_ptr(:)
COMPLEX,POINTER,INTENT(OUT),OPTIONAL :: cmplx_data_ptr(:)
INTEGER,INTENT(OUT) :: handle
TYPE(c_ptr)::ptr
INTEGER:: e
INTEGER(MPI_ADDRESS_KIND) :: length
INTEGER :: type_size,slot_size
INTEGER :: type_size
length=0
IF (present(real_data_ptr)) THEN
length=length+1
CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION,type_size,e)
ENDIF
IF (present(cmplx_data_ptr)) THEN
length=length+1
CALL MPI_TYPE_SIZE(MPI_DOUBLE_COMPLEX,type_size,e)
ENDIF
IF (present(int_data_ptr)) THEN
length=length+1
CALL MPI_TYPE_SIZE(MPI_INTEGER,type_size,e)
ENDIF
if (length.ne.1) call judft_error("Bug in eig66_mpi:create_memory")
length=slot_size*local_slots
SELECT TYPE(data_ptr)
TYPE IS (REAL)
CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION,type_size,e)
TYPE IS (COMPLEX)
CALL MPI_TYPE_SIZE(MPI_DOUBLE_COMPLEX,type_size,e)
TYPE IS (INTEGER)
CALL MPI_TYPE_SIZE(MPI_INTEGER,type_size,e)
END SELECT
length=length*type_size
CALL MPI_ALLOC_MEM(length,MPI_INFO_NULL,ptr,e)
IF (e.NE.0) CPP_error("Could not allocated MPI-Data in eig66_mpi")
CALL C_F_POINTER(ptr,data_ptr,(/length/type_size/))
CALL MPI_WIN_CREATE(data_ptr, length,slot_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
IF (present(real_data_ptr)) THEN
CALL C_F_POINTER(ptr,real_data_ptr,(/length/type_size/))
CALL MPI_WIN_CREATE(real_data_ptr, length,slot_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
ELSEIF(present(int_data_ptr)) THEN
CALL C_F_POINTER(ptr,int_data_ptr,(/length/type_size/))
CALL MPI_WIN_CREATE(int_data_ptr, length,slot_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
ELSE
CALL C_F_POINTER(ptr,cmplx_data_ptr,(/length/type_size/))
CALL MPI_WIN_CREATE(cmplx_data_ptr, length,slot_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
ENDIF
END SUBROUTINE priv_create_memory
SUBROUTINE priv_readfromfile()
USE m_eig66_DA,ONLY:open_eig_DA=>open_eig,read_eig_DA=>read_eig,close_eig_da=>close_eig
INTEGER:: jspin,nk,i,ii,iii,nv,tmp_id
......
main/fleur.F90
View file @ f6681e04
......@@ -194,6 +194,10 @@
INTEGER :: ok
LOGICAL :: l_restart
COMPLEX :: cdum
#ifdef CPP_MPI
include 'mpif.h'
integer:: ierr(2)
#endif
ivers = 'fleur 27'
mpi%mpi_comm=mpi_comm
CALL fleur_init(ivers,mpi,input,dimension,atoms,sphhar,cell,stars,sym,noco,vacuum,&
......@@ -510,20 +514,16 @@
! send all result of local total energies to the r
IF (mpi%irank==0) THEN
CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%valence,&
& 1,MPI_REAL8,MPI_SUM,0,&
& mpi,ierr(1))
CALL MPI_Reduce((MPI_IN_PLACE,te_hfex%te_hfex%core,&
& 1,MPI_REAL8,MPI_SUM,0,&
& mpi,ierr(1))
1,MPI_REAL8,MPI_SUM,0,mpi,ierr(1))
CALL MPI_Reduce(MPI_IN_PLACE,results%te_hfex%core,&
1,MPI_REAL8,MPI_SUM,0,mpi,ierr(1))
ELSE
CALL MPI_Reduce(results%te_hfex%valence,MPI_IN_PLACE,&
& 1,MPI_REAL8,MPI_SUM,0,&
& mpi,ierr(1))
CALL MPI_Reduce((te_hfex%te_hfex%core,MPI_IN_PLACE,&
& 1,MPI_REAL8,MPI_SUM,0,&
& mpi,ierr(1))
1,MPI_REAL8,MPI_SUM,0, mpi,ierr(1))
CALL MPI_Reduce(results%te_hfex%core,MPI_IN_PLACE,&
1,MPI_REAL8,MPI_SUM,0, mpi,ierr(1))
ENDIF
END IF
! END IF
#endif
END IF ! xcpot%icorr = any hybrid
......
mpi/mpi_bc_all.F90
View file @ f6681e04
......@@ -4,7 +4,6 @@ CONTAINS
mpi,stars,sphhar,atoms,obsolete,sym,&
kpts,jij,dimension,input,banddos,sliceplot,&
vacuum,cell,enpara,noco,oneD,&
MM,nn2d_1,n2d_1,nop_1,&
xcpot,hybrid)
!
!**********************************************************************
......@@ -32,9 +31,6 @@ CONTAINS
TYPE(t_sphhar),INTENT(INOUT) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms
! .. Scalar Arguments ..
INTEGER,INTENT(INOUT) :: n2d_1,nn2d_1,nop_1,MM
! ..
! .. Local Scalars ..
INTEGER n
REAL rdum
! .. Local Arrays ..
......@@ -46,12 +42,10 @@ CONTAINS
EXTERNAL MPI_BCAST
mpi%typ_real=MPI_DOUBLE_PRECISION
mpi%typ_complex=MPI_DOUBLE_COMPLEX
IF (mpi%irank.EQ.0) THEN
i(1)=1 ; i(2)=obsolete%lpr ; i(3)=atoms%ntype ; i(5)=obsolete%nwd ; i(6)=input%isec1
i(7)=stars%ng2 ; i(8)=stars%nq3 ; i(9)=vacuum%nmz ; i(10)=vacuum%nmzxy ; i(11)=obsolete%lepr
i(7)=stars%ng2 ; i(8)=stars%ng3 ; i(9)=vacuum%nmz ; i(10)=vacuum%nmzxy ; i(11)=obsolete%lepr
i(12)=input%jspins ; i(13)=vacuum%nvac ; i(14)=input%itmax ; i(15)=sliceplot%kk ; i(16)=vacuum%layers
i(17)=sliceplot%nnne ; i(18)=banddos%ndir ; i(19)=stars%mx1 ; i(20)=stars%mx2 ; i(21)=stars%mx3
i(22)=atoms%n_u ; i(23) = sym%nop2 ; i(24) = sym%nsymt ; i(25) = xcpot%icorr
......@@ -85,10 +79,10 @@ CONTAINS
atoms%n_u=i(22) ; sym%nop2=i(23) ; sym%nsymt = i(24) ; xcpot%icorr=i(25)
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; stars%mx1=i(19) ; stars%mx2=i(20) ; stars%mx3=i(21)
input%jspins=i(12) ; vacuum%nvac=i(13) ; input%itmax=i(14) ; sliceplot%kk=i(15) ; vacuum%layers=i(16)
stars%ng2=i(7) ; stars%nq3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
stars%ng2=i(7) ; stars%ng3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
obsolete%lpr=i(2) ; atoms%ntype=i(3) ; obsolete%nwd=i(5) ; input%isec1=i(6)
!
CALL MPI_BCAST(r,SIZE(r),mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(r,SIZE(r),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
rdum=aMix_VHSE( r(27) ); rdum=omega_VHSE( r(28) )
hybrid%tolerance2=r(23) ; input%delgau=r(24) ; input%tkb=r(25) ; input%efield%vslope=r(26)
cell%volint=r(19) ; hybrid%gcutm1=r(20) ; hybrid%tolerance1=r(21) ; hybrid%gcutm2=r(22)
......@@ -129,9 +123,9 @@ CONTAINS
CALL MPI_BCAST (input%efield%C2,n,MPI_REAL,0,mpi%mpi_comm,ierr)
END IF
CALL MPI_BCAST(stars%ustep,stars%n3d,mpi%typ_complex,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%ustep,stars%n3d,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = sphhar%memd*(sphhar%nlhd+1)*sphhar%ntypsd
CALL MPI_BCAST(sphhar%clnu,n,mpi%typ_complex,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%clnu,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%mlh,n,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sphhar%nlh,sphhar%ntypsd,MPI_INTEGER,0,mpi%mpi_comm,ierr)
n = (sphhar%nlhd+1)*sphhar%ntypsd
......@@ -150,30 +144,30 @@ CONTAINS
CALL MPI_BCAST(stars%ig2,stars%n3d,MPI_INTEGER,0,mpi%mpi_comm,ierr)
n = (2*stars%k1d+1)*(2*stars%k2d+1)*(2*stars%k3d+1)
CALL MPI_BCAST(stars%ig,n,MPI_INTEGER,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%rgphs,n,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%ellow,obsolete%nwdd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%elup,obsolete%nwdd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%rkmax,obsolete%nwdd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,atoms%ntypd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,atoms%ntypd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%dx,atoms%ntypd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%sk3,stars%n3d,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(enpara%evac0,2*dimension%jspd*obsolete%nwdd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%amat,9,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bbmat,9,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%taual,3*atoms%natd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%pos,3*atoms%natd,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%tau,3*sym%nop,mpi%type_real,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%rgphs,n,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%ellow,obsolete%nwdd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%elup,obsolete%nwdd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%rkmax,obsolete%nwdd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%rmt,atoms%ntypd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%volmts,atoms%ntypd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%dx,atoms%ntypd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(stars%sk3,stars%n3d,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(enpara%evac0,2*dimension%jspd*obsolete%nwdd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%amat,9,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bmat,9,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(cell%bbmat,9,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%taual,3*atoms%natd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(atoms%pos,3*atoms%natd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(sym%tau,3*sym%nop,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
<