diff --git a/cdn/cdntot.f90 b/cdn/cdntot.f90 index 4e5ba259bff4ecec1c7c7c37786a2cbbc0f9537d..ad16fea5f4aaf678bf48a43f7500c6db5f3062b3 100644 --- a/cdn/cdntot.f90 +++ b/cdn/cdntot.f90 @@ -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 diff --git a/global/qfix.f90 b/global/qfix.f90 index 7ecbd4959a8391e2f123f93f1d690b2d4d24d89e..2b0cb43646a502dd0a298da11444c04fa8db7e50 100644 --- a/global/qfix.f90 +++ b/global/qfix.f90 @@ -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,& den,l_noco,l_printData,force_fix,fix) USE m_types @@ -20,6 +20,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 @@ -51,7 +52,7 @@ CONTAINS ! qfix==0 means no qfix was given in inp.xml. ! In this case do nothing except when forced to fix! - CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,den,.TRUE.,qtot,qis) + CALL cdntot(mpi,stars,atoms,sym,vacuum,input,cell,oneD,den,.TRUE.,qtot,qis) !The total nucleii charge zc=SUM(atoms%neq(:)*atoms%zatom(:)) @@ -92,7 +93,7 @@ CONTAINS IF (ABS(fix-1.0)<1.E-6) RETURN !no second calculation of cdntot as nothing was fixed CALL openXMLElementNoAttributes('fixedCharges') - CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,den,l_printData,qtot,qis) + CALL cdntot(mpi,stars,atoms,sym,vacuum,input,cell,oneD,den,l_printData,qtot,qis) CALL closeXMLElement('fixedCharges') IF (fix>1.1) CALL juDFT_WARN("You lost too much charge") diff --git a/main/cdngen.F90 b/main/cdngen.F90 index 3ee272bc23377bfacc6c8f4d5d5940ddb14b6c42..ff70ca3741458a2a07d016f7d816cd9921cfe47c 100644 --- a/main/cdngen.F90 +++ b/main/cdngen.F90 @@ -137,7 +137,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& IF (vacuum%nstm.EQ.3) CALL juDFT_end("VACWAVE OK",mpi%irank) IF (mpi%irank.EQ.0) THEN - CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy) + CALL cdntot(mpi,stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy) CALL closeXMLElement('valenceDensity') END IF ! mpi%irank = 0 @@ -158,7 +158,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& IF (mpi%irank.EQ.0) THEN CALL openXMLElementNoAttributes('allElectronCharges') - CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix) + CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix) CALL closeXMLElement('allElectronCharges') IF (input%jspins.EQ.2) THEN diff --git a/main/fleur.F90 b/main/fleur.F90 index 9f65284d07f997d028b71749c58a60c501eb55d1..b25f25a530648c4e80ec8e8718a2a94d426d1bd1 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -148,7 +148,7 @@ CONTAINS CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,& 0,results%ef,l_qfix,inDen) CALL timestart("Qfix") - CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix) + CALL qfix(mpi,stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false.,fix) CALL timestop("Qfix") CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,& 0,-1.0,results%ef,.FALSE.,inDen) diff --git a/main/mix.F90 b/main/mix.F90 index f6a0e468f07c2fae2c13247dcc3cc277376b1fc8..c3303e46632c7042476cef53d8cb2d4e736cb6d5 100644 --- a/main/mix.F90 +++ b/main/mix.F90 @@ -265,7 +265,7 @@ contains if( input%jspins == 2 ) call resDen%ChargeAndMagnetisationToSpins() ! fix the preconditioned density call outDen%addPotDen( resDen, inDen ) - call qfix( stars, atoms, sym, vacuum, sphhar, input, cell, oneD, outDen, noco%l_noco, .false., .true., fix ) + call qfix(mpi,stars, atoms, sym, vacuum, sphhar, input, cell, oneD, outDen, noco%l_noco, .false., .true., fix ) call resDen%subPotDen( outDen, inDen ) call brysh1( input, stars, atoms, sphhar, noco, vacuum, sym, oneD, & intfac, vacfac, resDen, nmap, nmaph, mapmt, mapvac, mapvac2, fsm ) @@ -297,7 +297,7 @@ contains DEALLOCATE (sm,fsm) !fix charge of the new density - CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false., fix) + CALL qfix(mpi,stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen,noco%l_noco,.FALSE.,.false., fix) IF(atoms%n_u.NE.n_u_keep) THEN inDen%mmpMat = n_mmpTemp diff --git a/main/optional.F90 b/main/optional.F90 index 80ee077250f29f2aac5e88b36fe7da5c119c033e..9b5a70f0a62bc3814eabbec824bbe39d28143ea9 100644 --- a/main/optional.F90 +++ b/main/optional.F90 @@ -96,7 +96,7 @@ CONTAINS IF (sliceplot%iplot .AND. (mpi%irank==0) ) THEN IF (noco%l_noco) THEN - CALL pldngen(sym,stars,atoms,sphhar,vacuum,& + CALL pldngen(mpi,sym,stars,atoms,sphhar,vacuum,& cell,input,noco,oneD,sliceplot) ENDIF ENDIF diff --git a/optional/pldngen.f90 b/optional/pldngen.f90 index 5889d19a175804ca0e944590626185381ed05f66..79a2eef434b93d7770b60efb9241811ad49c25d9 100644 --- a/optional/pldngen.f90 +++ b/optional/pldngen.f90 @@ -24,7 +24,7 @@ MODULE m_pldngen CONTAINS -SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,& +SUBROUTINE pldngen(mpi,sym,stars,atoms,sphhar,vacuum,& cell,input,noco,oneD,sliceplot) !******** ABBREVIATIONS *********************************************** @@ -52,6 +52,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,& IMPLICIT NONE + TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_sym),INTENT(IN) :: sym TYPE(t_stars),INTENT(IN) :: stars TYPE(t_vacuum),INTENT(IN) :: vacuum @@ -153,7 +154,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,& den%vacz(:,:,4) = AIMAG(cdomvz(:,:)) den%vacxy(:,:,:,3) = cdomvxy END IF - CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,noco%l_noco,.FALSE.,.true.,fix) + CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,noco%l_noco,.FALSE.,.true.,fix) rho(:,0:,1:,:input%jspins) = den%mt(:,0:,1:,:input%jspins) qpw(1:,:input%jspins) = den%pw(1:,:input%jspins) rht(1:,1:,:input%jspins) = den%vacz(1:,1:,:input%jspins) diff --git a/optional/stden.f90 b/optional/stden.f90 index 54d974adb3cfb038d13ab7631b7bb61528e9d566..921d313535fe64530ad8be1ae6c6cb5aa4221303 100644 --- a/optional/stden.f90 +++ b/optional/stden.f90 @@ -198,7 +198,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,& IF (mpi%irank == 0) THEN ! Check the normalization of total density - CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,.FALSE.,.FALSE.,.true.,fix) + CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,den,.FALSE.,.FALSE.,.true.,fix) z=SUM(atoms%neq(:)*atoms%zatom(:)) IF (ABS(fix*z-z)>0.5) THEN CALL judft_warn("Starting density not charge neutral",hint= & diff --git a/rdmft/rdmft.F90 b/rdmft/rdmft.F90 index afa0ca513d59ad510054bf8c2bc23fafc94a636d..5b56faa391b8d3083e83ecd38e2481d839dbcea8 100644 --- a/rdmft/rdmft.F90 +++ b/rdmft/rdmft.F90 @@ -156,7 +156,7 @@ SUBROUTINE rdmft(eig_id,mpi,input,kpts,banddos,cell,atoms,enpara,stars,vacuum,di CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,& stars,cell,sphhar,atoms,vTot,overallDen,moments,results) IF (mpi%irank.EQ.0) THEN - CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,overallDen,noco%l_noco,.TRUE.,.true.,fix) + CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,overallDen,noco%l_noco,.TRUE.,.true.,fix) END IF #ifdef CPP_MPI CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,overallDen)