mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-16 19:50:50 +01:00
150 lines
4.7 KiB
Fortran
Executable File
150 lines
4.7 KiB
Fortran
Executable File
************************************************************************
|
|
subroutine diis(ndit,nmax,pvec,evec,ndiis,diisfile,errfile,ifltln,
|
|
$bmat,invbmat)
|
|
************************************************************************
|
|
* DIIS extrapolation *
|
|
* ndit - iteration step *
|
|
* nmax - dimension of the vector to be extrapolated *
|
|
* pvec - the parameter vector *
|
|
* evec - the error vector *
|
|
* ndiis - maximum no. of DIIS vectors *
|
|
* diisfile - file for parameter vectors *
|
|
* errfile - file for error vectors *
|
|
* ifltln - length of floating point variables in bytes (=8) *
|
|
* bmat - B matrix, which must not be overwritten outside *
|
|
* invbmat - scratch vector of size of (ndiis+1)^2 *
|
|
************************************************************************
|
|
implicit none
|
|
integer ndit,nact,i,j,ii,jj,nmax,ndiis,diisfile,errfile,nactn
|
|
integer ifltln,nactpl,imap(ndiis)
|
|
real*8 bmat(ndiis,ndiis),invbmat(ndiis+1,ndiis+1)
|
|
real*8 cvec(ndiis+1),tmp,evec(nmax),pvec(nmax),ddot,emin
|
|
real*8 scl(ndiis+1),eig(ndiis+1),work(3*(ndiis+1))
|
|
integer*4 isyev
|
|
equivalence(i,isyev)
|
|
C Open files, Fortran 2003 is used with ifort for very large systems
|
|
#if defined (Intel)
|
|
open(diisfile,status='unknown',access='stream')
|
|
open(errfile ,status='unknown',access='stream')
|
|
#else
|
|
open(diisfile,status='unknown',access='direct',recl=nmax*ifltln)
|
|
open(errfile ,status='unknown',access='direct',recl=nmax*ifltln)
|
|
#endif
|
|
C Decide which vector is replaced
|
|
if(ndit.le.min(nmax,ndiis)) then
|
|
nact=ndit
|
|
nactpl=ndit
|
|
else
|
|
nact=min(nmax,ndiis)
|
|
emin=bmat(1,1)
|
|
nactpl=1
|
|
do i=2,nact
|
|
if(bmat(i,i).gt.emin) then
|
|
emin=bmat(i,i)
|
|
nactpl=i
|
|
endif
|
|
enddo
|
|
endif
|
|
C Save parameters and error vector
|
|
#if defined (Intel)
|
|
write(diisfile,pos=(nactpl-1)*nmax*ifltln+1) pvec
|
|
write(errfile ,pos=(nactpl-1)*nmax*ifltln+1) evec
|
|
#else
|
|
write(diisfile,rec=nactpl) pvec
|
|
write(errfile ,rec=nactpl) evec
|
|
#endif
|
|
C Update the scalar product matrix (B matrix)
|
|
do i=1,nact
|
|
if(i.eq.nactpl) then
|
|
tmp=ddot(nmax,evec,1,evec,1)
|
|
emin=tmp
|
|
else
|
|
#if defined (Intel)
|
|
read(errfile,pos=(i-1)*nmax*ifltln+1) pvec
|
|
#else
|
|
read(errfile,rec=i) pvec
|
|
#endif
|
|
tmp=ddot(nmax,pvec,1,evec,1)
|
|
endif
|
|
bmat(i,nactpl)=tmp
|
|
bmat(nactpl,i)=tmp
|
|
enddo
|
|
C Cure numerical instability
|
|
do i=1,nact
|
|
emin=min(emin,bmat(i,i))
|
|
enddo
|
|
nactn=0
|
|
imap(1:nact)=0
|
|
do i=1,nact
|
|
tmp=bmat(i,i)
|
|
if(emin*1d15.gt.tmp.or.i.eq.nactpl) then
|
|
nactn=nactn+1
|
|
imap(i)=nactn
|
|
endif
|
|
enddo
|
|
do i=1,nact
|
|
ii=imap(i)
|
|
if(ii.gt.0) then
|
|
do j=1,i
|
|
jj=imap(j)
|
|
if(jj.gt.0) invbmat(ii,jj)=bmat(i,j)
|
|
enddo
|
|
endif
|
|
enddo
|
|
invbmat(nactn+1,1:nactn)=-1.d0
|
|
invbmat(nactn+1,nactn+1)=0.d0
|
|
cvec(1:nactn)=0.d0
|
|
cvec(nactn+1)=-1.d0
|
|
if(emin.gt.0.d0) then
|
|
do i=1,nactn
|
|
scl(i)=1.d0/dsqrt(invbmat(i,i))
|
|
enddo
|
|
scl(nactn+1)=1.d0
|
|
do i=1,nactn+1
|
|
do j=1,i
|
|
invbmat(i,j)=scl(i)*scl(j)*invbmat(i,j)
|
|
enddo
|
|
enddo
|
|
else
|
|
scl(1:nactn+1)=1.d0
|
|
endif
|
|
C Solve linear system of equations
|
|
call dsyev('V','L',nactn+1,invbmat,ndiis+1,eig,work,3*(ndiis+1),
|
|
$isyev)
|
|
if(isyev.ne.0) then
|
|
#if defined (Intel)
|
|
read(diisfile,pos=(nactpl-1)*nmax*ifltln+1) pvec
|
|
#else
|
|
read(diisfile,rec=nactpl) pvec
|
|
#endif
|
|
return
|
|
endif
|
|
work(1:nactn)=0.d0
|
|
do i=1,nactn+1
|
|
if(dabs(eig(i)).gt.1d-10)
|
|
$work(1:nactn)=work(1:nactn)+invbmat(1:nactn,i)*
|
|
$dot_product(invbmat(1:nactn+1,i),cvec(1:nactn+1))/eig(i)
|
|
enddo
|
|
cvec(1:nactn)=work(1:nactn)*scl(1:nactn)
|
|
cvec(1:nactn)=cvec(1:nactn)/sum(cvec(1:nactn))
|
|
C New parameters
|
|
pvec=0.d0
|
|
do i=1,nact
|
|
ii=imap(i)
|
|
if(ii.gt.0) then
|
|
#if defined (Intel)
|
|
read(diisfile,pos=(i-1)*nmax*ifltln+1) evec
|
|
#else
|
|
read(diisfile,rec=i) evec
|
|
#endif
|
|
call daxpy(nmax,cvec(ii),evec,1,pvec,1)
|
|
endif
|
|
enddo
|
|
C Close files
|
|
close(diisfile)
|
|
close(errfile)
|
|
C
|
|
return
|
|
end
|
|
C
|