Commit 08c083af authored by Uliana Alekseeva's avatar Uliana Alekseeva

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 0e88e072 2943c360
......@@ -29,7 +29,7 @@ test-gfortran:
paths:
- build
script:
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";cd /builds/fleur/fleur/build;ctest
- ulimit -s unlimited ;export juDFT_MPI="mpirun -n 2 --allow-run-as-root ";export OMP_NUM_THREADS=4;cd /builds/fleur/fleur/build;ctest
artifacts:
when: on_failure
paths:
......
......@@ -114,12 +114,12 @@ CONTAINS
ENDIF
!---> loop over lapws
#ifndef CPP_OLDINTEL
!$OMP PARALLEL DO &
!$OMP& DEFAULT(none)&
!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!$OMP& inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm)&
!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,force,nat_start,nat_stop)
!!$OMP PARALLEL DO &
!!$OMP& DEFAULT(none)&
!!$OMP& PRIVATE(k,i,work_r,work_c,ccchi,kspin,fg,fk,s,r1,fj,dfj,l,df,wronk,tmk,phase,lo,nkvec,&
!!$OMP& inap,nap,j,fgr,fgp,s2h,s2h_e,fkr,fkp,ylm,ll1,m,c_0,c_1,c_2,lmp,inv_f,lm)&
!!$OMP& SHARED(n,nn,natom,natom_l,noco,atoms,sym,cell,oneD,lapw,nvmax,ne,zMat,usdus,ci,iintsp,eig,l_force,&
!!$OMP& alo1,blo1,clo1,jatom,jspin,apw,const,nbasf0,acof,bcof,ccof,force,nat_start,nat_stop)
#endif
DO k = 1,nvmax
IF (zmat%l_real) THEN
......@@ -217,7 +217,7 @@ CONTAINS
END DO
ENDDO ! loop over LAPWs (k)
#ifndef CPP_OLDINTEL
!$OMP END PARALLEL DO
!!$OMP END PARALLEL DO
#endif
IF (zmat%l_real) THEN
DEALLOCATE(work_r)
......
......@@ -30,9 +30,9 @@ module m_eig66_data
INTEGER,ALLOCATABLE :: pe_basis(:,:),slot_basis(:,:)
INTEGER,ALLOCATABLE :: pe_ev(:,:,:),slot_ev(:,:,:)
INTEGER :: irank
INTEGER,POINTER :: neig_data(:)
REAL,POINTER :: eig_data(:),zr_data(:), w_iks_data(:)
COMPLEX,POINTER :: zc_data(:)
INTEGER,POINTER :: neig_data(:)
REAL,POINTER :: eig_data(:),zr_data(:), w_iks_data(:)
COMPLEX,POINTER :: zc_data(:)
END TYPE
TYPE,EXTENDS(t_data):: t_data_hdf
#ifdef CPP_HDF
......@@ -82,7 +82,7 @@ module m_eig66_data
INTEGER,INTENT(IN),OPTIONAL :: io_mode
CLASS(t_data),pointer::d
TYPE(t_list),POINTER:: listpointer,lastinlist
TYPE(t_list),POINTER,ASYNCHRONOUS:: listpointer,lastinlist
lastinlist=>null()
listpointer=>linked_list
......
......@@ -2,6 +2,7 @@ MODULE m_eig66_mpi
#include "juDFT_env.h"
USE m_eig66_data
USE m_types
USE m_judft
#ifdef CPP_MPI
use mpi
#endif
......@@ -12,7 +13,7 @@ CONTAINS
SUBROUTINE priv_find_data(id,d)
INTEGER,INTENT(IN)::id
TYPE(t_data_mpi),POINTER:: d
TYPE(t_data_mpi),POINTER,ASYNCHRONOUS:: d
CLASS(t_data),POINTER ::dp
CALL eig66_find_data(dp,id)
......@@ -35,24 +36,15 @@ CONTAINS
#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
TYPE(t_data_MPI),POINTER,ASYNCHRONOUS :: d
CALL priv_find_data(id,d)
CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real.and..not.l_soc,l_soc)
IF (PRESENT(n_size_opt)) d%n_size=n_size_opt
IF (ALLOCATED(d%pe_ev)) THEN
IF (create) THEN
d%neig_data=0
d%eig_data=1E99
d%w_iks_data=1E99
if (d%l_real.and..not.l_soc) THEN
d%zr_data=0.0
else
d%zc_data=0.0
endif
ENDIF
IF (PRESENT(filename)) CALL priv_readfromfile()
IF (create) CALL reset_eig(id,l_soc)
IF (PRESENT(filename)) CALL judft_error("Storing of data not implemented for MPI case",calledby="eig66_mpi.F")
RETURN !everything already done!
ENDIF
......@@ -81,21 +73,21 @@ CONTAINS
local_slots=COUNT(d%pe_ev==d%irank)
slot_size=nmat
if (l_real.and..not.l_soc) THEN
IF (l_real.AND..NOT.l_soc) THEN
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_handle,cmplx_data_ptr=d%zc_data)
endif
IF (PRESENT(filename).AND..NOT.create) CALL priv_readfromfile()
ENDIF
IF (PRESENT(filename).AND..NOT.create) CALL judft_error("Storing of data not implemented for MPI case",calledby="eig66_mpi.F")
CALL MPI_BARRIER(MPI_COMM,e)
CALL timestop("create data spaces in ei66_mpi")
CONTAINS
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
INTEGER,POINTER,OPTIONAL :: int_data_ptr(:)
REAL ,POINTER,OPTIONAL :: real_data_ptr(:)
COMPLEX,POINTER,OPTIONAL :: cmplx_data_ptr(:)
INTEGER,POINTER,OPTIONAL,ASYNCHRONOUS :: int_data_ptr(:)
REAL ,POINTER,OPTIONAL,ASYNCHRONOUS :: real_data_ptr(:)
COMPLEX,POINTER,OPTIONAL,ASYNCHRONOUS :: cmplx_data_ptr(:)
INTEGER,INTENT(OUT) :: handle
#ifdef CPP_MPI
TYPE(c_ptr)::ptr
......@@ -119,91 +111,50 @@ CONTAINS
if (length.ne.1) call judft_error("Bug in eig66_mpi:create_memory")
length=MAX(1,slot_size*local_slots)
#ifdef CPP_MPI_ALLOC
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")
IF (present(real_data_ptr)) THEN
CALL C_F_POINTER(ptr,real_data_ptr,(/length/type_size/))
#endif
IF (PRESENT(real_data_ptr)) THEN
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr,real_data_ptr,(/length/type_size/))
#else
ALLOCATE(real_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(real_data_ptr, length,slot_size*type_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/))
ELSEIF(PRESENT(int_data_ptr)) THEN
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr,int_data_ptr,(/length/type_size/))
#else
ALLOCATE(int_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(int_data_ptr, length,slot_size*type_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*type_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
ENDIF
ELSE
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr,cmplx_data_ptr,(/length/type_size/))
#else
ALLOCATE(cmplx_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(cmplx_data_ptr, length,slot_size*type_size,Mpi_INFO_NULL, MPI_COMM,handle, e)
ENDIF
#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
REAL :: wk,bk3(3),evac(2)
REAL :: eig(neig),w_iks(neig)
TYPE(t_zmat)::zmat
zmat%l_real=d%l_real
zmat%nbasfcn=nmat
zmat%nbands=neig
allocate(zmat%z_r(nmat,neig),zmat%z_c(nmat,neig))
!only do this with PE=0
IF (d%irank==0) THEN
tmp_id=eig66_data_newid(DA_mode)
CALL open_eig_DA(tmp_id,nmat,neig,nkpts,jspins,.FALSE.,d%l_real,l_soc,filename)
DO jspin=1,jspins
DO nk=1,nkpts
!CALL read_eig_DA(tmp_id,nk,jspin,nv,i,bk3,wk,ii,eig,w_iks,el,ello,evac,zmat=zmat)
STOP "code no longer works"
! CALL write_eig(id,nk,jspin,ii,ii,nv,nmat,bk3,wk,eig,w_iks,el,ello,evac,nlotot,zmat=zmat)
ENDDO
ENDDO
CALL close_eig_DA(tmp_id)
ENDIF
END SUBROUTINE priv_readfromfile
#endif
END SUBROUTINE open_eig
SUBROUTINE close_eig(id,delete,filename)
INTEGER,INTENT(IN) :: id
LOGICAL,INTENT(IN),OPTIONAL:: delete
CHARACTER(LEN=*),INTENT(IN),OPTIONAL::filename
TYPE(t_data_MPI),POINTER :: d
TYPE(t_data_MPI),POINTER,ASYNCHRONOUS :: d
CALL priv_find_data(id,d)
IF (PRESENT(delete)) THEN
IF (delete) WRITE(*,*) "No deallocation of memory implemented in eig66_mpi"
ENDIF
IF (PRESENT(filename)) CALL priv_writetofile()
CONTAINS
SUBROUTINE priv_writetofile()
USE m_eig66_DA,ONLY:open_eig_DA=>open_eig,write_eig_DA=>write_eig,close_eig_DA=>close_eig
IMPLICIT NONE
INTEGER:: nk,jspin,nv,i,ii,tmp_id
REAL :: wk,bk3(3),evac(2)
REAL :: eig(d%neig),w_iks(d%neig)
TYPE(t_zmat)::zmat
zmat%l_real=d%l_real
zmat%nbasfcn=d%nmat
zmat%nbands=d%neig
allocate(zmat%z_r(d%nmat,d%neig),zmat%z_c(d%nmat,d%neig))
IF (d%irank==0) THEN
tmp_id=eig66_data_newid(DA_mode)
CALL open_eig_DA(tmp_id,d%nmat,d%neig,d%nkpts,d%jspins,.FALSE.,d%l_real,d%l_soc,filename)
DO jspin=1,d%jspins
DO nk=1,d%nkpts
!CALL read_eig(id,nk,jspin,nv,i,bk3,wk,ii,eig,w_iks,el,ello,evac,zmat=zmat)
stop "CODE no longer working"
!CALL write_eig_DA(tmp_id,nk,jspin,ii,ii,nv,i,bk3,wk,eig,w_iks,el,ello,evac,nlotot,zmat=zmat)
ENDDO
ENDDO
CALL close_eig_DA(tmp_id)
ENDIF
CALL eig66_remove_data(id)
END SUBROUTINE priv_writetofile
IF (PRESENT(filename)) CALL judft_error("Storing of data not implemented for MPI case",calledby="eig66_mpi.F")
END SUBROUTINE close_eig
SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zmat)
......@@ -221,7 +172,7 @@ CONTAINS
INTEGER,ALLOCATABLE :: tmp_int(:)
REAL,ALLOCATABLE :: tmp_real(:)
COMPLEX,ALLOCATABLE :: tmp_cmplx(:)
TYPE(t_data_MPI),POINTER :: d
TYPE(t_data_MPI),POINTER,ASYNCHRONOUS :: d
CALL priv_find_data(id,d)
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
......@@ -308,7 +259,7 @@ CONTAINS
REAL,ALLOCATABLE :: tmp_real(:)
COMPLEX,ALLOCATABLE :: tmp_cmplx(:)
LOGICAL :: acc
TYPE(t_data_MPI),POINTER :: d
TYPE(t_data_MPI),POINTER,ASYNCHRONOUS :: d
CALL priv_find_data(id,d)
......@@ -394,7 +345,7 @@ CONTAINS
INTEGER, INTENT(IN) :: id
LOGICAL, INTENT(IN) :: l_soc
#ifdef CPP_MPI
TYPE(t_data_MPI),POINTER :: d
TYPE(t_data_MPI),POINTER,ASYNCHRONOUS :: d
CALL priv_find_data(id,d)
d%neig_data=0
......@@ -408,84 +359,11 @@ CONTAINS
#endif
END SUBROUTINE reset_eig
#ifdef CPP_MPI
SUBROUTINE priv_put_data(pe,slot,DATA,handle)
IMPLICIT NONE
INTEGER,INTENT(IN) :: pe,slot
CLASS(*),INTENT(IN) :: DATA(:)
INTEGER,INTENT(IN) :: handle
INTEGER :: len,e
INTEGER,ALLOCATABLE :: int_tmp(:)
REAL,ALLOCATABLE :: real_tmp(:)
COMPLEX,ALLOCATABLE:: cmplx_tmp(:)
INCLUDE 'mpif.h'
len=SIZE(DATA)
SELECT TYPE(DATA)
TYPE IS (INTEGER)
ALLOCATE(int_tmp(len))
int_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e)
CALL MPI_PUT(int_tmp,len,MPI_INTEGER,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_INTEGER,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
TYPE is (REAL)
ALLOCATE(real_tmp(len))
real_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e)
CALL MPI_PUT(real_tmp,len,MPI_DOUBLE_PRECISION,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_DOUBLE_PRECISION,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
TYPE is (COMPLEX)
ALLOCATE(cmplx_tmp(len))
cmplx_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e)
CALL MPI_PUT(cmplx_tmp,len,MPI_DOUBLE_COMPLEX,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_DOUBLE_COMPLEX,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
END SELECT
END SUBROUTINE priv_put_data
SUBROUTINE priv_get_data(pe,slot,len,handle,idata,rdata,cdata)
IMPLICIT NONE
INTEGER,INTENT(IN) :: pe,slot,len
INTEGER,INTENT(OUT),optional :: iDATA(len)
REAL,INTENT(OUT),optional :: rDATA(len)
COMPLEX,INTENT(OUT),optional :: cDATA(len)
INTEGER,INTENT(IN) :: handle
INTEGER :: e
INTEGER,ALLOCATABLE :: int_tmp(:)
REAL,ALLOCATABLE :: real_tmp(:)
COMPLEX,ALLOCATABLE:: cmplx_tmp(:)
INCLUDE 'mpif.h'
IF (present(idata)) THEN
ALLOCATE(int_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e)
CALL MPI_GET(int_tmp,len,MPI_INTEGER,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_INTEGER,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
iDATA=int_tmp
ELSE IF (PRESENT(rdata)) THEN
ALLOCATE(real_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e)
CALL MPI_GET(real_tmp,len,MPI_DOUBLE_PRECISION,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_DOUBLE_PRECISION,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
rDATA=real_tmp
ELSE IF (PRESENT(cdata)) THEN
ALLOCATE(cmplx_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e)
CALL MPI_GET(cmplx_tmp,len,MPI_DOUBLE_COMPLEX,pe,int(slot,MPI_ADDRESS_KIND),len,MPI_DOUBLE_COMPLEX,handle,e)
CALL MPI_WIN_UNLOCK(pe,handle,e)
cDATA=cmplx_tmp
ELSE
call judft_error("BUG in priv_get_data")
ENDIF
END SUBROUTINE priv_get_data
#endif
#ifdef CPP_MPI
SUBROUTINE create_maps(d,isize,nkpts,jspins,neig,n_size)
IMPLICIT NONE
TYPE(t_data_MPI),INTENT(INOUT):: d
TYPE(t_data_MPI),INTENT(INOUT),ASYNCHRONOUS:: d
INTEGER,INTENT(IN):: isize,nkpts,jspins,neig,n_size
INTEGER:: nk,j,n1,n2,n,pe,n_members
......
This source diff could not be displayed because it is too large. You can view the blob instead.
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