Commit 21904ba4 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of fleur-git:fleur into develop

parents 060d063d 8ad5c13b
......@@ -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!'
......
This diff is collapsed.
......@@ -18,6 +18,10 @@ MODULE m_pot_io
USE m_juDFT
USE m_loddop
USE m_wrtdop
USE m_cdnpot_io_hdf
#ifdef CPP_HDF
USE hdf5
#endif
IMPLICIT NONE
PRIVATE
......@@ -58,19 +62,57 @@ MODULE m_pot_io
LOGICAL :: l_exist
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)
IF(mode.EQ.POT_HDF5_MODE) THEN
#ifdef CPP_HDF
INQUIRE(FILE='pot.hdf',EXIST=l_exist)
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
WRITE(*,*) 'pot.hdf file not found.'
WRITE(*,*) 'Potential entry or pot.hdf file not found.'
WRITE(*,*) 'Falling back to stream access file pot.str.'
mode = POT_STREAM_MODE
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
IF(mode.EQ.POT_STREAM_MODE) THEN
......@@ -114,15 +156,17 @@ MODULE m_pot_io
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)
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER, INTENT (IN) :: iter
INTEGER, INTENT (IN) :: archiveType
......@@ -133,14 +177,64 @@ MODULE m_pot_io
! local variables
INTEGER :: mode, iUnit
LOGICAL :: l_exist
LOGICAL :: l_exist, l_storeIndices
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)
IF(mode.EQ.POT_HDF5_MODE) THEN
! Write potential to pot.hdf file
STOP 'POT_HDF5_MODE not yet implemented!'
#ifdef CPP_HDF
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
! Write potential to pot.str file
STOP 'POT_STREAM_MODE not yet implemented!'
......@@ -170,8 +264,15 @@ MODULE m_pot_io
INTEGER, INTENT(OUT) :: mode
mode = POT_DIRECT_MODE
IF (juDFT_was_argument("-stream_pot")) mode=POT_STREAM_MODE
IF (juDFT_was_argument("-hdf_pot")) mode=POT_HDF5_MODE
IF (juDFT_was_argument("-stream_cdn")) mode=POT_STREAM_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 MODULE m_pot_io
......@@ -288,6 +288,9 @@
input%total = .TRUE.
ENDIF!(obsolete%pot8)
ENDIF !mpi%irank.eq.0
#ifdef CPP_MPI
CALL MPI_BCAST(input%total,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
#endif
!--- J<
IF(jij%l_jenerg) GOTO 234
......
......@@ -105,6 +105,10 @@ CONTAINS
!.....energy density
REAL, ALLOCATABLE :: excz(:,:),excr(:,:,:)
#ifdef CPP_MPI
include 'mpif.h'
integer:: ierr
#endif
!
! if you want to calculate potential gradients
!
......@@ -395,7 +399,6 @@ CONTAINS
ENDIF
END IF
!ENDIF !irank==0
!
!==========END TOTAL===================================================
!
......@@ -417,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
! used otherwise anyway.
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)
DO js = 1,input%jspins
DO i = 1,stars%ng3
......@@ -431,6 +434,7 @@ CONTAINS
11, iter,vr,vpw,vz,vxy)
CLOSE(11)
END IF
ENDIF !irank==0
! ******** exchange correlation potential******************
!+ta
......@@ -448,6 +452,7 @@ CONTAINS
excr(:,:,:) = 0.0
! ---> vacuum region
IF (mpi%irank == 0) THEN
IF (input%film) THEN
CALL timestart("Vxc in vacuum")
......@@ -574,15 +579,24 @@ CONTAINS
WRITE (6,FMT=8040) (vbar(js),js=1,input%jspins)
WRITE (16,FMT=8040) (vbar(js),js=1,input%jspins)
8040 FORMAT (/,5x,'interstitial potential average (vbar) =',2f10.6)
ENDIF !irank==0
!
! ------------------------------------------
! ----> muffin tin spheres region
CALL timestart ("Vxc in MT")
#ifdef CPP_MPI
CALL MPI_BCAST(atoms%vr0,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%efield%vslope,1,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(rho,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(vr,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(rhmn,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(ichsmrg,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
#endif
IF ((xcpot%igrd.EQ.0).AND.(xcpot%icorr.NE.-1)) THEN
CALL vmtxc(dimension,sphhar,atoms, rho,xcpot,input,sym, vr, excr,vxr)
ELSEIF ((xcpot%igrd.GT.0).OR.(xcpot%icorr.EQ.-1)) THEN
CALL vmtxcg(dimension,sphhar,atoms, rho,xcpot,input,sym,&
CALL vmtxcg(dimension,mpi,sphhar,atoms, rho,xcpot,input,sym,&
obsolete, vxr,vr,rhmn,ichsmrg, excr)
ELSE
CALL juDFT_error("something wrong with xcpot before vmtxc" ,calledby ="vgen")
......@@ -593,6 +607,7 @@ CONTAINS
! add MT EXX potential to vr
!
IF (mpi%irank == 0) THEN
INQUIRE(file='vr_exx',exist=exi)
IF( exi ) THEN
ALLOCATE( vr_exx(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd) )
......@@ -836,7 +851,7 @@ CONTAINS
vpw_w(i,js)=vpw_w(i,js)/stars%nstr(i)
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)
DO js=1,input%jspins
......@@ -845,7 +860,7 @@ CONTAINS
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,vxpw_w,vz,vxy)
END IF
......
......@@ -40,7 +40,7 @@ CONTAINS
INTEGER n
REAL rdum
! .. Local Arrays ..
INTEGER i(36),ierr(3)
INTEGER i(37),ierr(3)
REAL r(29)
LOGICAL l(43)
! ..
......@@ -52,10 +52,10 @@ CONTAINS
i(7)=stars%ng2 ; i(8)=stars%ng3 ; i(9)=vacuum%nmz ; i(10)=vacuum%nmzxy ; i(11)=obsolete%lepr
i(12)=input%jspins ; i(13)=vacuum%nvac ; i(14)=input%itmax ; i(15)=sliceplot%kk ; i(16)=vacuum%layers
i(17)=sliceplot%nnne ; i(18)=banddos%ndir ; i(19)=stars%mx1 ; i(20)=stars%mx2 ; i(21)=stars%mx3
i(22)=atoms%n_u ; i(23) = sym%nop2 ; i(24) = sym%nsymt ; i(25) = xcpot%icorr
i(26)=vacuum%nstars ; i(27)=vacuum%nstm ; i(28)=oneD%odd%nq2 ; i(29)=oneD%odd%nop
i(30)=input%gw ; i(31)=input%gw_neigd ; i(32)=hybrid%ewaldlambda ; i(33)=hybrid%lexp
i(34)=hybrid%bands1 ; i(35)=hybrid%bands2 ; i(36)=input%imix
i(22)=atoms%n_u ; i(23) = sym%nop2 ; i(24) = sym%nsymt ; i(25) = xcpot%icorr ; i(26) = xcpot%igrd
i(27)=vacuum%nstars ; i(28)=vacuum%nstm ; i(29)=oneD%odd%nq2 ; i(30)=oneD%odd%nop
i(31)=input%gw ; i(32)=input%gw_neigd ; i(33)=hybrid%ewaldlambda ; i(34)=hybrid%lexp
i(35)=hybrid%bands1 ; i(36)=hybrid%bands2 ; i(37)=input%imix
r(1)=cell%omtil ; r(2)=cell%area ; r(3)=vacuum%delz ; r(4)=cell%z1 ; r(5)=input%alpha
r(6)=sliceplot%e1s ; r(7)=sliceplot%e2s ; r(8)=noco%theta ; r(9)=noco%phi ; r(10)=vacuum%tworkf
r(11)=vacuum%locx(1) ; r(12)=vacuum%locx(2); r(13)=vacuum%locy(1) ; r(14)=vacuum%locy(2)
......@@ -77,10 +77,10 @@ CONTAINS
ENDIF
!
CALL MPI_BCAST(i,SIZE(i),MPI_INTEGER,0,mpi%mpi_comm,ierr)
hybrid%bands1=i(34) ; hybrid%bands2=i(35) ; input%imix=i(36)
input%gw=i(30) ; input%gw_neigd=i(31) ; hybrid%ewaldlambda=i(32) ; hybrid%lexp=i(33)
vacuum%nstars=i(26) ; vacuum%nstm=i(27) ; oneD%odd%nq2=i(28) ; oneD%odd%nop=i(29)
atoms%n_u=i(22) ; sym%nop2=i(23) ; sym%nsymt = i(24) ; xcpot%icorr=i(25)
hybrid%bands1=i(35) ; hybrid%bands2=i(36) ; input%imix=i(37)
input%gw=i(31) ; input%gw_neigd=i(32) ; hybrid%ewaldlambda=i(33) ; hybrid%lexp=i(34)
vacuum%nstars=i(27) ; vacuum%nstm=i(28) ; oneD%odd%nq2=i(29) ; oneD%odd%nop=i(30)
atoms%n_u=i(22) ; sym%nop2=i(23) ; sym%nsymt = i(24) ; xcpot%icorr=i(25) ; xcpot%igrd=i(26)
sliceplot%nnne=i(17) ; banddos%ndir=i(18) ; stars%mx1=i(19) ; stars%mx2=i(20) ; stars%mx3=i(21)
input%jspins=i(12) ; vacuum%nvac=i(13) ; input%itmax=i(14) ; sliceplot%kk=i(15) ; vacuum%layers=i(16)
stars%ng2=i(7) ; stars%ng3=i(8) ; vacuum%nmz=i(9) ; vacuum%nmzxy=i(10) ; obsolete%lepr=i(11)
......
......@@ -10,6 +10,6 @@ jt::testrun($executable,$workdir);
#now test output
$result=jt::test_fileexists("$workdir/band.1");
$result=jt::test_fileexists("$workdir/DOS.1");
$result+=jt::test_grepnumber("$workdir/DOS.1","9.40276","9.40276 (.....)",0.290,0.0001);
$result+=jt::test_grepnumber("$workdir/DOS.1","9.40670","9.40670 (.....)",0.290,0.0001);
jt::stageresult($workdir,$result,"2");
......@@ -8,6 +8,6 @@ jt::testrun("$executable -xmlInput",$workdir);
#now test output
$result=jt::test_fileexists("$workdir/band.1");
$result=jt::test_fileexists("$workdir/DOS.1");
$result+=jt::test_grepnumber("$workdir/DOS.1","9.40276","9.40276 (.....)",0.290,0.0001);
$result+=jt::test_grepnumber("$workdir/DOS.1","9.40670","9.40670 (.....)",0.290,0.0001);
jt::stageresult($workdir,$result,"1");
......@@ -9,6 +9,6 @@ jt::testrun($executable,$workdir);
#now test output
$result=jt::test_fileexists("$workdir/DOS.1");
$result+=jt::test_grepnumber("$workdir/DOS.1","10.88235","10.88235 (.....)",0.105,0.0001);
$result+=jt::test_grepnumber("$workdir/DOS.1","10.88690","10.88690 (.....)",0.105,0.0001);
jt::stageresult($workdir,$result,"2");
......@@ -7,6 +7,6 @@ jt::testrun("$executable -xmlInput",$workdir);
#now test output
$result=jt::test_fileexists("$workdir/DOS.1");
$result+=jt::test_grepnumber("$workdir/DOS.1","10.88486","10.88486 (.....)",0.105,0.0001);
$result+=jt::test_grepnumber("$workdir/DOS.1","10.88842","10.88842 (.....)",0.107,0.0001);
jt::stageresult($workdir,$result,"1");
This diff is collapsed.
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