Commit 4543f0e1 authored by S.Rost's avatar S.Rost

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents de766e79 e169e840
......@@ -100,7 +100,7 @@ build-intel:
- build.intel
script:
- set +e && source compilervars.sh intel64 && set -e ; ulimit -s unlimited
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel AUTO ; cd build.intel; make
- cd /builds/fleur/fleur; FC=mpiifort FLEUR_LIBRARIES="-lmkl_scalapack_lp64;-lmkl_blacs_intelmpi_lp64" ./configure.sh -t -l intel INTEL_MPI ; cd build.intel; make
only:
- schedules
- triggers
......
......@@ -109,10 +109,10 @@
LOGICAL,INTENT (IN) :: l_st
! ..
! .. Array Arguments ..
COMPLEX,INTENT (INOUT) :: qpw(stars%ng3,DIMENSION%jspd)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,DIMENSION%jspd)
COMPLEX,INTENT (INOUT) :: qpw(stars%ng3,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
REAL, INTENT (INOUT) :: rh(DIMENSION%msh,atoms%ntype)
! ..
! .. Local Scalars ..
......
......@@ -127,7 +127,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end)) ! Deallocation before mpi_col_den
ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end))
ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,dimension%jspd))
ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,input%jspins))
! Initializations
CALL usdus%init(atoms,input%jspins)
......@@ -227,7 +227,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
IF (input%film) CALL regCharges%sumBandsVac(vacuum,dos,noccbd,ikpt,jsp_start,jsp_end,eig,we)
! valence density in the atomic spheres
CALL eigVecCoeffs%init(dimension,atoms,noco,jspin,noccbd)
CALL eigVecCoeffs%init(input,DIMENSION,atoms,noco,jspin,noccbd)
DO ispin = jsp_start, jsp_end
IF (input%l_f) CALL force%init2(noccbd,input,atoms)
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
......@@ -276,7 +276,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#endif
IF (mpi%irank==0) THEN
CALL cdnmt(dimension%jspd,atoms,sphhar,noco,jsp_start,jsp_end,&
CALL cdnmt(input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,den%mt)
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO ispin = jsp_start,jsp_end
......
......@@ -20,8 +20,8 @@ CONTAINS
INTEGER, INTENT (IN) :: l,ityp
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)
REAL, INTENT (INOUT) :: uu21n(0:atoms%lmaxd,atoms%ntype),ud21n(0:atoms%lmaxd,atoms%ntype)
REAL, INTENT (INOUT) :: du21n(0:atoms%lmaxd,atoms%ntype),dd21n(0:atoms%lmaxd,atoms%ntype)
......
......@@ -25,9 +25,9 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ilo,n
! ... Array Arguments
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,dimension%jspd)
REAL, INTENT (IN) :: flo(:,:,:,:)!(atoms%jmtd,2,atoms%nlod,dimension%jspd)
REAL, INTENT (IN) :: f(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)
REAL, INTENT (IN) :: g(:,:,0:,:)!(atoms%jmtd,2,0:atoms%lmaxd,input%jspins)
REAL, INTENT (IN) :: flo(:,:,:,:)!(atoms%jmtd,2,atoms%nlod,input%jspins)
! ...local scalars
INTEGER iri,l,lp,ilop
......
......@@ -29,7 +29,7 @@ CONTAINS
INTEGER, INTENT (IN) :: itype, iRepAtom
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: chmom(:,:)!(atoms%ntype,dimension%jspd)
REAL, INTENT (IN) :: chmom(:,:)!(atoms%ntype,input%jspins)
REAL, INTENT (IN) :: vr0(:,:,:)!(atoms%jmtd,atoms%ntype,jspd)
COMPLEX, INTENT (IN) :: qa21(atoms%ntype)
! ..
......
......@@ -39,7 +39,7 @@ CONTAINS
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: qpwc(stars%ng3)
REAL, INTENT (INOUT) :: rho(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: rho(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
!-odim
!+odim
! ..
......
......@@ -70,15 +70,15 @@ CONTAINS
INTEGER,PARAMETER :: n2max=13
REAL,PARAMETER :: emax=2.0/hartree_to_ev_const
! .. Array Arguments ..
REAL, INTENT(IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT(IN) :: evac(2,input%jspins)
REAL, INTENT(IN) :: we(DIMENSION%neigd)
REAL :: vz(vacuum%nmzd,2) ! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments
REAL, INTENT (IN) :: eig(DIMENSION%neigd)
! local STM variables
INTEGER nv2(DIMENSION%jspd)
INTEGER kvac1(DIMENSION%nv2d,DIMENSION%jspd),kvac2(DIMENSION%nv2d,DIMENSION%jspd),map2(DIMENSION%nvd,DIMENSION%jspd)
INTEGER kvac3(DIMENSION%nv2d,DIMENSION%jspd),map1(DIMENSION%nvd,DIMENSION%jspd)
INTEGER nv2(input%jspins)
INTEGER kvac1(DIMENSION%nv2d,input%jspins),kvac2(DIMENSION%nv2d,input%jspins),map2(DIMENSION%nvd,input%jspins)
INTEGER kvac3(DIMENSION%nv2d,input%jspins),map1(DIMENSION%nvd,input%jspins)
INTEGER mapg2k(DIMENSION%nv2d)
! .. Local Scalars ..
COMPLEX aa,ab,av,ba,bb,bv,t1,aae,bbe,abe,bae,aaee,bbee,abee,baee,&
......@@ -138,14 +138,14 @@ CONTAINS
CALL timestart("vacden")
ALLOCATE ( ac(DIMENSION%nv2d,DIMENSION%neigd,DIMENSION%jspd),bc(DIMENSION%nv2d,DIMENSION%neigd,DIMENSION%jspd),dt(DIMENSION%nv2d),&
ALLOCATE ( ac(DIMENSION%nv2d,DIMENSION%neigd,input%jspins),bc(DIMENSION%nv2d,DIMENSION%neigd,input%jspins),dt(DIMENSION%nv2d),&
& dte(DIMENSION%nv2d),du(vacuum%nmzd),ddu(vacuum%nmzd,DIMENSION%nv2d),due(vacuum%nmzd),&
& ddue(vacuum%nmzd,DIMENSION%nv2d),t(DIMENSION%nv2d),te(DIMENSION%nv2d),&
& tei(DIMENSION%nv2d,DIMENSION%jspd),u(vacuum%nmzd,DIMENSION%nv2d,DIMENSION%jspd),ue(vacuum%nmzd,DIMENSION%nv2d,DIMENSION%jspd),&
& tei(DIMENSION%nv2d,input%jspins),u(vacuum%nmzd,DIMENSION%nv2d,input%jspins),ue(vacuum%nmzd,DIMENSION%nv2d,input%jspins),&
& v(3),yy(vacuum%nmzd))
IF (oneD%odi%d1) THEN
ALLOCATE ( ac_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,DIMENSION%jspd),&
& bc_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,DIMENSION%jspd),&
ALLOCATE ( ac_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,input%jspins),&
& bc_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%neigd,input%jspins),&
& dt_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),&
& dte_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),&
& du_1(vacuum%nmzd,-oneD%odi%mb:oneD%odi%mb),&
......@@ -154,9 +154,9 @@ CONTAINS
& ddue_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),&
& t_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),&
& te_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb),&
& tei_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%jspd),&
& u_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%jspd),&
& ue_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,DIMENSION%jspd) )
& tei_1(DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins),&
& u_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins),&
& ue_1(vacuum%nmzd,DIMENSION%nv2d,-oneD%odi%mb:oneD%odi%mb,input%jspins) )
END IF ! oneD%odi%d1
!
......
......@@ -26,9 +26,9 @@ SUBROUTINE calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffs), INTENT(INOUT) :: denCoeffs
INTEGER, INTENT(IN) :: noccbd
REAL, INTENT(IN) :: we(noccbd)
INTEGER, INTENT(IN) :: noccbd
INTEGER, INTENT(IN) :: ispin
!---> set up coefficients for the spherical and
......
......@@ -47,10 +47,10 @@ SUBROUTINE cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
REAL :: seig, rhoint, momint
LOGICAL, PARAMETER :: l_st=.FALSE.
REAL :: rh(dimension%msh,atoms%ntype,dimension%jspd)
REAL :: qint(atoms%ntype,dimension%jspd)
REAL :: tec(atoms%ntype,DIMENSION%jspd)
REAL :: rhTemp(dimension%msh,atoms%ntype,dimension%jspd)
REAL :: rh(dimension%msh,atoms%ntype,input%jspins)
REAL :: qint(atoms%ntype,input%jspins)
REAL :: tec(atoms%ntype,input%jspins)
REAL :: rhTemp(dimension%msh,atoms%ntype,input%jspins)
results%seigc = 0.0
IF (mpi%irank.EQ.0) THEN
......
......@@ -8,18 +8,18 @@ MODULE m_orbMagMoms
CONTAINS
SUBROUTINE orbMagMoms(dimension,atoms,noco,clmom)
SUBROUTINE orbMagMoms(input,atoms,noco,clmom)
USE m_types
USE m_xmlOutput
IMPLICIT NONE
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_input), INTENT(IN) :: input
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_noco), INTENT(IN) :: noco
REAL, INTENT(INOUT) :: clmom(3,atoms%ntype,dimension%jspd)
REAL, INTENT(INOUT) :: clmom(3,atoms%ntype,input%jspins)
INTEGER :: iType, j
REAL :: thetai, phii, slmom, slxmom, slymom
......
......@@ -24,10 +24,10 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: rhochr(:),rhospn(:)!(dimension%msh)
REAL, INTENT (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: tecs(:,:)!(atoms%ntype,dimension%jspd)
REAL, INTENT (OUT) :: qints(:,:)!(atoms%ntype,dimension%jspd)
REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd)
REAL, INTENT (IN) :: vrs(:,:,:)!(atoms%jmtd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: tecs(:,:)!(atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: qints(:,:)!(atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rho(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL d,dxx,q,rad,rhs
......
......@@ -30,10 +30,10 @@ CONTAINS
! ..
! .. Array Arguments ..
REAL, INTENT(IN) :: vr(atoms%jmtd,atoms%ntype)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd)
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,DIMENSION%jspd)
REAL, INTENT(INOUT) :: qint(atoms%ntype,DIMENSION%jspd)
REAL, INTENT(INOUT) :: tec(atoms%ntype,DIMENSION%jspd)
REAL, INTENT(INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: qint(atoms%ntype,input%jspins)
REAL, INTENT(INOUT) :: tec(atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL e,fj,fl,fn,q,rad,rhos,rhs,sea,sume,t2
......@@ -85,7 +85,7 @@ CONTAINS
! rn = rmt(jatom)
dxx = atoms%dx(jatom)
bmu = 0.0
CALL setcor(jatom,DIMENSION%jspd,atoms,input,bmu,nst,kappa,nprnc,occ_h)
CALL setcor(jatom,input%jspins,atoms,input,bmu,nst,kappa,nprnc,occ_h)
IF ((bmu > 99.)) THEN
occ(1:nst) = input%jspins * occ_h(1:nst,jspin)
ELSE
......
......@@ -21,9 +21,9 @@ CONTAINS
REAL seig
! ..
! .. Array Arguments ..
REAL , INTENT (IN) :: vrs(atoms%jmtd,atoms%ntype,DIMENSION%jspd)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd)
REAL, INTENT (OUT) :: rhc(DIMENSION%msh,atoms%ntype,DIMENSION%jspd),qints(atoms%ntype,DIMENSION%jspd)
REAL , INTENT (IN) :: vrs(atoms%jmtd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (OUT) :: rhc(DIMENSION%msh,atoms%ntype,input%jspins),qints(atoms%ntype,input%jspins)
! ..
! .. Local Scalars ..
REAL dxx,rnot,sume,t2,t2b,z,t1,rr,d,v1,v2
......@@ -32,8 +32,8 @@ CONTAINS
! ..
! .. Local Arrays ..
REAL br(atoms%jmtd,atoms%ntype),brd(DIMENSION%msh),etab(100,atoms%ntype),&
rhcs(atoms%jmtd,atoms%ntype,DIMENSION%jspd),rhochr(DIMENSION%msh),rhospn(DIMENSION%msh),&
tecs(atoms%ntype,DIMENSION%jspd),vr(atoms%jmtd,atoms%ntype),vrd(DIMENSION%msh)
rhcs(atoms%jmtd,atoms%ntype,input%jspins),rhochr(DIMENSION%msh),rhospn(DIMENSION%msh),&
tecs(atoms%ntype,input%jspins),vr(atoms%jmtd,atoms%ntype),vrd(DIMENSION%msh)
INTEGER nkmust(atoms%ntype),ntab(100,atoms%ntype),ltab(100,atoms%ntype)
! ..
......
......@@ -117,7 +117,7 @@ CONTAINS
IF (TRIM(juDFT_string_for_argument("-diag"))=="chase") THEN
nevd = min(dimension%neigd,dimension%nvd+atoms%nlotot)
nexd = min(max(nevd/4, 45),dimension%nvd+atoms%nlotot-nevd) !dimensioning for workspace
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,DIMENSION%jspd,&
chase_eig_id=open_eig(mpi%mpi_comm,DIMENSION%nbasfcn,nevd+nexd,kpts%nkpt,input%jspins,&
noco%l_noco,.TRUE.,l_real,noco%l_soc,.FALSE.,mpi%n_size)
END IF
END SUBROUTINE init_chase
......
......@@ -611,7 +611,7 @@ MODULE m_corespec_eval
ila1la2 = cimu**(la1-la2)
if(abs(real(td(1))).gt.0.d0.or.abs(real(td(2))).gt.0.d0.or.abs(imag(td(2))).gt.0.d0) then
if(abs(real(td(1))).gt.0.d0.or.abs(real(td(2))).gt.0.d0.or.abs(aimag(td(2))).gt.0.d0) then
write(39,'(2f4.0,i2,6i4,a,6i4,a,6f7.3,a,4f10.6)') ila1la2,la1-la2,l1,-m1,la1,mu1,li,mi,' ',l2,-m2,la2,mu2,li,mi,' ',ga(0,1),ga(0,2),ga(1,1),ga(1,2),ga(2,1),ga(2,2),' ',1000000*td
endif
......
......@@ -105,7 +105,7 @@ CONTAINS
INTEGER :: comm(kpts%nkpt),irank2(kpts%nkpt),isize2(kpts%nkpt), dealloc_stat
character(len=300) :: errmsg
call ud%init(atoms,DIMENSION%jspd)
call ud%init(atoms,input%jspins)
ALLOCATE (eig(DIMENSION%neigd),bkpt(3))
l_real=sym%invs.AND..NOT.noco%l_noco
......
......@@ -38,22 +38,22 @@ CONTAINS
!up-up component (or only component in collinear case)
IF (SIZE(mat)==1) THEN
CALL mat_final%move(mat(1,1))
!CALL mat(1,1)%free()
CALL mat(1,1)%free()
RETURN
ENDIF
CALL mat_final%copy(mat(1,1),1,1)
!CALL mat(1,1)%free()
CALL mat(1,1)%free()
!down-down component
CALL mat_final%copy(mat(2,2),lapw%nv(1)+atoms%nlotot+1,lapw%nv(1)+atoms%nlotot+1)
!CALL mat(2,2)%free()
CALL mat(2,2)%free()
!Now collect off-diagonal parts
CALL mat(1,2)%add_transpose(mat(2,1))
CALL mat_final%copy(mat(1,2),1,lapw%nv(1)+atoms%nlotot+1)
!CALL mat(1,2)%free()
!CALL mat(2,1)%free()
CALL mat(1,2)%free()
CALL mat(2,1)%free()
END SUBROUTINE eigen_redist_matrix
END MODULE m_eigen_redist_matrix
......
......@@ -11,7 +11,7 @@ CONTAINS
USE m_types
COMPLEX,INTENT(in) :: chi(2,2)
TYPE(t_mat),INTENT(IN) :: mat_tmp
CLASS(t_mat),INTENT(INOUT):: mat(2,2)
CLASS(t_mat),INTENT(INOUT):: mat(:,:)
INTEGER:: iintsp,jintsp
......
......@@ -6,8 +6,109 @@
MODULE m_hsmt_fjgj
USE m_juDFT
IMPLICIT NONE
INTERFACE hsmt_fjgj
module procedure hsmt_fjgj_cpu
#ifdef CPP_GPU
module procedure hsmt_fjgj_gpu
#endif
END INTERFACE
CONTAINS
SUBROUTINE hsmt_fjgj(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
#ifdef CPP_GPU
SUBROUTINE synth_fjgj(nv,ispin,jspins,lmax,lmaxd,apw,l_flag,rk,rmt,con1,uds,dus,us,duds,fj,gj)
USE m_sphbes
USE m_dsphbs
INTEGER, INTENT(IN) :: nv, ispin, jspins, lmax, lmaxd
LOGICAL, INTENT(IN) :: apw(0:lmaxd), l_flag
REAL, INTENT(IN) :: rk(:),rmt,con1
REAL, INTENT(IN) :: uds(0:lmaxd,jspins),dus(0:lmaxd,jspins),us(0:lmaxd,jspins),duds(0:lmaxd,jspins)
REAL,INTENT(OUT),MANAGED :: fj(:,0:,:),gj(:,0:,:)
REAL gb(0:lmaxd), fb(0:lmaxd)
REAL ws(jspins)
REAL ff,gg,gs
INTEGER k,l,jspin
DO k = 1,nv
gs = rk(k)*rmt
CALL sphbes(lmax,gs,fb)
CALL dsphbs(lmax,gs,fb,gb)
DO l = 0,lmax
!---> set up wronskians for the matching conditions for each ntype
DO jspin = 1, jspins
ws(jspin) = con1/(uds(l,jspin)*dus(l,jspin) - us(l,jspin)*duds(l,jspin))
END DO
ff = fb(l)
gg = rk(k)*gb(l)
IF ( apw(l) ) THEN
fj(k,l,ispin) = 1.0*con1 * ff / us(l,ispin)
gj(k,l,ispin) = 0.0d0
ELSE
IF (l_flag) THEN
DO jspin = 1, jspins
fj(k,l,jspin) = ws(jspin) * ( uds(l,jspin)*gg - duds(l,jspin)*ff )
gj(k,l,jspin) = ws(jspin) * ( dus(l,jspin)*ff - us(l,jspin)*gg )
END DO
ELSE
fj(k,l,ispin) = ws(ispin) * ( uds(l,ispin)*gg - duds(l,ispin)*ff )
gj(k,l,ispin) = ws(ispin) * ( dus(l,ispin)*ff - us(l,ispin)*gg )
ENDIF
ENDIF
ENDDO
ENDDO ! k = 1, lapw%nv
END SUBROUTINE synth_fjgj
SUBROUTINE hsmt_fjgj_gpu(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
!Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
!radial functions at the MT boundary as contained in usdus
USE m_constants, ONLY : fpi_const
USE m_types
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_usdus),INTENT(IN) :: usdus
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ispin,n
REAL,INTENT(OUT),MANAGED :: fj(:,0:,:,:),gj(:,0:,:,:)
! ..
! .. Local Scalars ..
REAL con1
INTEGER l,lo,intspin
LOGICAL l_socfirst
! .. Local Arrays ..
LOGICAL apw(0:atoms%lmaxd)
! ..
l_socfirst = noco%l_soc .AND. noco%l_noco .AND. (.NOT. noco%l_ss)
con1 = fpi_const/SQRT(cell%omtil)
DO l = 0,atoms%lmax(n)
apw(l)=ANY(atoms%l_dulo(:atoms%nlo(n),n))
IF ((input%l_useapw).AND.(atoms%lapw_l(n).GE.l)) apw(l) = .FALSE.
ENDDO
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n)) = .TRUE.
ENDDO
DO intspin=1,MERGE(2,1,noco%l_noco)
CALL synth_fjgj(lapw%nv(intspin),ispin,input%jspins,atoms%lmax(n),atoms%lmaxd,apw,noco%l_constr.or.l_socfirst,&
lapw%rk(:,intspin),atoms%rmt(n),con1,usdus%uds(:,n,:),usdus%dus(:,n,:),usdus%us(:,n,:),usdus%duds(:,n,:),&
fj(:,0:,:,intspin),gj(:,0:,:,intspin))
ENDDO
RETURN
END SUBROUTINE hsmt_fjgj_gpu
#endif
SUBROUTINE hsmt_fjgj_cpu(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
!Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
!radial functions at the MT boundary as contained in usdus
USE m_constants, ONLY : fpi_const
......@@ -84,5 +185,5 @@ CONTAINS
!$OMP END PARALLEL DO
ENDDO
RETURN
END SUBROUTINE hsmt_fjgj
END SUBROUTINE hsmt_fjgj_cpu
END MODULE m_hsmt_fjgj
......@@ -19,7 +19,7 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_tlmplm),INTENT(IN) :: td
CLASS(t_mat),INTENT(INOUT) :: hmat(2,2)
CLASS(t_mat),INTENT(INOUT) :: hmat(:,:)!(2,2)
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n,isp
......
......@@ -19,7 +19,7 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_usdus),INTENT(IN) :: usdus
TYPE(t_tlmplm),INTENT(IN) :: td
CLASS(t_mat),INTENT(INOUT) :: hmat(2,2)
CLASS(t_mat),INTENT(INOUT) :: hmat(:,:)!(2,2)
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n
......
......@@ -35,7 +35,7 @@ CONTAINS
INTEGER, INTENT (IN) :: jsp
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT (IN) :: evac(2,input%jspins)
! ..
! .. Local Scalars ..
COMPLEX hij,sij,apw_lo,c_1
......@@ -46,16 +46,16 @@ CONTAINS
INTEGER i_start,nc,nc_0
! ..
! .. Local Arrays ..
INTEGER:: nv2(DIMENSION%jspd)
INTEGER kvac1(DIMENSION%nv2d,DIMENSION%jspd),kvac2(DIMENSION%nv2d,DIMENSION%jspd)
INTEGER map2(DIMENSION%nvd,DIMENSION%jspd)
INTEGER:: nv2(input%jspins)
INTEGER kvac1(DIMENSION%nv2d,input%jspins),kvac2(DIMENSION%nv2d,input%jspins)
INTEGER map2(DIMENSION%nvd,input%jspins)
COMPLEX tddv(DIMENSION%nv2d,DIMENSION%nv2d),tduv(DIMENSION%nv2d,DIMENSION%nv2d)
COMPLEX tudv(DIMENSION%nv2d,DIMENSION%nv2d),tuuv(DIMENSION%nv2d,DIMENSION%nv2d)
COMPLEX vxy_help(stars%ng2-1)
COMPLEX a(DIMENSION%nvd,DIMENSION%jspd),b(DIMENSION%nvd,DIMENSION%jspd)
REAL ddnv(DIMENSION%nv2d,DIMENSION%jspd),dudz(DIMENSION%nv2d,DIMENSION%jspd)
REAL duz(DIMENSION%nv2d,DIMENSION%jspd), udz(DIMENSION%nv2d,DIMENSION%jspd)
REAL uz(DIMENSION%nv2d,DIMENSION%jspd)
COMPLEX a(DIMENSION%nvd,input%jspins),b(DIMENSION%nvd,input%jspins)
REAL ddnv(DIMENSION%nv2d,input%jspins),dudz(DIMENSION%nv2d,input%jspins)
REAL duz(DIMENSION%nv2d,input%jspins), udz(DIMENSION%nv2d,input%jspins)
REAL uz(DIMENSION%nv2d,input%jspins)
! ..
d2 = SQRT(cell%omtil/cell%area)
......
......@@ -40,9 +40,9 @@ CONTAINS
! ..
! .. Array Arguments ..
COMPLEX, INTENT (INOUT) :: vxy(vacuum%nmzxyd,n2d_1-1,2)
INTEGER, INTENT (OUT):: nv2(DIMENSION%jspd)
INTEGER, INTENT (OUT):: nv2(input%jspins)
REAL, INTENT (INOUT) :: vz(vacuum%nmzd,2,4)
REAL, INTENT (IN) :: evac(2,DIMENSION%jspd)
REAL, INTENT (IN) :: evac(2,input%jspins)
REAL, INTENT (IN) :: bkpt(3)
LOGICAL, INTENT(IN) :: l_real
......@@ -76,17 +76,17 @@ CONTAINS
ALLOCATE (&
ai(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),bi(-vM:vM,DIMENSION%nv2d,DIMENSION%nvd),&
nvp(DIMENSION%nv2d,DIMENSION%jspd),ind(stars%ng2,DIMENSION%nv2d,DIMENSION%jspd),&
kvac3(DIMENSION%nv2d,DIMENSION%jspd),map1(DIMENSION%nvd,DIMENSION%jspd),&
nvp(DIMENSION%nv2d,input%jspins),ind(stars%ng2,DIMENSION%nv2d,input%jspins),&
kvac3(DIMENSION%nv2d,input%jspins),map1(DIMENSION%nvd,input%jspins),&
tddv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),&
tduv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),&
tudv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),&
tuuv(-vM:vM,-vM:vM,DIMENSION%nv2d,DIMENSION%nv2d),&
a(-vM:vM,DIMENSION%nvd,DIMENSION%jspd),b(-vM:vM,DIMENSION%nvd,DIMENSION%jspd),&
a(-vM:vM,DIMENSION%nvd,input%jspins),b(-vM:vM,DIMENSION%nvd,input%jspins),&
bess(-vM:vM),dbss(-vM:vM),bess1(-vM:vM),&
ddnv(-vM:vM,DIMENSION%nv2d,DIMENSION%jspd),dudz(-vM:vM,DIMENSION%nv2d,DIMENSION%jspd),&
duz(-vM:vM,DIMENSION%nv2d,DIMENSION%jspd),&
udz(-vM:vM,DIMENSION%nv2d,DIMENSION%jspd),uz(-vM:vM,DIMENSION%nv2d,DIMENSION%jspd) )
ddnv(-vM:vM,DIMENSION%nv2d,input%jspins),dudz(-vM:vM,DIMENSION%nv2d,input%jspins),&
duz(-vM:vM,DIMENSION%nv2d,input%jspins),&
udz(-vM:vM,DIMENSION%nv2d,input%jspins),uz(-vM:vM,DIMENSION%nv2d,input%jspins) )
!---> set up mapping function from 3d-->1d lapws
!---> creating arrays ind and nvp
......
......@@ -36,19 +36,19 @@ CONTAINS
INTEGER, INTENT (