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
sliceplot,noco,sym,&
cell,&
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
CALL Ek_write_sl(&
eig_id,dimension,kpts,atoms,vacuum,&
......
......@@ -17,7 +17,7 @@ CONTAINS
& sliceplot,noco,sym,&
& cell,&
& l_mcd,ncored,ncore,e_mcd,&
& efermi,nsld,oneD)
& efermi,bandgap,nsld,oneD)
USE m_eig66_io,ONLY:read_dos,read_eig
USE m_evaldos
USE m_cdninf
......@@ -40,7 +40,7 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
INTEGER, INTENT (IN) :: nsld,eig_id
INTEGER, INTENT (IN) :: ncored
REAL, INTENT (IN) :: efermi
REAL, INTENT (IN) :: efermi, bandgap
LOGICAL, INTENT (IN) :: l_mcd
! ..
! .. Array Arguments ..
......@@ -137,7 +137,7 @@ CONTAINS
IF (banddos%dos.AND.(banddos%ndir.LT.0)) THEN
CALL evaldos(&
& eig_id,input,banddos,vacuum,kpts,atoms,sym,noco,oneD,cell,&
& DIMENSION,efermi,&
& DIMENSION,efermi,bandgap,&
& l_mcd,ncored,ncore,e_mcd,nsld)
ENDIF
!
......
MODULE m_evaldos
CONTAINS
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
......@@ -27,6 +27,8 @@
USE m_ptdos
USE m_smooth
USE m_types
USE m_constants
USE m_cdn_io
IMPLICIT NONE
INTEGER,INTENT(IN) :: eig_id
TYPE(t_dimension),INTENT(IN) :: dimension
......@@ -42,7 +44,7 @@
INTEGER, INTENT(IN) :: ncored
INTEGER, INTENT(IN) :: nsld
REAL, INTENT(IN) :: efermiarg
REAL, INTENT(IN) :: efermiarg, bandgap
LOGICAL, INTENT(IN) :: l_mcd
INTEGER, INTENT(IN) :: ncore(:)!(ntype)
......@@ -51,12 +53,11 @@
!+odim
! locals
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 icore,qdim,n_orb
REAL as,de,efermi,emax,emin,qmt,sigma,totdos
REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk
LOGICAL l_tria,l_orbcomp
REAL as,de,efermi,emax,emin,qmt,sigma,totdos,efermiPrev
REAL e_up,e_lo,e_test1,e_test2,fac,sumwei,dk,eFermiCorrection
LOGICAL l_tria,l_orbcomp,l_error
INTEGER itria(3,2*kpts%nkpt),nevk(kpts%nkpt),itetra(4,6*kpts%nkpt)
INTEGER, ALLOCATABLE :: ksym(:),jsym(:)
......@@ -97,10 +98,10 @@
ENDIF
!
! scale energies
sigma = banddos%sig_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
sigma = banddos%sig_dos*hartree_to_ev_const
emin =min(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const)
emax =max(banddos%e1_dos*hartree_to_ev_const,banddos%e2_dos*hartree_to_ev_const)
efermi = efermiarg*hartree_to_ev_const
WRITE (6,'(a)') 'DOS-Output is generated!'
......@@ -135,8 +136,8 @@
ENDDO
ENDDO
ENDDO
e_lo = e_lo*factor - efermi - emax
e_up = e_up*factor - efermi
e_lo = e_lo*hartree_to_ev_const - efermi - emax
e_up = e_up*hartree_to_ev_const - efermi
de = (e_up-e_lo)/(ned-1)
DO i=1,ned
e_grid(i) = e_lo + (i-1)*de
......@@ -237,7 +238,7 @@
!---- > convert eigenvalues to ev and shift them by efermi
!
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
DO i = nevk(k) + 1, dimension%neigd
ev(i,k) = 9.9e+99
......@@ -418,8 +419,8 @@
DO icore = 1 , ncore(n)
DO i = 1 , ned-1
IF (e(i).GT.0) THEN ! take unoccupied part only
e_test1 = -e(i) - efermi +e_mcd(n,jspin,icore)*factor
e_test2 = -e(i+1)-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)*hartree_to_ev_const
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)
DO k = 3*(n-1)+1,3*(n-1)+3
......@@ -472,6 +473,20 @@
!------------------------------------------------------------------------------
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))
ntb = minval(nevk(:))
kx(1) = 0.0
......@@ -485,7 +500,7 @@
ENDDO
DO i = 1, ntb
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
CLOSE (18)
......
......@@ -128,6 +128,7 @@ CONTAINS
efermi = results%ef
IF (nstef.LT.n) THEN
gap = e(INDEX(nstef+1)) - results%ef
results%bandgap = gap*hartree_to_ev_const
IF ( mpi%irank == 0 ) THEN
attributes = ''
WRITE(attributes(1),'(f20.10)') gap*hartree_to_ev_const
......
......@@ -212,6 +212,7 @@ CONTAINS
results%ts = 0.0
!-po
results%w_iks = 0.0
results%bandgap = 0.0
IF (input%gauss) THEN
CALL fergwt(kpts,input,mpi,ne, eig,results)
ELSE IF (input%tria) THEN
......
......@@ -706,6 +706,7 @@
REAL :: e_ldau !<total energy contribution of LDA+U
REAL :: tote
REAL :: last_distance
REAL :: bandgap
TYPE(t_energy_hf) :: te_hfex
REAL :: te_hfex_loc(2)
REAL, ALLOCATABLE :: w_iks(:,:,:)
......
......@@ -16,7 +16,7 @@ io/inpnoco.F90
io/loddop.f90
io/cdnpot_io_hdf.F90
io/cdn_io.F90
io/pot_io.f90
io/pot_io.F90
io/rw_inp.f90
io/rw_noco.f90
io/r_inpXML.F90
......
......@@ -28,7 +28,7 @@ MODULE m_cdn_io
PUBLIC readDensity, writeDensity
PUBLIC isDensityFilePresent, isCoreDensityPresent
PUBLIC readCoreDensity, writeCoreDensity
PUBLIC setStartingDensity
PUBLIC setStartingDensity, readPrevEFermi
PUBLIC CDN_INPUT_DEN_const, CDN_OUTPUT_DEN_const
PUBLIC CDN_ARCHIVE_TYPE_CDN1_const, CDN_ARCHIVE_TYPE_NOCO_const
PUBLIC CDN_ARCHIVE_TYPE_CDN_const
......@@ -87,7 +87,6 @@ MODULE m_cdn_io
fermiEnergy = 0.0
l_qfix = .FALSE.
WRITE(*,*) 'fermiEnergy and l_qfix set to default values in readDensity!'
CALL getMode(mode)
......@@ -126,7 +125,7 @@ MODULE m_cdn_io
CALL juDFT_error("Invalid inOrOutCDN selected.",calledby ="readDensity")
END SELECT
l_exist = isDensityEntryPresentHDF(fileID,archiveName,densityType)
CALL closeCDN_HDF(fileID)
CALL closeCDNPOT_HDF(fileID)
END IF
IF (l_exist) THEN
......@@ -136,7 +135,7 @@ MODULE m_cdn_io
CALL readDensityHDF(fileID, archiveName, densityType,&
fermiEnergy,l_qfix,iter,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
CALL closeCDN_HDF(fileID)
CALL closeCDNPOT_HDF(fileID)
RETURN
ELSE
WRITE(*,*) 'cdn.hdf file or relevant density entry not found.'
......@@ -351,11 +350,11 @@ MODULE m_cdn_io
fermiEnergy,l_qfix,iter+relCdnIndex,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
IF(l_storeIndices) THEN
CALL writeHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,readDensityIndex,lastDensityIndex)
CALL writeCDNHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,readDensityIndex,lastDensityIndex)
END IF
CALL closeCDN_HDF(fileID)
CALL closeCDNPOT_HDF(fileID)
#endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
! Write density to cdn.str file
......@@ -495,6 +494,58 @@ MODULE m_cdn_io
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)
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -525,7 +576,7 @@ MODULE m_cdn_io
CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex)
CALL readCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints)
CALL closeCDN_HDF(fileID)
CALL closeCDNPOT_HDF(fileID)
RETURN
ELSE
WRITE(*,*) 'No core density is available in HDF5 format.'
......@@ -594,7 +645,7 @@ MODULE m_cdn_io
CALL openCDN_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex)
CALL writeCoreDensityHDF(fileID,input,atoms,dimension,rhcs,tecs,qints)
CALL closeCDN_HDF(fileID)
CALL closeCDNPOT_HDF(fileID)
#endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
! Write core density to cdn.str file
......@@ -662,9 +713,9 @@ MODULE m_cdn_io
WRITE(*,*) 'archiveName: ', TRIM(ADJUSTL(archiveName))
CALL juDFT_error("For selected starting density index no in-density is present.",calledby ="setStartingDensity")
END IF
CALL writeHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,sdIndex,lastDensityIndex)
CALL closeCDN_HDF(fileID)
CALL writeCDNHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,&
currentStructureIndex,sdIndex,lastDensityIndex)
CALL closeCDNPOT_HDF(fileID)
#endif
ELSE IF(mode.EQ.CDN_STREAM_MODE) THEN
STOP 'CDN_STREAM_MODE not yet implemented!'
......
......@@ -16,14 +16,16 @@ MODULE m_cdnpot_io_hdf
PRIVATE
#ifdef CPP_HDF
PUBLIC openCDN_HDF, closeCDN_HDF
PUBLIC openCDN_HDF, openPOT_HDF, closeCDNPOT_HDF
PUBLIC writeStarsHDF, readStarsHDF
PUBLIC writeLatharmsHDF, readLatharmsHDF
PUBLIC writeStructureHDF, readStructureHDF
PUBLIC writeDensityHDF, readDensityHDF
PUBLIC writePotentialHDF, readPotentialHDF
PUBLIC writeCoreDensityHDF, readCoreDensityHDF
PUBLIC writeHeaderData
PUBLIC isCoreDensityPresentHDF, isDensityEntryPresentHDF
PUBLIC writeCDNHeaderData, writePOTHeaderData
PUBLIC isCoreDensityPresentHDF
PUBLIC isDensityEntryPresentHDF, isPotentialEntryPresentHDF
PUBLIC peekDensityEntryHDF
#endif
......@@ -31,6 +33,7 @@ MODULE m_cdnpot_io_hdf
PUBLIC DENSITY_TYPE_IN_const, DENSITY_TYPE_OUT_const
PUBLIC DENSITY_TYPE_NOCO_IN_const, DENSITY_TYPE_NOCO_OUT_const
PUBLIC DENSITY_TYPE_PRECOND_const
PUBLIC POTENTIAL_TYPE_IN_const, POTENTIAL_TYPE_OUT_const
INTEGER, PARAMETER :: DENSITY_TYPE_UNDEFINED_const = 0
INTEGER, PARAMETER :: DENSITY_TYPE_IN_const = 1
......@@ -39,6 +42,9 @@ MODULE m_cdnpot_io_hdf
INTEGER, PARAMETER :: DENSITY_TYPE_NOCO_OUT_const = 4
INTEGER, PARAMETER :: DENSITY_TYPE_PRECOND_const = 5
INTEGER, PARAMETER :: POTENTIAL_TYPE_IN_const = 1
INTEGER, PARAMETER :: POTENTIAL_TYPE_OUT_const = 2
CONTAINS
#ifdef CPP_HDF
......@@ -87,10 +93,48 @@ MODULE m_cdnpot_io_hdf
CALL h5gclose_f(generalGroupID, hdfError)
END IF
END SUBROUTINE openCDN_HDF
SUBROUTINE closeCDN_HDF(fileID)
SUBROUTINE openPOT_HDF(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex)
INTEGER(HID_T), INTENT(OUT) :: fileID
INTEGER, INTENT(OUT) :: currentStarsIndex,currentLatharmsIndex,currentStructureIndex
INTEGER(HID_T) :: generalGroupID
INTEGER :: hdfError
LOGICAL :: l_exist
currentStarsIndex = 0
currentLatharmsIndex = 0
currentStructureIndex = 0
INQUIRE(FILE='pot.hdf',EXIST=l_exist)
IF(l_exist) THEN ! only open file
CALL h5fopen_f('pot.hdf', H5F_ACC_RDWR_F, fileID, hdfError, H5P_DEFAULT_F)
CALL h5gopen_f(fileID, '/general', generalGroupID, hdfError)
! read in primary attributes from the header '/general'
CALL io_read_attint0(generalGroupID,'currentStarsIndex',currentStarsIndex)
CALL io_read_attint0(generalGroupID,'currentLatharmsIndex',currentLatharmsIndex)
CALL io_read_attint0(generalGroupID,'currentStructureIndex',currentStructureIndex)
CALL h5gclose_f(generalGroupID, hdfError)
ELSE ! create file
CALL h5fcreate_f('pot.hdf', H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
! write initial values to primary attributes in the header '/general'
CALL io_write_attint0(generalGroupID,'currentStarsIndex',currentStarsIndex)
CALL io_write_attint0(generalGroupID,'currentLatharmsIndex',currentLatharmsIndex)
CALL io_write_attint0(generalGroupID,'currentStructureIndex',currentStructureIndex)
CALL h5gclose_f(generalGroupID, hdfError)
END IF
END SUBROUTINE openPOT_HDF
SUBROUTINE closeCDNPOT_HDF(fileID)
INTEGER(HID_T), INTENT(IN) :: fileID
......@@ -98,9 +142,9 @@ MODULE m_cdnpot_io_hdf
CALL h5fclose_f(fileID, hdfError)
END SUBROUTINE closeCDN_HDF
END SUBROUTINE closeCDNPOT_HDF
SUBROUTINE writeHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
SUBROUTINE writeCDNHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex,&
readDensityIndex,lastDensityIndex)
INTEGER(HID_T), INTENT(IN) :: fileID
......@@ -123,7 +167,27 @@ MODULE m_cdnpot_io_hdf
CALL h5gclose_f(generalGroupID, hdfError)
END SUBROUTINE writeHeaderData
END SUBROUTINE writeCDNHeaderData
SUBROUTINE writePOTHeaderData(fileID,currentStarsIndex,currentLatharmsIndex,currentStructureIndex)
INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER, INTENT(IN) :: currentStarsIndex
INTEGER, INTENT(IN) :: currentLatharmsIndex
INTEGER, INTENT(IN) :: currentStructureIndex
INTEGER(HID_T) :: generalGroupID
INTEGER :: hdfError
CALL h5gopen_f(fileID, '/general', generalGroupID, hdfError)
CALL io_write_attint0(generalGroupID,'currentStarsIndex',currentStarsIndex)
CALL io_write_attint0(generalGroupID,'currentLatharmsIndex',currentLatharmsIndex)
CALL io_write_attint0(generalGroupID,'currentStructureIndex',currentStructureIndex)
CALL h5gclose_f(generalGroupID, hdfError)
END SUBROUTINE writePOTHeaderData
SUBROUTINE writeStarsHDF(fileID, starsIndex, stars)
......@@ -1345,6 +1409,216 @@ MODULE m_cdnpot_io_hdf
END SUBROUTINE writeDensityHDF
SUBROUTINE writePotentialHDF(input, fileID, archiveName, potentialType,&
starsIndex, latharmsIndex, structureIndex,&
iter,fr,fpw,fz,fzxy)
TYPE(t_input), INTENT(IN) :: input
INTEGER(HID_T), INTENT(IN) :: fileID
INTEGER, INTENT(IN) :: potentialType
INTEGER, INTENT(IN) :: starsIndex, latharmsIndex, structureIndex
CHARACTER(LEN=*), INTENT(IN) :: archiveName
INTEGER, INTENT (IN) :: iter
REAL, INTENT (IN) :: fr(:,:,:,:)
REAL, INTENT (IN) :: fz(:,:,:)
COMPLEX, INTENT (IN) :: fpw(:,:)
COMPLEX, INTENT (IN) :: fzxy(:,:,:,:)
INTEGER :: ntype,jmtd,nmzd,nmzxyd,nlhd,ng3,ng2
INTEGER :: nmz, nvac, od_nq2, nmzxy
INTEGER :: hdfError
LOGICAL :: l_film, l_exist
INTEGER(HID_T) :: archiveID, groupID
CHARACTER(LEN=30) :: groupName, potentialTypeName
INTEGER(HSIZE_T) :: dims(7)
INTEGER :: dimsInt(7)
INTEGER(HID_T) :: frSpaceID, frSetID
INTEGER(HID_T) :: fpwSpaceID, fpwSetID
INTEGER(HID_T) :: fzSpaceID, fzSetID
INTEGER(HID_T) :: fzxySpaceID, fzxySetID
WRITE(groupname,'(a,i0)') '/structure-', structureIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
IF(.NOT.l_exist) THEN
CALL juDFT_error("Structure entry "//TRIM(ADJUSTL(groupName))//" does not exist",calledby ="writePotentialHDF")
END IF
CALL h5gopen_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
CALL io_read_attlog0(groupID,'l_film',l_film)
CALL io_read_attint0(groupID,'ntype',ntype)
CALL io_read_attint0(groupID,'jmtd',jmtd)
CALL io_read_attint0(groupID,'nmzd',nmzd)
CALL io_read_attint0(groupID,'nmzxyd',nmzxyd)
CALL io_read_attint0(groupID,'nmzxy',nmzxy)
CALL io_read_attint0(groupID,'nmz',nmz)
CALL io_read_attint0(groupID,'nvac',nvac)
CALL io_read_attint0(groupID,'od_nq2',od_nq2)
CALL h5gclose_f(groupID, hdfError)
WRITE(groupname,'(a,i0)') '/latharms-', latharmsIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
IF(.NOT.l_exist) THEN
CALL juDFT_error("Latharms entry "//TRIM(ADJUSTL(groupName))//" does not exist",calledby ="writePotentialHDF")
END IF
CALL h5gopen_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
CALL io_read_attint0(groupID,'nlhd',nlhd)
CALL h5gclose_f(groupID, hdfError)
WRITE(groupname,'(a,i0)') '/stars-', starsIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
IF(.NOT.l_exist) THEN
CALL juDFT_error("Stars entry "//TRIM(ADJUSTL(groupName))//" does not exist",calledby ="writePotentialHDF")
END IF
CALL h5gopen_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
CALL io_read_attint0(groupID,'ng3',ng3)
CALL io_read_attint0(groupID,'ng2',ng2)
CALL h5gclose_f(groupID, hdfError)
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(archiveName)))
SELECT CASE (potentialType)
CASE(POTENTIAL_TYPE_IN_const)
potentialTypeName = '/in'
CASE(POTENTIAL_TYPE_OUT_const)
potentialTypeName = '/out'
CASE DEFAULT
CALL juDFT_error("Unknown potential type selected",calledby ="writePotentialHDF")
END SELECT
groupName = TRIM(ADJUSTL(archiveName))//TRIM(ADJUSTL(potentialTypeName))
IF(l_exist) THEN
CALL h5gopen_f(fileID, TRIM(ADJUSTL(archiveName)), archiveID, hdfError)
CALL io_write_attint0(archiveID,'starsIndex',starsIndex)
CALL io_write_attint0(archiveID,'latharmsIndex',latharmsIndex)
CALL io_write_attint0(archiveID,'structureIndex',structureIndex)
CALL io_write_attint0(archiveID,'spins',input%jspins)
CALL io_write_attint0(archiveID,'iter',iter)
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
IF(l_exist) THEN
CALL h5gopen_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
dimsInt(:4)=(/jmtd,nlhd+1,ntype,input%jspins/)
CALL h5dopen_f(groupID, 'fr', frSetID, hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL h5dclose_f(frSetID, hdfError)
dimsInt(:3)=(/2,ng3,input%jspins/)
CALL h5dopen_f(groupID, 'fpw', fpwSetID, hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),fpw)
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
dimsInt(:3)=(/nmzd,2,input%jspins/)
CALL h5dopen_f(groupID, 'fz', fzSetID, hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL h5dclose_f(fzSetID, hdfError)
dimsInt(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
CALL h5dopen_f(groupID, 'fzxy', fzxySetID, hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL h5dclose_f(fzxySetID, hdfError)
END IF
CALL h5gclose_f(groupID, hdfError)
ELSE
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
dims(:4)=(/jmtd,nlhd+1,ntype,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(4,dims(:4),frSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fr", H5T_NATIVE_DOUBLE, frSpaceID, frSetID, hdfError)
CALL h5sclose_f(frSpaceID,hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL h5dclose_f(frSetID, hdfError)
dims(:3)=(/2,ng3,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),fpwSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fpw", H5T_NATIVE_DOUBLE, fpwSpaceID, fpwSetID, hdfError)
CALL h5sclose_f(fpwSpaceID,hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),fpw)
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
dims(:3)=(/nmzd,2,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL h5dclose_f(fzxySetID, hdfError)
END IF
CALL h5gclose_f(groupID, hdfError)
END IF
CALL h5gclose_f(archiveID, hdfError)
ELSE
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(archiveName)), archiveID, hdfError)
CALL io_write_attint0(archiveID,'starsIndex',starsIndex)
CALL io_write_attint0(archiveID,'latharmsIndex',latharmsIndex)
CALL io_write_attint0(archiveID,'structureIndex',structureIndex)
CALL io_write_attint0(archiveID,'spins',input%jspins)
CALL io_write_attint0(archiveID,'iter',iter)
CALL h5gcreate_f(fileID, TRIM(ADJUSTL(groupName)), groupID, hdfError)
dims(:4)=(/jmtd,nlhd+1,ntype,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(4,dims(:4),frSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fr", H5T_NATIVE_DOUBLE, frSpaceID, frSetID, hdfError)
CALL h5sclose_f(frSpaceID,hdfError)
CALL io_write_real4(frSetID,(/1,1,1,1/),dimsInt(:4),fr)
CALL h5dclose_f(frSetID, hdfError)
dims(:3)=(/2,ng3,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),fpwSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fpw", H5T_NATIVE_DOUBLE, fpwSpaceID, fpwSetID, hdfError)
CALL h5sclose_f(fpwSpaceID,hdfError)
CALL io_write_complex2(fpwSetID,(/-1,1,1/),dimsInt(:3),fpw)
CALL h5dclose_f(fpwSetID, hdfError)
IF (l_film) THEN
dims(:3)=(/nmzd,2,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(3,dims(:3),fzSpaceID,hdfError)
CALL h5dcreate_f(groupID, "fz", H5T_NATIVE_DOUBLE, fzSpaceID, fzSetID, hdfError)
CALL h5sclose_f(fzSpaceID,hdfError)
CALL io_write_real3(fzSetID,(/1,1,1/),dimsInt(:3),fz)
CALL h5dclose_f(fzSetID, hdfError)
dims(:5)=(/2,nmzxyd,ng2-1,2,input%jspins/)
dimsInt = dims
CALL h5screate_simple_f(5,dims(:5),fzxySpaceID,hdfError)
CALL h5dcreate_f(groupID, "fzxy", H5T_NATIVE_DOUBLE, fzxySpaceID, fzxySetID, hdfError)
CALL h5sclose_f(fzxySpaceID,hdfError)
CALL io_write_complex4(fzxySetID,(/-1,1,1,1,1/),dimsInt(:5),fzxy)
CALL h5dclose_f(fzxySetID, hdfError)
END IF
CALL h5gclose_f(groupID, hdfError)
CALL h5gclose_f(archiveID, hdfError)
END IF
END SUBROUTINE writePotentialHDF
SUBROUTINE readDensityHDF(fileID, archiveName, densityType,&
fermiEnergy,l_qfix,iter,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
......@@ -1411,13 +1685,13 @@ MODULE m_cdnpot_io_hdf
CASE(DENSITY_TYPE_PRECOND_const)
densityTypeName = '/precond'
CASE DEFAULT
CALL juDFT_error("Unknown density type selected",calledby ="writeDensityHDF")
CALL juDFT_error("Unknown density type selected",calledby ="readDensityHDF")
END SELECT
groupName = TRIM(ADJUSTL(archiveName))//TRIM(ADJUSTL(densityTypeName))
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
IF(.NOT.l_exist) THEN
CALL juDFT_error('density entry '//TRIM(ADJUSTL(groupName))//' does not exist.' ,calledby ="readDensityHDF")
CALL juDFT_error('Density entry '//TRIM(ADJUSTL(groupName))//' does not exist.' ,calledby ="readDensityHDF")
END IF
CALL h5gopen_f(fileID, TRIM(ADJUSTL(archiveName)), archiveID, hdfError)
......@@ -1517,6 +1791,129 @@ MODULE m_cdnpot_io_hdf
END SUBROUTINE readDensityHDF
SUBROUTINE readPotentialHDF(fileID, archiveName, potentialType,&