mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 12:10:50 +01:00
300 lines
11 KiB
Fortran
300 lines
11 KiB
Fortran
module domain
|
|
type domain_type
|
|
! integer iatmo
|
|
! integer inatmo
|
|
integer :: imem_start
|
|
integer, contiguous, pointer :: nmoat(:),moat(:,:)
|
|
integer, contiguous, pointer :: atdom(:,:),natdom(:)
|
|
integer, contiguous, pointer :: dfatdom(:,:),dfnatdom(:)
|
|
integer, contiguous, pointer :: aoat(:,:),naoat(:,:)
|
|
integer, contiguous, pointer :: dfnmobasis(:)
|
|
integer, contiguous, pointer :: nmobasis(:)
|
|
integer, contiguous, pointer :: atind(:,:)
|
|
integer, contiguous, pointer :: dfatind(:,:)
|
|
integer, contiguous, pointer :: moadd(:)
|
|
double precision :: excrad
|
|
end type
|
|
end module
|
|
|
|
!********************************************************************************
|
|
subroutine build_domains_type(dcore,icore,imem,ifile,nbasis,nocc,dom,mo,natoms, &
|
|
iimem,natrange,iout,dfnbasis,scrfile4,scftype,lwdfn,ialpha,locfit,scftol)
|
|
!********************************************************************************
|
|
!********************************************************************************
|
|
use domain, only: domain_type
|
|
implicit none
|
|
|
|
integer imem,nbasis,ifile,nocc,natoms,iimem,iout,natrange(2,natoms,*)
|
|
integer dfnbasis,scrfile4,icore(*)
|
|
integer isa,ivi,iai,iind,iv,ist,hailen,step,ialpha,locfit
|
|
integer iipra,IDFNMOBASIS_OLD,llocfit,inatmo,iatmo
|
|
double precision dcore(*),mo(nbasis,nocc),chargetol,scftol
|
|
character*5 scftype
|
|
logical linv,lwdfn
|
|
type(domain_type) dom
|
|
|
|
integer imem_old
|
|
integer dblalloc,intalloc
|
|
|
|
imem_old=imem
|
|
llocfit=locfit
|
|
chargetol=0.1d0
|
|
if (scftype.ne.'rhf ') chargetol=chargetol/2.d0
|
|
linv=.false.
|
|
step=2
|
|
isa=dblalloc(nbasis**2)
|
|
ivi=dblalloc(nbasis)
|
|
iai=dblalloc(nbasis)
|
|
iind=intalloc(natoms)
|
|
iv=dblalloc(nbasis*nocc)
|
|
inatmo=intalloc(nocc)
|
|
iatmo=intalloc(natoms*nocc)
|
|
ist=idnint(dble(natoms)/5.d0)
|
|
open(ifile,file='SROOT',form='UNFORMATTED')
|
|
call roeint(dcore(imem),dcore(imem),dcore(isa),ifile,nbasis)
|
|
close(ifile)
|
|
call dsymm('l','l',nbasis,nocc,1.d0,dcore(isa),nbasis,mo,nbasis,0.d0,&
|
|
dcore(iv),nbasis)
|
|
call bopu(nbasis,nocc,natoms,natrange,dcore(iv),dcore(iv),icore(iind), &
|
|
dcore(imem),dcore(isa),dcore(isa),dcore(ivi),dcore(iai),icore(iatmo), &
|
|
dom%nmoat,dom%moat,icore(inatmo),chargetol,chargetol,nocc,max(2*step,ist),&
|
|
'lowd',icore(iimem),natrange,nbasis,dcore(iv),dcore(imem),0,0.d0,0.0d0, &
|
|
.false.,iout,0.05d0)
|
|
! Construct domains
|
|
iipra=dblalloc(natoms**2)
|
|
idfnmobasis_old=intalloc(nocc)
|
|
!iatdom=intalloc(natoms)
|
|
call locdom(nbasis,nocc,natoms,natrange,icore(iatmo),dom%nmoat,dom%moat, &
|
|
icore(inatmo),dom%excrad,dom%atdom,dcore(iipra),dom%dfnmobasis,dom%moadd,&
|
|
hailen,dfnbasis,icore(idfnmobasis_old),linv,scrfile4,step, &
|
|
icore(iimem+natoms),iout,'rhf ',lwdfn,mo,dom%dfatdom,dom%dfnatdom, &
|
|
icore(iimem),dom%dfatind,2,ialpha,llocfit,dom%nmobasis,dom%natdom, &
|
|
dom%atdom,dom%naoat,dom%aoat,dom%atind,scftol,.false.)
|
|
call dbldealloc(imem_old)
|
|
|
|
end subroutine
|
|
|
|
!********************************************************************************
|
|
subroutine build_domains(dcore,icore,imem,ifile,nbasis,nocc,mo,nmoat,moat, &
|
|
natoms,iimem,natrange,iout,atdom,excrad,dfnmobasis,moadd,dfnbasis,scrfile4, &
|
|
scftype,lwdfn,ialpha,locfit,nmobasis,natdom,aoat,naoat,atind,dfatind, &
|
|
dfatdom,dfnatdom,scftol)
|
|
!********************************************************************************
|
|
!********************************************************************************
|
|
implicit none
|
|
|
|
integer imem,nbasis,ifile,nocc,natoms,iimem,iout,natrange(2,natoms,*)
|
|
integer nmoat(natoms),moat(natoms,nocc)
|
|
integer atdom(natoms,nocc),dfnmobasis(nocc),moadd(nocc),dfnbasis,scrfile4
|
|
integer isa,ivi,iai,iind,iv,ist,hailen,step,ialpha,locfit,nmobasis(nocc)
|
|
integer natdom(nocc),naoat(natoms,2),atind(nocc,natoms),icore(*)
|
|
integer iipra,IDFNMOBASIS_OLD,iatdom,llocfit,inatmo,iatmo
|
|
integer aoat(natoms,nocc),dfatind(nocc,natoms)
|
|
integer dfatdom(natoms,nocc),dfnatdom(nocc)
|
|
double precision dcore(*),mo(nbasis,nocc),chargetol,scftol,excrad
|
|
character*5 scftype
|
|
logical linv,lwdfn
|
|
|
|
integer imem_old
|
|
integer dblalloc,intalloc
|
|
|
|
imem_old=imem
|
|
llocfit=locfit
|
|
chargetol=0.1d0
|
|
if (scftype.ne.'rhf ') chargetol=chargetol/2.d0
|
|
linv=.false.
|
|
step=2
|
|
isa=dblalloc(nbasis**2)
|
|
ivi=dblalloc(nbasis)
|
|
iai=dblalloc(nbasis)
|
|
iind=intalloc(natoms)
|
|
iv=dblalloc(nbasis*nocc)
|
|
inatmo=intalloc(nocc)
|
|
iatmo=intalloc(natoms*nocc)
|
|
ist=idnint(dble(natoms)/5.d0)
|
|
open(ifile,file='SROOT',form='UNFORMATTED')
|
|
call roeint(dcore(imem),dcore(imem),dcore(isa),ifile,nbasis)
|
|
close(ifile)
|
|
call dsymm('l','l',nbasis,nocc,1.d0,dcore(isa),nbasis,mo,nbasis,0.d0, &
|
|
dcore(iv),nbasis)
|
|
call bopu(nbasis,nocc,natoms,natrange,dcore(iv),dcore(iv),icore(iind), &
|
|
dcore(imem),dcore(isa),dcore(isa),dcore(ivi),dcore(iai),icore(iatmo),nmoat, &
|
|
moat,icore(inatmo),chargetol,chargetol,nocc,max(2*step,ist),'lowd', &
|
|
icore(iimem),natrange,nbasis,dcore(iv),dcore(imem),0,0.d0,0.0d0,.false., &
|
|
iout,0.05d0)
|
|
! Construct domains
|
|
iipra=dblalloc(natoms**2)
|
|
idfnmobasis_old=intalloc(nocc)
|
|
iatdom=intalloc(natoms)
|
|
call locdom(nbasis,nocc,natoms,natrange,icore(iatmo),nmoat,moat,icore(inatmo),&
|
|
excrad,icore(iatdom),dcore(iipra),dfnmobasis,moadd,hailen,dfnbasis, &
|
|
icore(idfnmobasis_old),linv,scrfile4,step,icore(iimem+natoms),iout,scftype, &
|
|
lwdfn,mo,dfatdom,dfnatdom,icore(iimem),dfatind,2,ialpha,llocfit,nmobasis, &
|
|
natdom,atdom,naoat,aoat,atind,scftol,.false.)
|
|
call dbldealloc(imem_old)
|
|
|
|
end subroutine
|
|
|
|
!********************************************************************************
|
|
subroutine alloc_domains_type(dom,natoms,nocc,icore,imem)
|
|
!********************************************************************************
|
|
! Allocate memory for domains
|
|
!********************************************************************************
|
|
use domain, only: domain_type
|
|
implicit none
|
|
integer :: natoms,nocc,imem,i
|
|
integer, target :: icore(*)
|
|
type(domain_type) :: dom
|
|
|
|
integer intalloc
|
|
|
|
dom%imem_start = imem
|
|
i=intalloc(natoms)
|
|
dom%nmoat(1:natoms) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%moat(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%atdom(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%dfnmobasis(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%moadd(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%nmobasis(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%natdom(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%aoat(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*2)
|
|
dom%naoat(1:natoms,1:2) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%atind(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%dfatind(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%dfatdom(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%dfnatdom(1:nocc) => icore(i:imem-1)
|
|
|
|
end subroutine
|
|
|
|
!********************************************************************************
|
|
subroutine alloc_zero_domains(dom,natoms,nocc,nbasis,dfnbasis,icore,imem)
|
|
!********************************************************************************
|
|
!********************************************************************************
|
|
use domain, only: domain_type
|
|
implicit none
|
|
integer :: natoms,nocc,imem,dfnbasis,nbasis,i
|
|
integer, target :: icore(*)
|
|
type(domain_type) :: dom
|
|
|
|
integer intalloc
|
|
|
|
interface
|
|
subroutine alloc_domains_type(dom,natoms,nocc,icore,imem)
|
|
use domain, only: domain_type
|
|
implicit none
|
|
integer :: natoms,nocc,imem
|
|
integer, target :: icore(*)
|
|
type(domain_type) :: dom
|
|
end subroutine
|
|
end interface
|
|
|
|
call alloc_domains_type(dom,0,0,icore,imem)
|
|
i=intalloc(nocc)
|
|
dom%dfnmobasis(1:nocc) => icore(i:imem-1)
|
|
dom%dfnmobasis=dfnbasis
|
|
i=intalloc(nocc)
|
|
dom%moadd(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%nmobasis(1:nocc) => icore(i:imem-1)
|
|
dom%nmobasis=nbasis
|
|
|
|
end subroutine
|
|
|
|
!********************************************************************************
|
|
subroutine alloc_domains_prop(dom,natoms,nocc,dfnmobasis,nmobasis,moadd,llocfit,&
|
|
icore,imem)
|
|
!********************************************************************************
|
|
! Allocate memory for domains in prop.f:scfgrad
|
|
!********************************************************************************
|
|
use domain, only: domain_type
|
|
implicit none
|
|
integer :: natoms,nocc,imem,i
|
|
integer, target :: icore(*),dfnmobasis(*),nmobasis(*),moadd(*)
|
|
logical llocfit
|
|
type(domain_type) :: dom
|
|
|
|
integer intalloc
|
|
|
|
dom%imem_start = imem
|
|
dom%dfnmobasis(1:nocc) => dfnmobasis(1:nocc)
|
|
dom%moadd(1:nocc) => moadd(1:nocc)
|
|
dom%nmobasis(1:nocc) => nmobasis(1:nocc)
|
|
if(llocfit) then
|
|
i=intalloc(natoms)
|
|
dom%nmoat(1:natoms) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%moat(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%atdom(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%natdom(1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%aoat(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*2)
|
|
dom%naoat(1:natoms,1:2) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%atind(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%dfatind(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(natoms*nocc)
|
|
dom%dfatdom(1:natoms,1:nocc) => icore(i:imem-1)
|
|
i=intalloc(nocc)
|
|
dom%dfnatdom(1:nocc) => icore(i:imem-1)
|
|
else
|
|
dom%nmoat(1:natoms) => icore(imem:imem+natoms-1)
|
|
dom%moat(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%atdom(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%natdom(1:nocc) => icore(imem:imem+nocc-1)
|
|
dom%aoat(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%naoat(1:natoms,1:2) => icore(imem:imem+2*natoms-1)
|
|
dom%atind(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%dfatind(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%dfatdom(1:natoms,1:nocc) => icore(imem:imem+natoms*nocc-1)
|
|
dom%dfnatdom(1:nocc) => icore(imem:imem+nocc-1)
|
|
endif
|
|
|
|
end subroutine
|
|
!********************************************************************************
|
|
subroutine alloc_domains(inmoat,imoat,iatdom,idfnmobasis,imoadd, &
|
|
inmobasis,inatdom,iaoat,inaoat,iatind,idfatind,idfatdom,idfnatdom,natoms,nocc)
|
|
!********************************************************************************
|
|
! Allocate memory for domains
|
|
!********************************************************************************
|
|
implicit none
|
|
integer inmoat,imoat,iatdom,idfnmobasis,imoadd,inaoat
|
|
integer inmobasis,inatdom,iaoat,iatind,idfatind,natoms,nocc
|
|
integer idfatdom,idfnatdom
|
|
|
|
integer intalloc
|
|
|
|
! iatmo=intalloc(natoms*nocc)
|
|
inmoat=intalloc(natoms)
|
|
imoat=intalloc(natoms*nocc)
|
|
! inatmo=intalloc(nocc)
|
|
iatdom=intalloc(natoms*nocc)
|
|
idfnmobasis=intalloc(nocc)
|
|
imoadd=intalloc(nocc)
|
|
inmobasis=intalloc(nocc)
|
|
inatdom=intalloc(nocc)
|
|
iaoat=intalloc(natoms*nocc)
|
|
inaoat=intalloc(natoms*2)
|
|
iatind=intalloc(natoms*nocc)
|
|
idfatind=intalloc(natoms*nocc)
|
|
idfatdom=intalloc(natoms*nocc)
|
|
idfnatdom=intalloc(nocc)
|
|
|
|
end subroutine
|
|
|