Skip to content

GitLab

Commit 71182b53 authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files

Fixed several bugs in IO of DOS and bandstructure. Should work now for bulk 

and MPI, mem & DA versions
parent 67a8953b
Hide whitespace changes
Inline Side-by-side
Showing with 50 additions and 42 deletions
cdn/cdnval.F90
View file @ 71182b53
......@@ -831,8 +831,8 @@ CONTAINS
!
!--dw now write k-point data to tmp_dos
!
call write_dos(eig_id,ikpt,ispin,qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),qis(:,ikpt,ispin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,jsym,mcd,qintsl,&
call write_dos(eig_id,ikpt,jspin,qal(:,:,:,jspin),qvac(:,:,ikpt,jspin),qis(:,ikpt,jspin),&
qvlay(:,:,:,ikpt,jspin),qstars,ksym,jsym,mcd,qintsl,&
qmtsl(:,:),qmtp(:,:),orbcomp)
CALL timestop("cdnval: write_info")
......@@ -882,6 +882,9 @@ enddo
nsl,nslat)
ENDIF
ENDIF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif
call timestop("cdnval: dos")
ENDIF
......
dos/evaldos.f90
View file @ 71182b53
......@@ -19,7 +19,7 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_triang
USE m_maketetra
USE m_tetrados
......@@ -94,8 +94,8 @@
!
! scale energies
sigma = banddos%sig_dos*factor
emin = banddos%e1_dos*factor
emax = banddos%e2_dos*factor
emin =min(banddos%e1_dos*factor,banddos%e2_dos*factor)
emax =max(banddos%e1_dos*factor,banddos%e2_dos*factor)
efermi = efermiarg*factor
WRITE (6,'(a)') 'DOS-Output is generated!'
......@@ -163,6 +163,7 @@
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd))
ALLOCATE( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
ALLOCATE( qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,2))
CALL read_eig(eig_id,k,jspin,bk=vk(:,k),wk=wt(k),neig=nevk(k),eig=ev(:,k))
CALL read_dos(eig_id,k,jspin,qal_tmp,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
qal(1:lmax*atoms%ntype,:,k)=reshape(qal_tmp,(/lmax*atoms%ntype,size(qal_tmp,3)/))
qal(lmax*atoms%ntype+2,:,k)=qvac(:,1) ! vacuum 1
......@@ -500,7 +501,7 @@
DEALLOCATE(qal,qval,qlay,qstars)
IF (l_mcd) DEALLOCATE( mcd )
99001 FORMAT (f10.5,110(1x,d10.3))
99001 FORMAT (f10.5,110(1x,e10.3))
END SUBROUTINE evaldos
END MODULE m_evaldos
eigen/eigen.F90
View file @ 71182b53
......@@ -325,7 +325,7 @@ CONTAINS
endif
eig_id=open_eig(&
mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,atoms%lmaxd,&
atoms%nlod,atoms%ntypd,atoms%nlotot,noco%l_noco,.true.,.false.,n_size)
atoms%nlod,atoms%ntypd,atoms%nlotot,noco%l_noco,.true.,.false.,n_size,layers=vacuum%layers,nstars=vacuum%nstars,ncored=dimension%nstd,nsld=atoms%natd,nat=atoms%natd,l_dos=banddos%dos,l_mcd=banddos%l_mcd,l_orb=banddos%l_orb)
ALLOCATE ( a(matsize), stat = err )
IF (err.NE.0) THEN
WRITE (*,*) 'eigen: an error occured during allocation of'
......
io/eig66_da.F90
View file @ 71182b53
......@@ -69,14 +69,14 @@ CONTAINS
recl_dos=i1*2*neig !ksym&jsym
INQUIRE(IOLENGTH=i1) r1
recl_dos=recl_dos+i1*3*neig !qvac&qis
recl_dos=recl_dos+i1*4*ntype !qal
recl_dos=recl_dos+i1*neig*2*layers !qvlay
recl_dos=recl_dos+i1*4*ntype*neig !qal
recl_dos=recl_dos+i1*neig*2*max(1,layers) !qvlay
IF (l_orb) THEN
recl_dos=recl_dos+i1*2*nsld*neig !qintsl,qmtsl
recl_dos=recl_dos+i1*24*neig*nat !qmtp,orbcomp
ENDIF
INQUIRE(IOLENGTH=i1) c1
recl_dos=recl_dos+i1*nstars*neig*layers*2 !qstars
recl_dos=recl_dos+i1*nstars*neig*max(1,layers)*2 !qstars
IF (l_mcd) recl_dos=recl_dos+i1*3*ntype*ncored*neig !mcd
ELSE
recl_dos=-1
......
io/eig66_mem.F90
View file @ 71182b53
......@@ -77,8 +77,8 @@ CONTAINS
ALLOCATE(d%qal(0:3,ntype,neig,length))
ALLOCATE(d%qvac(neig,2,length))
ALLOCATE(d%qis(neig,length))
ALLOCATE(d%qvlay(neig,layers,2,length))
ALLOCATE(d%qstars(nstars,neig,layers,2,length))
ALLOCATE(d%qvlay(neig,max(layers,1),2,length))
ALLOCATE(d%qstars(nstars,neig,max(layers,1),2,length))
ALLOCATE(d%ksym(neig,length))
ALLOCATE(d%jsym(neig,length))
IF (l_mcd) ALLOCATE(d%mcd(3*ntype,ncored,neig,length))
......
io/eig66_mpi.F90
View file @ 71182b53
......@@ -114,8 +114,8 @@ CONTAINS
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*max(1,layers)*2,local_slots,d%qvlay_handle,real_data_ptr=d%qvlay_data)
CALL priv_create_memory(max(1,nstars)*neig*max(1,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)
......@@ -504,27 +504,29 @@ CONTAINS
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,slot,len,MPI_INTEGER,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,slot,len,MPI_DOUBLE_PRECISION,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,slot,len,MPI_DOUBLE_COMPLEX,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,DATA,len,handle)
SUBROUTINE priv_get_data(pe,slot,len,handle,idata,rdata,cdata)
IMPLICIT NONE
INTEGER,INTENT(IN) :: pe,slot,len
CLASS(*),INTENT(OUT) :: DATA(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
......@@ -533,26 +535,28 @@ CONTAINS
COMPLEX,ALLOCATABLE:: cmplx_tmp(:)
INCLUDE 'mpif.h'
SELECT TYPE(DATA)
TYPE IS (INTEGER)
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,slot,len,MPI_INTEGER,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)
DATA=int_tmp
TYPE is (REAL)
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,slot,len,MPI_DOUBLE_PRECISION,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)
DATA=real_tmp
TYPE is (COMPLEX)
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,slot,len,MPI_DOUBLE_COMPLEX,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)
DATA=cmplx_tmp
END SELECT
cDATA=cmplx_tmp
ELSE
call judft_error("BUG in priv_get_data")
ENDIF
END SUBROUTINE priv_get_data
......@@ -604,19 +608,19 @@ CONTAINS
pe=d%pe_basis(nk,jspin)
slot=d%slot_basis(nk,jspin)
CALL priv_get_data(pe,slot,qal,SIZE(qal),d%qal_handle)
CALL priv_get_data(pe,slot,qvac,SIZE(qvac),d%qvac_handle)
CALL priv_get_data(pe,slot,qis,SIZE(qis),d%qis_handle)
CALL priv_get_data(pe,slot,qvlay,SIZE(qvlay),d%qvlay_handle)
CALL priv_get_data(pe,slot,qstars,SIZE(qstars),d%qstars_handle)
CALL priv_get_data(pe,slot,ksym,SIZE(ksym),d%ksym_handle)
CALL priv_get_data(pe,slot,jsym,SIZE(jsym),d%jsym_handle)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_get_data(pe,slot,mcd,SIZE(mcd),d%mcd_handle)
CALL priv_get_data(pe,slot,SIZE(qal),d%qal_handle,rdata=qal)
CALL priv_get_data(pe,slot,SIZE(qvac),d%qvac_handle,rdata=qvac)
CALL priv_get_data(pe,slot,SIZE(qis),d%qis_handle,rdata=qis)
CALL priv_get_data(pe,slot,SIZE(qvlay),d%qvlay_handle,rdata=qvlay)
CALL priv_get_data(pe,slot,SIZE(qstars),d%qstars_handle,cdata=qstars)
CALL priv_get_data(pe,slot,SIZE(ksym),d%ksym_handle,idata=ksym)
CALL priv_get_data(pe,slot,SIZE(jsym),d%jsym_handle,idata=jsym)
IF (d%l_mcd.AND.PRESENT(mcd)) CALL priv_get_data(pe,slot,SIZE(mcd),d%mcd_handle,rdata=mcd)
IF (d%l_orb.AND.PRESENT(qintsl)) THEN
CALL priv_get_data(pe,slot,qintsl,SIZE(qintsl),d%qintsl_handle)
CALL priv_get_data(pe,slot,qmtsl,SIZE(qmtsl),d%qmtsl_handle)
CALL priv_get_data(pe,slot,qmtp,SIZE(qmtp),d%qmtp_handle)
CALL priv_get_data(pe,slot,orbcomp,SIZE(orbcomp),d%orbcomp_handle)
CALL priv_get_data(pe,slot,SIZE(qintsl),d%qintsl_handle,rdata=qintsl)
CALL priv_get_data(pe,slot,SIZE(qmtsl),d%qmtsl_handle,rdata=qmtsl)
CALL priv_get_data(pe,slot,SIZE(qmtp),d%qmtp_handle,rdata=qmtp)
CALL priv_get_data(pe,slot,SIZE(orbcomp),d%orbcomp_handle,rdata=orbcomp)
ENDIF
END SUBROUTINE read_dos
......
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