From 7b39300755726b28f35de8e943084a11708cb657 Mon Sep 17 00:00:00 2001 From: Daniel Wortmann Date: Fri, 29 Apr 2016 17:07:42 +0200 Subject: [PATCH] Fixed many SOC related bugs, more to come :-) --- eigen_soc/alineso.F90 | 12 ++++++------ eigen_soc/eigenso.f90 | 10 +++------- eigen_soc/soinit.f90 | 2 +- eigen_soc/sorad.f90 | 10 +++++----- eigen_soc/spnorb.f90 | 11 +++++------ 5 files changed, 20 insertions(+), 25 deletions(-) diff --git a/eigen_soc/alineso.F90 b/eigen_soc/alineso.F90 index c935b00a..acbd40b0 100644 --- a/eigen_soc/alineso.F90 +++ b/eigen_soc/alineso.F90 @@ -98,17 +98,17 @@ CONTAINS z(:,:,:)= 0. zso(:,:,:)= CMPLX(0.,0.) - ALLOCATE(lapw%k1(DIMENSION%nvd,1)) - ALLOCATE(lapw%k2(DIMENSION%nvd,1)) - ALLOCATE(lapw%k3(DIMENSION%nvd,1)) - ALLOCATE(lapw%rk(DIMENSION%nvd,1)) + ALLOCATE(lapw%k1(DIMENSION%nvd,input%jspins)) + ALLOCATE(lapw%k2(DIMENSION%nvd,input%jspins)) + ALLOCATE(lapw%k3(DIMENSION%nvd,input%jspins)) + ALLOCATE(lapw%rk(DIMENSION%nvd,input%jspins)) DO jsp = 1,input%jspins CALL read_eig(& eig_id,nk,jsp,& bk=bkdu,el=epar,ello=ello(:,:,jsp),& evac=evac,neig=ne,eig=eig(:,jsp),& - nmat=lapw%nmat,nv=lapw%nv(1),k1=lapw%k1(:,1),k2=lapw%k2(:,1),k3=lapw%k3(:,1),kveclo=kveclo) + nmat=lapw%nmat,nv=lapw%nv(jsp),k1=lapw%k1(:,jsp),k2=lapw%k2(:,jsp),k3=lapw%k3(:,jsp),kveclo=kveclo) CALL read_eig(& eig_id,nk,jsp,& n_start=1,n_end=ne,& @@ -163,7 +163,7 @@ CONTAINS ! set up hamilton matrix ! - CALL timestop("alineso SOC: -ham") + CALL timestart("alineso SOC: -ham") ALLOCATE ( hsomtx(2,2,DIMENSION%neigd,DIMENSION%neigd) ) CALL hsoham(& & atoms,noco,input,nsz,chelp,& diff --git a/eigen_soc/eigenso.f90 b/eigen_soc/eigenso.f90 index 1c230565..a551fe13 100644 --- a/eigen_soc/eigenso.f90 +++ b/eigen_soc/eigenso.f90 @@ -134,13 +134,8 @@ CONTAINS soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2) ) soangl(:,:,:,:,:,:) = CMPLX(0.0,0.0) - CALL spnorb(& - atoms,noco,input,mpi,& - enpara,vr,& - input%sso_opt(atoms%ntype+2), & - rsopp,rsoppd,rsopdp,rsopdpd,usdus,& - rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop,& - soangl) + CALL spnorb( atoms,noco,input,mpi, enpara,vr, rsopp,rsoppd,rsopdp,rsopdpd,usdus,& + rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl) ! l_all = .FALSE. INQUIRE (file='allbut',exist=l_all) @@ -271,6 +266,7 @@ CONTAINS ELSE DO jspin = 1,wannierspin + CALL timestart("eigenso: write_eig") CALL write_eig(eig_id,& nk,jspin,neig=nsz,neig_total=nsz,nmat=SIZE(zso,1),& eig=eig_so(:nsz),z=zso(:,:nsz,jspin)) diff --git a/eigen_soc/soinit.f90 b/eigen_soc/soinit.f90 index fa2267ea..57b83ba6 100644 --- a/eigen_soc/soinit.f90 +++ b/eigen_soc/soinit.f90 @@ -16,7 +16,7 @@ CONTAINS TYPE(t_enpara),INTENT(IN) :: enpara TYPE(t_input),INTENT(IN) :: input TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_usdus),INTENT(OUT) :: usdus + TYPE(t_usdus),INTENT(INOUT) :: usdus ! ! .. Scalar Arguments .. ! .. diff --git a/eigen_soc/sorad.f90 b/eigen_soc/sorad.f90 index af89fb63..670e7c29 100644 --- a/eigen_soc/sorad.f90 +++ b/eigen_soc/sorad.f90 @@ -20,7 +20,7 @@ CONTAINS TYPE(t_enpara),INTENT(IN) :: enpara TYPE(t_input),INTENT(IN) :: input TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_usdus),INTENT(OUT) :: usdus + TYPE(t_usdus),INTENT(INOUT) :: usdus ! .. ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: ntyp @@ -113,10 +113,10 @@ CONTAINS IF (l.GT.0) THEN ! there is no spin-orbit for s-states DO i = 1, 2 DO j = 1, 2 - rsopp(ntyp,l,i,j) = radso( p(:,i), p(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) - rsopdp(ntyp,l,i,j) = radso(pd(:,i), p(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) - rsoppd(ntyp,l,i,j) = radso( p(:,i),pd(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) - rsopdpd(ntyp,l,i,j) = radso(pd(:,i),pd(:,j),vso(:,i),atoms%rmsh(1,ntyp),atoms%dx(ntyp)) + rsopp(ntyp,l,i,j) = radso( p(:,i), p(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp)) + rsopdp(ntyp,l,i,j) = radso(pd(:,i), p(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp)) + rsoppd(ntyp,l,i,j) = radso( p(:,i),pd(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp)) + rsopdpd(ntyp,l,i,j) = radso(pd(:,i),pd(:,j),vso(:,i),atoms%dx(ntyp),atoms%rmsh(1,ntyp)) ENDDO ENDDO ENDIF ! l>0 diff --git a/eigen_soc/spnorb.f90 b/eigen_soc/spnorb.f90 index 5b29c062..a7c2f6f7 100644 --- a/eigen_soc/spnorb.f90 +++ b/eigen_soc/spnorb.f90 @@ -6,7 +6,7 @@ MODULE m_spnorb ! using the functions anglso and sgml. !********************************************************************* CONTAINS - SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr,spav, rsopp,rsoppd,rsopdp,rsopdpd,& + SUBROUTINE spnorb(atoms,noco,input,mpi, enpara, vr, rsopp,rsoppd,rsopdp,rsopdpd,& usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl) USE m_anglso @@ -21,10 +21,8 @@ CONTAINS TYPE(t_input),INTENT(IN) :: input TYPE(t_noco),INTENT(IN) :: noco TYPE(t_atoms),INTENT(IN) :: atoms - TYPE(t_usdus),INTENT(OUT) :: usdus + TYPE(t_usdus),INTENT(INOUT) :: usdus ! .. - ! .. Scalar Arguments .. - LOGICAL, INTENT (IN) :: spav ! if T, spin-averaged pot is used ! .. ! .. Array Arguments .. REAL, INTENT (IN) :: vr(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntypd,dimension%jspd) @@ -49,8 +47,9 @@ CONTAINS ! .. DATA ispjsp/1,-1/ - CALL soinit(atoms,input,enpara, vr,spav, rsopp,rsoppd,rsopdp,rsopdpd,& - usdus, rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop) + CALL soinit(atoms,input,enpara, vr,noco%soc_opt(atoms%ntype+2), & + rsopp,rsoppd,rsopdp,rsopdpd, usdus,rsoplop,rsoplopd,rsopdplo,& + rsopplo,rsoploplop) ! IF (mpi%irank.EQ.0) THEN DO n = 1,atoms%ntype -- GitLab