Commit ef2959cd authored by Gregor Michalicek's avatar Gregor Michalicek

Wome more work on the integration of the use mpi statement

...many mpi -> fmpi replacements and also some other stuff.
parent cb34d2f0
......@@ -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 MPI 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 MPI 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)
......
......@@ -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,&