Commit dcf5c2d4 authored by Daniel Wortmann's avatar Daniel Wortmann

Made compileable

parent dfec26e9
......@@ -412,8 +412,8 @@ CONTAINS
! mix input and output densities
CALL timestart("mixing")
CALL mix(field2,xcpot,dimension,obsolete,sliceplot,mpi,stars,atoms,sphhar,vacuum,input,&
sym,cell,noco,oneD,hybrid,archiveType,inDen,outDen,results)
CALL mix(field2,dimension,mpi,stars,atoms,sphhar,vacuum,input,&
sym,cell,noco,oneD,archiveType,inDen,outDen,results)
CALL timestop("mixing")
IF(mpi%irank == 0) THEN
......
......@@ -29,7 +29,8 @@ contains
use m_umix
USE m_kerker
use m_types_mixvector
use m_distance
USE m_distance
use m_mixing_history
implicit none
type(t_oneD), intent(in) :: oneD
......@@ -51,10 +52,10 @@ contains
real :: fix
type(t_potden) :: resDen, vYukawa
TYPE(t_mixvector),allocatable :: sm(:), fsm(:)
TYPE(t_mixvector) :: fmMet, smMet,fsm_mag
TYPE(t_mixvector),ALLOCATABLE :: sm(:), fsm(:)
TYPE(t_mixvector) :: fsm_mag
LOGICAL :: l_densitymatrix
integer :: it
INTEGER :: it,maxiter
MPI0_a: IF( mpi%irank == 0 ) THEN
......@@ -97,7 +98,7 @@ contains
maxiter=merge(1,input%maxiter,input%imix==0)
CALL mixing_history(maxiter,inden,outden,sm,fsm,it)
CALL distance(mpi%irank,cell%vol,input%jspins,fsm,sm,inDen%iter,outDen,results)
CALL distance(mpi%irank,cell%vol,input%jspins,fsm(it),sm(it),inDen%iter,outDen,results,fsm_Mag)
! KERKER PRECONDITIONER
IF( input%preconditioning_param /= 0 ) call kerker(field, DIMENSION, mpi, &
......@@ -108,7 +109,7 @@ contains
!mixing of the densities
if(input%imix==0.or.it==1) CALL stmix(atoms,input,noco,fsm(it),fsm_mag,sm(it))
!if(it>1.and.input%imix==9) CALL pulay(input%alpha,fsm,sm)
if(it>1.and.(input%imax==3.or.input%imix==5.or.input%imix==7)) Call broyden(input%alpha,fsm,sm)
if(it>1.and.(input%imix==3.or.input%imix==5.or.input%imix==7)) Call broyden(input%alpha,fsm,sm)
!initiatlize mixed density and extract it
CALL sm(it)%to_density(inDen)
......@@ -116,11 +117,7 @@ contains
!fix charge of the new density
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 = outden%mmpMat
END IF
atoms%n_u=n_u_keep
IF(vacuum%nvac.EQ.1) THEN
inDen%vacz(:,2,:) = inDen%vacz(:,1,:)
......@@ -131,13 +128,7 @@ contains
END IF
END IF
IF (atoms%n_u > 0) THEN
IF (.NOT.l_densityMatrixPresent) THEN
inDen%mmpMat(:,:,:,:) = outDen%mmpMat(:,:,:,:)
CALL resetBroydenHistory()
END IF
ENDIF
!write out mixed density
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
1,results%last_distance,results%ef,.TRUE.,inDen)
......
......@@ -4,11 +4,13 @@ mix/metr_z0.f
set(fleur_F90 ${fleur_F90}
mix/type_mixvector.F90
mix/kerker.F90
mix/broyden.F90
mix/broyden2.F90
mix/brysh1.f90
mix/brysh2.f90
mix/metric.f90
mix/broyden_history.F90
mix/mixing_history.F90
mix/distance.F90
#mix/broyden2.F90
#mix/brysh1.f90
#mix/brysh2.f90
#mix/metric.f90
mix/potdis.f90
mix/stdmix.f90
mix/u_mix.f90
......
......@@ -25,10 +25,10 @@ CONTAINS
REAL :: dfivi,fmvm,vmnorm
REAL,ALLOCATABLE :: am(:)
TYPE(t_mixvector) :: fm1,sm1,ui,um,vi,vm
Type(t_mixvector) :: u_store(:),v_store(:)
TYPE(t_mixvector),allocatable :: u_store(:),v_store(:)
hlen=size(fm)
ALLOCATE(u_store(hlen-1),v_store(h_len-1))
ALLOCATE(u_store(hlen-1),v_store(hlen-1))
do it=1,hlen-1
call u_store(it)%alloc()
call v_store(it)%alloc()
......@@ -55,7 +55,7 @@ CONTAINS
ui=u_store(n)
vi=v_store(n)
am(it) = vi.dot.fm
am(it) = vi.dot.fm(n)
! calculate um(:) = -am(it)*ui(:) + um(:)
um=um-am(it)*ui
WRITE(6,FMT='(5x,"<vi|w|Fm> for it",i2,5x,f10.6)')it,am(it)
......@@ -83,9 +83,9 @@ CONTAINS
enddo
! update rho(m+1)
! calculate <fm|w|vm>
fmvm = vm.dot.fm
fmvm = vm.dot.fm(hlen)
! calculate sm(:) = (1.0-fmvm)*um(:) + sm
sm=sm+(1.0-fmvm)*um
sm(hlen)=sm(hlen)+(1.0-fmvm)*um
END SUBROUTINE broyden
END MODULE m_broyden
......@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
module m_distance
contains
SUBROUTINE distance(irank,vol,jspins,fsm,sm,iter,outden,results)
SUBROUTINE distance(irank,vol,jspins,fsm,sm,iter,outden,results,fsm_mag)
use m_types
use m_types_mixvector
use m_xmlOutput
......@@ -16,40 +16,42 @@ contains
type(t_mixvector),INTENT(IN) :: fsm,sm
TYPE(t_potden),INTENT(IN) :: outden
TYPE(t_results),INTENT(INOUT) :: results
type(t_mixvector),INTENT(OUT) :: fsm_mag
integer ::js
REAL :: dist(6) !1:up,2:down,3:spinoff,4:total,5:magnet,6:noco
type(t_mixvector)::fmMet,fsm_mag
TYPE(t_mixvector)::fmMet
character(len=100)::attributes(2)
CALL fmMet%alloc()
if (input%jspins==2) CALL fsm_mag%alloc()
if (jspins==2) CALL fsm_mag%alloc()
! calculate Magnetisation-difference
CALL fsm_mag%from_density(outden,swapspin=.true.)
fsm_mag=fsm_mag-sm(it)
fsm_mag=fsm_mag-sm
! Apply metric w to fsm and store in fmMet: w |fsm>
fmMet=fsm%apply_metric()
dist(:) = 0.0
DO js = 1,input%jspins
DO js = 1,jspins
dist(js) = fsm%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),js)
END DO
dist(6) = fsm%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),3)
IF (input%jspins.EQ.2) then
IF (jspins.EQ.2) THEN
dist(3) = fsm_mag%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),1)+&
fsm_mag%multiply_dot_mask(fmMet,(/.true.,.true.,.true.,.false./),2)
dist(4) = dist(1) + dist(2) + 2.0e0*dist(3)
dist(5) = dist(1) + dist(2) - 2.0e0*dist(3)
endif
ENDIF
results%last_distance=maxval(1000*SQRT(ABS(dist/vol)))
if (irank>1) return
!calculate the distance of charge densities for each spin
CALL openXMLElement('densityConvergence',(/'units'/),(/'me/bohr^3'/))
DO js = 1,input%jspins
DO js = 1,jspins
attributes = ''
WRITE(attributes(1),'(i0)') js
WRITE(attributes(2),'(f20.10)') 1000*SQRT(ABS(dist(js)/vol))
......@@ -62,7 +64,7 @@ contains
!calculate the distance of total charge and spin density
!|rho/m(o) - rho/m(i)| = |rh1(o) -rh1(i)|+ |rh2(o) -rh2(i)| +/_
! +/_2<rh2(o) -rh2(i)|rh1(o) -rh1(i)>
IF (input%jspins.EQ.2) THEN
IF (jspins.EQ.2) THEN
CALL writeXMLElementFormPoly('overallChargeDensity',(/'distance'/),&
(/1000*SQRT(ABS(dist(4)/vol))/),reshape((/10,20/),(/1,2/)))
CALL writeXMLElementFormPoly('spinDensity',(/'distance'/),&
......
......@@ -13,6 +13,7 @@ MODULE m_kerker
USE m_vgen_coulomb
USE m_VYukawaFilm
USE m_juDFT
USE m_qfix
USE m_types
USE m_types_mixvector
USE m_constants
......
......@@ -16,7 +16,9 @@ contains
integer,intent(in)::maxiter
type(t_potden),intent(in)::inden,outden
type(t_mixvector),ALLOCATABLE::sm(:),fsm(:)
integer,intent(out)::it
INTEGER,INTENT(out)::it
INTEGER:: n
if (.not.allocated(sm_store)) THEN
allocate(sm_store(maxiter),fsm_store(maxiter))
......@@ -31,7 +33,7 @@ contains
fsm(it) = fsm(it) - sm(it)
do n=it-1,1,-1 !Copy from storage
sm(n)=sm_store(n)
fm(n)=fsm_store(n)
fsm(n)=fsm_store(n)
ENDDO
if(iter_stored<maxiter) THEN
iter_stored=iter_stored+1
......@@ -39,7 +41,7 @@ contains
fsm_store(:iter_stored)=fsm(:iter_stored)
else
sm_store(:maxiter-1)=sm(2:maxiter)
fsm_store(:maxiter-1)=sm(2:maxiter)
fsm_store(:maxiter-1)=fsm(2:maxiter)
endif
end subroutine mixing_history
......
......@@ -48,6 +48,7 @@ MODULE m_types_mixvector
PROCEDURE :: from_density=>mixvector_from_density
PROCEDURE :: to_density=>mixvector_to_density
PROCEDURE :: apply_metric=>mixvector_metric
PROCEDURE :: multiply_dot_mask
END TYPE t_mixvector
INTERFACE OPERATOR (*)
......@@ -65,7 +66,7 @@ MODULE m_types_mixvector
END INTERFACE OPERATOR (.dot.)
PUBLIC :: OPERATOR(+),OPERATOR(-),OPERATOR(*),OPERATOR(.dot.)
PUBLIC :: mixvector_init,multiply_dot_mask
PUBLIC :: mixvector_init
CONTAINS
......@@ -181,7 +182,7 @@ CONTAINS
FUNCTION mixvector_metric(vec)RESULT(mvec)
USE m_types
USE m_metric
USE m_convol
IMPLICIT NONE
CLASS(t_mixvector),INTENT(IN) :: vec
TYPE(t_mixvector) :: mvec
......@@ -521,25 +522,29 @@ CONTAINS
END FUNCTION multiply_dot
FUNCTION multiply_dot_mask(vec1,vec2,mask,spin)RESULT(dprod)
TYPE(t_mixvector),INTENT(IN)::vec1,vec2
CLASS(t_mixvector),INTENT(IN)::vec1
TYPE(t_mixvector),INTENT(IN)::vec2
LOGICAL,INTENT(IN) ::mask(4)
INTEGER,INTENT(IN) ::spin
REAL ::dprod
INTEGER:: js
dprod=0.0
DO js=1,3
IF (mask(1).and.(spin==js.or.spin==0.and.start_pw(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_pw(start_pw(js):stop_pw(js)),&
vec2%vec_pw(start_pw(js):stop_pw(js)))
IF (mask(2).and.(spin==js.or.spin==0.and.start_mt(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_mt(start_mt(js):stop_mt(js)),&
vec2%vec_mt(start_mt(js):stop_mt(js)))
IF (mask(3).and.(spin==js.or.spin==0.and.start_vac(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_vac(start_vac(js):stop_vac(js)),&
vec2%vec_vac(start_vac(js):stop_vac(js)))
IF (mask(4).and.(spin==js.or.spin==0.and.start_misc(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_misc(start_misc(js):stop_misc(js)),&
vec2%vec_misc(start_misc(js):stop_misc(js)))
IF (mask(1).and.(spin==js.or.spin==0.and.pw_start(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_pw(pw_start(js):pw_stop(js)),&
vec2%vec_pw(pw_start(js):pw_stop(js)))
IF (mask(2).and.(spin==js.or.spin==0.and.mt_start(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_mt(mt_start(js):mt_stop(js)),&
vec2%vec_mt(mt_start(js):mt_stop(js)))
IF (mask(3).and.(spin==js.or.spin==0.and.vac_start(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_vac(vac_start(js):vac_stop(js)),&
vec2%vec_vac(vac_start(js):vac_stop(js)))
IF (mask(4).and.(spin==js.or.spin==0.and.misc_start(js)>0)) &
dprod=dprod+dot_PRODUCT(vec1%vec_misc(misc_start(js):misc_stop(js)),&
vec2%vec_misc(misc_start(js):misc_stop(js)))
enddo
#ifdef CPP_MPI
......
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