Commit ce154e54 authored by Gregor Michalicek's avatar Gregor Michalicek

Remove readPotential calls in eigen_soc/eigenso.F90 and main/cdngen.F90

parent c24c1cf6
......@@ -9,7 +9,7 @@ MODULE m_eigen
CONTAINS
SUBROUTINE eigen(mpi,stars,sphhar,atoms,obsolete,xcpot,&
sym,kpts,DIMENSION, vacuum, input, cell, enpara_in,banddos, noco,jij, oneD,hybrid,&
it,eig_id,inDen,results,v,vx)
it,eig_id,inDen,results,vTot,vx)
!*********************************************************************
! sets up and solves the eigenvalue problem for a basis of lapws.
!
......@@ -28,7 +28,6 @@ CONTAINS
USE m_hsvac
USE m_od_hsvac
USE m_usetup
USE m_pot_io
USE m_eigen_diag
USE m_add_vnonlocal
USE m_subvxc
......@@ -60,7 +59,7 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: inDen
TYPE(t_potden),INTENT(INOUT) :: v,vx
TYPE(t_potden),INTENT(INOUT) :: vTot,vx
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
......@@ -146,14 +145,9 @@ CONTAINS
8120 FORMAT (' IT=',i4,' ISEC1=',i4,' reduced diagonalization')
l_wu = .TRUE.
END IF
!IF (mpi%irank.EQ.0) THEN
! CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
! v%iter,v%mt,v%pw,v%vacz,v%vacxy)
!END IF
999 CONTINUE
IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/it,v%iter/),&
IF (mpi%irank.EQ.0) CALL openXMLElementFormPoly('iteration',(/'numberForCurrentRun','overallNumber '/),(/it,vTot%iter/),&
RESHAPE((/19,13,5,5/),(/2,2/)))
......@@ -161,7 +155,7 @@ CONTAINS
! set energy parameters (normally to that, what we read in)
!
CALL lodpot(mpi,atoms,sphhar,obsolete,vacuum,&
input, v%mt,v%vacz, enpara_in, enpara)
input, vTot%mt,vTot%vacz, enpara_in, enpara)
!
......@@ -243,10 +237,10 @@ CONTAINS
! ..
! LDA+U
IF ((atoms%n_u.GT.0)) THEN
ALLOCATE( v%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins) )
CALL u_setup(sym,atoms,sphhar,input,enpara%el0(0:,:,:),inDen,v,mpi,results)
ALLOCATE( vTot%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u,input%jspins) )
CALL u_setup(sym,atoms,sphhar,input,enpara%el0(0:,:,:),inDen,vTot,mpi,results)
ELSE
ALLOCATE( v%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2) )
ALLOCATE( vTot%mmpMat(-lmaxU_const:-lmaxU_const,-lmaxU_const:-lmaxU_const,1,2) )
ENDIF
!
!---> loop over k-points: each can be a separate task
......@@ -275,8 +269,8 @@ CONTAINS
CALL juDFT_error("eigen: Error during allocation of tlmplm, tdd etc.",calledby ="eigen")
ENDIF
lh0=1
CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, v%mt(1,0,1,jsp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,v%mmpMat,atoms%n_u>0,1,jsp,input%jspins)
CALL tlmplm(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi, vTot%mt(1,0,1,jsp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,1,jsp,input%jspins)
CALL timestop("tlmplm")
!---> pk non-collinear
......@@ -286,8 +280,8 @@ CONTAINS
IF (noco%l_noco) THEN
isp = 2
CALL timestart("tlmplm")
CALL tlmplm(sphhar,atoms,DIMENSION,enpara,isp,isp,mpi, v%mt(1,0,1,isp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,v%mmpMat,atoms%n_u>0,2,2,input%jspins)
CALL tlmplm(sphhar,atoms,DIMENSION,enpara,isp,isp,mpi, vTot%mt(1,0,1,isp),lh0,input, td,ud)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,2,2,input%jspins)
CALL timestop("tlmplm")
ENDIF
!
......@@ -317,7 +311,7 @@ CONTAINS
!---> set up interstitial hamiltonian and overlap matrices
!
CALL timestart("Interstitial Hamiltonian&Overlap")
CALL hsint(input,noco,jij,stars, v%pw(:,jsp),lapw,jsp, mpi%n_size,mpi%n_rank,kpts%bk(:,nk),cell,atoms,l_real,hamOvlp)
CALL hsint(input,noco,jij,stars, vTot%pw(:,jsp),lapw,jsp, mpi%n_size,mpi%n_rank,kpts%bk(:,nk),cell,atoms,l_real,hamOvlp)
CALL timestop("Interstitial Hamiltonian&Overlap")
!
......@@ -326,7 +320,7 @@ CONTAINS
IF (.NOT.l_wu) THEN
CALL timestart("MT Hamiltonian&Overlap")
CALL hsmt(DIMENSION,atoms,sphhar,sym,enpara, mpi%SUB_COMM,mpi%n_size,mpi%n_rank,jsp,input,mpi,&
lmaxU_const, noco,cell, lapw, bkpt,v%mt,v%mmpMat, oneD,ud, kveclo,td,l_real,hamOvlp)
lmaxU_const, noco,cell, lapw, bkpt,vTot%mt,vTot%mmpMat, oneD,ud, kveclo,td,l_real,hamOvlp)
CALL timestop("MT Hamiltonian&Overlap")
ENDIF
!
......@@ -340,7 +334,7 @@ CONTAINS
IF( hybrid%l_subvxc ) THEN
CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,v%mt(:,0,:,:),atoms,ud,hybrid,enpara%el0,enpara%ello0,&
CALL subvxc(lapw,kpts%bk(:,nk),DIMENSION,input,jsp,vTot%mt(:,0,:,:),atoms,ud,hybrid,enpara%el0,enpara%ello0,&
sym, atoms%nlotot,kveclo, cell,sphhar, stars, xcpot,mpi,&
oneD, hamovlp,vx)
END IF
......@@ -351,10 +345,10 @@ CONTAINS
!
CALL timestart("Vacuum Hamiltonian&Overlap")
IF (input%film .AND. .NOT.oneD%odi%d1) THEN
CALL hsvac(vacuum,stars,DIMENSION, atoms, jsp,input,v%vacxy(1,1,1,jsp),v%vacz,enpara%evac0,cell, &
CALL hsvac(vacuum,stars,DIMENSION, atoms, jsp,input,vTot%vacxy(1,1,1,jsp),vTot%vacz,enpara%evac0,cell, &
bkpt,lapw,sym, noco,jij, mpi%n_size,mpi%n_rank,nv2,l_real,hamOvlp)
ELSEIF (oneD%odi%d1) THEN
CALL od_hsvac(vacuum,stars,DIMENSION, oneD,atoms, jsp,input,v%vacxy(1,1,1,jsp),v%vacz, &
CALL od_hsvac(vacuum,stars,DIMENSION, oneD,atoms, jsp,input,vTot%vacxy(1,1,1,jsp),vTot%vacz, &
enpara%evac0,cell, bkpt,lapw, oneD%odi%M,oneD%odi%mb,oneD%odi%m_cyl,oneD%odi%n2d, &
mpi%n_size,mpi%n_rank,sym,noco,jij,nv2,l_real,hamOvlp)
END IF
......@@ -417,7 +411,7 @@ ENDIF
DEALLOCATE (td%ind,td%tuulo,td%tdulo)
DEALLOCATE (td%tuloulo)
END DO ! spin loop ends
DEALLOCATE(v%mmpMat)
DEALLOCATE(vTot%mmpMat)
DEALLOCATE (matind)
IF (l_real) THEN
DEALLOCATE(hamOvlp%a_r,hamOvlp%b_r)
......
......@@ -20,17 +20,13 @@ MODULE m_eigenso
!**********************************************************************
!
CONTAINS
SUBROUTINE eigenso(eig_id, mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco, input,kpts, oneD)
!
SUBROUTINE eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts,oneD,vTot)
USE m_eig66_io, ONLY : read_eig,write_eig
USE m_spnorb
USE m_alineso
USE m_pot_io
USE m_types
#ifdef CPP_MPI
USE m_mpi_bc_pot
#endif
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
......@@ -46,13 +42,14 @@ CONTAINS
TYPE(t_kpts),INTENT(IN) :: kpts
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: vTot
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: eig_id
! ..
! ..
! .. Local Scalars ..
INTEGER i,j,nk,jspin ,iter ,n ,l
INTEGER i,j,nk,jspin,n ,l
INTEGER n_loc,n_plus,i_plus,n_end,nsz,nmat
LOGICAL l_file,l_socvec !,l_all
INTEGER wannierspin
......@@ -71,8 +68,6 @@ CONTAINS
REAL, ALLOCATABLE :: rsopplo(:,:,:,:),rsoploplop(:,:,:,:,:)
COMPLEX, ALLOCATABLE :: zso(:,:,:),soangl(:,:,:,:,:,:)
REAL, ALLOCATABLE :: vz(:,:,:),vr(:,:,:,:)
COMPLEX, ALLOCATABLE :: vzxy(:,:,:,:),vpw(:,:)
TYPE(t_zmat)::zmat
INTEGER :: ierr
......@@ -86,21 +81,6 @@ CONTAINS
!noco%phi= noco%phi+pi_const
! now the definition of rotation matrices
! is equivalent to the def in the noco-routines
!
! load potential by calling readPotential.
!
ALLOCATE ( vz(vacuum%nmzd,2,DIMENSION%jspd),vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd),&
vzxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,DIMENSION%jspd),vpw(stars%ng3,DIMENSION%jspd) )
IF (mpi%irank.EQ.0) THEN
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
iter,vr,vpw,vz,vzxy)
END IF
#ifdef CPP_MPI
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,iter,vr,vpw,vz,vzxy)
#endif
DEALLOCATE ( vz,vzxy,vpw )
ALLOCATE( usdus%us(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd), usdus%dus(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),&
usdus%uds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),usdus%duds(0:atoms%lmaxd,atoms%ntype,DIMENSION%jspd),&
......@@ -142,7 +122,7 @@ CONTAINS
soangl(atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2,atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,2) )
soangl(:,:,:,:,:,:) = CMPLX(0.0,0.0)
CALL spnorb( atoms,noco,input,mpi, enpara,vr, rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
CALL spnorb( atoms,noco,input,mpi, enpara,vTot%mt, rsopp,rsoppd,rsopdp,rsopdpd,usdus,&
rsoplop,rsoplopd,rsopdplo,rsopplo,rsoploplop, soangl)
!
!Check if SOC is to be scaled for some atom
......@@ -276,7 +256,7 @@ CONTAINS
DEALLOCATE (rsoplop,rsopdp,rsopdpd,rsopp,rsoppd,soangl)
DEALLOCATE ( vr,usdus%us,usdus%dus,usdus%uds,usdus%duds,usdus%ulos,usdus%dulos,usdus%uulon,usdus%dulon,usdus%ddn )
DEALLOCATE (usdus%us,usdus%dus,usdus%uds,usdus%duds,usdus%ulos,usdus%dulos,usdus%uulon,usdus%dulon,usdus%ddn)
RETURN
END SUBROUTINE eigenso
END MODULE m_eigenso
......@@ -11,7 +11,7 @@ CONTAINS
SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
dimension,kpts,atoms,sphhar,stars,sym,obsolete,&
enpara,cell,noco,jij,results,oneD,coreSpecInput,&
enpara,cell,noco,jij,vTot,results,oneD,coreSpecInput,&
inIter,outDen)
!*****************************************************
......@@ -25,7 +25,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
USE m_prpqfftmap
USE m_cdnval
USE m_cdn_io
USE m_pot_io
USE m_wrtdop
USE m_cdntot
USE m_cdnovlp
......@@ -37,7 +36,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
USE m_types
USE m_xmlOutput
#ifdef CPP_MPI
USE m_mpi_bc_pot
USE m_mpi_bc_potden
USE m_mpi_bc_coreden
#endif
......@@ -64,6 +62,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
TYPE(t_potden),INTENT(IN) :: vTot
TYPE(t_potden),INTENT(INOUT) :: outDen
!Scalar Arguments
......@@ -87,9 +86,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
REAL tec(atoms%ntype,DIMENSION%jspd),rhTemp(dimension%msh,atoms%ntype,dimension%jspd)
REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
INTEGER,ALLOCATABLE :: igq_fft(:)
REAL ,ALLOCATABLE :: vz(:,:,:),vr(:,:,:,:)
REAL ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:)
COMPLEX,ALLOCATABLE :: vpw(:,:),vzxy(:,:,:,:)
CHARACTER(LEN=20) :: attributes(4)
!pk non-collinear (start)
......@@ -98,19 +95,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
COMPLEX,ALLOCATABLE :: qa21(:)
!pk non-collinear (end)
!Read Potential and keep only vr(:,0,:,:) and vz
ALLOCATE(vpw(stars%ng3,dimension%jspd),vzxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,dimension%jspd))
ALLOCATE(vz(vacuum%nmzd,2,dimension%jspd),vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd))
IF (mpi%irank.EQ.0) THEN
CALL readPotential(stars,vacuum,atoms,sphhar,input,sym,POT_ARCHIVE_TYPE_TOT_const,&
iter,vr,vpw,vz,vzxy)
END IF
#ifdef CPP_MPI
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,&
iter,vr,vpw,vz,vzxy)
#endif
DEALLOCATE ( vpw,vzxy )
iter = inIter
CALL outDen%init(stars,atoms,sphhar,vacuum,oneD,DIMENSION%jspd,.FALSE.)
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
......@@ -170,7 +154,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL timestart("cdngen: cdnval")
CALL cdnval(eig_id,&
mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atoms,enpara,stars, vacuum,dimension,&
sphhar,sym,obsolete,igq_fft,vr,vz(:,:,jspin),oneD,coreSpecInput,&
sphhar,sym,obsolete,igq_fft,vTot%mt,vTot%vacz(:,:,jspin),oneD,coreSpecInput,&
outDen%mmpMat(-lmaxU_const:,-lmaxU_const:,:,jspin),results, outDen%pw,outDen%vacxy,outDen%mt,outDen%vacz,&
outDen%cdom,outDen%cdomvz,outDen%cdomvxy,qvac,qvlay,qa21, chmom,clmom)
CALL timestop("cdngen: cdnval")
......@@ -221,7 +205,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!add in core density
IF (mpi%irank.EQ.0) THEN
CALL cored(input,jspin,atoms, outDen%mt,dimension, sphhar, vr(:,0,:,jspin), qint,rh,tec,seig)
CALL cored(input,jspin,atoms,outDen%mt,dimension,sphhar,vTot%mt(:,0,:,jspin), qint,rh,tec,seig)
rhTemp(:,:,jspin) = rh(:,:,jspin)
results%seigc = results%seigc + seig
IF (input%jspins.EQ.2) THEN
......@@ -284,7 +268,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (.NOT.sliceplot%slice) THEN
!add in core density
IF (mpi%irank.EQ.0) THEN
CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vr(:,0,:,:),qint,rh)
CALL coredr(input,atoms,seig, outDen%mt,dimension,sphhar,vTot%mt(:,0,:,:),qint,rh)
results%seigc = results%seigc + seig
IF (input%jspins.EQ.2) THEN
DO jspin = 1,input%jspins
......@@ -396,7 +380,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
!calculate the perpendicular part of the local moment
!and relax the angle of the local moment or calculate
!the constraint B-field.
CALL m_perp(atoms,n,noco_new,vr(:,0,:,:),chmom,qa21,alphdiff)
CALL m_perp(atoms,n,noco_new,vTot%mt(:,0,:,:),chmom,qa21,alphdiff)
END IF
END DO
CALL closeXMLElement('magneticMomentsInMTSpheres')
......
......@@ -428,7 +428,7 @@ CONTAINS
ENDIF
! WRITE(6,fmt='(A)') 'Starting 2nd variation ...'
CALL eigenso(eig_id,mpi,DIMENSION,stars,vacuum,atoms,sphhar,&
obsolete,sym,cell,noco,input,kpts, oneD)
obsolete,sym,cell,noco,input,kpts, oneD,vTot)
IF(noco%l_soc.AND.input%gw.EQ.2) THEN
CLOSE(4649)
INQUIRE(1014,opened=l_endit)
......@@ -591,7 +591,7 @@ CONTAINS
IF (mpi%irank==0) WRITE(*,"(a)",advance="no") "* New Charge "
CALL cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DIMENSION,kpts,atoms,sphhar,stars,sym,obsolete,&
enpara,cell,noco,jij,results,oneD,coreSpecInput,&
enpara,cell,noco,jij,vTot,results,oneD,coreSpecInput,&
inDen%iter,outDen)
IF ( noco%l_soc .AND. (.NOT. noco%l_noco) ) dimension%neigd=dimension%neigd/2
......
......@@ -50,7 +50,6 @@ CONTAINS
USE m_points
USE m_fleur_vdw
#ifdef CPP_MPI
USE m_mpi_bc_pot
USE m_mpi_bc_potden
#endif
IMPLICIT NONE
......@@ -842,9 +841,10 @@ CONTAINS
ENDIF ! mpi%irank == 0
! broadcast potentials
#ifdef CPP_MPI
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,vTot%iter,vTot%mt,vTot%pw,vTot%vacz,vTot%vacxy)
CALL mpi_bc_pot(mpi,stars,sphhar,atoms,input,vacuum,vCoul%iter,vCoul%mt,vCoul%pw,vCoul%vacz,vCoul%vacxy)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vTot)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vCoul)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vx)
#endif
......
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