Commit f6681e04 authored by Daniel Wortmann's avatar Daniel Wortmann

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

parent 8cbe3b01
......@@ -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)
......
......@@ -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
......
......@@ -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'
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -27,7 +27,7 @@ CONTAINS
!
! -> Broadcast the arrays:
CALL MPI_BCAST(qpwc,stars%n3d,mpi%TYP_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(qpwc,stars%n3d,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END SUBROUTINE mpi_bc_st
!*********************************************************************
......@@ -52,7 +52,7 @@ CONTAINS
n = atoms%jmtd*(sphhar%nlhd+1)*atoms%ntypd
ALLOCATE(r_b(n))
CALL MPI_REDUCE(rho,r_b,n,MPI%Typ_real,MPI_SUM,0,&
CALL MPI_REDUCE(rho,r_b,n,MPI_DOUBLE_PRECISION,MPI_SUM,0,&
& mpi%mpi_comm,ierr)
IF (mpi%irank == 0) rho=reshape(r_b,(/atoms%jmtd,1+sphhar%nlhd,atoms%ntypd/))
......
......@@ -3,40 +3,25 @@ MODULE m_mpi_col_den
! collect all data calculated in cdnval on different pe's on pe 0
!
CONTAINS
SUBROUTINE mpi_col_den(&
mpi,mpi,sphhar,atoms,oneD,&
stars,vacuum,vacuum,&
input,&
noco,noco,l_fmpl,&
jspin,llpd,&
rhtxy,rht,qpw,ener,sqal,results,svac,pvac,&
uu,dd,du,uunmt,ddnmt,udnmt,dunmt,sqlo,&
aclo,bclo,cclo,acnmt,bcnmt,ccnmt,enerlo,&
orb,orbl,orblo,mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,&
cdom,cdomvz,cdomvxy,n_mmp)
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,&
input, noco,l_fmpl,jspin,llpd,rhtxy,rht,qpw,ener,&
sqal,results,svac,pvac,uu,dd,du,uunmt,ddnmt,udnmt,dunmt,sqlo,&
aclo,bclo,cclo,acnmt,bcnmt,ccnmt,enerlo,orb,orbl,orblo,mt21,lo21,uloulop21,&
uunmt21,ddnmt21,udnmt21,dunmt21,cdom,cdomvz,cdomvxy,n_mmp)
!
#include"cpp_double.h"
USE m_types
IMPLICIT NONE
TYPE(t_results),INTENT(IN) :: results
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_results),INTENT(INOUT):: results
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
INCLUDE 'mpif.h'
! ..
! .. Scalar Arguments ..
......@@ -47,7 +32,7 @@ CONTAINS
COMPLEX, INTENT (INOUT) :: qpw(stars%n3d)
COMPLEX, INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2)
REAL, INTENT (INOUT) :: ener(0:3,atoms%ntypd),sqal(0:3,ntypd)
REAL, INTENT (INOUT) :: ener(0:3,atoms%ntypd),sqal(0:3,atoms%ntype)
REAL, INTENT (INOUT) :: svac(2),pvac(2)
REAL, INTENT (INOUT) :: dd(0:atoms%lmaxd,atoms%ntypd)
REAL, INTENT (INOUT) :: du(0:atoms%lmaxd,atoms%ntypd)
......@@ -56,22 +41,22 @@ CONTAINS
REAL, INTENT (INOUT) :: dunmt(0:llpd,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: udnmt(0:llpd,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: uunmt(0:llpd,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: sqlo(atoms%nlod,atoms%ntypd),enerlo(nlod,ntypd)
REAL, INTENT (INOUT) :: aclo(atoms%nlod,atoms%ntypd),bclo(nlod,ntypd)
REAL, INTENT (INOUT) :: cclo(atoms%nlod,nlod,atoms%ntypd)
REAL, INTENT (INOUT) :: sqlo(atoms%nlod,atoms%ntypd),enerlo(atoms%nlod,atoms%ntype)
REAL, INTENT (INOUT) :: aclo(atoms%nlod,atoms%ntypd),bclo(atoms%nlod,atoms%ntype)
REAL, INTENT (INOUT) :: cclo(atoms%nlod,atoms%nlod,atoms%ntypd)
REAL, INTENT (INOUT) :: acnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: bcnmt(0:atoms%lmaxd,atoms%nlod,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: ccnmt(atoms%nlod,nlod,sphhar%nlhd,atoms%ntypd)
REAL, INTENT (INOUT) :: ccnmt(atoms%nlod,atoms%nlod,sphhar%nlhd,atoms%ntypd)
COMPLEX,INTENT(INOUT) :: ddnmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: dunmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: udnmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: uunmt21((atoms%lmaxd+1)**2 )
COMPLEX,INTENT(INOUT) :: uloulop21(atoms%nlod,nlod,atoms%ntypd)
COMPLEX,INTENT(INOUT) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntypd)
COMPLEX,INTENT(INOUT) :: n_mmp(-3:3,-3:3,atoms%n_u),cdomvz(vacuum%nmzd,2)
COMPLEX,INTENT(INOUT) :: cdom(stars%n3d),cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
TYPE (t_orb), INTENT (INOUT) :: orb(0:atoms%lmaxd,-lmaxd:lmaxd,atoms%ntypd)
TYPE (t_orbl), INTENT (INOUT) :: orbl(atoms%nlod,-atoms%llod:llod,atoms%ntypd)
TYPE (t_orblo),INTENT (INOUT) :: orblo(atoms%nlod,nlod,-atoms%llod:llod,atoms%ntypd)
TYPE (t_orb), INTENT (INOUT) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntypd)
TYPE (t_orbl), INTENT (INOUT) :: orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntypd)
TYPE (t_orblo),INTENT (INOUT) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntypd)
TYPE (t_mt21), INTENT (INOUT) :: mt21(0:atoms%lmaxd,atoms%ntypd)
TYPE (t_lo21), INTENT (INOUT) :: lo21(atoms%nlod,atoms%ntypd)
! ..
......@@ -199,9 +184,9 @@ CONTAINS
n=3*atoms%ntypd
ALLOCATE(r_b(n))
CALL MPI_REDUCE(results%force,r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(results%force(1,1,jspin),r_b,n,CPP_MPI_REAL,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_scopy(n, r_b, 1, results%force, 1)
CALL CPP_BLAS_scopy(n, r_b, 1, results%force(1,1,jspin), 1)
ENDIF
DEALLOCATE (r_b)
......@@ -433,7 +418,7 @@ CONTAINS
!
! --> lo,lo' coeff's:
!
n = atoms%nlod*nlod*atoms%ntypd
n = atoms%nlod*atoms%nlod*atoms%ntypd
ALLOCATE(c_b(n))
CALL MPI_REDUCE(uloulop21,c_b,n,CPP_MPI_COMPLEX, MPI_SUM,0,MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
......
......@@ -147,9 +147,9 @@ CONTAINS
! write (*,*) irank,n_groups,n_start,i_mygroup
CALL MPI_COMM_GROUP (MPI_COMM,WORLD_GROUP,ierr)
CALL MPI_COMM_GROUP (mpi%MPI_COMM,WORLD_GROUP,ierr)
CALL MPI_GROUP_INCL (WORLD_GROUP,n_size,i_mygroup, SUB_GROUP,ierr)
CALL MPI_COMM_CREATE (MPI_COMM,SUB_GROUP,SUB_COMM,ierr)
CALL MPI_COMM_CREATE (mpi%MPI_COMM,SUB_GROUP,SUB_COMM,ierr)
CALL MPI_COMM_RANK (SUB_COMM,n_rank,ierr)
!
......@@ -185,6 +185,7 @@ CONTAINS
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_noco),INTENT(IN) :: noco
INTEGER, INTENT (IN) :: mlotot,mlolotot
INTEGER, INTENT (OUT) :: n_size
......
......@@ -78,10 +78,9 @@ CONTAINS
& qlm)
#ifdef CPP_MPI
psq(:) = CMPLX(0.0,0.0)
CALL MPI_BCAST(qpw,stars*DIMENSION%jspd,CPP_MPI_COMPLEX,0,&
& mpi,ierr)
CALL MPI_BCAST(qpw,size(qpw),CPP_MPI_COMPLEX,0,mpi,ierr)
nd = (2*atoms%lmaxd+1)*(atoms%lmaxd+1)*atoms%ntypd
CALL MPI_BCAST(qlm,nd,CPP_MPI_COMPLEX,0,MPI_COMM,ierr)
CALL MPI_BCAST(qlm,nd,CPP_MPI_COMPLEX,0,mpi%MPI_COMM,ierr)
#endif
!
! pn(l,n) = (2l + 2nc(n) + 3)!! / (2l + 1)!! R^l ; ncv(n)=n+l in paper
......@@ -156,8 +155,7 @@ CONTAINS
!$OMP END PARALLEL DO
#ifdef CPP_MPI
ALLOCATE(c_b(stars%n3d))
CALL MPI_REDUCE(psq,c_b,stars%n3d,CPP_MPI_COMPLEX,MPI_SUM,0,&
& MPI_COMM,ierr)
CALL MPI_REDUCE(psq,c_b,stars%n3d,CPP_MPI_COMPLEX,MPI_SUM,0,mpi%MPI_COMM,ierr)
IF (mpi%irank.EQ.0) THEN
psq(:stars%n3d)=c_b(:stars%n3d)