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

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

and MPI, mem & DA versions
parent 67a8953b
......@@ -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
......
......@@ -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
......@@ -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'
......
......@@ -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
......
......@@ -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))
......
......@@ -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