Commit 1f704db5 authored by Matthias Redies's avatar Matthias Redies

more mpi -> fmpi

parent 7145f59c
......@@ -514,7 +514,6 @@
real :: qf(stars%ng3)
complex qpwc_at(stars%ng3)
#ifdef CPP_MPI
external mpi_bcast
complex :: qpwc_loc(stars%ng3)
integer :: ierr
#endif
......
......@@ -23,12 +23,12 @@ MODULE m_eparas
!***********************************************************************
!
CONTAINS
SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,mpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
SUBROUTINE eparas(jsp,atoms,noccbd,ev_list,fmpi,ikpt,ne,we,eig,skip_t,l_evp,eigVecCoeffs,&
usdus,regCharges,dos,l_mcd,mcd)
USE m_types
IMPLICIT NONE
TYPE(t_usdus), INTENT(IN) :: usdus
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mpi), INTENT(IN) :: fmpi
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
......@@ -60,7 +60,7 @@ CONTAINS
!---> initialize ener, sqal, enerlo and sqlo on first call
!
IF ((ikpt.LE.mpi%isize).AND..NOT.l_evp) THEN
IF ((ikpt.LE.fmpi%isize).AND..NOT.l_evp) THEN
regCharges%ener(:,:,jsp) = 0.0
regCharges%sqal(:,:,jsp) = 0.0
regCharges%enerlo(:,:,jsp) = 0.0
......
......@@ -6,7 +6,7 @@
MODULE m_pwden
CONTAINS
SUBROUTINE pwden(stars, kpts, banddos, oneD, input, mpi, noco, cell, atoms, sym, &
SUBROUTINE pwden(stars, kpts, banddos, oneD, input, fmpi, noco, cell, atoms, sym, &
ikpt, jspin, lapw, ne, ev_list, we, eig, den, results, f_b8, zMat, dos)
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! In this subroutine the star function expansion coefficients of
......@@ -83,7 +83,7 @@ CONTAINS
USE m_fft_interface
IMPLICIT NONE
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mpi), INTENT(IN) :: fmpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_input), INTENT(IN) :: input
......@@ -257,7 +257,7 @@ CONTAINS
!
IF (noco%l_noco) THEN
rhomat = 0.0
IF (ikpt .LE. mpi%isize) THEN
IF (ikpt .LE. fmpi%isize) THEN
dos%qis = 0.0
ENDIF
ELSE
......
......@@ -12,7 +12,7 @@ MODULE m_qpwtonmt
! Stefan Bl"ugel , IFF, Nov. 1997
!***************************************************************
CONTAINS
SUBROUTINE qpw_to_nmt(sphhar,atoms,stars,sym,cell,oneD,mpi,jspin,l_cutoff,qpwc,rho)
SUBROUTINE qpw_to_nmt(sphhar,atoms,stars,sym,cell,oneD,fmpi,jspin,l_cutoff,qpwc,rho)
!
USE m_constants
USE m_phasy1
......@@ -29,7 +29,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
INTEGER, INTENT (IN) :: jspin,l_cutoff
! ..
......@@ -87,7 +87,7 @@ CONTAINS
!
! ----> g=0 component
CALL timestart("qpw_to_nmt")
IF (mpi%irank == 0) THEN
IF (fmpi%irank == 0) THEN
cp = qpwc(1)*stars%nstr(1)
DO n = 1 , atoms%ntype
DO j = 1,atoms%jri(n)
......@@ -115,7 +115,7 @@ CONTAINS
!$ ALLOCATE(rho_tmp(size(rho,1),0:size(rho,2)-1,size(rho,3)))
!$ rho_tmp=0
!$OMP DO
DO k = mpi%irank+2,stars%ng3,mpi%isize
DO k = fmpi%irank+2,stars%ng3,fmpi%isize
cp = qpwc(k)*stars%nstr(k)
IF (.NOT.oneD%odi%d1) THEN
CALL phasy1(atoms,stars,sym,cell,k,pylm)
......
......@@ -8,7 +8,7 @@ MODULE m_cdncore
CONTAINS
SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
SUBROUTINE cdncore(fmpi,oneD,input,vacuum,noco,nococonv,sym,&
stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
USE m_constants
......@@ -28,7 +28,7 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mpi), INTENT(IN) :: fmpi
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_input), INTENT(IN) :: input
......@@ -57,7 +57,7 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
results%seigc = 0.0
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
DO jspin = 1,input%jspins
DO n = 1,atoms%ntype
moments%svdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
......@@ -68,7 +68,7 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
IF (input%kcrel==0) THEN
! Generate input file ecore for subsequent GW calculation
! 11.2.2004 Arno Schindlmayr
IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) THEN
IF ((input%gw==1 .or. input%gw==3).AND.(fmpi%irank==0)) THEN
OPEN (15,file='ecore',status='unknown', action='write',form='unformatted')
END IF
......@@ -76,17 +76,17 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
tec = 0.0
qint = 0.0
IF (input%frcor) THEN
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
CALL readCoreDensity(input,atoms,rh,tec,qint)
END IF
#ifdef CPP_MPI
CALL mpi_bc_coreDen(mpi,atoms,input,rh,tec,qint)
CALL mpi_bc_coreDen(fmpi,atoms,input,rh,tec,qint)
#endif
END IF
END IF
!add in core density
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
IF (input%kcrel==0) THEN
DO jspin = 1,input%jspins
IF(PRESENT(EnergyDen)) THEN
......@@ -105,12 +105,12 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
END IF
END IF
DO jspin = 1,input%jspins
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
DO n = 1,atoms%ntype
moments%stdn(n,jspin) = outDen%mt(1,0,n,jspin) / (sfp_const*atoms%rmsh(1,n)*atoms%rmsh(1,n))
END DO
END IF
IF ((noco%l_noco).AND.(mpi%irank==0)) THEN
IF ((noco%l_noco).AND.(fmpi%irank==0)) THEN
IF (jspin==2) THEN
IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for noco")
......@@ -136,10 +136,10 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
IF (input%ctail) THEN
IF(PRESENT(EnergyDen)) call juDFT_error("Energyden not implemented for ctail")
!+gu hope this works as well
CALL cdnovlp(mpi,sphhar,stars,atoms,sym,vacuum,&
CALL cdnovlp(fmpi,sphhar,stars,atoms,sym,vacuum,&
cell,input,oneD,l_st,jspin,rh(:,:,jspin),&
outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz)
ELSE IF (mpi%irank==0) THEN
ELSE IF (fmpi%irank==0) THEN
DO iType = 1,atoms%ntype
outDen%pw(1,jspin) = outDen%pw(1,jspin) + qint(iType,jspin) / (input%jspins * cell%volint)
END DO
......@@ -148,10 +148,10 @@ SUBROUTINE cdncore(mpi,oneD,input,vacuum,noco,nococonv,sym,&
END DO
IF (input%kcrel==0) THEN
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
CALL writeCoreDensity(input,atoms,rhTemp,tec,qint)
END IF
IF ((input%gw==1 .or. input%gw==3).AND.(mpi%irank==0)) CLOSE(15)
IF ((input%gw==1 .or. input%gw==3).AND.(fmpi%irank==0)) CLOSE(15)
END IF
END SUBROUTINE cdncore
......
......@@ -11,7 +11,7 @@ MODULE m_cdnmt
!***********************************************************************
CONTAINS
SUBROUTINE cdnmt(mpi,jspd,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,banddos,&
SUBROUTINE cdnmt(fmpi,jspd,input,atoms,sym,sphhar,noco,jsp_start,jsp_end,enpara,banddos,&
vr,denCoeffs,usdus,orb,denCoeffsOffdiag,moments,rho,hub1inp,jDOS,hub1data)
USE m_types
......@@ -24,7 +24,7 @@ CONTAINS
IMPLICIT NONE
TYPE(t_input), INTENT(IN) :: input
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mpi), INTENT(IN) :: fmpi
TYPE(t_usdus), INTENT(INOUT) :: usdus !in fact only the lo part is intent(in)
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sphhar), INTENT(IN) :: sphhar
......@@ -66,7 +66,7 @@ CONTAINS
CALL timestart("cdnmt")
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
IF (noco%l_mperp) THEN
IF (denCoeffsOffdiag%l_fmpl) THEN
!ALLOCATE ( rho21(atoms%jmtd,0:sphhar%nlhd,atoms%ntype) )
......@@ -335,7 +335,7 @@ CONTAINS
ENDIF
ENDIF !(mpi%irank==0) THEN
ENDIF !(fmpi%irank==0) THEN
CALL timestop("cdnmt")
......
......@@ -4,14 +4,14 @@ IMPLICIT NONE
CONTAINS
SUBROUTINE denMultipoleExp(input, mpi, atoms, sphhar, stars, sym, cell, oneD, den)
SUBROUTINE denMultipoleExp(input, fmpi, atoms, sphhar, stars, sym, cell, oneD, den)
USE m_types
USE m_constants
USE m_mpmom
TYPE(t_input), INTENT(IN) :: input
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_mpi), INTENT(IN) :: fmpi
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_stars), INTENT(IN) :: stars
......@@ -24,48 +24,48 @@ SUBROUTINE denMultipoleExp(input, mpi, atoms, sphhar, stars, sym, cell, oneD, de
COMPLEX :: qlm(-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,atoms%ntype)
IF(input%jspins == 2) THEN
IF(mpi%irank.EQ.0) THEN
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) 'Multipole expansion for spin-up density:'
WRITE(oUnit,*) '======================================='
END IF
qlm = CMPLX(0.0,0.0)
workDen = den
CALL mpmom(input,mpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,1),workDen%mt(:,0:,1:,1),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(mpi%irank.EQ.0) THEN
CALL mpmom(input,fmpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,1),workDen%mt(:,0:,1:,1),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) '======================================='
END IF
IF(mpi%irank.EQ.0) THEN
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) 'Multipole expansion for spin-down density:'
WRITE(oUnit,*) '======================================='
END IF
qlm = CMPLX(0.0,0.0)
CALL mpmom(input,mpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,2),workDen%mt(:,0:,1:,2),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(mpi%irank.EQ.0) THEN
CALL mpmom(input,fmpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,2),workDen%mt(:,0:,1:,2),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) '======================================='
END IF
END IF
IF(mpi%irank.EQ.0) THEN
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) 'Multipole expansion for charge density:'
WRITE(oUnit,*) '======================================='
END IF
qlm = CMPLX(0.0,0.0)
workDen = den
IF(input%jspins == 2) CALL workDen%SpinsToChargeAndMagnetisation()
CALL mpmom(input,mpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,1),workDen%mt(:,0:,1:,1),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(mpi%irank.EQ.0) THEN
CALL mpmom(input,fmpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,1),workDen%mt(:,0:,1:,1),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) '======================================='
END IF
IF(input%jspins == 2) THEN
IF(mpi%irank.EQ.0) THEN
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) 'Multipole expansion for magnetization density:'
WRITE(oUnit,*) '======================================='
END IF
qlm = CMPLX(0.0,0.0)
CALL mpmom(input,mpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,2),workDen%mt(:,0:,1:,2),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(mpi%irank.EQ.0) THEN
CALL mpmom(input,fmpi,atoms,sphhar,stars,sym,cell,oneD,workDen%pw(1:,2),workDen%mt(:,0:,1:,2),POTDEN_TYPE_DEN,qlm,.FALSE.)
IF(fmpi%irank.EQ.0) THEN
WRITE(oUnit,*) '======================================='
END IF
END IF
......
......@@ -8,11 +8,11 @@ MODULE m_symmetrize_matrix
USE m_juDFT
CONTAINS
SUBROUTINE symmetrize_matrix(mpi,noco,kpts,nk,hmat,smat)
SUBROUTINE symmetrize_matrix(fmpi,noco,kpts,nk,hmat,smat)
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_noco),INTENT(in) :: noco
TYPE(t_kpts),INTENT(in) :: kpts
INTEGER,INTENT(in) :: nk
......@@ -30,7 +30,7 @@ CONTAINS
RETURN
ENDIF
IF (mpi%irank==0) THEN
IF (fmpi%irank==0) THEN
PRINT *,"Complex matrix made real"
WRITE(oUnit,*) "Complex matrix made real"
END IF
......
......@@ -15,7 +15,7 @@ CONTAINS
!! 4. The vacuum part is added (in hsvac())
!! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts.
SUBROUTINE eigen_hssetup(isp,mpi,hybinp,enpara,input,vacuum,noco,nococonv,sym,&
SUBROUTINE eigen_hssetup(isp,fmpi,hybinp,enpara,input,vacuum,noco,nococonv,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final)
USE m_types
USE m_types_mpimat
......@@ -27,7 +27,7 @@ CONTAINS
USE m_eigen_redist_matrix
IMPLICIT NONE
INTEGER,INTENT(IN) :: isp
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_hybinp),INTENT(IN) :: hybinp
TYPE(t_enpara),INTENT(IN) :: enpara
......@@ -55,14 +55,14 @@ CONTAINS
!Matrices for Hamiltonian and Overlapp
!In noco case we need 4-matrices for each spin channel
nspins=MERGE(2,1,noco%l_noco)
IF (mpi%n_size==1) THEN
IF (fmpi%n_size==1) THEN
ALLOCATE(t_mat::smat(nspins,nspins),hmat(nspins,nspins))
ELSE
ALLOCATE(t_mpimat::smat(nspins,nspins),hmat(nspins,nspins))
ENDIF
DO i=1,nspins
DO j=1,nspins
CALL smat(i,j)%init(l_real,lapw%nv(i)+atoms%nlotot,lapw%nv(j)+atoms%nlotot,mpi%sub_comm,.false.)
CALL smat(i,j)%init(l_real,lapw%nv(i)+atoms%nlotot,lapw%nv(j)+atoms%nlotot,fmpi%sub_comm,.false.)
CALL hmat(i,j)%init(smat(i,j))
ENDDO
ENDDO
......@@ -70,14 +70,14 @@ CONTAINS
CALL timestart("Interstitial part")
!Generate interstitial part of Hamiltonian
CALL hs_int(input,noco,stars,lapw,mpi,cell,isp,v%pw_w,smat,hmat)
CALL hs_int(input,noco,stars,lapw,fmpi,cell,isp,v%pw_w,smat,hmat)
CALL timestop("Interstitial part")
CALL timestart("MT part")
!MT-part of Hamiltonian. In case of noco, we need an loop over the local spin of the atoms
DO i=1,nspins;DO j=1,nspins
!$acc enter data copyin(hmat(i,j),smat(i,j),hmat(i,j)%data_r,smat(i,j)%data_r,hmat(i,j)%data_c,smat(i,j)%data_c)
ENDDO;ENDDO
CALL hsmt(atoms,sym,enpara,isp,input,mpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
CALL hsmt(atoms,sym,enpara,isp,input,fmpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
DO i=1,nspins;DO j=1,nspins;if (hmat(1,1)%l_real) THEN
!$acc exit data copyout(hmat(i,j)%data_r,smat(i,j)%data_r)
ELSE
......@@ -88,7 +88,7 @@ CONTAINS
!Vacuum contributions
IF (input%film) THEN
CALL timestart("Vacuum part")
CALL hsvac(vacuum,stars,mpi,isp,input,v,enpara%evac,cell,&
CALL hsvac(vacuum,stars,fmpi,isp,input,v,enpara%evac,cell,&
lapw,sym, noco,nococonv,hmat,smat)
CALL timestop("Vacuum part")
ENDIF
......@@ -99,8 +99,8 @@ CONTAINS
ALLOCATE(smat_final,mold=smat(1,1))
ALLOCATE(hmat_final,mold=smat(1,1))
CALL timestart("Matrix redistribution")
CALL eigen_redist_matrix(mpi,lapw,atoms,smat,smat_final)
CALL eigen_redist_matrix(mpi,lapw,atoms,hmat,hmat_final,smat_final)
CALL eigen_redist_matrix(fmpi,lapw,atoms,smat,smat_final)
CALL eigen_redist_matrix(fmpi,lapw,atoms,hmat,hmat_final,smat_final)
CALL timestop("Matrix redistribution")
END SUBROUTINE eigen_hssetup
......
......@@ -14,11 +14,11 @@ CONTAINS
!! In the non-collinear case, the 2x2 array of matrices is combined into the final matrix. Again a redistribution will happen in the parallel case
SUBROUTINE eigen_redist_matrix(mpi,lapw,atoms,mat,mat_final,mat_final_templ)
SUBROUTINE eigen_redist_matrix(fmpi,lapw,atoms,mat,mat_final,mat_final_templ)
USE m_types
USE m_types_mpimat
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_atoms),INTENT(IN) :: atoms
CLASS(t_mat),INTENT(INOUT):: mat(:,:)
......@@ -31,7 +31,7 @@ CONTAINS
m=lapw%nv(1)+atoms%nlotot
IF (SIZE(mat)>1) m=m+lapw%nv(2)+atoms%nlotot
IF (.NOT.PRESENT(mat_final_templ)) THEN
CALL mat_final%init(mat(1,1)%l_real,m,m,mpi%sub_comm,.TRUE.) !here the .true. creates a block-cyclic scalapack distribution
CALL mat_final%init(mat(1,1)%l_real,m,m,fmpi%sub_comm,.TRUE.) !here the .true. creates a block-cyclic scalapack distribution
ELSE
CALL mat_final%init(mat_final_templ)
ENDIF
......
......@@ -16,7 +16,7 @@ MODULE m_hlomat
! p.kurz sept. 1996
!***********************************************************************
CONTAINS
SUBROUTINE hlomat(input,atoms,mpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,isp,jsp,&
SUBROUTINE hlomat(input,atoms,fmpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,isp,jsp,&
ntyp,na,fjgj,alo1,blo1,clo1, iintsp,jintsp,chi,hmat)
!
USE m_hsmt_ab
......@@ -26,7 +26,7 @@ CONTAINS
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_usdus),INTENT(IN) :: ud
TYPE(t_tlmplm),INTENT(IN) :: tlmplm
TYPE(t_sym),INTENT(IN) :: sym
......@@ -139,8 +139,8 @@ CONTAINS
!+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 !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
IF (MOD(locol-1,fmpi%n_size) == fmpi%n_rank) THEN !only this fmpi rank calculates this column
locol=(locol-1)/fmpi%n_size+1 !this is the column in local storage
IF (hmat%l_real) THEN
DO kp = 1,lapw%nv(iintsp)
hmat%data_r(kp,locol) = hmat%data_r(kp,locol) + chi*invsfct * (&
......@@ -185,8 +185,8 @@ CONTAINS
!---> 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 !only this MPI rank calculates this column
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
IF (MOD(locol-1,fmpi%n_size) == fmpi%n_rank) THEN !only this fmpi rank calculates this column
locol=(locol-1)/fmpi%n_size+1 !this is the column in local storage
!---> calculate the hamiltonian matrix elements with other
!---> local orbitals at the same atom, if they have the same l
DO lop = 1, MERGE(lo-1,atoms%nlo(ntyp),iintsp==jintsp)
......@@ -289,7 +289,7 @@ CONTAINS
END DO
END DO
END DO
ENDIF !If this lo to be calculated by mpi rank
ENDIF !If this lo to be calculated by fmpi rank
END DO
END DO ! end of lo = 1,atoms%nlo loop
!$acc end kernels
......
......@@ -7,7 +7,7 @@
MODULE m_hs_int
CONTAINS
!Subroutine to construct the interstitial Hamiltonian and overlap matrix
SUBROUTINE hs_int(input,noco,stars,lapw,mpi,cell,isp,vpw,&
SUBROUTINE hs_int(input,noco,stars,lapw,fmpi,cell,isp,vpw,&
smat,hmat)
USE m_types
IMPLICIT NONE
......@@ -16,7 +16,7 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
INTEGER,INTENT(IN) :: isp
COMPLEX,INTENT(IN) :: vpw(:,:)
CLASS(t_mat),INTENT(INOUT) :: smat(:,:),hmat(:,:)
......@@ -35,12 +35,12 @@ CONTAINS
jjspin=MIN(jspin,SIZE(smat,1))
!$OMP PARALLEL DO SCHEDULE(dynamic) DEFAULT(none) &
!$OMP SHARED(mpi,lapw,stars,input,cell,vpw) &
!$OMP SHARED(fmpi,lapw,stars,input,cell,vpw) &
!$OMP SHARED(jjspin,iispin,ispin,jspin)&
!$OMP SHARED(hmat,smat)&
!$OMP PRIVATE(ii,i0,i,j,in,phase,b1,b2,r2,th,ts)
DO i = mpi%n_rank+1,lapw%nv(ispin),mpi%n_size
i0=(i-1)/mpi%n_size+1
DO i = fmpi%n_rank+1,lapw%nv(ispin),fmpi%n_size
i0=(i-1)/fmpi%n_size+1
!---> loop over (k+g)
DO j = 1,MIN(i,lapw%nv(jspin))
ii = lapw%gvec(:,i,ispin) - lapw%gvec(:,j,jspin)
......
......@@ -21,7 +21,7 @@ CONTAINS
!! The off-diagonal contribution in first-variation soc and constraint calculations is still missing
SUBROUTINE hsmt(atoms,sym,enpara,&
isp,input,mpi,noco,nococonv,cell,lapw,usdus,td,smat,hmat)
isp,input,fmpi,noco,nococonv,cell,lapw,usdus,td,smat,hmat)
USE m_types
USE m_types_mpimat
USE m_hsmt_nonsph
......@@ -34,7 +34,7 @@ CONTAINS
USE m_hsmt_mtNocoPot_offdiag
USE m_hsmt_offdiag
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN) :: nococonv
......@@ -60,7 +60,7 @@ CONTAINS
!
IF (noco%l_noco.AND..NOT.noco%l_ss) THEN
IF (mpi%n_size==1) THEN
IF (fmpi%n_size==1) THEN
ALLOCATE(t_mat::hmat_tmp,smat_tmp)
ELSE
ALLOCATE(t_mpimat::hmat_tmp,smat_tmp)
......@@ -84,9 +84,9 @@ CONTAINS
!This is for collinear calculations: the (1,1) element of the matrices is all
!that is needed and allocated
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat(1,1),hmat(1,1))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,jspin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat(1,1))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat(1,1),smat(1,1))
CALL hsmt_sph(n,atoms,fmpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat(1,1),hmat(1,1))
CALL hsmt_nonsph(n,fmpi,sym,atoms,ispin,jspin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat(1,1))
CALL hsmt_lo(input,atoms,sym,cell,fmpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat(1,1),smat(1,1))
ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN
!The NOCO but non-spinspiral setup follows:
!The Matrix-elements are first calculated in the local frame of the atom and
......@@ -94,18 +94,18 @@ CONTAINS
!global spin-matrices.
CALL hmat_tmp%clear();CALL smat_tmp%clear()
IF (ispin==jspin) THEN !local spin-diagonal contribution
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat_tmp,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,ispin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat_tmp,smat_tmp)
CALL hsmt_sph(n,atoms,fmpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat_tmp,hmat_tmp)
CALL hsmt_nonsph(n,fmpi,sym,atoms,ispin,ispin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,fmpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat_tmp,smat_tmp)
CALL hsmt_spinor(ispin,n,nococonv,chi)
CALL timestart("hsmt_distspins")
CALL hsmt_distspins(chi,smat_tmp,smat)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
CALL timestop("hsmt_distspins")
ELSE !Add off-diagonal contributions to Hamiltonian if needed
IF (noco%l_mtNocoPot) CALL hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,mpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
IF (noco%l_soc) CALL hsmt_soc_offdiag(n,atoms,cell,mpi,nococonv,lapw,sym,usdus,td,fjgj,hmat)
IF (noco%l_mtNocoPot) CALL hsmt_mtNocoPot_offdiag(n,input,fmpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,fmpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
IF (noco%l_soc) CALL hsmt_soc_offdiag(n,atoms,cell,fmpi,nococonv,lapw,sym,usdus,td,fjgj,hmat)
ENDIF
ELSE
!In the spin-spiral case the loop over the interstitial=global spin has to
......@@ -114,15 +114,15 @@ CONTAINS
DO iintsp=1,2
DO jintsp=1,2
IF (ispin==jspin) THEN !local diagonal spin
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,iintsp,jintsp,chi(iintsp,jintsp),&
CALL hsmt_sph(n,atoms,fmpi,ispin,input,nococonv,iintsp,jintsp,chi(iintsp,jintsp),&
lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat(iintsp,jintsp),hmat(iintsp,jintsp))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,jspin,iintsp,jintsp,chi(iintsp,jintsp),noco,nococonv,cell,&
CALL hsmt_nonsph(n,fmpi,sym,atoms,ispin,jspin,iintsp,jintsp,chi(iintsp,jintsp),noco,nococonv,cell,&
lapw,td,fjgj,hmat(iintsp,jintsp))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,&
CALL hsmt_lo(input,atoms,sym,cell,fmpi,noco,nococonv,lapw,usdus,td,fjgj,&
n,chi(iintsp,jintsp),ispin,jspin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
ELSE
IF (noco%l_mtNocoPot) call hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,mpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
IF (noco%l_mtNocoPot) call hsmt_mtNocoPot_offdiag(n,input,fmpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,fmpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
ENDIF
ENDDO
ENDDO
......
......@@ -8,14 +8,14 @@ MODULE m_hsmt_lo
USE m_juDFT
IMPLICIT NONE
CONTAINS
SUBROUTINE Hsmt_lo(Input,Atoms,Sym,Cell,Mpi,Noco,nococonv,Lapw,Ud,Tlmplm,FjGj,N,Chi,Isp,jsp,Iintsp,Jintsp,Hmat,Smat)
SUBROUTINE Hsmt_lo(Input,Atoms,Sym,Cell,fmpi,Noco,nococonv,Lapw,Ud,Tlmplm,FjGj,N,Chi,Isp,jsp,Iintsp,Jintsp,Hmat,Smat)
USE m_hlomat
USE m_slomat
USE m_setabc1lo
USE m_types
USE m_hsmt_fjgj
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_input),INTENT