Commit 5b72e8c9 authored by Daniel Wortmann's avatar Daniel Wortmann

Changes to vgen now compile, tests do not work yet...

parent 0725c6e9
......@@ -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
......@@ -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(:)
......@@ -555,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
......
......@@ -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
......
......@@ -76,6 +76,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
......@@ -113,7 +114,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")
......@@ -145,8 +146,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)
CALL inDenRot%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
......@@ -163,10 +164,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)
......@@ -244,7 +245,7 @@ CONTAINS
!---< gwf
CALL timestart("generation of potential")
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
CALL vgen(hybrid,field,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,inDen,inDenRot,vTot,vx,vCoul)
CALL timestop("generation of potential")
......@@ -380,7 +381,7 @@ CONTAINS
!!$ !-Wannier
CALL timestart("generation of new charge density (total)")
CALL outDen%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL outDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
outDen%iter = inDen%iter
CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DIMENSION,kpts,atoms,sphhar,stars,sym,obsolete,&
......
......@@ -7,7 +7,7 @@
IMPLICIT NONE
CONTAINS
SUBROUTINE fleur_init(mpi,&
input,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
input,field,DIMENSION,atoms,sphhar,cell,stars,sym,noco,vacuum,forcetheo,&
sliceplot,banddos,obsolete,enpara,xcpot,results,kpts,hybrid,&
oneD,coreSpecInput,wann,l_opti)
USE m_judft
......@@ -43,6 +43,7 @@
! Types, these variables contain a lot of data!
TYPE(t_mpi) ,INTENT(INOUT):: mpi
TYPE(t_input) ,INTENT(OUT):: input
TYPE(t_field), INTENT(OUT) :: field
TYPE(t_dimension),INTENT(OUT):: DIMENSION
TYPE(t_atoms) ,INTENT(OUT):: atoms
TYPE(t_sphhar) ,INTENT(OUT):: sphhar
......@@ -185,7 +186,7 @@
results%force(:,:,:) = 0.0
END IF
CALL postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
CALL 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)
......
This diff is collapsed.
......@@ -40,7 +40,7 @@ contains
!atoms%jmtd = maxval(atoms%jri(:))
!sphhar%nlhd = maxval(sphhar%nlh(:))
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
IF(noco%l_noco) THEN
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
......
......@@ -54,7 +54,7 @@
IF (input%jspins/=2) CALL juDFT_error("cdnsp: set jspins = 2 and remove fl7para!", calledby ="cdnsp")
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
input%jspins=1
CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc)
......
......@@ -49,7 +49,7 @@ SUBROUTINE flipcdn(atoms,input,vacuum,sphhar,stars,sym,noco,oneD,cell)
! Local Arrays
CHARACTER(len=80), ALLOCATABLE :: clines(:)
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
IF(noco%l_noco) THEN
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
......
......@@ -122,7 +122,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
!---> reload the density matrix from file rhomat_inp
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
IF (.NOT.sliceplot%slice) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,den)
......@@ -141,7 +141,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
END IF
IF (.NOT. sliceplot%slice) THEN
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
den%iter = iter
den%mt(:,0:,1:,:input%jspins) = rho(:,0:,1:,:input%jspins)
den%pw(1:,:input%jspins) = qpw(1:,:input%jspins)
......@@ -317,7 +317,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
inp=input
inp%jspins=1
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,inp%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,inp%jspins,noco%l_noco,POTDEN_TYPE_DEN)
den%iter = iter
den%mt(:,0:,1:,1:1) = rho(:,0:,1:,1:1)
den%pw(1:,1:1) = qpw(1:,1:1)
......
......@@ -134,7 +134,7 @@ SUBROUTINE plotdop(oneD,dimension,stars,vacuum,sphhar,atoms,&
! Read in charge/potential
DO i = 1, numInFiles
CALL den(i)%init(stars,atoms,sphhar,vacuum,noco,oneD,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_DEN)
CALL den(i)%init(stars,atoms,sphhar,vacuum,DIMENSION%jspd,noco%l_noco,POTDEN_TYPE_DEN)
IF(TRIM(ADJUSTL(cdnFilenames(i))).EQ.'cdn1') THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den(i))
......
......@@ -68,7 +68,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
IF (input%jspins > DIMENSION%jspd) CALL juDFT_error("input%jspins > dimension%jspd", calledby = "stden")
CALL den%init(stars,atoms,sphhar,vacuum,noco,oneD,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
ALLOCATE ( rat(DIMENSION%msh,atoms%ntype),eig(DIMENSION%nstd,DIMENSION%jspd,atoms%ntype) )
ALLOCATE ( rh(DIMENSION%msh,atoms%ntype,DIMENSION%jspd),rh1(DIMENSION%msh,atoms%ntype,DIMENSION%jspd) )
......@@ -78,14 +78,14 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
IF (mpi%irank == 0) THEN
! if sigma is not 0.0, then divide this charge among all atoms
IF ( ABS(input%efield%sigma).LT. 1.e-6) THEN
IF ( ABS(input%sigma).LT. 1.e-6) THEN
qdel = 0.0
ELSE
natot = 0
DO n = 1, atoms%ntype
IF (atoms%zatom(n).GE.1.0) natot = natot + atoms%neq(n)
END DO
qdel = 2.*input%efield%sigma/natot
qdel = 2.*input%sigma/natot
END IF
WRITE (6,FMT=8000)
......
......@@ -16,11 +16,13 @@ types/types_enpara.F90
types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
types/types_field.F90
)
set(inpgen_F90 ${inpgen_F90}
types/types.F90
types/types_mat.F90
types/types_field.F90
types/types_xcpot.F90
types/types_mpi.F90
types/types_lapw.F90
......
......@@ -20,4 +20,5 @@ MODULE m_types
USE m_types_potden
USE m_types_forcetheo
USE m_types_cdnval
USE m_types_field
END MODULE m_types
......@@ -422,6 +422,7 @@ CONTAINS
INTEGER ityp,j,l,lo,jsp,n
REAL vbar,maxdist,maxdist2
INTEGER same(atoms%nlod)
LOGICAL l_enpara
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr
......@@ -514,6 +515,8 @@ CONTAINS
"differ from the input by more than 1Htr, chances are "//&
"high that your initial setup was broken.")
ENDIF
INQUIRE(file='enpara',exist=l_enpara)
IF (mpi%irank==0.AND.l_enpara) CALL enpara%WRITE(atoms,input%jspins,input%film)
#ifdef CPP_MPI
CALL MPI_BCAST(enpara%el0,SIZE(enpara%el0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(enpara%ello0,SIZE(enpara%ello0),MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
......
!--------------------------------------------------------------------------------
! 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_types_field
!*************************************************************
! This module contains definitions for electric and magnetic field -types
!*************************************************************
PRIVATE
REAL,TARGET::sigma=0.0
TYPE t_efield
REAL :: zsigma = 10.0 ! Distance to the charged plates
REAL,POINTER :: sigma ! charge at the plates
REAL :: sig_b(2)= 0.0 ! Extra charge for the top/bottom plate
COMPLEX :: vslope = 0.0 ! Dirichlet bnd. cond.: Slope
REAL, ALLOCATABLE :: sigEF(:,:,:) ! (nx, ny, nvac)
COMPLEX, ALLOCATABLE :: rhoEF(:,:) ! (g_||, nvac)
COMPLEX, ALLOCATABLE :: C1(:), C2(:) ! Coeff. for Dirichlet bnd.cond.
LOGICAL :: l_segmented = .FALSE.
LOGICAL :: plot_charge = .FALSE. ! Plot charge as inputted
LOGICAL :: plot_rho = .FALSE. ! Plot Fourier-transformed charge
LOGICAL :: autocomp = .TRUE. ! Auto-compensate film charge
LOGICAL :: dirichlet = .FALSE. ! Dirichlet vs. Neumann boundary cond.
LOGICAL :: l_dirichlet_coeff = .FALSE. ! For MPI, true if C1/C2 set
END TYPE t_efield
TYPE t_field
TYPE(t_efield) :: efield
LOGICAL :: l_b_field=.false.
REAL :: b_field
REAL,ALLOCATABLE :: b_field_mt(:)
CONTAINS
PROCEDURE :: init=>init_field
END TYPE t_field
PUBLIC t_field,t_efield
CONTAINS
SUBROUTINE init_field(this,input)
USE m_types_setup
IMPLICIT NONE
CLASS(t_field),INTENT(INOUT)::this
TYPE(t_input),INTENT(INOUT) ::input
input%sigma => this%efield%sigma
this%efield%sigma=>sigma
END SUBROUTINE init_field
END MODULE m_types_field
......@@ -34,14 +34,52 @@ MODULE m_types_potden
PROCEDURE :: resetpotden
GENERIC :: init=>init_potden_types,init_potden_simple
PROCEDURE :: copy_both_spin
PROCEDURE :: sum_both_spin
END TYPE t_potden
CONTAINS
SUBROUTINE sum_both_spin(this,that)
IMPLICIT NONE
CLASS(t_potden),INTENT(INOUT) :: this
TYPE(t_potden),INTENT(INOUT),OPTIONAL :: that
IF (PRESENT(that)) THEN
IF (SIZE(this%pw,2)>1) THEN
that%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
that%pw(:,1)=this%pw(:,1)+this%pw(:,2)
that%vacz(:,:,1)=this%vacz(:,:,1)+this%vacz(:,:,2)
that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)+this%vacxy(:,:,:,2)
IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
ELSE
that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
that%pw(:,1)=this%pw(:,1)
that%vacz(:,:,1)=this%vacz(:,:,1)
that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)
IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
ENDIF
ELSE
IF (SIZE(this%pw,2)>1) THEN
this%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
this%pw(:,1)=this%pw(:,1)+this%pw(:,2)
this%vacz(:,:,1)=this%vacz(:,:,1)+this%vacz(:,:,2)
this%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)+this%vacxy(:,:,:,2)
IF (ALLOCATED(this%pw_w)) this%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
ENDIF
END IF
END SUBROUTINE sum_both_spin
SUBROUTINE copy_both_spin(this,that)
IMPLICIT NONE
CLASS(t_potden),INTENT(IN) :: this
TYPE(t_potden),INTENT(INOUT) :: that
that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
that%pw(:,1)=this%pw(:,1)
that%vacz(:,:,1)=this%vacz(:,:,1)
that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)
IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
IF (SIZE(that%mt,4)==2) THEN
that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
that%pw(:,2)=this%pw(:,1)
......@@ -51,32 +89,30 @@ CONTAINS
END IF
END SUBROUTINE copy_both_spin