Commit 01507889 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' into stable

parents 4ea754ba e38c9228
# Summary
<!-- Summarize the bug encountered concisely. -->
## Input and output file:
<!--Please provide at least the inp.xml and the out files produced. -->
## Compute environment
<!-- Please shortly describe the machine&compiler you use. -->
## This is BUG because:
<!-- Please indicate the correct behaviour you expect. -->
## The problem only occurs if:
<!-- Please indicate if you checked if the bug only occurs if, e.g. you run on a specific machine,
in MPI mode, with several OpenMP task, you use LOs or SOC or ... -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Ideas for fixes
<!-- If you can, give hints that that might help fixing the problem. -->
<!-- Please choose an appropriate label like: ~Bug ~"Critial Bug" . -->
/label ~Bug
# Summary
<!-- Summarize the problem encountered concisely. -->
## Machine
<!-- Please describe the machine you use. -->
## Compiler
<!-- Please describe the compiler you use. -->
## Libraries
<!-- Please describe any specific libraries you use. -->
## Version you try to compile
<!-- Best is to use 'git describe' on the source code and paste the output here. -->
## Command line
<!-- Please give the command line of the configure script you use and of any corresponding environment variables you set -->
## Console output and other logs
<!-- Paste any relevant logs - please use code blocks (```) to format console output,
logs, and code as it's very hard to read otherwise. -->
## Further comments
\label ~"Compilation related"
\ No newline at end of file
# Summary
<!-- Summarize the feature concisely. -->
## Why is this feature needed?
<!-- Please describe the usecase. -->
## Implementation ideas
<!-- If yoy have ideas how the feature should be realized share them. -->
\label ~"Feature Request"
\ No newline at end of file
......@@ -4,7 +4,7 @@ MODULE m_cdntot
! vacuum, and mt regions c.l.fu
! ********************************************************
CONTAINS
SUBROUTINE cdntot(stars,atoms,sym,vacuum,input,cell,oneD,&
SUBROUTINE cdntot(mpi,stars,atoms,sym,vacuum,input,cell,oneD,&
den,l_printData,qtot,qistot)
USE m_intgr, ONLY : intgr3
......@@ -18,6 +18,7 @@ CONTAINS
IMPLICIT NONE
! .. Scalar Arguments ..
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sym),INTENT(IN) :: sym
......@@ -88,7 +89,7 @@ CONTAINS
ELSE
qis = 0.
CALL pwint_all(stars,atoms,sym,oneD,cell,x)
CALL pwint_all(stars,atoms,sym,oneD,cell,1,stars%ng3,x)
DO j = 1,stars%ng3
qis = qis + den%pw(j,jspin)*x(j)*stars%nstr(j)
ENDDO
......
......@@ -122,7 +122,7 @@
END SUBROUTINE pwint
SUBROUTINE pwint_all(&
& stars,atoms,sym,oneD,&
& cell,&
& cell,x_start,x_end,&
& x)
USE m_spgrot
......@@ -138,6 +138,7 @@
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_cell),INTENT(IN) :: cell
INTEGER, INTENT (IN) :: x_start,x_end
COMPLEX, INTENT (OUT):: x(:)
! ..
!-odim
......@@ -159,7 +160,7 @@
!$OMP PARALLEL DO default(shared) &
!$OMP PRIVATE(ng,ig3d,g,gr,fj,ig2d,s,na,kr,ph,n)&
!$OMP PRIVATE(srmt,nn,sfs,arg,s1,ii)
starloop:DO ng=1,size(x)
starloop:DO ng=x_start,x_end
ig3d = stars%ig(stars%kv3(1,ng),stars%kv3(2,ng),stars%kv3(3,ng))
IF (ig3d.EQ.0) THEN
x(ng) = (0.,0.)
......
......@@ -9,7 +9,7 @@ if (XXD_PROG)
else()
ADD_CUSTOM_COMMAND(
OUTPUT ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND mv ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMAND cp ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h.backup ${CMAKE_SOURCE_DIR}/io/xml/inputSchema.h
COMMENT "No xxd found using backup")
message("No xxd command found! Using backup of inputSchema.h")
endif()
#!/bin/bash
echo "Please make sure you are in a git directory on the develop branch"
echo "Also the pipeline status should be OK and your workdirectory should be clean"
echo "Press OK to continue"
read
TAG=`date "+%m.%y"`
TAG="snapshot-$TAG"
echo $TAG
git tag -a -m "Monthly snapshot" $TAG
git checkout stable
git merge --ff-only develop
git push origin $TAG
git push
......@@ -26,8 +26,8 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_noco),INTENT(IN) :: noco
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: na,ntyp
......@@ -48,20 +48,20 @@ CONTAINS
INTEGER locol,lorow,ii,ij,n,k,ab_size
! ..
! .. Local Arrays ..
COMPLEX, ALLOCATABLE :: ab(:,:),ax(:),bx(:),cx(:)
COMPLEX, ALLOCATABLE :: ab(:,:,:),ax(:),bx(:),cx(:)
COMPLEX,ALLOCATABLE :: abclo(:,:,:,:,:)
! ..
!--> synthesize the complex conjugates of a and b
ALLOCATE(ab(MAXVAL(lapw%nv),0:2*atoms%lmaxd*(atoms%lmaxd+2)+1))
ALLOCATE(ab(MAXVAL(lapw%nv),0:2*atoms%lmaxd*(atoms%lmaxd+2)+1,MIN(jintsp,iintsp):MAX(jintsp,iintsp)))
ALLOCATE(ax(MAXVAL(lapw%nv)),bx(MAXVAL(lapw%nv)),cx(MAXVAL(lapw%nv)))
ALLOCATE(abclo(3,-atoms%llod:atoms%llod,2*(2*atoms%llod+1),atoms%nlod,2))
DO i=MIN(jintsp,iintsp),MAX(jintsp,iintsp)
CALL hsmt_ab(sym,atoms,noco,isp,i,ntyp,na,cell,lapw,fj,gj,ab(:,:),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1)
CALL hsmt_ab(sym,atoms,noco,isp,i,ntyp,na,cell,lapw,fj,gj,ab(:,:,i),ab_size,.TRUE.,abclo(:,:,:,:,i),alo1,blo1,clo1)
ENDDO
mlo=0;mlolo=0
DO m=1,ntyp-1
mlo=mlo+atoms%nlo(m)
......@@ -80,7 +80,7 @@ CONTAINS
IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na) == 1) invsfct = 2
!
DO lo = 1,atoms%nlo(ntyp)
l = atoms%llo(lo,ntyp)
!---> calculate the hamiltonian matrix elements with the regular
......@@ -117,19 +117,18 @@ CONTAINS
!---> and that a,b,alo... are the complex
!---> conjugates of the a,b...-coefficients
DO kp = 1,lapw%nv(iintsp)
ax(kp) = ax(kp) + ab(kp,lmp)*utu + ab(kp,ab_size/2+lmp)*dtu
bx(kp) = bx(kp) + ab(kp,lmp)*utd + ab(kp,ab_size/2+lmp)*dtd
cx(kp) = cx(kp) + ab(kp,lmp)*utulo + ab(kp,ab_size/2+lmp)*dtulo
ax(kp) = ax(kp) + ab(kp,lmp,iintsp)*utu + ab(kp,ab_size/2+lmp,iintsp)*dtu
bx(kp) = bx(kp) + ab(kp,lmp,iintsp)*utd + ab(kp,ab_size/2+lmp,iintsp)*dtd
cx(kp) = cx(kp) + ab(kp,lmp,iintsp)*utulo + ab(kp,ab_size/2+lmp,iintsp)*dtulo
END DO
END IF
END DO
END DO
!+t3e
DO nkvec = 1,invsfct* (2*l+1)
locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e
IF (hmat%l_real) THEN
DO kp = 1,lapw%nv(iintsp)
hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (&
......@@ -142,8 +141,8 @@ CONTAINS
IF (input%l_useapw) THEN
!---> APWlo
hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct * (&
(CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*&
(CONJG(ab(kp,lm,iintsp))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm,iintsp))*ud%uds(l,ntyp,isp))*&
(abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)&
+abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
+abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
......@@ -151,19 +150,19 @@ CONTAINS
ENDDO
ELSE
DO kp = 1,lapw%nv(iintsp)
hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (&
abclo(1,m,nkvec,lo,jintsp) * CONJG( ax(kp) ) +&
abclo(2,m,nkvec,lo,jintsp) * CONJG( bx(kp) ) +&
abclo(3,m,nkvec,lo,jintsp) * CONJG( cx(kp) ) )
IF (input%l_useapw) THEN
!---> APWlo
hmat%data_c(kp,locol)=hmat%data_c(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct*(&
(CONJG(ab(kp,lm))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm))*ud%uds(l,ntyp,isp))*&
(abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)&
+abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
+abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
ENDIF
hmat%data_c(kp,locol) = hmat%data_c(kp,locol) + chi*invsfct * (&
abclo(1,m,nkvec,lo,jintsp) * CONJG( ax(kp) ) +&
abclo(2,m,nkvec,lo,jintsp) * CONJG( bx(kp) ) +&
abclo(3,m,nkvec,lo,jintsp) * CONJG( cx(kp) ) )
IF (input%l_useapw) THEN
!---> APWlo
hmat%data_c(kp,locol)=hmat%data_c(kp,locol) + 0.25 * atoms%rmt(ntyp)**2 * chi*invsfct*(&
(CONJG(ab(kp,lm,iintsp))* ud%us(l,ntyp,isp)+&
CONJG(ab(kp,ab_size/2+lm,iintsp))*ud%uds(l,ntyp,isp))*&
(abclo(1,m,nkvec,lo,jintsp)* ud%dus(l,ntyp,isp)&
+abclo(2,m,nkvec,lo,jintsp)* ud%duds(l,ntyp,isp)&
+abclo(3,m,nkvec,lo,jintsp)*ud%dulos(lo,ntyp,isp) ))
ENDIF
ENDDO
ENDIF
!---> jump to the last matrixelement of the current row
......@@ -173,13 +172,13 @@ CONTAINS
!---> calculate the hamiltonian matrix elements with other
!---> local orbitals at the same atom and with itself
DO nkvec = 1,invsfct* (2*l+1)
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e
!---> calculate the hamiltonian matrix elements with other
!---> local orbitals at the same atom, if they have the same l
DO lop = 1, (lo-1)
DO lop = 1, MERGE(lo-1,atoms%nlo(ntyp),iintsp==jintsp)
IF (lop==lo) CYCLE
lp = atoms%llo(lop,ntyp)
DO nkvecp = 1,invsfct* (2*lp+1)
lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
......@@ -207,8 +206,13 @@ CONTAINS
ulotu=CONJG(tlmplm%tuulo(lm,mp,lop+mlo,isp))
ulotd=CONJG(tlmplm%tdulo(lm,mp,lop+mlo,isp))
!---> note that lo > lop
lolop = ((lo-1)*lo)/2 + lop
ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp))
IF (lo>lop) THEN
lolop = ((lo-1)*lo)/2 + lop
ulotulo = CONJG(tlmplm%tuloulo (m,mp,lolop+mlolo,isp))
ELSE
lolop = ((lop-1)*lop)/2 + lo
ulotulo = CONJG(tlmplm%tuloulo (mp,m,lolop+mlolo,isp))
ENDIF
axx=CONJG(abclo(1,m,nkvec,lo,jintsp))*utu +&
CONJG(abclo(2,m,nkvec,lo,jintsp))*utd +&
CONJG(abclo(3,m,nkvec,lo,jintsp))*utulo
......@@ -240,7 +244,8 @@ CONTAINS
END DO
!---> calculate the hamiltonian matrix elements of one local
!---> orbital with itself
DO nkvecp = 1,nkvec
lop=lo
DO nkvecp = 1,MERGE(nkvec,invsfct* (2*l+1),iintsp==jintsp)
lorow=lapw%nv(iintsp)+lapw%index_lo(lop,na)+nkvecp
DO m = -l,l
lm = l* (l+1) + m
......@@ -294,13 +299,12 @@ CONTAINS
END DO
END DO
END DO
ENDIF
!-t3e
ENDIF !If this lo to be calculated by mpi rank
END DO
END DO ! end of lo = 1,atoms%nlo loop
END IF
!$OMP END MASTER
!$OMP barrier
END SUBROUTINE hlomat
END MODULE m_hlomat
END MODULE m_hlomat
......@@ -43,7 +43,7 @@ CONTAINS
REAL, INTENT (IN) :: fj(:,0:,:),gj(:,0:,:)
TYPE(t_usdus),INTENT(IN) :: ud
CLASS(t_mat),INTENT(INOUT) :: smat
! ..
! .. Local Scalars ..
REAL con,dotp,fact1,fact2,fact3,fl2p1
......@@ -67,10 +67,11 @@ CONTAINS
!---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na) == 1) invsfct = 2
con = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(ntyp))**2)/2.0
DO lo = 1,atoms%nlo(ntyp) !loop over all LOs for this atom
l = atoms%llo(lo,ntyp)
fl2p1 = (2*l+1)/fpi_const
fact1 = (con**2)* fl2p1 * (&
......@@ -80,11 +81,9 @@ CONTAINS
2*clo1(lo) * ud%dulon(lo,ntyp,isp) ) +&
clo1(lo)* clo1(lo) )
DO nkvec = 1,invsfct* (2*l+1) !Each LO can have several functions
!+t3e
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage!
k = lapw%kvec(nkvec,lo,na)
!---> calculate the overlap matrix elements with the regular
!---> flapw basis-functions
......@@ -105,7 +104,8 @@ CONTAINS
END DO
!---> calculate the overlap matrix elements with other local
!---> orbitals at the same atom, if they have the same l
DO lop = 1, (lo-1)
DO lop = 1, MERGE(lo-1,atoms%nlo(ntyp),iintsp==jintsp)
IF (lop==lo) CYCLE !Do later
lp = atoms%llo(lop,ntyp)
IF (l == lp) THEN
fact3 = con**2 * fl2p1 * (&
......@@ -128,12 +128,12 @@ CONTAINS
cph(k,jintsp)*CONJG(cph(kp,iintsp))
ENDIF
END DO
ELSE
END IF
ENDIF
END DO
!---> calculate the overlap matrix elements of one local
!---> orbital with itself
DO nkvecp = 1,nkvec
lop=lo
DO nkvecp = 1,MERGE(nkvec,invsfct* (2*l+1),iintsp==jintsp)
kp = lapw%kvec(nkvecp,lo,na)
lorow=lapw%nv(iintsp)+lapw%index_lo(lo,na)+nkvecp
dotp = dot_PRODUCT(lapw%gk(:,k,jintsp),lapw%gk(:,kp,iintsp))
......@@ -146,7 +146,6 @@ CONTAINS
ENDIF
END DO
ENDIF ! mod(locol-1,n_size) = nrank
!-t3e
END DO
END DO
END IF
......
......@@ -27,22 +27,28 @@ CONTAINS
INTEGER, INTENT (IN) :: n,jspin,jsp !atom index,physical spin&spin index for data
REAL dvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL dvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd )
REAL f(atoms%jmtd,2,0:atoms%lmaxd,2),g(atoms%jmtd,2,0:atoms%lmaxd,2),x(atoms%jmtd)
REAL flo(atoms%jmtd,2,atoms%nlod)
INTEGER:: indt(0:SIZE(td%tuu,1)-1)
REAL vr0(SIZE(v%mt,1),0:SIZE(v%mt,2)-1)
REAL, ALLOCATABLE :: dvd(:,:),dvu(:,:),uvd(:,:),uvu(:,:),f(:,:,:,:),g(:,:,:,:),x(:),flo(:,:,:)
INTEGER,ALLOCATABLE :: indt(:)
REAL,ALLOCATABLE :: vr0(:,:)
COMPLEX :: cil
REAL :: temp
INTEGER i,l,l2,lamda,lh,lm,lmin,lmin0,lmp,lmpl,lmplm,lmx,lmxx,lp,info,in
INTEGER lp1,lpl ,mem,mems,mp,mu,nh,na,m,nsym,s,i_u,jspin1,jspin2
ALLOCATE( dvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd ))
ALLOCATE( dvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd ))
ALLOCATE( uvd(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd ))
ALLOCATE( uvu(0:atoms%lmaxd*(atoms%lmaxd+3)/2,0:sphhar%nlhd ))
ALLOCATE( f(atoms%jmtd,2,0:atoms%lmaxd,2),g(atoms%jmtd,2,0:atoms%lmaxd,2),x(atoms%jmtd))
ALLOCATE( flo(atoms%jmtd,2,atoms%nlod))
ALLOCATE( indt(0:SIZE(td%tuu,1)-1))
ALLOCATE( vr0(SIZE(v%mt,1),0:SIZE(v%mt,2)-1))
vr0=v%mt(:,:,n,jsp)
IF (jsp<3) vr0(:,0)=0.0
......@@ -179,7 +185,7 @@ CONTAINS
!---> if there are any
IF (atoms%nlo(n).GE.1) THEN
CALL tlo(atoms,sphhar,jspin,jsp,n,enpara,1,input,v%mt(1,0,n,jsp),&
na,flo,f,g,ud, ud%uuilon(:,:,jspin),ud%duilon(:,:,jspin),ud%ulouilopn(:,:,:,jspin), td)
na,flo,f(:,:,:,jspin),g(:,:,:,jspin),ud, ud%uuilon(:,:,jspin),ud%duilon(:,:,jspin),ud%ulouilopn(:,:,:,jspin), td)
ENDIF
END SUBROUTINE tlmplm
......
......@@ -6,10 +6,8 @@ MODULE m_alineso
! Eigenvalues and vectors (eig_so and zso) are returned
!----------------------------------------------------------------------
CONTAINS
SUBROUTINE alineso(eig_id,lapw,&
mpi,DIMENSION,atoms,sym,kpts,&
input,noco,cell,oneD, nk, usdus,rsoc,&
nsize,nmat, eig_so,zso)
SUBROUTINE alineso(eig_id,lapw,mpi,DIMENSION,atoms,sym,kpts,input,noco,&
cell,oneD, nk, usdus,rsoc,nsize,nmat, eig_so,zso)
#include"cpp_double.h"
USE m_types
......@@ -99,16 +97,12 @@ CONTAINS
zso(:,:,:)= CMPLX(0.,0.)
DO jsp = 1,input%jspins
CALL read_eig(&
eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
CALL read_eig(eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
IF (judft_was_argument("-debugtime")) THEN
WRITE(6,*) "Non-SOC ev for nk,jsp:",nk,jsp
WRITE(6,"(6(f10.6,1x))") eig(:ne,jsp)
ENDIF
CALL read_eig(&
eig_id,nk,jsp,&
n_start=1,n_end=ne,&
zmat=zmat(jsp))
CALL read_eig(eig_id,nk,jsp,n_start=1,n_end=ne,zmat=zmat(jsp))
! write(*,*) 'process',irank,' reads ',nk
......@@ -156,50 +150,36 @@ CONTAINS
nat_stop = atoms%nat
ENDIF
nat_l = nat_stop - nat_start + 1
!
! set up A and B coefficients
!
ALLOCATE ( ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) )
ALLOCATE ( bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins) )
ALLOCATE ( chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins) )
ALLOCATE (ahelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins))
ALLOCATE (bhelp(atoms%lmaxd*(atoms%lmaxd+2),nat_l,DIMENSION%neigd,input%jspins))
ALLOCATE (chelp(-atoms%llod :atoms%llod, DIMENSION%neigd,atoms%nlod,nat_l,input%jspins))
CALL timestart("alineso SOC: -help")
write(*,*) nat_start,nat_stop,nat_l
CALL hsohelp(&
& DIMENSION,atoms,sym,&
& input,lapw,nsz,&
& cell,&
& zmat,usdus,&
& zso,noco,oneD,&
& nat_start,nat_stop,nat_l,&
& ahelp,bhelp,chelp)
CALL hsohelp(DIMENSION,atoms,sym,input,lapw,nsz,cell,zmat,usdus,&
zso,noco,oneD,nat_start,nat_stop,nat_l,ahelp,bhelp,chelp)
CALL timestop("alineso SOC: -help")
!
! set up hamilton matrix
!
CALL timestart("alineso SOC: -ham")
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%MPI_COMM,ierr)
#endif
ALLOCATE ( hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2) )
ALLOCATE (hsomtx(DIMENSION%neigd,DIMENSION%neigd,2,2))
CALL hsoham(atoms,noco,input,nsz,dimension%neigd,chelp,rsoc,ahelp,bhelp,&
nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,&
hsomtx)
write(*,*) 'after hsoham'
DEALLOCATE ( ahelp,bhelp,chelp )
nat_start,nat_stop,mpi%n_rank,mpi%n_size,mpi%SUB_COMM,hsomtx)
DEALLOCATE (ahelp,bhelp,chelp)
CALL timestop("alineso SOC: -ham")
IF (mpi%n_rank==0) THEN
!
! add e.v. on diagonal
!
! write(*,*) '!!!!!!!!!!! remove SOC !!!!!!!!!!!!!!'
! hsomtx = 0 !!!!!!!!!!!!
DO jsp = 1,input%jspins
DO i = 1,nsz(jsp)
hsomtx(i,i,jsp,jsp) = hsomtx(i,i,jsp,jsp) +&
& CMPLX(eig(i,jsp),0.)
hsomtx(i,i,jsp,jsp) = hsomtx(i,i,jsp,jsp) + CMPLX(eig(i,jsp),0.)
IF (input%jspins.EQ.1) THEN
hsomtx(i,i,2,2) = hsomtx(i,i,2,2) +&
& CMPLX(eig(i,jsp),0.)
hsomtx(i,i,2,2) = hsomtx(i,i,2,2) + CMPLX(eig(i,jsp),0.)
ENDIF
ENDDO
ENDDO
......@@ -207,34 +187,33 @@ CONTAINS
!
! resort H-matrix
!
ALLOCATE ( hso(2*DIMENSION%neigd,2*DIMENSION%neigd) )
ALLOCATE (hso(2*DIMENSION%neigd,2*DIMENSION%neigd))
DO jsp = 1,2
DO jsp1 = 1,2
IF (jsp.EQ.1) nn = 0
IF (jsp1.EQ.1) nn1 = 0
IF (jsp.EQ.2) nn = nsz(1)
IF (jsp1.EQ.2) nn1 = nsz(1)
!
!write(3333,'(2i3,4e15.8)') jsp,jsp1,hsomtx(jsp,jsp1,8,8),hsomtx(jsp,jsp1,32,109)
DO i = 1,nsz(jsp)
DO j = 1,nsz(jsp1)
hso(i+nn,j+nn1) = hsomtx(i,j,jsp,jsp1)
ENDDO
ENDDO
!
ENDDO
ENDDO
DEALLOCATE ( hsomtx )
DEALLOCATE (hsomtx)
!
! add Sigma-vxc (QSGW)
!
IF( l_qsgw ) THEN
IF(l_qsgw) THEN
nbas = lapw%nv(1) + atoms%nlotot
WRITE(*,'(A,I3,A,I5,A)') 'Read fleur.qsgw (',nk,',',nbas,')'
IF( input%jspins .EQ. 2 ) STOP 'alineso: GW+noco not implemented.'
ALLOCATE ( sigma_xc(2*nsz(1),2*nsz(1)) )
ALLOCATE ( sigma_xc_apw(nbas,nbas) )
ALLOCATE (sigma_xc(2*nsz(1),2*nsz(1)))
ALLOCATE (sigma_xc_apw(nbas,nbas))
INQUIRE(667,opened=l_open)
IF( .NOT.l_open ) THEN
IF( nk.NE.1 ) STOP 'unit 667 not opened but not at 1st k'
......@@ -260,12 +239,12 @@ CONTAINS
j = nsz(1) * (jsp2-1) + 1 ; j1 = nsz(1) * jsp2
if (l_real) THEN
sigma_xc(i:i1,j:j1) = &
& MATMUL ( TRANSPOSE(zmat(1)%data_r(:nbas,:)) ,&
& MATMUL ( sigma_xc_apw, zmat(1)%data_r(:nbas,:) ) )
MATMUL ( TRANSPOSE(zmat(1)%data_r(:nbas,:)) ,&
MATMUL ( sigma_xc_apw, zmat(1)%data_r(:nbas,:) ) )
else
sigma_xc(i:i1,j:j1) = &
& MATMUL ( CONJG(TRANSPOSE(zmat(1)%data_c(:nbas,:))) ,&
& MATMUL ( sigma_xc_apw, zmat(1)%data_c(:nbas,:) ) )
MATMUL ( CONJG(TRANSPOSE(zmat(1)%data_c(:nbas,:))) ,&
MATMUL ( sigma_xc_apw, zmat(1)%data_c(:nbas,:) ) )
endif
hso(i:i1,j:j1) = hso(i:i1,j:j1) + CONJG(sigma_xc(i:i1,j:j1))
IF(jsp1.NE.jsp2) THEN
......@@ -274,7 +253,7 @@ else
ENDIF
ENDDO
ENDDO
DEALLOCATE ( sigma_xc_apw )
DEALLOCATE (sigma_xc_apw)
ENDIF
!
......@@ -285,29 +264,25 @@ else
CALL timestart("alineso SOC: -diag")
ALLOCATE ( cwork(idim_c),rwork(idim_r) )
ALLOCATE (cwork(idim_c),rwork(idim_r))
IF (input%eonly) THEN
vectors= 'N'
ELSE
vectors= 'V'
ENDIF
CALL CPP_LAPACK_cheev(vectors,'U',nsize,&
& hso,2*DIMENSION%neigd,&
& eig_so,&
& cwork, idim_c, rwork, &
& info)
CALL CPP_LAPACK_cheev(vectors,'U',nsize,hso,2*DIMENSION%neigd,eig_so,&
cwork, idim_c, rwork, info)
IF (info.NE.0) WRITE (6,FMT=8000) info
8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4)
CALL timestop("alineso SOC: -diag")
DEALLOCATE ( cwork,rwork )
DEALLOCATE (cwork,rwork)
IF (input%eonly) THEN
IF(l_socvec) CALL juDFT_error&
& ("EONLY set. Vectors not calculated.",calledby ="alineso")
IF(l_socvec) CALL juDFT_error("EONLY set. Vectors not calculated.",calledby ="alineso")
ELSE
ALLOCATE ( zhelp2(DIMENSION%neigd,2*DIMENSION%neigd) )
ALLOCATE (zhelp2(DIMENSION%neigd,2*DIMENSION%neigd))
!
! proj. back to G - space: old eigenvector 'z' to new one 'Z'
! +
......@@ -354,11 +329,11 @@ else
& MATMUL ( sigma_xc , CONJG(hso(:nn,:nn)) ) )
WRITE(1014) nn
WRITE(1014) ((sigma_xc(i,j),i=1,j),j=1,nn)
DEALLOCATE ( sigma_xc )
DEALLOCATE (sigma_xc)
ENDIF
ENDIF
DEALLOCATE ( zhelp2 )
DEALLOCATE (zhelp2)
ENDIF ! (.NOT.input%eonly)
DEALLOCATE ( hso )
......
......@@ -148,7 +148,7 @@ CONTAINS
'branchLowest ','branchHighest','value '/),&
attributes,RESHAPE((/12,4,6,12,13,5,6,1,3,8,8,16/),(/6,2/)))
ENDIF
WRITE(6,'(a6,i3,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
WRITE(6,'(a6,i5,i2,a1,a12,f6.2,a3,f6.2,a13,f8.4)') ' Atom',n,nqn,ch(l),' branch from',&
e_lo, ' to',e_up,' htr. ; e_l =',e
ENDIF
END FUNCTION priv_method1
......
......@@ -11,7 +11,7 @@ MODULE m_qfix
! qfix file no longer supported!
CONTAINS
SUBROUTINE qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,&
SUBROUTINE qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,&