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 ...@@ -831,8 +831,8 @@ CONTAINS
! !
!--dw now write k-point data to tmp_dos !--dw now write k-point data to tmp_dos
! !
call write_dos(eig_id,ikpt,ispin,qal(:,:,:,ispin),qvac(:,:,ikpt,ispin),qis(:,ikpt,ispin),& call write_dos(eig_id,ikpt,jspin,qal(:,:,:,jspin),qvac(:,:,ikpt,jspin),qis(:,ikpt,jspin),&
qvlay(:,:,:,ikpt,ispin),qstars,ksym,jsym,mcd,qintsl,& qvlay(:,:,:,ikpt,jspin),qstars,ksym,jsym,mcd,qintsl,&
qmtsl(:,:),qmtp(:,:),orbcomp) qmtsl(:,:),qmtp(:,:),orbcomp)
CALL timestop("cdnval: write_info") CALL timestop("cdnval: write_info")
...@@ -882,6 +882,9 @@ enddo ...@@ -882,6 +882,9 @@ enddo
nsl,nslat) nsl,nslat)
ENDIF ENDIF
ENDIF ENDIF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ie)
#endif
call timestop("cdnval: dos") call timestop("cdnval: dos")
ENDIF ENDIF
......
...@@ -19,7 +19,7 @@ ...@@ -19,7 +19,7 @@
! ntb=max(nevk) ! ntb=max(nevk)
! !
!---------------------------------------------------------------------- !----------------------------------------------------------------------
USE m_eig66_io,ONLY:read_dos USE m_eig66_io,ONLY:read_dos,read_eig
USE m_triang USE m_triang
USE m_maketetra USE m_maketetra
USE m_tetrados USE m_tetrados
...@@ -94,8 +94,8 @@ ...@@ -94,8 +94,8 @@
! !
! scale energies ! scale energies
sigma = banddos%sig_dos*factor sigma = banddos%sig_dos*factor
emin = banddos%e1_dos*factor emin =min(banddos%e1_dos*factor,banddos%e2_dos*factor)
emax = banddos%e2_dos*factor emax =max(banddos%e1_dos*factor,banddos%e2_dos*factor)
efermi = efermiarg*factor efermi = efermiarg*factor
WRITE (6,'(a)') 'DOS-Output is generated!' WRITE (6,'(a)') 'DOS-Output is generated!'
...@@ -163,6 +163,7 @@ ...@@ -163,6 +163,7 @@
ALLOCATE( orbcomp(dimension%neigd,23,atoms%natd),qintsl(nsld,dimension%neigd)) 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( qmtsl(nsld,dimension%neigd),qmtp(dimension%neigd,atoms%natd),qvac(dimension%neigd,2))
ALLOCATE( qis(dimension%neigd),qvlay(dimension%neigd,vacuum%layerd,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) 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(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 qal(lmax*atoms%ntype+2,:,k)=qvac(:,1) ! vacuum 1
...@@ -500,7 +501,7 @@ ...@@ -500,7 +501,7 @@
DEALLOCATE(qal,qval,qlay,qstars) DEALLOCATE(qal,qval,qlay,qstars)
IF (l_mcd) DEALLOCATE( mcd ) 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 SUBROUTINE evaldos
END MODULE m_evaldos END MODULE m_evaldos
...@@ -325,7 +325,7 @@ CONTAINS ...@@ -325,7 +325,7 @@ CONTAINS
endif endif
eig_id=open_eig(& eig_id=open_eig(&
mpi%mpi_comm,dimension%nbasfcn,dimension%neigd,kpts%nkpt,dimension%jspd,atoms%lmaxd,& 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 ) ALLOCATE ( a(matsize), stat = err )
IF (err.NE.0) THEN IF (err.NE.0) THEN
WRITE (*,*) 'eigen: an error occured during allocation of' WRITE (*,*) 'eigen: an error occured during allocation of'
......
...@@ -69,14 +69,14 @@ CONTAINS ...@@ -69,14 +69,14 @@ CONTAINS
recl_dos=i1*2*neig !ksym&jsym recl_dos=i1*2*neig !ksym&jsym
INQUIRE(IOLENGTH=i1) r1 INQUIRE(IOLENGTH=i1) r1
recl_dos=recl_dos+i1*3*neig !qvac&qis recl_dos=recl_dos+i1*3*neig !qvac&qis
recl_dos=recl_dos+i1*4*ntype !qal recl_dos=recl_dos+i1*4*ntype*neig !qal
recl_dos=recl_dos+i1*neig*2*layers !qvlay recl_dos=recl_dos+i1*neig*2*max(1,layers) !qvlay
IF (l_orb) THEN IF (l_orb) THEN
recl_dos=recl_dos+i1*2*nsld*neig !qintsl,qmtsl recl_dos=recl_dos+i1*2*nsld*neig !qintsl,qmtsl
recl_dos=recl_dos+i1*24*neig*nat !qmtp,orbcomp recl_dos=recl_dos+i1*24*neig*nat !qmtp,orbcomp
ENDIF ENDIF
INQUIRE(IOLENGTH=i1) c1 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 IF (l_mcd) recl_dos=recl_dos+i1*3*ntype*ncored*neig !mcd
ELSE ELSE
recl_dos=-1 recl_dos=-1
......
...@@ -77,8 +77,8 @@ CONTAINS ...@@ -77,8 +77,8 @@ CONTAINS
ALLOCATE(d%qal(0:3,ntype,neig,length)) ALLOCATE(d%qal(0:3,ntype,neig,length))
ALLOCATE(d%qvac(neig,2,length)) ALLOCATE(d%qvac(neig,2,length))
ALLOCATE(d%qis(neig,length)) ALLOCATE(d%qis(neig,length))
ALLOCATE(d%qvlay(neig,layers,2,length)) ALLOCATE(d%qvlay(neig,max(layers,1),2,length))
ALLOCATE(d%qstars(nstars,neig,layers,2,length)) ALLOCATE(d%qstars(nstars,neig,max(layers,1),2,length))
ALLOCATE(d%ksym(neig,length)) ALLOCATE(d%ksym(neig,length))
ALLOCATE(d%jsym(neig,length)) ALLOCATE(d%jsym(neig,length))
IF (l_mcd) ALLOCATE(d%mcd(3*ntype,ncored,neig,length)) IF (l_mcd) ALLOCATE(d%mcd(3*ntype,ncored,neig,length))
......
...@@ -114,8 +114,8 @@ CONTAINS ...@@ -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(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*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,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(neig*max(1,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(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%jsym_handle,d%jsym_data)
CALL priv_create_memory(neig,local_slots,d%ksym_handle,d%ksym_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_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 ...@@ -504,27 +504,29 @@ CONTAINS
ALLOCATE(int_tmp(len)) ALLOCATE(int_tmp(len))
int_tmp=DATA int_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
TYPE is (REAL) TYPE is (REAL)
ALLOCATE(real_tmp(len)) ALLOCATE(real_tmp(len))
real_tmp=DATA real_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
TYPE is (COMPLEX) TYPE is (COMPLEX)
ALLOCATE(cmplx_tmp(len)) ALLOCATE(cmplx_tmp(len))
cmplx_tmp=DATA cmplx_tmp=DATA
CALL MPI_WIN_LOCK(MPI_LOCK_EXCLUSIVE,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
END SELECT END SELECT
END SUBROUTINE priv_put_data 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 IMPLICIT NONE
INTEGER,INTENT(IN) :: pe,slot,len 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,INTENT(IN) :: handle
INTEGER :: e INTEGER :: e
...@@ -533,26 +535,28 @@ CONTAINS ...@@ -533,26 +535,28 @@ CONTAINS
COMPLEX,ALLOCATABLE:: cmplx_tmp(:) COMPLEX,ALLOCATABLE:: cmplx_tmp(:)
INCLUDE 'mpif.h' INCLUDE 'mpif.h'
SELECT TYPE(DATA) IF (present(idata)) THEN
TYPE IS (INTEGER)
ALLOCATE(int_tmp(len)) ALLOCATE(int_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
DATA=int_tmp iDATA=int_tmp
TYPE is (REAL) ELSE IF (PRESENT(rdata)) THEN
ALLOCATE(real_tmp(len)) ALLOCATE(real_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
DATA=real_tmp rDATA=real_tmp
TYPE is (COMPLEX) ELSE IF (PRESENT(cdata)) THEN
ALLOCATE(cmplx_tmp(len)) ALLOCATE(cmplx_tmp(len))
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED,pe,0,handle,e) 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) CALL MPI_WIN_UNLOCK(pe,handle,e)
DATA=cmplx_tmp cDATA=cmplx_tmp
END SELECT ELSE
call judft_error("BUG in priv_get_data")
ENDIF
END SUBROUTINE priv_get_data END SUBROUTINE priv_get_data
...@@ -604,19 +608,19 @@ CONTAINS ...@@ -604,19 +608,19 @@ CONTAINS
pe=d%pe_basis(nk,jspin) pe=d%pe_basis(nk,jspin)
slot=d%slot_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,SIZE(qal),d%qal_handle,rdata=qal)
CALL priv_get_data(pe,slot,qvac,SIZE(qvac),d%qvac_handle) CALL priv_get_data(pe,slot,SIZE(qvac),d%qvac_handle,rdata=qvac)
CALL priv_get_data(pe,slot,qis,SIZE(qis),d%qis_handle) CALL priv_get_data(pe,slot,SIZE(qis),d%qis_handle,rdata=qis)
CALL priv_get_data(pe,slot,qvlay,SIZE(qvlay),d%qvlay_handle) CALL priv_get_data(pe,slot,SIZE(qvlay),d%qvlay_handle,rdata=qvlay)
CALL priv_get_data(pe,slot,qstars,SIZE(qstars),d%qstars_handle) CALL priv_get_data(pe,slot,SIZE(qstars),d%qstars_handle,cdata=qstars)
CALL priv_get_data(pe,slot,ksym,SIZE(ksym),d%ksym_handle) CALL priv_get_data(pe,slot,SIZE(ksym),d%ksym_handle,idata=ksym)
CALL priv_get_data(pe,slot,jsym,SIZE(jsym),d%jsym_handle) 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,mcd,SIZE(mcd),d%mcd_handle) 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 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,SIZE(qintsl),d%qintsl_handle,rdata=qintsl)
CALL priv_get_data(pe,slot,qmtsl,SIZE(qmtsl),d%qmtsl_handle) CALL priv_get_data(pe,slot,SIZE(qmtsl),d%qmtsl_handle,rdata=qmtsl)
CALL priv_get_data(pe,slot,qmtp,SIZE(qmtp),d%qmtp_handle) CALL priv_get_data(pe,slot,SIZE(qmtp),d%qmtp_handle,rdata=qmtp)
CALL priv_get_data(pe,slot,orbcomp,SIZE(orbcomp),d%orbcomp_handle) CALL priv_get_data(pe,slot,SIZE(orbcomp),d%orbcomp_handle,rdata=orbcomp)
ENDIF ENDIF
END SUBROUTINE read_dos 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