Commit dfb2193a authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'vgen-refactor' into 'develop'

Vgen refactoring finished

See merge request fleur/fleur!2
parents fe834ea8 ff31ed59
......@@ -58,9 +58,10 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms!in u_setup n_u might be modified
TYPE(t_potden),INTENT(IN) :: inden
TYPE(t_potden),INTENT(INOUT) :: v,vx
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: inden,vx
TYPE(t_potden),INTENT(INOUT) :: v !u_setup will modify the potential matrix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_constants
IMPLICIT NONE
INTEGER, PARAMETER :: noState_const = 0
INTEGER, PARAMETER :: coreState_const = 1
INTEGER, PARAMETER :: valenceState_const = 2
REAL, PARAMETER :: pi_const=3.1415926535897932
REAL, PARAMETER :: tpi_const=2.*3.1415926535897932
REAL, PARAMETER :: fpi_const=4.*3.1415926535897932
REAL, PARAMETER :: sfp_const=sqrt(4.*3.1415926535897932)
REAL, PARAMETER :: hartree_to_ev_const=27.21138602 ! value from 2014 CODATA recommended values. Uncertainty is 0.00000017
REAL, PARAMETER :: eVac0Default_const = -0.25
CHARACTER(len=9), PARAMETER :: version_const = 'fleur 27'
CHARACTER(2),DIMENSION(0:103),PARAMETER :: namat_const=(/
& 'va',' H','He','Li','Be',' B',' C',' N',' O',' F','Ne',
& 'Na','Mg','Al','Si',' P',' S','Cl','Ar',' K','Ca','Sc','Ti',
& ' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se',
& 'Br','Kr','Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd',
& 'Ag','Cd','In','Sn','Sb','Te',' I','Xe','Cs','Ba','La','Ce',
& 'Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',
& 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb',
& 'Bi','Po','At','Rn','Fr','Ra','Ac','Th','Pa',' U','Np','Pu',
& 'Am','Cm','Bk','Cf','Es','Fm','Md','No','Lw'/)
CHARACTER(7),DIMENSION(29),PARAMETER :: coreStateList_const=(/
+ '(1s1/2)','(2s1/2)','(2p1/2)','(2p3/2)','(3s1/2)',
+ '(3p1/2)','(3p3/2)','(4s1/2)','(3d3/2)','(3d5/2)',
+ '(4p1/2)','(4p3/2)','(5s1/2)','(4d3/2)','(4d5/2)',
+ '(5p1/2)','(5p3/2)','(6s1/2)','(4f5/2)','(4f7/2)',
+ '(5d3/2)','(5d5/2)','(6p1/2)','(6p3/2)','(7s1/2)',
+ '(5f5/2)','(5f7/2)','(6d3/2)','(6d5/2)' /)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNumElecsList_const=(/ ! This is the number of electrons per spin
+ 1, 1, 1, 2, 1, 1, 2, 1, 2, 3, 1, 2, 1, 2,
+ 3, 1, 2, 1, 3, 4, 2, 3, 1, 2, 1, 3, 4, 2, 3/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateNprncList_const=(/
+ 1, 2, 2, 2, 3, 3, 3, 4, 3, 3, 4, 4, 5, 4, 4,
+ 5, 5, 6, 4, 4, 5, 5, 6, 6, 7, 5, 5, 6, 6/)
INTEGER,DIMENSION(29),PARAMETER :: coreStateKappaList_const=(/
+ -1,-1, 1,-2,-1, 1,-2,-1, 2,-3, 1,-2,-1, 2,-3,
+ 1,-2,-1, 3,-4, 2,-3, 1,-2,-1, 3,-4, 2,-3/)
CHARACTER(4),DIMENSION(6),PARAMETER :: nobleGasConfigList_const=(/
+ '[He]','[Ne]','[Ar]','[Kr]','[Xe]','[Rn]'/)
INTEGER,DIMENSION(6),PARAMETER :: nobleGasNumStatesList_const=(/
+ 1, 4, 7, 12, 17, 24/)
CONTAINS
!------------------------------------------------------------------------
REAL PURE FUNCTION pimach()
!
! This subprogram supplies the value of the constant PI correct to
! machine precision where
!
! PI=3.1415926535897932384626433832795028841971693993751058209749446
!
pimach = 3.1415926535897932
END FUNCTION pimach
!------------------------------------------------------------------------
REAL ELEMENTAL FUNCTION c_light(fac)
!
! This subprogram supplies the value of c according to
! NIST standard 13.1.99
! Hartree and Rydbergs changed by fac = 1.0 or 2.0
!
REAL, INTENT (IN) :: fac
c_light = 137.0359895e0 * fac
RETURN
END FUNCTION c_light
END MODULE m_constants
......@@ -55,7 +55,7 @@ CONTAINS
!The total nucleii charge
zc=SUM(atoms%neq(:)*atoms%zatom(:))
zc = zc + 2*input%efield%sigma
zc = zc + 2*input%sigma
IF (fixtotal) THEN
!-roa
......
......@@ -3,9 +3,9 @@
USE m_constants
IMPLICIT NONE
PRIVATE
PUBLIC :: efield
PUBLIC :: e_field
CONTAINS
SUBROUTINE efield(atoms, dimension, stars, sym, vacuum, cell, input)
SUBROUTINE e_field(atoms, DIMENSION, stars, sym, vacuum, cell, input,efield)
!
!*********************************************************************
! sets the values of the sheets of charge for external electric
......@@ -28,7 +28,8 @@
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_input),INTENT(INOUT) :: input
TYPE(t_input),INTENT(IN) :: input
TYPE(t_efield),INTENT(INOUT) :: efield
! ..
! ..
! .. Local Scalars ..
......@@ -74,7 +75,7 @@
WRITE (6, '(3x,a,f12.5)') 'total electronic charge =', qe
WRITE (6, '(3x,a,f12.5)') 'total nuclear charge =', qn
CALL read_efield (input%efield, stars%mx1, stars%mx2, vacuum%nvac, cell%area)
CALL read_efield (efield, stars%mx1, stars%mx2, vacuum%nvac, cell%area)
! Sign convention of electric field: E>0 repels electrons,
! consistent with conventional choice that current is
......@@ -83,13 +84,13 @@
! In case of Dirichlet boundary conditions, we ignore the
! value of "sigma" and take the surplus charge into account
! in vvac.
if (input%efield%autocomp .or. input%efield%dirichlet) input%efield%sigma = 0.5*(qe-qn)
if (efield%autocomp .or. efield%dirichlet) efield%sigma = 0.5*(qe-qn)
CALL print_efield (6, input%efield, cell%area, vacuum%nvac, cell%amat,vacuum%dvac)
CALL print_efield (6, efield, cell%area, vacuum%nvac, cell%amat,vacuum%dvac)
IF (.NOT. input%efield%dirichlet&
& .AND. ABS (SUM (input%efield%sig_b) + 2*input%efield%sigma - (qe-qn)) > eps) THEN
IF (ABS (SUM (input%efield%sig_b) - (qe-qn)) < eps) THEN
IF (.NOT. efield%dirichlet&
& .AND. ABS (SUM (efield%sig_b) + 2*efield%sigma - (qe-qn)) > eps) THEN
IF (ABS (SUM (efield%sig_b) - (qe-qn)) < eps) THEN
CALL juDFT_error&
& ("E field: top+bottom+film charge does not add up to "&
& //"zero.",&
......@@ -104,29 +105,29 @@
& ,calledby ="efield")
ENDIF
IF (ABS (input%efield%sigma) > 0.49 .OR. ANY (ABS (input%efield%sig_b) > 0.49)) THEN
IF (ABS (efield%sigma) > 0.49 .OR. ANY (ABS (efield%sig_b) > 0.49)) THEN
WRITE ( 6,*) 'If you really want to calculate an e-field this'
WRITE ( 6,*) 'big, uncomment STOP in efield.f !'
CALL juDFT_error("E-field too big or No. of e- not correct"&
& ,calledby ="efield")
ENDIF
IF (input%efield%l_segmented) THEN
IF (efield%l_segmented) THEN
CALL V_seg_EF(&
& input,&
& efield,&
& vacuum, stars)
IF (input%efield%plot_rho)&
IF (efield%plot_rho)&
& CALL print_rhoEF(&
& input%efield, stars%mx1, stars%mx2, vacuum%nvac, stars%ng2, sym%nop, sym%nop2,&
& efield, stars%mx1, stars%mx2, vacuum%nvac, stars%ng2, sym%nop, sym%nop2,&
& stars%ng2, stars%kv2, sym%mrot, sym%symor, sym%tau, sym%invtab,&
& cell%area, stars%nstr2, cell%amat)
END IF
IF (ALLOCATED (input%efield%sigEF)) DEALLOCATE (input%efield%sigEF)
IF (ALLOCATED (efield%sigEF)) DEALLOCATE (efield%sigEF)
IF (input%efield%dirichlet .AND. ALLOCATED (input%efield%rhoEF))&
& call set_dirchlet_coeff (input%efield, vacuum%dvac, stars%ng2, stars%sk2, vacuum%nvac)
IF (efield%dirichlet .AND. ALLOCATED (efield%rhoEF))&
& call set_dirchlet_coeff (efield, vacuum%dvac, stars%ng2, stars%sk2, vacuum%nvac)
CONTAINS
......@@ -797,13 +798,12 @@
END SUBROUTINE print_efield
SUBROUTINE V_seg_EF(&
& input,&
& vacuum, stars&
& )
& efield,&
& vacuum, stars)
USE m_fft2d
use m_types
! Dummy variables:
TYPE(t_input), INTENT(INOUT) :: input
TYPE(t_efield), INTENT(INOUT) :: efield
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_stars), INTENT(IN) :: stars
......@@ -812,17 +812,17 @@
REAL :: fg, fgi
REAL :: rhoRS(3*stars%mx1,3*stars%mx2), rhoRSimag(3*stars%mx1,3*stars%mx2) ! Real space density
ALLOCATE (input%efield%rhoEF (stars%ng2-1, vacuum%nvac))
ALLOCATE (efield%rhoEF (stars%ng2-1, vacuum%nvac))
DO ivac = 1, vacuum%nvac
rhoRSimag = 0.0 ! Required in the loop. fft2d overrides this
! The fft2d algorithm puts the normalization to the isn=-1
! (r->k) transformation, thus we need to multiply by
! ifft2 = 3*k1d*3*k2d to compensate.
IF (input%efield%dirichlet) THEN
rhoRS(:,:) = input%efield%sigEF(:,:,ivac)
IF (efield%dirichlet) THEN
rhoRS(:,:) = efield%sigEF(:,:,ivac)
ELSE
rhoRS(:,:) = input%efield%sigEF(:,:,ivac)*(3*stars%mx1*3*stars%mx2)
rhoRS(:,:) = efield%sigEF(:,:,ivac)*(3*stars%mx1*3*stars%mx2)
END IF
! FFT rhoRS(r_2d) -> rhoEF(g_2d)
......@@ -830,16 +830,16 @@
& stars,&
& rhoRS, rhoRSimag,&
& fg, fgi,&
& input%efield%rhoEF(:,ivac), 1, -1)
& efield%rhoEF(:,ivac), 1, -1)
! FFT gives the the average charge per grid point
! while sig_b stores the (total) charge per sheet
IF (input%efield%dirichlet .and. ABS (fg) > 1.0e-15) THEN
IF (efield%dirichlet .and. ABS (fg) > 1.0e-15) THEN
PRINT *, 'INFO: Difference of average potential: fg=',&
& fg,', sig_b=', input%efield%sig_b(ivac),&
& fg,', sig_b=', efield%sig_b(ivac),&
& ", ivac=", ivac
ELSE IF (ABS (fg/(3*stars%mx1*3*stars%mx2)) > 1.0e-15) THEN
PRINT *, 'INFO: Difference of average potential: fg=',&
& fg/(3*stars%mx1*3*stars%mx2),', sig_b=', input%efield%sig_b(ivac),&
& fg/(3*stars%mx1*3*stars%mx2),', sig_b=', efield%sig_b(ivac),&
& ", ivac=", ivac
END IF
END DO ! ivac
......@@ -928,7 +928,7 @@
CLOSE (754)
END DO ! ivac
END SUBROUTINE print_rhoEF
END SUBROUTINE efield
END SUBROUTINE e_field
SUBROUTINE read_namelist (iou, E, eV)
USE m_types, only: t_efield
......@@ -978,4 +978,4 @@
END IF
END do
END FUNCTION lower_case
END MODULE m_efield
END MODULE m_efield
......@@ -112,8 +112,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
ALLOCATE(atoms%numStatesProvided(atoms%ntype))
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
ALLOCATE(atoms%vr0(atoms%ntype)) ! This should actually not be in the atoms type!
ALLOCATE(atoms%ncv(atoms%ntype))
ALLOCATE(atoms%ngopr(atoms%nat))
ALLOCATE(atoms%lapw_l(atoms%ntype))
......@@ -195,7 +194,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
atoms%icorr = -99
oneD%odd%nq2 = oneD%odd%n2d
atoms%vr0(:) = 0.0
stars%sk2(:) = 0.0
stars%phi2(:) = 0.0
END IF
......
......@@ -73,7 +73,6 @@ CONTAINS
CALL dimens(mpi,input,sym,stars,atoms,sphhar,DIMENSION,vacuum,&
obsolete,kpts,oneD,hybrid)
DIMENSION%nn2d= (2*stars%mx1+1)* (2*stars%mx2+1)
DIMENSION%nn3d= (2*stars%mx1+1)* (2*stars%mx2+1)* (2*stars%mx3+1)
!-odim
......@@ -110,7 +109,7 @@ CONTAINS
ALLOCATE ( kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt) )
ALLOCATE ( stars%pgfft(0:DIMENSION%nn3d-1),stars%pgfft2(0:DIMENSION%nn2d-1) )
ALLOCATE ( stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1) )
ALLOCATE ( atoms%bmu(atoms%ntype),atoms%vr0(atoms%ntype) )
ALLOCATE ( atoms%bmu(atoms%ntype) )
ALLOCATE ( atoms%l_geo(atoms%ntype) )
ALLOCATE ( atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype) )
ALLOCATE ( atoms%lo1l(0:atoms%llod,atoms%ntype),atoms%nlol(0:atoms%llod,atoms%ntype),atoms%lapw_l(atoms%ntype) )
......@@ -137,7 +136,7 @@ CONTAINS
input%l_coreSpec = .FALSE.
atoms%vr0(:) = 0.0
IF(.NOT.juDFT_was_argument("-toXML")) THEN
PRINT *,"--------------WARNING----------------------"
......
......@@ -185,7 +185,7 @@
!
!---> set up electric field parameters (if needed)
!
CALL efield(atoms, DIMENSION, stars, sym, vacuum, cell, input)
! CALL e_field(atoms, DIMENSION, stars, sym, vacuum, cell, input,field)
ENDIF
ENDIF
......
......@@ -8,7 +8,7 @@ MODULE m_postprocessInput
CONTAINS
SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts,&
oneD,hybrid,cell,banddos,sliceplot,xcpot,forcetheo,&
noco,DIMENSION,enpara,sphhar,l_opti,noel,l_kpts)
......@@ -62,6 +62,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
TYPE(t_dimension),INTENT(INOUT) :: dimension
TYPE(t_enpara) ,INTENT(INOUT) :: enpara
TYPE(t_sphhar) ,INTENT (OUT) :: sphhar
TYPE(t_field), INTENT(INOUT) :: field
LOGICAL, INTENT (OUT) :: l_opti
LOGICAL, INTENT (IN) :: l_kpts
CHARACTER(len=3), ALLOCATABLE, INTENT(IN) :: noel(:)
......@@ -275,8 +276,6 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
dimension%msh = 0
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype))
ALLOCATE(atoms%vr0(atoms%ntype)) ! This should actually not be in the atoms type!
atoms%vr0(:) = 0.0
na = 0
DO iType = 1, atoms%ntype
l_vca = .FALSE.
......@@ -557,7 +556,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
CALL stepf(sym,stars,atoms,oneD,input,cell,vacuum,mpi)
IF (mpi%irank.EQ.0) THEN
CALL convn(DIMENSION,atoms,stars)
CALL efield(atoms,DIMENSION,stars,sym,vacuum,cell,input)
CALL e_field(atoms,DIMENSION,stars,sym,vacuum,cell,input,field%efield)
END IF !(mpi%irank.EQ.0)
END IF
......
......@@ -142,7 +142,7 @@
input%vchk = .false. ; input%cdinf = .false.
input%l_bmt= .false. ; input%eonly = .false.
input%gauss= .false. ; input%tria = .false.
sliceplot%slice= .false. ; obsolete%disp = .false. ; input%swsp = .false.
sliceplot%slice= .false. ; input%swsp = .false.
input%lflip= .false. ; banddos%vacdos= .false. ; input%integ = .false.
sliceplot%iplot= .false. ; input%score = .false. ; sliceplot%plpot = .false.
input%pallst = .false. ; obsolete%lwb = .false. ; vacuum%starcoeff = .false.
......
......@@ -639,22 +639,22 @@ SUBROUTINE r_inpXML(&
numberNodes = xmlGetNumberOfNodes(xPathA)
IF (numberNodes.EQ.1) THEN
input%efield%zsigma = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@zsigma'))
input%efield%sig_b(1) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@sig_b_1'))
input%efield%sig_b(2) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@sig_b_2'))
input%efield%plot_charge = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@plot_charge'))
input%efield%plot_rho = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@plot_rho'))
input%efield%autocomp = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@autocomp'))
input%efield%dirichlet = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@dirichlet'))
l_eV = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@eV'))
!input%efield%zsigma = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@zsigma'))
!input%efield%sig_b(1) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@sig_b_1'))
!input%efield%sig_b(2) = evaluateFirstOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@sig_b_2'))
!input%efield%plot_charge = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@plot_charge'))
!input%efield%plot_rho = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@plot_rho'))
!input%efield%autocomp = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@autocomp'))
!input%efield%dirichlet = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@dirichlet'))
!l_eV = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@eV'))
STOP 'Error: Reading input for E-Fields not yet implemented completely!'
! ALLOCATE(input%efield%sigEF(3*k1d, 3*k2d, nvac))
! input%efield%sigEF = 0.0
IF (l_eV) THEN
input%efield%sig_b(:) = input%efield%sig_b/hartree_to_ev_const
!IF (l_eV) THEN
! input%efield%sig_b(:) = input%efield%sig_b/hartree_to_ev_const
! input%efield%sigEF(:,:,:) = input%efield%sigEF/hartree_to_ev_const
END IF
!END IF
END IF
! Read in optional energy parameter limits
......@@ -1710,7 +1710,6 @@ SUBROUTINE r_inpXML(&
input%vchk = .FALSE.
input%cdinf = .FALSE.
obsolete%disp = .FALSE.
sliceplot%iplot = .FALSE.
input%score = .FALSE.
......@@ -1741,7 +1740,7 @@ SUBROUTINE r_inpXML(&
IF (numberNodes.EQ.1) THEN
input%vchk = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@vchk'))
input%cdinf = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@cdinf'))
obsolete%disp = evaluateFirstBoolOnly(xmlGetAttributeValue(TRIM(ADJUSTL(xPathA))//'/@disp'))
END IF
! Read in optional plotting parameters
......
......@@ -547,12 +547,13 @@
!!$ ENDIF
READ (UNIT=5,FMT=8050,END=99,ERR=99)&
& input%frcor,sliceplot%slice,input%ctail,obsolete%disp,input%kcrel
& input%frcor,sliceplot%slice,input%ctail
input%coretail_lmax=99
input%kcrel=.false.
BACKSPACE(5)
READ (UNIT=5,fmt='(A)') line
input%l_bmt= ( line(52:56)=='bmt=T' ).or.( line(52:56)=='bmt=t' )
WRITE (6,9170) input%frcor,sliceplot%slice,input%ctail,obsolete%disp,input%kcrel
WRITE (6,9170) input%frcor,sliceplot%slice,input%ctail
8050 FORMAT (6x,l1,7x,l1,7x,l1,6x,l1,7x,i1,5x,l1,5x,l1)
! check if itmax consists of 2 or 3 digits
......@@ -895,9 +896,8 @@
WRITE (5,fmt='(f10.5,1x,A)') input%rkmax, '=kmax'
WRITE (5,9160) input%gauss,input%delgau,input%tria
9160 FORMAT ('gauss=',l1,f10.5,'tria=',l1)
WRITE (5,9170) input%frcor,sliceplot%slice,input%ctail,obsolete%disp,input%kcrel
9170 FORMAT ('frcor=',l1,',slice=',l1,',ctail=',l1,',disp=',&
& l1,',kcrel=',i1,',u2f=',l1,',f2u=',l1,',bmt=',l1)
WRITE (5,9170) input%frcor,sliceplot%slice,input%ctail
9170 FORMAT ('frcor=',l1,',slice=',l1,',ctail=',l1)
WRITE (5,9180) input%itmax,input%maxiter,input%imix,input%alpha,input%spinf
9180 FORMAT ('itmax=',i3,',maxiter=',i3,',imix=',i2,',alpha=',&
& f6.2,',spinf=',f6.2)
......
......@@ -629,8 +629,8 @@ SUBROUTINE w_inpXML(&
WRITE (fileNum,368) banddos%dos,band,banddos%vacdos,sliceplot%slice
! <checks vchk="F" cdinf="F" disp="F"/>
370 FORMAT(' <checks vchk="',l1,'" cdinf="',l1,'" disp="',l1,'"/>')
WRITE (fileNum,370) input%vchk,input%cdinf,obsolete%disp
370 FORMAT(' <checks vchk="',l1,'" cdinf="',l1,'"/>')
WRITE (fileNum,370) input%vchk,input%cdinf
! <densityOfStates ndir="0" minEnergy="-0.50000" maxEnergy="0.50000" sigma="0.01500"/>
380 FORMAT(' <densityOfStates ndir="',i0,'" minEnergy="',f0.8,'" maxEnergy="',f0.8,'" sigma="',f0.8,'"/>')
......
......@@ -45,7 +45,6 @@ CONTAINS
USE m_broyd_io
USE m_qfix
USE m_vgen
USE m_rhodirgen
USE m_writexcstuff
USE m_vmatgen
USE m_eigen
......@@ -76,6 +75,7 @@ CONTAINS
! Types, these variables contain a lot of data!
TYPE(t_input) :: input
TYPE(t_field) :: field
TYPE(t_dimension):: DIMENSION
TYPE(t_atoms) :: atoms
TYPE(t_sphhar) :: sphhar
......@@ -97,13 +97,13 @@ CONTAINS
TYPE(t_coreSpecInput) :: coreSpecInput
TYPE(t_wann) :: wann
TYPE(t_potden) :: vTot,vx,vCoul,vTemp
TYPE(t_potden) :: inDen, outDen, inDenRot
TYPE(t_potden) :: inDen, outDen
CLASS(t_forcetheo),ALLOCATABLE:: forcetheo
! .. Local Scalars ..
INTEGER:: eig_id, archiveType
INTEGER:: n,it,ithf
LOGICAL:: reap,l_opti,l_cont,l_qfix, l_wann_inp
LOGICAL:: l_opti,l_cont,l_qfix, l_wann_inp
REAL :: fermiEnergyTemp, fix
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -113,7 +113,7 @@ CONTAINS
mpi%mpi_comm = mpi_comm
CALL timestart("Initialization")
CALL fleur_init(mpi,input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
CALL fleur_init(mpi,input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
sliceplot,banddos,obsolete,enpara,xcpot,results,kpts,hybrid,&
oneD,coreSpecInput,wann,l_opti)
CALL timestop("Initialization")
......@@ -141,9 +141,8 @@ CONTAINS
IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('scfLoop')
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL inDenRot%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL inDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
......@@ -159,10 +158,10 @@ CONTAINS
! Initialize and load inDen density (end)
! Initialize potentials (start)
CALL vTot%init(stars,atoms,sphhar,vacuum,noco,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTTOT)
CALL vCoul%init(stars,atoms,sphhar,vacuum,noco,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTCOUL)
CALL vx%init(stars,atoms,sphhar,vacuum,noco,oneD,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_POTCOUL)
CALL vTemp%init(stars,atoms,sphhar,vacuum,noco,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTTOT)
CALL vTot%init(stars,atoms,sphhar,vacuum,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTTOT)
CALL vCoul%init(stars,atoms,sphhar,vacuum,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTCOUL)
CALL vx%init(stars,atoms,sphhar,vacuum,DIMENSION%jspd,.FALSE.,POTDEN_TYPE_POTCOUL)
CALL vTemp%init(stars,atoms,sphhar,vacuum,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_POTTOT)
! Initialize potentials (end)
scfloop:DO WHILE (l_cont)
......@@ -170,7 +169,6 @@ CONTAINS
it = it + 1
IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/)&
,(/it,inden%iter/), RESHAPE((/19,13,5,5/),(/2,2/)))
inDenRot = inDen
!!$ !+t3e
!!$ IF (input%alpha.LT.10.0) THEN
......@@ -190,20 +188,6 @@ CONTAINS
! ----> potential generator
!
!---> pk non-collinear
!---> reload the density matrix from file rhomat_in
!---> calculate spin-up and -down density for USE in the
!---> potential generator and store the direction of
!---> magnetization on file dirofmag
IF (noco%l_noco) THEN
CALL timestart("gen. spin-up and -down density")
CALL rhodirgen(DIMENSION,sym,stars,atoms,sphhar,&
vacuum,cell,input,noco,oneD,inDenRot)
CALL timestop("gen. spin-up and -down density")
ENDIF
!---> pk non-collinear
reap=.NOT.obsolete%disp
input%total = .TRUE.
ENDIF !mpi%irank.eq.0
#ifdef CPP_MPI
......@@ -212,7 +196,6 @@ CONTAINS
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDen)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDenRot)
#endif
......@@ -240,21 +223,10 @@ CONTAINS
!---< gwf
CALL timestart("generation of potential")
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,inDen,inDenRot,vTot,vx,vCoul)
CALL vgen(hybrid,field,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,inDen,vTot,vx,vCoul)
CALL timestop("generation of potential")
IF (mpi%irank.EQ.0) THEN
!---> pk non-collinear
!---> generate the four component matrix potential from spin up
!---> and down potentials and direction of the magnetic field
IF (noco%l_noco) THEN
CALL timestart("generation of potential-matrix")
CALL vmatgen(stars, atoms,sphhar,vacuum,sym,input,oneD,inDenRot,vTot)
CALL timestop("generation of potential-matrix")
ENDIF
!
ENDIF ! mpi%irank.eq.0