Skip to content

GitLab

fleur
fleur
Commit 1cde15db authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files
Options

Bugfixes

parent ff0cec65
Hide whitespace changes
Inline Side-by-side
Showing with 209 additions and 258 deletions
dos/evaldos.f90
View file @ 1cde15db
......@@ -47,8 +47,8 @@
TYPE(t_atoms),INTENT(IN) :: atoms
REAL, INTENT(IN) :: efermiarg, bandgap
LOGICAL, INTENT(IN) :: l_mcd
LOGICAL, INTENT(IN) :: l_mcd
! locals
INTEGER, PARAMETER :: lmax= 4, ned = 1301
INTEGER i,s,v,index,jspin,k,l,l1,l2,ln,n,nl,ntb,ntria,ntetra
......@@ -73,7 +73,7 @@
qdim = lmax*atoms%ntype+3
l_orbcomp = banddos%l_orb
IF (banddos%ndir.EQ.-3) THEN
qdim = 2*slab%nsld
qdim = 2*slab%nsld
n_orb = 0
IF (banddos%l_orb) THEN
n_orb = banddos%orbCompAtom
......@@ -84,7 +84,7 @@
ALLOCATE( qal(qdim,dimension%neigd,kpts%nkpt),&
& qval(vacuum%nstars*vacuum%layers*vacuum%nvac,dimension%neigd,kpts%nkpt),&
& qlay(dimension%neigd,vacuum%layerd,2))
IF (l_mcd) THEN
IF (l_mcd) THEN
ALLOCATE(mcd_local(3*atoms%ntype*ncored,dimension%neigd,kpts%nkpt) )
ELSE
ALLOCATE(mcd_local(0,0,0))
......@@ -95,11 +95,11 @@
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!'
IF ( NINT((emax - emin)/sigma) > ned ) THEN
WRITE(6,*) 'sig_dos too small for DOS smoothing:'
WRITE(6,*) 'sig_dos too small for DOS smoothing:'
WRITE(6,*) 'Reduce energy window or enlarge banddos%sig_dos!'
WRITE(6,*) 'For now: setting sigma to zero !'
sigma = 0.0
......@@ -117,10 +117,10 @@
DO i=1,ned
e(i) = emin + (i-1)*de
ENDDO
IF ( l_mcd ) THEN ! create an energy grid for mcd-spectra
e_lo = 9.9*10.0**9
e_up = -9.9*10.0**9
e_lo = 9.9*10.0**9
e_up = -9.9*10.0**9
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
DO icore = 1 , mcd%ncore(n)
......@@ -129,7 +129,7 @@
ENDDO
ENDDO
ENDDO
e_lo = e_lo*hartree_to_ev_const - efermi - emax
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
......@@ -207,7 +207,7 @@
qal(lmax*atoms%ntype+1,i,k) = qal(lmax*atoms%ntype+1,i,k) - qmt
ENDDO
qal(lmax*atoms%ntype+1,i,k) = qal(lmax*atoms%ntype+1,i,k)&
-qal(lmax*atoms%ntype+2,i,k)*(3-vacuum%nvac) -qal(lmax*atoms%ntype+3,i,k)*(vacuum%nvac-1)
-qal(lmax*atoms%ntype+2,i,k)*(3-vacuum%nvac) -qal(lmax*atoms%ntype+3,i,k)*(vacuum%nvac-1)
ENDDO
ENDIF
!
......@@ -237,27 +237,17 @@
write(*,*) as,sym%nop2,l_tria
! l_tria=.true.
ELSE
IF (input%l_inpXML) THEN
IF (input%tria) THEN
ntetra = kpts%ntet
DO i = 1, ntetra
itetra(1:4,i) = kpts%ntetra(1:4,i)
voltet(i) = kpts%voltet(i) / ntetra
END DO
l_tria = input%tria
GOTO 67
ELSE
GOTO 66
END IF
IF (input%tria) THEN
ntetra = kpts%ntet
DO i = 1, ntetra
itetra(1:4,i) = kpts%ntetra(1:4,i)
voltet(i) = kpts%voltet(i) / ntetra
END DO
l_tria = input%tria
GOTO 67
ELSE
GOTO 66
END IF
OPEN (41,file='kpts',FORM='formatted',STATUS='old')
DO i = 1, kpts%nkpt+1
READ (41,*,END=66,ERR=66)
ENDDO
READ (41,'(i5)',END=66,ERR=66) ntetra
READ (41,'(4(4i6,4x))') ((itetra(i,k),i=1,4),k=1,ntetra)
READ (41,'(4f20.13)') (voltet(k),k=1,ntetra)
CLOSE(41)
voltet(1:ntetra) = voltet(1:ntetra) / ntetra
l_tria=.true.
GOTO 67
......@@ -265,7 +255,7 @@
CALL triang(kpts%bk,kpts%nkpt,itria,ntria,atr,as,l_tria)
l_tria=.true.
! YM: tetrahedrons is not the way in 1D
IF (oneD%odi%d1) as = 0.0
IF (oneD%odi%d1) as = 0.0
IF (sym%invs) THEN
IF (abs(sym%nop2*as-1.0).GT.0.000001) l_tria=.false.
ELSE
......@@ -328,9 +318,9 @@
CALL smooth(e,g(1,ln),sigma,ned)
ENDDO
ENDIF
!*** sum up for all atoms
IF (banddos%ndir.NE.-3) THEN
DO l = 1 , atoms%ntype
l1 = lmax*(l-1) + 1
......@@ -350,7 +340,7 @@
ENDDO
ENDDO
ENDIF
!**** write out DOS
OPEN (18,FILE='DOS'//spin12(jspin))
......@@ -409,14 +399,14 @@
ENDDO
ENDDO
ENDDO
CLOSE (18)
CLOSE (18)
ENDIF
DEALLOCATE (g)
!
!
!------------------------------------------------------------------------------
! now calculate the VACOS
!------------------------------------------------------------------------------
IF ( banddos%vacdos .and. input%film ) THEN
ALLOCATE(g(ned,vacuum%nstars*vacuum%layers*vacuum%nvac))
! CALL ptdos(
......@@ -425,16 +415,16 @@
! < g)
CALL ptdos(emin,emax,input%jspins,ned,vacuum%nstars*vacuum%nvac*vacuum%layers,ntb,ntria&
,as,atr,2*kpts%nkpt,itria,kpts%nkpt,ev(1:ntb,1:kpts%nkpt), qval(:,1:ntb,1:kpts%nkpt),e,g)
!---- > smoothening
IF ( sigma.GT.0.0 ) THEN
DO ln = 1 , vacuum%nstars*vacuum%nvac*vacuum%layers
CALL smooth(e,g(1,ln),sigma,ned)
ENDDO
ENDIF
! write VACDOS
OPEN (18,FILE='VACDOS'//spin12(jspin))
! WRITE (18,'(i2,25(2x,i3))') Layers , (Zlay(l),l=1,Layers)
DO i = 1 , ned
......@@ -464,11 +454,11 @@
END IF
OPEN (18,FILE='bands'//spin12(jspin))
ntb = minval(results%neig(:,jspin))
ntb = minval(results%neig(:,jspin))
kx(1) = 0.0
vkr(:,1)=matmul(kpts%bk(:,1),cell%bmat)
DO k = 2, kpts%nkpt
vkr(:,k)=matmul(kpts%bk(:,k),cell%bmat)
dk = (vkr(1,k)-vkr(1,k-1))**2 + (vkr(2,k)-vkr(2,k-1) )**2 + &
(vkr(3,k)-vkr(3,k-1))**2
......@@ -483,7 +473,7 @@
ENDIF
ENDDO
!
!
!------------------------------------------------------------------------------
! for MCD calculations ...
!------------------------------------------------------------------------------
......@@ -512,4 +502,4 @@
99001 FORMAT (f10.5,110(1x,e10.3))
END SUBROUTINE evaldos
END MODULE m_evaldos
END MODULE m_evaldos
fermi/fermie.F90
View file @ 1cde15db
......@@ -80,11 +80,11 @@ CONTAINS
!***********************************************************************
! ABBREVIATIONS
!
! eig : array of eigenvalues
! eig : array of eigenvalues
! wtkpt : list of the weights of each k-point (from inp-file)
! e : linear list of the eigenvalues
! e : linear list of the eigenvalues
! we : list of weights of the eigenvalues in e
! zelec : number of electrons
! zelec : number of electrons
! spindg : spindegeneracy (2 in nonmagnetic calculations)
! seigv : weighted sum of the occupied valence eigenvalues
! seigsc : weighted sum of the semi-core eigenvalues
......@@ -125,7 +125,7 @@ CONTAINS
IF (mpi%irank == 0) THEN
CALL read_eig(eig_id,k,jsp,neig=ne(k,jsp),eig=eig(:,k,jsp))
WRITE (6,'(a2,3f10.5,f12.6)') 'at',kpts%bk(:,k),kpts%wtkpt(k)
WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (6,'(i5,a14)') ne(k,jsp),' eigenvalues :'
WRITE (6,'(8f12.6)') (eig(i,k,jsp),i=1,ne(k,jsp))
IF(.NOT.judft_was_argument("-minimalOutput")) THEN
attributes = ''
......@@ -144,7 +144,7 @@ CONTAINS
ENDDO
!finished reading of eigenvalues
IF (mpi%irank == 0) CALL closeXMLElement('eigenvalues')
IF (mpi%irank == 0) THEN
IF (mpi%irank == 0) THEN
IF (ABS(input%fixed_moment)<1E-6) THEN
!this is a standard calculation
......@@ -167,7 +167,7 @@ CONTAINS
!Generate a list of energies
DO k = 1,kpts%nkpt
!
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> CONECTION TO THE ORIGINAL ARRAYS
!
DO j = 1,ne(k,jsp)
......@@ -208,7 +208,7 @@ CONTAINS
IF ( mpi%irank == 0 ) THEN
WRITE (6,FMT=8010) n,ws,weight
END IF
CALL juDFT_error("Not enough eavefunctions",calledby="fermie")
CALL juDFT_error("Not enough weavefunctions",calledby="fermie")
8010 FORMAT (/,10x,'error: not enough wavefunctions.',i10,2d20.10)
END IF
ws = ws + we(INDEX(l))
......
fermi/fertri.f
View file @ 1cde15db
......@@ -86,38 +86,14 @@ c
c---> write results of triang
IF (.not.film) THEN
IF(input%l_inpXML) THEN
ntetra = kpts%ntet
DO j = 1, ntetra
itetra(1:4,j) = kpts%ntetra(1:4,j)
voltet(j) = kpts%voltet(j) / ntetra
END DO
ELSE
IF ( irank == 0 ) THEN
WRITE (6,*) 'reading tetrahedrons from file kpts'
END IF
OPEN (41,file='kpts',FORM='formatted',STATUS='old')
DO i = 1, nkpt+1
READ (41,*)
ENDDO
READ (41,'(i5)',ERR=66,END=66) ntetra
IF (ntetra>6*nkpt) CALL juDFT_error("ntetra > 6 nkpt"
+ ,calledby ="fertri")
READ (41,'(4(4i6,4x))') ((itetra(i,j),i=1,4),j=1,ntetra)
READ (41,'(4f20.13)') (voltet(j),j=1,ntetra)
voltet(1:ntetra) = voltet(1:ntetra) / ntetra
GOTO 67
66 CONTINUE ! no tetrahedron-information of file
CALL make_tetra(
> nkpt,bk,ntria,itria,atr,
< ntetra,itetra,voltet)!keep
67 CONTINUE ! tetrahedron-information read or created
CLOSE(41)
END IF
lb = MINVAL(eig(:,:,:)) - 0.01
ub = ef + 0.2
CALL tetra_ef(
ntetra = kpts%ntet
DO j = 1, ntetra
itetra(1:4,j) = kpts%ntetra(1:4,j)
voltet(j) = kpts%voltet(j) / ntetra
END DO
lb = MINVAL(eig(:,:,:)) - 0.01
ub = ef + 0.2
CALL tetra_ef(
> jspins,nkpt,
> lb,ub,eig,zc,sfac,
> ntetra,itetra,voltet,
......
fleurinput/types_atoms.F90
View file @ 1cde15db
......@@ -278,9 +278,10 @@ MODULE m_types_atoms
!force type
xpath=''
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPaths))//'/force')==1) xpath=xpaths
IF(xml%getNumberOfNodes(TRIM(ADJUSTL(xPathg))//'/force')==1) xpath=xpathg
IF (xpath.NE.'') THEN
this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'/force/@calculate'))
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPathg))//'force/@relaxXYZ')
this%l_geo(n) = evaluateFirstBoolOnly(xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@calculate'))
valueString = xml%getAttributeValue(TRIM(ADJUSTL(xPath))//'/force/@relaxXYZ')
READ(valueString,'(3l1)') relaxX, relaxY, relaxZ
IF (relaxX) this%relax(1,n) = 1
IF (relaxY) this%relax(2,n) = 1
......
fleurinput/types_econfig.F90
View file @ 1cde15db
......@@ -9,7 +9,7 @@ MODULE m_types_econfig
PRIVATE
!This is used by t_atoms and does not extend t_fleurinput_base by itself
TYPE:: t_econfig
CHARACTER(len=100) :: coreconfig
CHARACTER(len=200) :: coreconfig
CHARACTER(len=100) :: valenceconfig
INTEGER :: num_core_states
INTEGER :: num_states
......@@ -29,7 +29,7 @@ MODULE m_types_econfig
END TYPE t_econfig
PUBLIC :: t_econfig
CONTAINS
SUBROUTINE get_core(econf,nst,nprnc,kappa,occupation,l_valence)
CLASS(t_econfig),INTENT(IN) :: econf
INTEGER ,INTENT(out) :: nst
......@@ -46,9 +46,9 @@ CONTAINS
occupation(:nst,:)=econf%occupation(:nst,:)
if (size(occupation,2)==1) occupation=occupation*2
END SUBROUTINE get_core
FUNCTION get_state_string(econf,i)RESULT(str)
CLASS(t_econfig),INTENT(IN):: econf
INTEGER,INTENT(in) :: i
......@@ -74,17 +74,17 @@ CONTAINS
CASE default
call judft_error("Invalid reqest for string with kappa")
END SELECT
WRITE(str,"(a1,i1,a)") "(",econf%nprnc(i),s
END FUNCTION get_state_string
SUBROUTINE broadcast(econf,mpi_comm)
USE m_mpi_bc_tool
CLASS(t_econfig),INTENT(INOUT):: econf
INTEGER,INTENT(in) :: mpi_comm
#ifdef CPP_MPI
#ifdef CPP_MPI
INCLUDE 'mpif.h'
INTEGER :: ierr,irank
......@@ -97,7 +97,7 @@ CONTAINS
CALL mpi_bc(econf%valence_electrons,0,mpi_comm)
#endif
END SUBROUTINE broadcast
SUBROUTINE init_num(econf,nc,nz)
USE m_constants
......@@ -114,8 +114,8 @@ CONTAINS
CALL econf%init(core,nz)
END SUBROUTINE init_num
SUBROUTINE init_simple(econf,str)
CLASS(t_econfig),INTENT(OUT):: econf
CHARACTER(len=*),INTENT(IN) :: str
......@@ -123,10 +123,10 @@ CONTAINS
CHARACTER(len=200)::core,valence
INTEGER :: n
REAL,allocatable :: core_occ(:),valence_occ(:)
n=INDEX(str,"|")
IF (n==0) CALL judft_error(("Invalid econfig:"//TRIM(str)))
IF (INDEX(str,"|")==1) THEN
! No core
core=""
......@@ -157,15 +157,15 @@ CONTAINS
INTEGER :: np(40),kap(40)
econf%coreconfig=core
econf%valenceconfig=valence
CALL expand_noble_gas(core) !extend noble gas config
IF (VERIFY(core,"(1234567spdf/) ")>0) call judft_error(("Invalid econfig:"//TRIM(core)))
IF (VERIFY(valence,"(1234567spdf/) ")>0) CALL judft_error(("Invalid econfig:"//TRIM(valence)))
econf%num_core_states=0
DO WHILE (len_TRIM(core)>1)
CALL extract_next(core,np(econf%num_core_states+1),kap(econf%num_core_states+1))
......@@ -180,7 +180,7 @@ CONTAINS
econf%nprnc=np(:econf%num_states)
econf%kappa=kap(:econf%num_states)
ALLOCATE(econf%occupation(econf%num_states,2))
CALL econf%set_occupation("(1s1/2)",-1.,-1.)
END SUBROUTINE init_all
......@@ -195,34 +195,34 @@ CONTAINS
CHARACTER(len=7)::str
IF (nz>54) CALL judft_warn("Specifying no explicit valence config for systems with f-states might lead to broken configs")
econf%coreconfig=core
CALL expand_noble_gas(core) !extend noble gas config
IF (VERIFY(core,"(1234567spdf/) ")>0) call judft_error(("Invalid econfig:"//TRIM(core)))
econf%num_core_states=0
DO WHILE (len_TRIM(core)>1)
CALL extract_next(core,np(econf%num_core_states+1),kap(econf%num_core_states+1))
econf%num_core_states=econf%num_core_states+1
ENDDO
econf%num_states=econf%num_core_states
!valence charge
charge=nz-SUM(ABS(kap(:econf%num_core_states)))*2
DO WHILE(charge>0) !Add valence
!valence charge
charge=nz-SUM(ABS(kap(:econf%num_core_states))**2)*2
DO WHILE(charge>0) !Add valence
str=coreStateList_const(econf%num_states+1)
PRINT*,econf%num_states,str,charge
CALL extract_next(str,np(econf%num_states+1),kap(econf%num_states+1))
econf%num_states=econf%num_states+1
charge=charge-ABS(kap(econf%num_states))
charge=charge-ABS(kap(econf%num_states)**2)*2
ENDDO
ALLOCATE(econf%nprnc(econf%num_states),econf%kappa(econf%num_states))
econf%nprnc=np(:econf%num_states)
econf%kappa=kap(:econf%num_states)
ALLOCATE(econf%occupation(econf%num_states,2))
CALL econf%set_occupation("(1s1/2)",-1.,-1.)
!last level might be partially occupied
IF (charge<0) THEN
......@@ -241,9 +241,9 @@ CONTAINS
REAL :: up,down
up=u
down=d
str=ADJUSTL(state)
IF (up==-1. .AND. down==-1) THEN
!Set all defaults
econf%occupation=0.0
......@@ -264,12 +264,12 @@ CONTAINS
up=-1;down=-1
END IF
END IF
END DO
END DO
END IF
econf%core_electrons=SUM(econf%occupation(:econf%num_core_states,:))
econf%valence_electrons=SUM(econf%occupation(econf%num_core_states+1:econf%num_states,:))
END SUBROUTINE set_occupation
SUBROUTINE set_initial_moment(econf,bmu)
CLASS(t_econfig),INTENT(INOUT):: econf
......@@ -301,7 +301,7 @@ CONTAINS
SUBROUTINE extract_next(str,n,kappa)
CHARACTER(len=*),INTENT(INOUT) :: str
INTEGER,INTENT(out) :: n,kappa
......@@ -345,29 +345,29 @@ CONTAINS
CASE ("Ne","ne","NE")
str="(1s1/2) (2s1/2) (2p1/2) "//str
CASE ("Ar","ar","AR")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) "//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) "//str
CASE ("Kr","kr","KR")
str="(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str
str="(1s1/2) (2s1/2) (2p1/2) (2p3/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"//str
CASE ("Xe","xe","XE")
str="(1s1/2) (2s1/2) (2p1/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) "//str
str="(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) "//str
CASE ("Rn","rn","RN")
str="(1s1/2) (2s1/2) (2p1/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) "//str
str="(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) "//str
CASE default
call judft_error(("Invalid econfig:"//TRIM(str)))
END SELECT
END SUBROUTINE expand_noble_gas
SUBROUTINE convert_to_extended(simple,extended,occupations)
CHARACTER(len=*),INTENT(IN) :: simple
CHARACTER(len=*),INTENT(OUT) :: extended
REAL,ALLOCATABLE,INTENT(OUT) :: occupations(:)
CHARACTER(len=200)::conf
REAL :: occupation(100) !this is the tmp local variable (no 's')
REAL :: occupation(200) !this is the tmp local variable (no 's')
INTEGER:: n,nn,occ
CHARACTER:: n_ch,ch
extended=""
......
fleurinput/types_enparaXML.f90
View file @ 1cde15db
......@@ -131,7 +131,7 @@ CONTAINS
enpara%qn_el(:,ntype,:)=ABS(enpara%qn_el(:,ntype,:))
END SUBROUTINE set_quantum_numbers
SUBROUTINE init(this,ntype,nlod,jspins,l_defaults,nz)
SUBROUTINE Init(This,Ntype,Nlod,Jspins,L_defaults,Nz)
USE m_constants
CLASS(t_enparaXML),INTENT(inout):: this
INTEGER,INTENT(IN) :: jspins,nlod,ntype
......@@ -141,6 +141,9 @@ CONTAINS
INTEGER :: n,i,jsp,l
this%evac0=-1E99
if (allocated(this%qn_el)) deallocate(this%qn_el)
if (allocated(this%qn_ello)) deallocate(this%qn_ello)
ALLOCATE(this%qn_el(0:3,ntype,jspins))
ALLOCATE(this%qn_ello(nlod,ntype,jspins))
......
fleurinput/types_input.f90
View file @ 1cde15db
......@@ -57,7 +57,7 @@ MODULE m_types_input
LOGICAL:: l_wann=.FALSE.
LOGICAL:: secvar=.FALSE.
LOGICAL:: evonly=.FALSE.
LOGICAL:: l_inpXML=.TRUE.
! LOGICAL:: l_inpXML=.TRUE.
REAL :: ellow=-1.8
REAL :: elup=1.0
REAL :: fixed_moment = 0.0
......@@ -135,7 +135,7 @@ CONTAINS
call mpi_bc(this%l_wann,rank,mpi_comm)
call mpi_bc(this%secvar,rank,mpi_comm)
call mpi_bc(this%evonly,rank,mpi_comm)
call mpi_bc(this%l_inpXML,rank,mpi_comm)
! call mpi_bc(this%l_inpXML,rank,mpi_comm)
call mpi_bc(this%ellow,rank,mpi_comm)
call mpi_bc(this%elup,rank,mpi_comm)
call mpi_bc(this%fixed_moment ,rank,mpi_comm)
......
fleurinput/types_noco.f90
View file @ 1cde15db
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE m_types_noco
USE m_judft
USE m_judft
USE m_types_fleurinput_base
IMPLICIT NONE
PRIVATE
......@@ -21,7 +21,7 @@ MODULE m_types_noco
LOGICAL:: l_spav= .FALSE.
REAL :: theta=0.0
REAL :: phi=0.0
LOGICAL, ALLOCATABLE :: l_relax(:)
REAL, ALLOCATABLE :: alphInit(:)
REAL, ALLOCATABLE :: alph(:)
......@@ -49,7 +49,7 @@ MODULE m_types_noco
ELSE
rank=0
END IF
CALL mpi_bc(this%l_ss,rank,mpi_comm)
CALL mpi_bc(this%l_soc,rank,mpi_comm)
CALL mpi_bc(this%l_noco ,rank,mpi_comm)
......@@ -61,27 +61,27 @@ MODULE m_types_noco
CALL mpi_bc(this%l_spav,rank,mpi_comm)
CALL mpi_bc(this%theta,rank,mpi_comm)
CALL mpi_bc(this%phi,rank,mpi_comm)
CALL mpi_bc(this%l_relax,rank,mpi_comm)
CALL mpi_bc(this%alphInit,rank,mpi_comm)
CALL mpi_bc(this%alph,rank,mpi_comm)
CALL mpi_bc(this%beta,rank,mpi_comm)
CALL mpi_bc(this%b_con,rank,mpi_comm)
CALL mpi_bc(this%socscale,rank,mpi_comm)
END SUBROUTINE mpi_bc_noco
SUBROUTINE read_xml_noco(this,xml)
USE m_types_xml
CLASS(t_noco),INTENT(inout):: this
TYPE(t_xml),INTENT(IN) :: xml
INTEGER:: numberNodes,ntype,itype
CHARACTER(len=100)::xpathA,xpathB,valueString
this%l_noco = evaluateFirstBoolOnly(xml%GetAttributeValue('/fleurInput/calculationSetup/magnetism/@l_noco'))
! Read in optional SOC parameters if present
xPathA = '/fleurInput/calculationSetup/soc'
numberNodes = xml%GetNumberOfNodes(xPathA)
......@@ -115,8 +115,9 @@ MODULE m_types_noco
ALLOCATE(this%socscale(ntype))
DO itype=1,ntype
this%socscale(Itype)=1.0
IF (xml%GetNumberOfNodes(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale')>0) &
this%socscale(iType)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale'))
this%socscale(Itype)=evaluateFirstOnly(xml%GetAttributeValue(TRIM(ADJUSTL(xml%speciesPath(itype)))//'/special/@socscale'))
!Read in atom group specific noco parameters
xPathB = TRIM(ADJUSTL(xml%groupPath(itype)))//'/nocoParams'
numberNodes = xml%GetNumberOfNodes(TRIM(ADJUSTL(xPathB)))
......@@ -139,7 +140,7 @@ MODULE m_types_noco
integer :: na,itype
! Check noco stuff and calculate missing noco parameters
IF (noco%l_noco) THEN
IF (noco%l_ss) THEN
......@@ -162,9 +163,9 @@ MODULE m_types_noco
END IF
end subroutine init_noco