Commit 5b87fe42 authored by Gregor Michalicek's avatar Gregor Michalicek

Move reading of density out of vgen

parent 5159e3b0
......@@ -966,6 +966,14 @@ CONTAINS
err=0
pd%iter=0
IF(ALLOCATED(pd%pw)) DEALLOCATE(pd%pw)
IF(ALLOCATED(pd%mt)) DEALLOCATE(pd%mt)
IF(ALLOCATED(pd%vacz)) DEALLOCATE(pd%vacz)
IF(ALLOCATED(pd%vacxy)) DEALLOCATE(pd%vacxy)
IF(ALLOCATED(pd%cdom)) DEALLOCATE(pd%cdom)
IF(ALLOCATED(pd%cdomvz)) DEALLOCATE(pd%cdomvz)
IF(ALLOCATED(pd%cdomvxy)) DEALLOCATE(pd%cdomvxy)
IF(ALLOCATED(pd%mmpMat)) DEALLOCATE(pd%mmpMat)
ALLOCATE(pd%pw(ng3,jsp),stat=err(1))
ALLOCATE(pd%mt(jmtd,0:nlhd,ntype,jsp),stat=err(2))
IF (PRESENT(nmzd)) THEN
......
......@@ -41,6 +41,8 @@ CONTAINS
USE m_fleur_init
USE m_pldngen
USE m_optional
USE m_cdn_io
USE m_qfix
USE m_vgen
USE m_rhodirgen
USE m_writexcstuff
......@@ -70,6 +72,7 @@ CONTAINS
USE m_ylm
#ifdef CPP_MPI
USE m_mpi_bc_all, ONLY : mpi_bc_all
USE m_mpi_bc_potden
#endif
USE m_eig66_io, ONLY : open_eig, close_eig
IMPLICIT NONE
......@@ -100,11 +103,13 @@ CONTAINS
TYPE(t_coreSpecInput) :: coreSpecInput
TYPE(t_wann) :: wann
TYPE(t_potden) :: v,vx
TYPE(t_potden) :: inDen, outDen
! .. Local Scalars ..
INTEGER:: eig_id
INTEGER:: eig_id, archiveType
INTEGER:: n,it,ithf,pc
LOGICAL:: stop80,reap,l_endit,l_opti,l_cont
LOGICAL:: stop80,reap,l_endit,l_opti,l_cont,l_qfix
REAL :: fermiEnergyTemp, fix
!--- J<
INTEGER :: phn
REAL, PARAMETER :: tol = 1.e-8
......@@ -223,6 +228,33 @@ CONTAINS
END IF
END IF
! Initialize and load inDen density (start)
CALL inDen%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.)
IF (noco%l_noco) THEN
ALLOCATE (inDen%cdom(stars%ng3),inDen%cdomvz(vacuum%nmzd,2))
ALLOCATE (inDen%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
ALLOCATE (inDen%cdom(1),inDen%cdomvz(1,1),inDen%cdomvxy(1,1,1))
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
END IF
IF(mpi%irank.EQ.0) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,inDen%iter,inDen%mt,inDen%pw,inDen%vacz,inDen%vacxy,&
inDen%cdom,inDen%cdomvz,inDen%cdomvxy)
CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,inDen%pw,inDen%vacxy,inDen%mt,inDen%vacz,&
.FALSE.,.false.,fix)
CALL timestop("Qfix")
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,inDen%iter,inDen%mt,inDen%pw,inDen%vacz,inDen%vacxy,inDen%cdom,&
inDen%cdomvz,inDen%cdomvxy)
END IF
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,inDen)
#endif
! Initialize and load inDen density (end)
DO qcount=1,jij%nqpt
IF (jij%l_J) THEN
noco%qss(:)=jij%qj(:,qcount)
......@@ -263,7 +295,7 @@ CONTAINS
CALL timestart("generation of potential")
IF (mpi%irank==0) WRITE(*,"(a)",advance="no") " * Potential generation "
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,&
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,v,vx)
sym,obsolete,cell, oneD,sliceplot,mpi ,results,noco,inDen,v,vx)
CALL timestop("generation of potential")
IF (mpi%irank.EQ.0) THEN
......@@ -567,9 +599,32 @@ CONTAINS
IF (obsolete%disp) THEN
reap = .FALSE.
input%total = .FALSE.
! Initialize and load outDen density (start)
CALL outDen%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.)
IF (noco%l_noco) THEN
ALLOCATE (outDen%cdom(stars%ng3),outDen%cdomvz(vacuum%nmzd,2))
ALLOCATE (outDen%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
ELSE
ALLOCATE (outDen%cdom(1),outDen%cdomvz(1,1),outDen%cdomvxy(1,1,1))
END IF
IF(mpi%irank.EQ.0) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,CDN_OUTPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,outDen%iter,outDen%mt,outDen%pw,outDen%vacz,outDen%vacxy,&
outDen%cdom,outDen%cdomvz,outDen%cdomvxy)
CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD,outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz,&
.FALSE.,.false.,fix)
CALL timestop("Qfix")
END IF
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif
! Initialize and load outDen density (end)
CALL timestart("generation of potential (total)")
CALL vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi, results,noco,v,vx)
obsolete,cell,oneD,sliceplot,mpi, results,noco,outDen,v,vx)
CALL timestop("generation of potential (total)")
CALL potdis(stars,vacuum,atoms,sphhar, input,cell,sym)
......
......@@ -7,7 +7,7 @@ MODULE m_vgen
USE m_juDFT
CONTAINS
SUBROUTINE vgen(hybrid,reap,input,xcpot,DIMENSION, atoms,sphhar,stars,&
vacuum,sym, obsolete,cell,oneD,sliceplot,mpi, results,noco,v,vx)
vacuum,sym, obsolete,cell,oneD,sliceplot,mpi, results,noco,den,v,vx)
! ***********************************************************
! FLAPW potential generator *
! ***********************************************************
......@@ -66,6 +66,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(INOUT) :: atoms !vr0 is updated
TYPE(t_potden), INTENT(IN) :: den
TYPE(t_potden),INTENT(OUT) :: v,vx
! ..
! .. Scalar Arguments ..
......@@ -73,15 +74,15 @@ CONTAINS
! .. Local type instances ..
TYPE(t_potden) :: den
TYPE(t_potden) :: workDen
! .. Local Scalars ..
COMPLEX vintcza,xint,rhobar
INTEGER i,i3,irec2,irec3,ivac,j,js,k,k3,lh,n,nzst1
INTEGER imz,imzxy,ichsmrg,ivfft,npd
INTEGER ifftd,ifftd2, ifftxc3d,datend
INTEGER itypsym,itype,jsp,l,nat,archiveType
INTEGER itypsym,itype,jsp,l,nat
! INTEGER i_sm,n_sm,i_sta,i_end
REAL ani,g3,signum,z,rhmn,fix,mfie,fermiEnergyTemp
REAL ani,g3,signum,z,rhmn,mfie,fermiEnergyTemp
REAL sig1dh,vz1dh,zat_l(atoms%ntype),rdum,dpdot ! ,delta,deltb,corr
LOGICAL l_pottot,l_vdw,l_qfix
LOGICAL exi
......@@ -126,17 +127,18 @@ CONTAINS
excz(vacuum%nmzd,2),excr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype),&
vpw_w(stars%ng3,dimension%jspd),vxpw_w(stars%ng3,dimension%jspd),psq(stars%ng3) )
CALL vx%init(stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,DIMENSION%jspd,.false.)
v%iter = den%iter
CALL den%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.)
CALL workDen%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.)
IF (noco%l_noco) THEN
ALLOCATE ( den%cdom(stars%ng3), den%cdomvz(vacuum%nmzd,2),den%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2) )
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ALLOCATE (workDen%cdom(stars%ng3),workDen%cdomvz(vacuum%nmzd,2))
ALLOCATE (workDen%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
ELSE
ALLOCATE ( den%cdom(1),den%cdomvz(1,1),den%cdomvxy(1,1,1) )
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
ALLOCATE (workDen%cdom(1),workDen%cdomvz(1,1),workDen%cdomvxy(1,1,1))
END IF
!
workDen = den
IF (mpi%irank == 0) THEN
!
! -- total = .false. and reap = .false. means, that we now calculate
......@@ -146,22 +148,6 @@ CONTAINS
IF (noco%l_noco) THEN
CALL juDFT_error("vgen:1",calledby ="vgen")
ENDIF
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,CDN_OUTPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,v%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
ELSE
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,v%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
END IF
IF (.NOT.l_xyav) THEN
CALL timestart("Qfix")
CALL qfix(stars,atoms,sym,vacuum, sphhar,input,cell,oneD, den%pw,den%vacxy,den%mt,den%vacz,.FALSE.,.false., fix)
CALL timestop("Qfix")
ENDIF
IF (input%total.OR.reap) THEN
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,v%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
END IF
WRITE (6,FMT=8000)
......@@ -170,11 +156,11 @@ CONTAINS
! ---> perform spin summation of charge densities
! ---> for the calculation of the coulomb potentials
IF ( (input%jspins.EQ.2).AND.(.NOT.l_xyav) ) THEN
den%mt(:,0:,:,1)=den%mt(:,0:,:,1)+den%mt(:,0:,:,2)
den%pw(:,1)=den%pw(:,1)+den%pw(:,2)
workDen%mt(:,0:,:,1)=workDen%mt(:,0:,:,1)+workDen%mt(:,0:,:,2)
workDen%pw(:,1)=workDen%pw(:,1)+workDen%pw(:,2)
IF (input%film) THEN
den%vacxy(:,:,:,1)=den%vacxy(:,:,:,1)+den%vacxy(:,:,:,2)
den%vacz(:,:,1) = den%vacz(:,:,1) + den%vacz(:,:,2)
workDen%vacxy(:,:,:,1)=workDen%vacxy(:,:,:,1)+workDen%vacxy(:,:,:,2)
workDen%vacz(:,:,1) = workDen%vacz(:,:,1) + workDen%vacz(:,:,2)
END IF
END IF
!
......@@ -189,17 +175,17 @@ CONTAINS
ENDIF ! (mpi%irank == 0)
#ifdef CPP_MPI
CALL MPI_BCAST(den%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(workDen%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
#endif
CALL timestart("psqpw")
CALL psqpw(mpi, atoms,sphhar,stars,vacuum, dimension,cell,input,sym,oneD,&
den%pw,den%mt,den%vacz,l_xyav, psq)
workDen%pw,workDen%mt,workDen%vacz,l_xyav, psq)
CALL timestop("psqpw")
IF (mpi%irank == 0) THEN
IF (l_xyav) THEN ! write out xy-averaged density & stop
CALL xy_av_den(stars,vacuum, cell,psq,den%vacz)
CALL xy_av_den(stars,vacuum, cell,psq,workDen%vacz)
CALL juDFT_error("xy-averaged density calculated", calledby ="vgen")
ENDIF
......@@ -209,7 +195,7 @@ CONTAINS
CALL timestart("coulomb potential")
!---> generates the m=0,gz=0 component of the vacuum potential
CALL od_vvac(stars,vacuum,cell, psq,den%vacz, v%vacz)
CALL od_vvac(stars,vacuum,cell, psq,workDen%vacz, v%vacz)
!---> generation of the vacuum warped potential components and
!---> interstitial pw potential
......@@ -217,7 +203,7 @@ CONTAINS
CALL od_vvacis(oneD%odi%n2d,dimension,vacuum,oneD%odi%nq2,&
oneD%odi%kv,cell,oneD%odi%M,stars,oneD%odi%nst2,&
oneD, den%vacz,den%vacxy,psq,v%vacz,sym, v%vacxy,v%pw)
oneD, workDen%vacz,workDen%vacxy,psq,v%vacz,sym, v%vacxy,v%pw)
CALL timestop("coulomb potential")
!+odim
......@@ -225,10 +211,10 @@ CONTAINS
! ----> potential in the vacuum region
!
CALL timestart("p vac")
CALL vvac(vacuum,stars, cell,sym,input, psq,den%vacz, v%vacz,rhobar,sig1dh,vz1dh)
CALL vvac(vacuum,stars, cell,sym,input, psq,workDen%vacz, v%vacz,rhobar,sig1dh,vz1dh)
CALL vvacis(stars,vacuum, sym,cell, psq, input, v%vacxy)
CALL vvacxy(stars,vacuum,cell,sym,input, den%vacxy, v%vacxy, alphm)
CALL vvacxy(stars,vacuum,cell,sym,input, workDen%vacxy, v%vacxy, alphm)
CALL timestop("p vac")
END IF
! ------------------------------------------
......@@ -296,7 +282,7 @@ CONTAINS
! ---> potential in the muffin-tin spheres
CALL timestart("p vmts")
CALL vmts(mpi, stars,sphhar,atoms, sym,cell,oneD, v%pw,den%mt, v%mt)
CALL vmts(mpi, stars,sphhar,atoms, sym,cell,oneD, v%pw,workDen%mt, v%mt)
! --------------------------------------------
CALL timestop("p vmts")
IF (mpi%irank == 0) THEN
......@@ -373,7 +359,7 @@ CONTAINS
!
results%te_vcoul = 0.0
CALL int_nv(stars,vacuum,atoms,sphhar, cell,sym,input,oneD,&
den%pw,vpw_w, den%vacxy,v%vacxy, den%vacz,v%vacz, den%mt,v%mt, results%te_vcoul)
workDen%pw,vpw_w, workDen%vacxy,v%vacxy, workDen%vacz,v%vacz, workDen%mt,v%mt, results%te_vcoul)
WRITE (6,FMT=8030) results%te_vcoul
WRITE (16,FMT=8030) results%te_vcoul
......@@ -387,7 +373,7 @@ CONTAINS
CALL timestart("fleur_vdW")
! calculate vdW contribution to potential
CALL fleur_vdW(mpi,atoms,sphhar,stars, input,dimension,&
cell,sym,oneD,vacuum, den%pw(:,1),den%mt(:,:,:,1), vpw_w(:,1),v%mt(:,:,:,:))
cell,sym,oneD,vacuum, workDen%pw(:,1),workDen%mt(:,:,:,1), vpw_w(:,1),v%mt(:,:,:,:))
CALL timestop("fleur_vdW")
ENDIF
......@@ -399,8 +385,7 @@ CONTAINS
! ----> reload the density for calculating vxc (for spin-pol. case)
!
IF (input%jspins.EQ.2) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,v%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
workDen = den
v%mt(:,0:,:,2) = v%mt(:,0:,:,1)
v%pw(:,2) = v%pw(:,1)
IF (input%film) THEN
......@@ -459,14 +444,14 @@ CONTAINS
IF (.NOT.oneD%odi%d1) THEN
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,&
den%vacxy,den%vacz,den%cdomvxy,den%cdomvz, v%vacxy,v%vacz, excxy,excz)
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, v%vacxy,v%vacz, excxy,excz)
ELSE
CALL judft_error("OneD broken")
! CALL vvacxc(&
! & stars,oneD%M,vacuum,odi%n2d,dimension,ifftd2,&
! & xcpot,input,odi%nq2,&
! & odi%nst2,den%vacxy,den%vacz,den%cdomvxy,den%cdomvz,noco,&
! & odi%nst2,workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz,noco,&
! & odi%kimax2%igf,odl%pgf,&
! & v%vacxy,v%vacz,&
! & excxy,excz)
......@@ -480,12 +465,12 @@ CONTAINS
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
cell,xcpot,input,obsolete, ichsmrg,&
den%vacxy,den%vacz,den%cdomvxy,den%cdomvz, v%vacxy,v%vacz,rhmn, excxy,excz)
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, v%vacxy,v%vacz,rhmn, excxy,excz)
ELSE
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
cell,xcpot,input,obsolete, ichsmrg,&
den%vacxy,den%vacz,den%cdomvxy,den%cdomvz, v%vacxy,v%vacz,rhmn, excxy,excz)
workDen%vacxy,workDen%vacz,workDen%cdomvxy,workDen%cdomvz, v%vacxy,v%vacz,rhmn, excxy,excz)
END IF
......@@ -507,12 +492,12 @@ CONTAINS
IF ( .NOT.xcpot%is_gga() ) THEN
! LDA
CALL visxc(ifftd,stars,noco,xcpot,input, den%pw,den%cdom,&
CALL visxc(ifftd,stars,noco,xcpot,input, workDen%pw,workDen%cdom,&
v%pw,vpw_w,vx%pw,vxpw_w, excpw)
ELSE ! GGA
CALL visxcg(ifftd,stars,sym, ifftxc3d, cell, den%pw,den%cdom, xcpot,input,&
CALL visxcg(ifftd,stars,sym, ifftxc3d, cell, workDen%pw,workDen%cdom, xcpot,input,&
obsolete,noco, rhmn,ichsmrg, v%pw,vpw_w,vx%pw,vxpw_w, excpw)
END IF
......@@ -524,7 +509,7 @@ CONTAINS
"visxcwb needs to be reprogrammed according to visxcg.f"
CALL juDFT_error("visxcwb",calledby ="vgen")
!sb CALL visxcwb(
!sb > den%pw,kimax,igfft,pgfft,ufft,
!sb > workDen%pw,kimax,igfft,pgfft,ufft,
!sb > icorr,total,krla,
!sb > igrd,ndvgrd,idsprs,isprsv,
!sb > idsprsi,chng,sprsv,lwb,rhmn,ichsmrg,
......@@ -584,16 +569,16 @@ CONTAINS
#ifdef CPP_MPI
CALL MPI_BCAST(atoms%vr0,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(input%efield%vslope,1,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(den%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(workDen%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(v%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(rhmn,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(ichsmrg,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
#endif
IF (xcpot%is_gga()) THEN
CALL vmtxcg(dimension,mpi,sphhar,atoms, den%mt,xcpot,input,sym,&
CALL vmtxcg(dimension,mpi,sphhar,atoms, workDen%mt,xcpot,input,sym,&
obsolete, vx%mt,v%mt,rhmn,ichsmrg, excr)
ELSE
CALL vmtxc(DIMENSION,sphhar,atoms, den%mt,xcpot,input,sym, v%mt, excr,vx%mt)
CALL vmtxc(DIMENSION,sphhar,atoms, workDen%mt,xcpot,input,sym, v%mt, excr,vx%mt)
ENDIF
......@@ -671,9 +656,10 @@ CONTAINS
!
IF (input%total) THEN
IF (noco%l_noco) THEN ! load den%pw,den%vacz,den%vacxyxy from 'cdn'-file
IF (noco%l_noco) THEN ! load workDen%pw,workDen%vacz,workDen%vacxyxy from 'cdn'-file
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
0,fermiEnergyTemp,l_qfix,v%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
0,fermiEnergyTemp,l_qfix,workDen%iter,workDen%mt,workDen%pw,workDen%vacz,workDen%vacxy,&
workDen%cdom,workDen%cdomvz,workDen%cdomvxy)
ENDIF
!
! CALCULATE THE INTEGRAL OF n1*Veff1 + n2*Veff2
......@@ -705,8 +691,8 @@ CONTAINS
8050 FORMAT (/,10x,'density-effective potential integrals for spin ',i2,/)
CALL int_nv(stars,vacuum,atoms,sphhar, cell,sym,input,oneD,&
den%pw(:,js),veffpw_w(:,js), den%vacxy(:,:,:,js),v%vacxy(:,:,:,js),&
den%vacz(:,:,js),v%vacz(:,:,js), den%mt(1,0,1,js),veffr(1,0,1,js), results%te_veff)
workDen%pw(:,js),veffpw_w(:,js), workDen%vacxy(:,:,:,js),v%vacxy(:,:,:,js),&
workDen%vacz(:,:,js),v%vacz(:,:,js), workDen%mt(1,0,1,js),veffr(1,0,1,js), results%te_veff)
!HF
IF (hybrid%l_addhf.and.( xcpot%is_hybrid() ) ) THEN
......@@ -740,17 +726,17 @@ CONTAINS
IF (input%jspins.EQ.2) THEN
nat = 1
DO n = 1,atoms%ntype
den%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,1) = den%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,1) + den%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,input%jspins)
workDen%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,1) = workDen%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,1) + workDen%mt(:atoms%jri(n),0:sphhar%nlh(atoms%ntypsy(nat)),n,input%jspins)
nat = nat + atoms%neq(n)
ENDDO
den%pw(:stars%ng3,1) = den%pw(:stars%ng3,1) + den%pw(:stars%ng3,input%jspins)
workDen%pw(:stars%ng3,1) = workDen%pw(:stars%ng3,1) + workDen%pw(:stars%ng3,input%jspins)
IF (input%film) THEN
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,1) = &
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,1) + &
den%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,input%jspins)
den%vacz(:vacuum%nmz,:vacuum%nvac,1) = den%vacz(:vacuum%nmz,:vacuum%nvac,1) +&
den%vacz(:vacuum%nmz,:vacuum%nvac,input%jspins)
workDen%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,1) = &
workDen%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,1) + &
workDen%vacxy(:vacuum%nmzxy,:oneD%odi%nq2 - 1,:vacuum%nvac,input%jspins)
workDen%vacz(:vacuum%nmz,:vacuum%nvac,1) = workDen%vacz(:vacuum%nmz,:vacuum%nvac,1) +&
workDen%vacz(:vacuum%nmz,:vacuum%nvac,input%jspins)
END IF
END IF
WRITE (6,FMT=8070)
......@@ -759,7 +745,7 @@ CONTAINS
results%te_exc = 0.0
CALL int_nv(stars,vacuum,atoms,sphhar, cell,sym,input,oneD,&
den%pw(:,1),excpw(1), den%vacxy,excxy, den%vacz,excz, den%mt,excr, results%te_exc)
workDen%pw(:,1),excpw(1), workDen%vacxy,excxy, workDen%vacz,excz, workDen%mt,excr, results%te_exc)
WRITE (6,FMT=8080) results%te_exc
WRITE (16,FMT=8080) results%te_exc
......
......@@ -5,6 +5,7 @@ if (${FLEUR_USE_MPI})
mpi/mingeselle.F90
mpi/mpi_bc_all.F90
mpi/mpi_bc_pot.F90
mpi/mpi_bc_potden.F90
mpi/mpi_bc_coreDen.F90
mpi/mpi_bc_st.F90
mpi/mpi_col_den.F90
......
!--------------------------------------------------------------------------------
! Copyright (c) 2017 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_mpi_bc_potden
CONTAINS
SUBROUTINE mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,potden)
USE m_types
USE m_constants
IMPLICIT NONE
INCLUDE 'mpif.h'
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_potden),INTENT(INOUT) :: potden
INTEGER :: n, ierr(3)
LOGICAL :: l_nocoAlloc, l_denMatAlloc
CALL MPI_BCAST(potden%iter,1,MPI_INTEGER,0,mpi%mpi_comm,ierr)
l_nocoAlloc = .FALSE.
l_denMatAlloc = .FALSE.
IF(mpi%irank.EQ.0) THEN
IF (ALLOCATED(potden%cdom)) l_nocoAlloc = .TRUE.
IF (ALLOCATED(potden%mmpMat)) l_denMatAlloc = .TRUE.
END IF
CALL MPI_BCAST(l_nocoAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(l_denMatAlloc,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
IF((mpi%irank.NE.0).AND.l_nocoAlloc) THEN
IF (noco%l_noco) THEN
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(stars%ng3))
IF(.NOT.ALLOCATED(potden%cdomvz)) ALLOCATE (potden%cdomvz(vacuum%nmzd,2))
IF(.NOT.ALLOCATED(potden%cdomvxy)) ALLOCATE (potden%cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
ELSE
IF(.NOT.ALLOCATED(potden%cdom)) ALLOCATE (potden%cdom(1))
IF(.NOT.ALLOCATED(potden%cdomvz)) ALLOCATE (potden%cdomvz(1,1))
IF(.NOT.ALLOCATED(potden%cdomvxy)) ALLOCATE (potden%cdomvxy(1,1,1))
END IF
END IF
IF((mpi%irank.NE.0).AND.l_denMatAlloc) THEN
IF ((atoms%n_u.GT.0)) THEN
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins))
END IF
ELSE
IF(.NOT.ALLOCATED(potden%mmpMat)) THEN
ALLOCATE(potDen%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2))
END IF
ENDIF
END IF
n = stars%ng3 * input%jspins
CALL MPI_BCAST(potden%pw,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = atoms%jmtd * (sphhar%nlhd+1) * atoms%ntype * input%jspins
CALL MPI_BCAST(potden%mt,n,MPI_DOUBLE,0,mpi%mpi_comm,ierr)
n = vacuum%nmzd * 2 * SIZE(potden%vacz,3)
CALL MPI_BCAST(potden%vacz,n,MPI_DOUBLE,0,mpi%mpi_comm,ierr)
n = vacuum%nmzxyd * (stars%ng2-1) * 2 * input%jspins
CALL MPI_BCAST(potden%vacxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
IF (l_nocoAlloc) THEN
n = SIZE(potden%cdom,1)
CALL MPI_BCAST(potden%cdom,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = SIZE(potden%cdomvz,1) * SIZE(potden%cdomvz,2)
CALL MPI_BCAST(potden%cdomvz,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
n = SIZE(potden%cdomvxy,1) * SIZE(potden%cdomvxy,2) * SIZE(potden%cdomvxy,3)
CALL MPI_BCAST(potden%cdomvxy,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
IF (l_denMatAlloc) THEN
n = SIZE(potden%mmpMat,1) * SIZE(potden%mmpMat,2) * SIZE(potden%mmpMat,3) * SIZE(potden%mmpMat,4)
CALL MPI_BCAST(potden%mmpMat,n,MPI_DOUBLE_COMPLEX,0,mpi%mpi_comm,ierr)
END IF
END SUBROUTINE mpi_bc_potden
END MODULE m_mpi_bc_potden
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment