Commit 19a16eb9 authored by ua741532's avatar ua741532

Merge branch 'develop' of ifflinux.iff.kfa-juelich.de:fleur into develop

parents ba313707 a3b985f8
...@@ -880,7 +880,7 @@ CONTAINS ...@@ -880,7 +880,7 @@ CONTAINS
sliceplot,noco,sym,& sliceplot,noco,sym,&
cell,& cell,&
l_mcd,ncored,ncore,e_mcd,& l_mcd,ncored,ncore,e_mcd,&
results%ef,nsld,oneD) results%ef,results%bandgap,nsld,oneD)
IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN IF (banddos%dos.AND.(banddos%ndir.EQ.-3)) THEN
CALL Ek_write_sl(& CALL Ek_write_sl(&
eig_id,dimension,kpts,atoms,vacuum,& eig_id,dimension,kpts,atoms,vacuum,&
......
...@@ -17,7 +17,7 @@ CONTAINS ...@@ -17,7 +17,7 @@ CONTAINS
& sliceplot,noco,sym,& & sliceplot,noco,sym,&
& cell,& & cell,&
& l_mcd,ncored,ncore,e_mcd,& & l_mcd,ncored,ncore,e_mcd,&
& efermi,nsld,oneD) & efermi,bandgap,nsld,oneD)
USE m_eig66_io,ONLY:read_dos,read_eig USE m_eig66_io,ONLY:read_dos,read_eig
USE m_evaldos USE m_evaldos
USE m_cdninf USE m_cdninf
...@@ -40,7 +40,7 @@ CONTAINS ...@@ -40,7 +40,7 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13 INTEGER,PARAMETER :: n2max=13
INTEGER, INTENT (IN) :: nsld,eig_id INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: ncored INTEGER, INTENT (IN) :: ncored
REAL, INTENT (IN) :: efermi REAL, INTENT (IN) :: efermi, bandgap
LOGICAL, INTENT (IN) :: l_mcd LOGICAL, INTENT (IN) :: l_mcd
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
...@@ -137,7 +137,7 @@ CONTAINS ...@@ -137,7 +137,7 @@ CONTAINS
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(& CALL evaldos(&
& eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,& & eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& DIMENSION,efermi,& & DIMENSION,efermi,bandgap,&
& l_mcd,ncored,ncore,e_mcd,nsld) & l_mcd,ncored,ncore,e_mcd,nsld)
ENDIF ENDIF
! !
......
MODULE m_evaldos MODULE m_evaldos
CONTAINS CONTAINS
SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,& SUBROUTINE evaldos(eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
dimension,efermiarg, l_mcd,ncored,ncore,e_mcd,nsld) dimension,efermiarg,bandgap,l_mcd,ncored,ncore,e_mcd,nsld)
!---------------------------------------------------------------------- !----------------------------------------------------------------------
! !
! vk: k-vectors ! vk: k-vectors
...@@ -27,6 +27,8 @@ ...@@ -27,6 +27,8 @@
USE m_ptdos USE m_ptdos
USE m_smooth USE m_smooth
USE m_types USE m_types
USE m_constants
USE m_cdn_io
IMPLICIT NONE IMPLICIT NONE
INTEGER,INTENT(IN) :: eig_id INTEGER,INTENT(IN) :: eig_id
TYPE(t_dimension),INTENT(IN) :: dimension TYPE(t_dimension),INTENT(IN) :: dimension
...@@ -42,7 +44,7 @@ ...@@ -42,7 +44,7 @@
INTEGER, INTENT(IN) :: ncored INTEGER, INTENT(IN) :: ncored
INTEGER, INTENT(IN) :: nsld INTEGER, INTENT(IN) :: nsld
REAL, INTENT(IN) :: efermiarg REAL, INTENT(IN) :: efermiarg, bandgap
LOGICAL, INTENT(IN) :: l_mcd LOGICAL, INTENT(IN) :: l_mcd
INTEGER, INTENT(IN) :: ncore(:)!(ntype) INTEGER, INTENT(IN) :: ncore(:)!(ntype)
...@@ -51,12 +53,11 @@ ...@@ -51,12 +53,11 @@
!+odim !+odim
! locals ! locals
INTEGER, PARAMETER :: lmax= 4, ned = 1301 INTEGER, PARAMETER :: lmax= 4, ned = 1301
REAL, PARAMETER :: factor = 27.2
INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra
INTEGER icore,qdim,n_orb INTEGER icore,qdim,n_orb
REAL as,de,efermi,emax,emin,qmt,sigma,totdos REAL as,de,efermi,emax,emin,qmt,sigma,totdos,efermiPrev
REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk,eFermiCorrection
LOGICAL l_tria,l_orbcomp LOGICAL l_tria,l_orbcomp,l_error
INTEGER itria(3,2*kpts%nkpt),nevk(kpts%nkpt),itetra(4,6*kpts%nkpt) INTEGER itria(3,2*kpts%nkpt),nevk(kpts%nkpt),itetra(4,6*kpts%nkpt)
INTEGER, ALLOCATABLE :: ksym(:),jsym(:) INTEGER, ALLOCATABLE :: ksym(:),jsym(:)
...@@ -97,10 +98,10 @@ ...@@ -97,10 +98,10 @@
ENDIF ENDIF
! !
! scale energies ! scale energies
sigma = banddos%sig_dos*factor sigma = banddos%sig_dos*hartree_to_ev_const
emin =min(banddos%e1_dos*factor,banddos%e2_dos*factor) emin =min(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const)
emax =max(banddos%e1_dos*factor,banddos%e2_dos*factor) emax =max(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const)
efermi = efermiarg*factor efermi = efermiarg*hartree_to_ev_const
WRITE (6,'(a)') 'DOS-Output is generated!' WRITE (6,'(a)') 'DOS-Output is generated!'
...@@ -135,8 +136,8 @@ ...@@ -135,8 +136,8 @@
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
e_lo = e_lo*factor - efermi - emax e_lo = e_lo*hartree_to_ev_const - efermi - emax
e_up = e_up*factor - efermi e_up = e_up*hartree_to_ev_const - efermi
de = (e_up-e_lo)/(ned-1) de = (e_up-e_lo)/(ned-1)
DO i=1,ned DO i=1,ned
e_grid(i) = e_lo + (i-1)*de e_grid(i) = e_lo + (i-1)*de
...@@ -237,7 +238,7 @@ ...@@ -237,7 +238,7 @@
!---- > convert eigenvalues to ev and shift them by efermi !---- > convert eigenvalues to ev and shift them by efermi
! !
DO i = 1 , nevk(k) DO i = 1 , nevk(k)
ev(i,k) = ev(i,k)*factor - efermi ev(i,k) = ev(i,k)*hartree_to_ev_const - efermi
ENDDO ENDDO
DO i = nevk(k) + 1, dimension%neigd DO i = nevk(k) + 1, dimension%neigd
ev(i,k) = 9.9e+99 ev(i,k) = 9.9e+99
...@@ -418,8 +419,8 @@ ...@@ -418,8 +419,8 @@
DO icore = 1 , ncore(n) DO icore = 1 , ncore(n)
DO i = 1 , ned-1 DO i = 1 , ned-1
IF (e(i).GT.0) THEN ! take unoccupied part only IF (e(i).GT.0) THEN ! take unoccupied part only
e_test1 = -e(i) - efermi +e_mcd(n,jspin,icore)*factor e_test1 = -e(i) - efermi +e_mcd(n,jspin,icore)*hartree_to_ev_const
e_test2 = -e(i+1)-efermi +e_mcd(n,jspin,icore)*factor e_test2 = -e(i+1)-efermi +e_mcd(n,jspin,icore)*hartree_to_ev_const
IF ((e_test2.LE.e_grid(l)).AND. (e_test1.GT.e_grid(l))) THEN IF ((e_test2.LE.e_grid(l)).AND. (e_test1.GT.e_grid(l))) THEN
fac = (e_grid(l)-e_test1)/(e_test2-e_test1) fac = (e_grid(l)-e_test1)/(e_test2-e_test1)
DO k = 3*(n-1)+1,3*(n-1)+3 DO k = 3*(n-1)+1,3*(n-1)+3
...@@ -472,6 +473,20 @@ ...@@ -472,6 +473,20 @@
!------------------------------------------------------------------------------ !------------------------------------------------------------------------------
IF (banddos%ndir == -4) THEN IF (banddos%ndir == -4) THEN
eFermiCorrection = 0.0
IF(bandgap.LT.(8.0*input%tkb*hartree_to_ev_const)) THEN
CALL readPrevEFermi(eFermiPrev,l_error)
IF(.NOT.l_error) THEN
WRITE(*,*) 'Fermi energy is automatically corrected in bands.* files.'
WRITE(*,*) 'It is consistent with last calculated density!'
WRITE(*,*) 'No manual correction (e.g. in band.gnu file) required.'
eFermiCorrection = (eFermiPrev-efermiarg)*hartree_to_ev_const
ELSE
WRITE(*,*) 'Fermi energy in bands.* files may not be consistent with last density.'
WRITE(*,*) 'Please correct it manually (e.g. in band.gnu file).'
END IF
END IF
OPEN (18,FILE='bands'//spin12(jspin)) OPEN (18,FILE='bands'//spin12(jspin))
ntb = minval(nevk(:)) ntb = minval(nevk(:))
kx(1) = 0.0 kx(1) = 0.0
...@@ -485,7 +500,7 @@ ...@@ -485,7 +500,7 @@
ENDDO ENDDO
DO i = 1, ntb DO i = 1, ntb
DO k = 1, kpts%nkpt DO k = 1, kpts%nkpt
write(18,'(2f15.9)') kx(k),ev(i,k) write(18,'(2f15.9)') kx(k),ev(i,k)-eFermiCorrection
ENDDO ENDDO
ENDDO ENDDO
CLOSE (18) CLOSE (18)
......
...@@ -128,6 +128,7 @@ CONTAINS ...@@ -128,6 +128,7 @@ CONTAINS
efermi = results%ef efermi = results%ef
IF (nstef.LT.n) THEN IF (nstef.LT.n) THEN
gap = e(INDEX(nstef+1)) - results%ef gap = e(INDEX(nstef+1)) - results%ef
results%bandgap = gap*hartree_to_ev_const
IF ( mpi%irank == 0 ) THEN IF ( mpi%irank == 0 ) THEN
attributes = '' attributes = ''
WRITE(attributes(1),'(f20.10)') gap*hartree_to_ev_const WRITE(attributes(1),'(f20.10)') gap*hartree_to_ev_const
......
...@@ -212,6 +212,7 @@ CONTAINS ...@@ -212,6 +212,7 @@ CONTAINS
results%ts = 0.0 results%ts = 0.0
!-po !-po
results%w_iks = 0.0 results%w_iks = 0.0
results%bandgap = 0.0
IF (input%gauss) THEN IF (input%gauss) THEN
CALL fergwt(kpts,input,mpi,ne, eig,results) CALL fergwt(kpts,input,mpi,ne, eig,results)
ELSE IF (input%tria) THEN ELSE IF (input%tria) THEN
......
...@@ -706,6 +706,7 @@ ...@@ -706,6 +706,7 @@
REAL :: e_ldau !<total energy contribution of LDA+U REAL :: e_ldau !<total energy contribution of LDA+U
REAL :: tote REAL :: tote
REAL :: last_distance REAL :: last_distance
REAL :: bandgap
TYPE(t_energy_hf) :: te_hfex TYPE(t_energy_hf) :: te_hfex
REAL :: te_hfex_loc(2) REAL :: te_hfex_loc(2)
REAL, ALLOCATABLE :: w_iks(:,:,:) REAL, ALLOCATABLE :: w_iks(:,:,:)
......
...@@ -16,7 +16,7 @@ io/inpnoco.F90 ...@@ -16,7 +16,7 @@ io/inpnoco.F90
io/loddop.f90 io/loddop.f90
io/cdnpot_io_hdf.F90 io/cdnpot_io_hdf.F90
io/cdn_io.F90 io/cdn_io.F90
io/pot_io.f90 io/pot_io.F90
io/rw_inp.f90 io/rw_inp.f90
io/rw_noco.f90 io/rw_noco.f90
io/r_inpXML.F90 io/r_inpXML.F90
......
...@@ -28,7 +28,7 @@ MODULE m_cdn_io ...@@ -28,7 +28,7 @@ MODULE m_cdn_io
PUBLIC readDensity, writeDensity PUBLIC readDensity, writeDensity
PUBLIC isDensityFilePresent, isCoreDensityPresent PUBLIC isDensityFilePresent, isCoreDensityPresent
PUBLIC readCoreDensity, writeCoreDensity PUBLIC readCoreDensity, writeCoreDensity
PUBLIC setStartingDensity PUBLIC setStartingDensity, readPrevEFermi
PUBLIC CDN_INPUT_DEN_const, CDN_OUTPUT_DEN_const PUBLIC CDN_INPUT_DEN_const, CDN_OUTPUT_DEN_const
PUBLIC CDN_ARCHIVE_TYPE_CDN1_const, CDN_ARCHIVE_TYPE_NOCO_const PUBLIC CDN_ARCHIVE_TYPE_CDN1_const, CDN_ARCHIVE_TYPE_NOCO_const
PUBLIC CDN_ARCHIVE_TYPE_CDN_const PUBLIC CDN_ARCHIVE_TYPE_CDN_const
...@@ -87,7 +87,6 @@ MODULE m_cdn_io ...@@ -87,7 +87,6 @@ MODULE m_cdn_io
fermiEnergy = 0.0 fermiEnergy = 0.0
l_qfix = .FALSE. l_qfix = .FALSE.
WRITE(*,*) 'fermiEnergy and l_qfix set to default values in readDensity!'
CALL getMode(mode) CALL getMode(mode)
...@@ -126,7 +125,7 @@ MODULE m_cdn_io ...@@ -126,7 +125,7 @@ MODULE m_cdn_io
CALL juDFT_error("Invalid inOrOutCDN selected.",calledby ="readDensity") CALL juDFT_error("Invalid inOrOutCDN selected.",calledby ="readDensity")
END SELECT END SELECT
l_exist = isDensityEntryPresentHDF(fileID,archiveName,densityType) l_exist = isDensityEntryPresentHDF(fileID,archiveName,densityType)
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
END IF END IF
IF (l_exist) THEN IF (l_exist) THEN
...@@ -136,7 +135,7 @@ MODULE m_cdn_io ...@@ -136,7 +135,7 @@ MODULE m_cdn_io
CALL readDensityHDF(fileID, archiveName, densityType,& CALL readDensityHDF(fileID, archiveName, densityType,&
fermiEnergy,l_qfix,iter,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy) fermiEnergy,l_qfix,iter,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
RETURN RETURN
ELSE ELSE
WRITE(*,*) 'cdn.hdf file or relevant density entry not found.' WRITE(*,*) 'cdn.hdf file or relevant density entry not found.'
...@@ -351,11 +350,11 @@ MODULE m_cdn_io ...@@ -351,11 +350,11 @@ MODULE m_cdn_io
fermiEnergy,l_qfix,iter+relCdnIndex,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy) fermiEnergy,l_qfix,iter+relCdnIndex,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
IF(l_storeIndices) THEN IF(l_storeIndices) THEN
CALL writeHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,& CALL writeCDNHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,readDensityIndex,lastDensityIndex) currentStructureIndex,readDensityIndex,lastDensityIndex)
END IF END IF
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
#endif #endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
! Write density to cdn.str file ! Write density to cdn.str file
...@@ -495,6 +494,58 @@ MODULE m_cdn_io ...@@ -495,6 +494,58 @@ MODULE m_cdn_io
END SUBROUTINE writeDensity END SUBROUTINE writeDensity
SUBROUTINE readPrevEFermi(eFermiPrev,l_error)
REAL, INTENT(OUT) :: eFermiPrev
LOGICAL, INTENT(OUT) :: l_error
INTEGER :: mode
#ifdef CPP_HDF
INTEGER(HID_T) :: fileID
#endif
INTEGER :: currentStarsIndex,currentLatharmsIndex
INTEGER :: currentStructureIndex
INTEGER :: readDensityIndex, lastDensityIndex
INTEGER :: starsIndex, latharmsIndex, structureIndex
INTEGER :: iter, jspins, previousDensityIndex
REAL :: fermiEnergy
LOGICAL :: l_qfix, l_exist
CHARACTER(LEN=30) :: archiveName
CALL getMode(mode)
eFermiPrev = 0.0
l_error = .FALSE.
IF(mode.EQ.CDN_HDF5_MODE) THEN
#ifdef CPP_HDF
CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex)
WRITE(archiveName,'(a,i0)') '/cdn-', readDensityIndex
CALL peekDensityEntryHDF(fileID, archiveName, DENSITY_TYPE_UNDEFINED_const,&
iter, starsIndex, latharmsIndex, structureIndex,&
previousDensityIndex, jspins, fermiEnergy, l_qfix)
archiveName = ''
WRITE(archiveName,'(a,i0)') '/cdn-', previousDensityIndex
l_exist = isDensityEntryPresentHDF(fileID,archiveName,DENSITY_TYPE_NOCO_OUT_const)
IF(l_exist) THEN
CALL peekDensityEntryHDF(fileID, archiveName, DENSITY_TYPE_NOCO_OUT_const,&
iter, starsIndex, latharmsIndex, structureIndex,&
previousDensityIndex, jspins, fermiEnergy, l_qfix)
eFermiPrev = fermiEnergy
ELSE
l_error = .TRUE.
END IF
CALL closeCDNPOT_HDF(fileID)
#endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
STOP 'cdn.str not yet implemented!'
ELSE
l_error = .TRUE.
END IF
END SUBROUTINE
SUBROUTINE readCoreDensity(input,atoms,dimension,rhcs,tecs,qints) SUBROUTINE readCoreDensity(input,atoms,dimension,rhcs,tecs,qints)
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
...@@ -525,7 +576,7 @@ MODULE m_cdn_io ...@@ -525,7 +576,7 @@ MODULE m_cdn_io
CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,& CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex) readDensityIndex,lastDensityIndex)
CALL readCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) CALL readCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints)
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
RETURN RETURN
ELSE ELSE
WRITE(*,*) 'No core density is available in HDF5 format.' WRITE(*,*) 'No core density is available in HDF5 format.'
...@@ -594,7 +645,7 @@ MODULE m_cdn_io ...@@ -594,7 +645,7 @@ MODULE m_cdn_io
CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,& CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex) readDensityIndex,lastDensityIndex)
CALL writeCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints) CALL writeCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints)
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
#endif #endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
! Write core density to cdn.str file ! Write core density to cdn.str file
...@@ -662,9 +713,9 @@ MODULE m_cdn_io ...@@ -662,9 +713,9 @@ MODULE m_cdn_io
WRITE(*,*) 'archiveName: ', TRIM(ADJUSTL(archiveName)) WRITE(*,*) 'archiveName: ', TRIM(ADJUSTL(archiveName))
CALL juDFT_error("For selected starting density index no in-density is present.",calledby ="setStartingDensity") CALL juDFT_error("For selected starting density index no in-density is present.",calledby ="setStartingDensity")
END IF END IF
CALL writeHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,& CALL writeCDNHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,sdIndex,lastDensityIndex) currentStructureIndex,sdIndex,lastDensityIndex)
CALL closeCDN_HDF(fileID) CALL closeCDNPOT_HDF(fileID)
#endif #endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
STOP 'CDN_STREAM_MODE not yet implemented!' STOP 'CDN_STREAM_MODE not yet implemented!'
......
This diff is collapsed.
...@@ -18,6 +18,10 @@ MODULE m_pot_io ...@@ -18,6 +18,10 @@ MODULE m_pot_io
USE m_juDFT USE m_juDFT
USE m_loddop USE m_loddop
USE m_wrtdop USE m_wrtdop
USE m_cdnpot_io_hdf
#ifdef CPP_HDF
USE hdf5
#endif
IMPLICIT NONE IMPLICIT NONE
PRIVATE PRIVATE
...@@ -58,19 +62,57 @@ MODULE m_pot_io ...@@ -58,19 +62,57 @@ MODULE m_pot_io
LOGICAL :: l_exist LOGICAL :: l_exist
CHARACTER(len=30) :: filename CHARACTER(len=30) :: filename
#ifdef CPP_HDF
INTEGER(HID_T) :: fileID
#endif
INTEGER :: currentStarsIndex,currentLatharmsIndex
INTEGER :: currentStructureIndex
INTEGER :: potentialType
CHARACTER(LEN=30) :: archiveName
CALL getMode(mode) CALL getMode(mode)
IF(mode.EQ.POT_HDF5_MODE) THEN IF(mode.EQ.POT_HDF5_MODE) THEN
#ifdef CPP_HDF
INQUIRE(FILE='pot.hdf',EXIST=l_exist) INQUIRE(FILE='pot.hdf',EXIST=l_exist)
IF (l_exist) THEN IF (l_exist) THEN
!load density from pot.hdf and exit subroutine CALL openPOT_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex)
RETURN archiveName = 'illegalPotentialArchive'
IF (archiveType.EQ.POT_ARCHIVE_TYPE_TOT_const) THEN
archiveName = 'pottot'
END IF
IF (archiveType.EQ.POT_ARCHIVE_TYPE_COUL_const) THEN
archiveName = 'potcoul'
END IF
IF (archiveType.EQ.POT_ARCHIVE_TYPE_X_const) THEN
archiveName = 'potx'
END IF
potentialType = POTENTIAL_TYPE_IN_const
l_exist = isPotentialEntryPresentHDF(fileID,archiveName,potentialType)
CALL closeCDNPOT_HDF(fileID)
END IF
IF(l_exist) THEN
CALL openPOT_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex)
CALL readPotentialHDF(fileID, archiveName, potentialType,&
iter,fr,fpw,fz,fzxy)
CALL closeCDNPOT_HDF(fileID)
ELSE ELSE
WRITE(*,*) 'pot.hdf file not found.' WRITE(*,*) 'Potential entry or pot.hdf file not found.'
WRITE(*,*) 'Falling back to stream access file pot.str.' WRITE(*,*) 'Falling back to stream access file pot.str.'
mode = POT_STREAM_MODE mode = POT_STREAM_MODE
END IF END IF
#else
WRITE(*,*) 'Not compiled for pot.hdf file usage.'
WRITE(*,*) 'Falling back to stream access file pot.str.'
mode = POT_STREAM_MODE
#endif
END IF END IF
IF(mode.EQ.POT_STREAM_MODE) THEN IF(mode.EQ.POT_STREAM_MODE) THEN
...@@ -114,15 +156,17 @@ MODULE m_pot_io ...@@ -114,15 +156,17 @@ MODULE m_pot_io
END SUBROUTINE readPotential END SUBROUTINE readPotential
SUBROUTINE writePotential(stars,vacuum,atoms,sphhar,input,sym,archiveType,& SUBROUTINE writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
iter,fr,fpw,fz,fzxy) iter,fr,fpw,fz,fzxy)
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER, INTENT (IN) :: iter INTEGER, INTENT (IN) :: iter
INTEGER, INTENT (IN) :: archiveType INTEGER, INTENT (IN) :: archiveType
...@@ -133,14 +177,64 @@ MODULE m_pot_io ...@@ -133,14 +177,64 @@ MODULE m_pot_io
! local variables ! local variables
INTEGER :: mode, iUnit INTEGER :: mode, iUnit
LOGICAL :: l_exist LOGICAL :: l_exist, l_storeIndices
CHARACTER(len=30) :: filename CHARACTER(len=30) :: filename
#ifdef CPP_HDF
INTEGER(HID_T) :: fileID
#endif
INTEGER :: currentStarsIndex,currentLatharmsIndex
INTEGER :: currentStructureIndex
INTEGER :: potentialType
CHARACTER(LEN=30) :: archiveName
CALL getMode(mode) CALL getMode(mode)
IF(mode.EQ.POT_HDF5_MODE) THEN IF(mode.EQ.POT_HDF5_MODE) THEN
! Write potential to pot.hdf file #ifdef CPP_HDF
STOP 'POT_HDF5_MODE not yet implemented!' CALL openPOT_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex)
l_storeIndices = .FALSE.
IF (currentStarsIndex.EQ.0) THEN
currentStarsIndex = 1
l_storeIndices = .TRUE.
CALL writeStarsHDF(fileID, currentStarsIndex, stars)
END IF
IF (currentLatharmsIndex.EQ.0) THEN
currentLatharmsIndex = 1
l_storeIndices = .TRUE.
CALL writeLatharmsHDF(fileID, currentLatharmsIndex, sphhar)
END IF
IF(currentStructureIndex.EQ.0) THEN
currentStructureIndex = 1
l_storeIndices = .TRUE.
CALL writeStructureHDF(fileID, input, atoms, cell, vacuum, oneD, currentStructureIndex)
END IF
archiveName = 'illegalPotentialArchive'
IF (archiveType.EQ.POT_ARCHIVE_TYPE_TOT_const) THEN
archiveName = 'pottot'
END IF
IF (archiveType.EQ.POT_ARCHIVE_TYPE_COUL_const) THEN
archiveName = 'potcoul'
END IF
IF (archiveType.EQ.POT_ARCHIVE_TYPE_X_const) THEN
archiveName = 'potx'
END IF
potentialType = POTENTIAL_TYPE_IN_const
CALL writePotentialHDF(input, fileID, archiveName, potentialType,&
currentStarsIndex, currentLatharmsIndex, currentStructureIndex,&
iter,fr,fpw,fz,fzxy)
IF(l_storeIndices) THEN
CALL writePOTHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex)
END IF
CALL closeCDNPOT_HDF(fileID)
#endif
ELSE IF(mode.EQ.POT_STREAM_MODE) THEN ELSE IF(mode.EQ.POT_STREAM_MODE) THEN
! Write potential to pot.str file ! Write potential to pot.str file
STOP 'POT_STREAM_MODE not yet implemented!' STOP 'POT_STREAM_MODE not yet implemented!'
...@@ -170,8 +264,15 @@ MODULE m_pot_io ...@@ -170,8 +264,15 @@ MODULE m_pot_io
INTEGER, INTENT(OUT) :: mode INTEGER, INTENT(OUT) :: mode
mode = POT_DIRECT_MODE mode = POT_DIRECT_MODE
IF (juDFT_was_argument("-stream_pot")) mode=POT_STREAM_MODE IF (juDFT_was_argument("-stream_cdn")) mode=POT_STREAM_MODE
IF (juDFT_was_argument("-hdf_pot")) mode=POT_HDF5_MODE IF (juDFT_was_argument("-hdf_cdn")) THEN
#ifdef CPP_HDF
mode=POT_HDF5_MODE
#else
WRITE(*,*) 'Code not compiled with HDF5 support.'
WRITE(*,*) 'Falling back to direct access.'
#endif
END IF
END SUBROUTINE getMode END SUBROUTINE getMode
END MODULE m_pot_io END MODULE m_pot_io
...@@ -420,7 +420,7 @@ CONTAINS ...@@ -420,7 +420,7 @@ CONTAINS
vpw_w(1:stars%ng3,js)=vpw_w(1:stars%ng3,js)/stars%nstr(1:stars%ng3) ! the PW-coulomb part is not vpw_w(1:stars%ng3,js)=vpw_w(1:stars%ng3,js)/stars%nstr(1:stars%ng3) ! the PW-coulomb part is not
! used otherwise anyway. ! used otherwise anyway.
ENDDO ENDDO
CALL writePotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_COUL_const,& CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_COUL_const,&
iter,vr,vpw_w,vz,vxy) iter,vr,vpw_w,vz,vxy)
DO js = 1,input%jspins DO js = 1,input%jspins
DO i = 1,stars%ng3 DO i = 1,stars%ng3
...@@ -851,7 +851,7 @@ CONTAINS ...@@ -851,7 +851,7 @@ CONTAINS
vpw_w(i,js)=vpw_w(i,js)/stars%nstr(i) vpw_w(i,js)=vpw_w(i,js)/stars%nstr(i)
ENDDO ENDDO
ENDDO ENDDO
CALL writePotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,& CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_TOT_const,&
iter,vr,vpw_w,vz,vxy) iter,vr,vpw_w,vz,vxy)
DO js=1,input%jspins DO js=1,input%jspins
...@@ -860,7 +860,7 @@ CONTAINS ...@@ -860,7 +860,7 @@ CONTAINS
ENDDO ENDDO
ENDDO ENDDO
CALL writePotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_X_const,& CALL writePotential(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,POT_ARCHIVE_TYPE_X_const,&
iter,vxr