mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-16 03:38:05 +01:00
732 lines
26 KiB
Fortran
Executable File
732 lines
26 KiB
Fortran
Executable File
SUBROUTINE GETMEM(GETWRD,IFIRST,IPOS)
|
|
#include "MRCCCOMMON"
|
|
integer GETWRD,IFIRST,IPOS
|
|
integer*8 index,mem,xalloc,iloc
|
|
C
|
|
if(getwrd.eq.0) return
|
|
MEM=GETWRD*IINTLN
|
|
INDEX=XALLOC(MEM)
|
|
IF(INDEX.EQ.0) THEN
|
|
IPOS=-1
|
|
write(iout,*) 'Request for ',getwrd,' words of memory failed.'
|
|
call mrccend(1)
|
|
RETURN
|
|
ENDIF
|
|
iloc=LOC(IFIRST)
|
|
IPOS=1+(INDEX-iloc)/IINTLN
|
|
C
|
|
RETURN
|
|
END
|
|
C
|
|
subroutine getmemr8(getwrd,ifirst,ipos)
|
|
C Allocate getwrd real*8 word of memory
|
|
#include "MRCCCOMMON"
|
|
integer getwrd,ifirst,ipos,dbladd
|
|
C
|
|
if(getwrd.eq.0) return
|
|
call getmem(iintfp*getwrd,ifirst,ipos)
|
|
ipos=dbladd(ipos)
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine memalloc
|
|
************************************************************************
|
|
* Allocate memory
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer i,imem1,intadd
|
|
character*1 line2(16)
|
|
character*2 ch2
|
|
character*16 line1
|
|
equivalence(line1,line2)
|
|
common/memcom/ imem1
|
|
C
|
|
if(mem_allocated) return
|
|
C
|
|
line1=' '
|
|
call getkey('mem',3,line1,16)
|
|
if(line1.ne.' ') then
|
|
i=1
|
|
do while(line2(i).ne.' '.and.i.lt.16)
|
|
i=i+1
|
|
enddo
|
|
call lowercase(line2(i-2),ch2,2)
|
|
if(ch2.ne.'mb'.and.ch2.ne.'gb') then
|
|
write(iout,*) 'Unknown memory unit!'
|
|
call exit(1)
|
|
endif
|
|
line2(i-2)=' '
|
|
line2(i-1)=' '
|
|
read(line1,*) maxmem
|
|
else
|
|
ch2='mb'
|
|
maxmem=256.d0
|
|
endif
|
|
if(ch2.eq.'gb') maxmem=1024.d0*maxmem
|
|
if(maxmem.lt.100.d0) then
|
|
write(iout,"(' Allocation of',f5.1,' Mbytes of memory...')")
|
|
$maxmem
|
|
else if(maxmem.lt.1000.d0) then
|
|
write(iout,"(' Allocation of',f6.1,' Mbytes of memory...')")
|
|
$maxmem
|
|
else if(maxmem.lt.10000.d0) then
|
|
write(iout,"(' Allocation of',f7.1,' Mbytes of memory...')")
|
|
$maxmem
|
|
else if(maxmem.lt.100000.d0) then
|
|
write(iout,"(' Allocation of',f5.1,' Gbytes of memory...')")
|
|
$maxmem/1024.d0
|
|
else if(maxmem.lt.1000000.d0) then
|
|
write(iout,"(' Allocation of',f6.1,' Gbytes of memory...')")
|
|
$maxmem/1024.d0
|
|
else
|
|
write(iout,"(' Allocation of',f7.1,' Gbytes of memory...')")
|
|
$maxmem/1024.d0
|
|
endif
|
|
maxmem=maxmem*dble(twoto20)/dble(ifltln)
|
|
maxcor=idnint(maxmem)
|
|
call getmemr8(maxcor,icore(1),imem)
|
|
imem1=imem
|
|
iimem=intadd(imem)
|
|
|
|
mem_allocated = .true.
|
|
C
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
subroutine memdealloc
|
|
************************************************************************
|
|
* Allocate memory
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer i,imem1,intadd
|
|
C
|
|
write(iout, "('Deallocating memory...')")
|
|
call xdealloc
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
integer function dblalloc(n)
|
|
************************************************************************
|
|
* Allocate n double precision words and return address wrt dcore
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer n,imem1,intadd
|
|
common/memcom/ imem1
|
|
C
|
|
dblalloc=imem
|
|
imem=imem+n
|
|
iimem=intadd(imem)
|
|
c write(iout,"(' Allocating ',f6.2,' GB')")
|
|
c $ifltln*dfloat(n)/1024**3
|
|
if(imem-imem1.gt.maxcor) then
|
|
write(iout,*) 'Insufficient memory!'
|
|
write(iout,"(' Requested: ',f6.2,' GB')")
|
|
$ifltln*dfloat(n)/1024**3
|
|
write(iout,"(' Available: ',f6.2,' GB')")
|
|
$ifltln*dfloat(maxcor-imem+imem1+n)/1024**3
|
|
call mrccend(1)
|
|
endif
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
integer function intalloc(n)
|
|
************************************************************************
|
|
* Allocate n integer words and return address wrt icore
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer n,imem1,dbladd
|
|
common/memcom/ imem1
|
|
C
|
|
intalloc=iimem
|
|
iimem=iimem+n
|
|
imem=dbladd(iimem)
|
|
c write(iout,"(' Allocating ',f6.2,' GB')")
|
|
c $iintln*dfloat(n)/1024**3
|
|
if(imem-imem1.gt.maxcor) then
|
|
write(iout,*) 'Insufficient memory!'
|
|
write(iout,"(' Requested: ',f6.2,' GB')")
|
|
$iintln*dfloat(n)/1024**3
|
|
write(iout,"(' Available: ',f6.2,' GB')")
|
|
$iintln*dfloat(maxcor-imem+imem1+n)/1024**3
|
|
call mrccend(1)
|
|
endif
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine dbldealloc(im)
|
|
************************************************************************
|
|
* Deallocate arrays starting from double precision memory address im
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer im,intadd
|
|
C
|
|
imem=im
|
|
iimem=intadd(imem)
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine intdealloc(im)
|
|
************************************************************************
|
|
* Deallocate arrays starting from integer memory address im
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer im,dbladd
|
|
C
|
|
iimem=im
|
|
imem=dbladd(iimem)
|
|
C
|
|
return
|
|
end
|
|
C
|
|
C Gyula
|
|
************************************************************************
|
|
subroutine dintmemcalc(intmem,nbset,ncontrmax,nprimmax,
|
|
$ibas,jbas,kbas,xyzomp,dfscrsz,dero,l3der)
|
|
************************************************************************
|
|
* Upper bound for the memory requirement of three-center dERI evaluation
|
|
************************************************************************
|
|
implicit none
|
|
integer intmem,nbset,ncontrmax,nprimmax,dero
|
|
integer ibas,jbas,kbas,xyzomp,dfscrsz,d
|
|
integer imax,jmax,kmax,icart,jcart,kcart,ispher,jspher,kspher
|
|
integer nmax1,n1crt,routeang,nmcrt,nangmaxv(nbset)
|
|
logical lbragen,lketgen ! max angular momenta are lower than the max ones for the generated codes or not
|
|
logical l3der ! derivatives with respect to every center?
|
|
integer dfintder1cmem,dfint3dermem
|
|
|
|
call getvar('nangmaxv ',nangmaxv)
|
|
imax=nangmaxv(ibas)
|
|
jmax=nangmaxv(jbas)
|
|
kmax=nangmaxv(kbas)
|
|
call dlcodegen(max(imax,jmax),lbragen,kmax,lketgen)
|
|
|
|
if(dero.eq.1.and.lbragen.and.lketgen) then ! only code generated integral-derivative subroutines will run
|
|
if(l3der) then
|
|
intmem=max(dfint3dermem(imax,jmax,kmax,nprimmax,
|
|
$ncontrmax,nprimmax,ncontrmax,nprimmax,d),
|
|
$ dfintder1cmem(imax,jmax,kmax,nprimmax,
|
|
$ncontrmax,nprimmax,ncontrmax,nprimmax,d)) ! l1der codes might be called
|
|
else
|
|
intmem=dfintder1cmem(imax,jmax,kmax,nprimmax,
|
|
$ncontrmax,nprimmax,ncontrmax,nprimmax,d)
|
|
endif
|
|
else ! general dprimcalc routine
|
|
intmem=0
|
|
call dprim_mem(
|
|
$d,d,d,d,d,d,d,d,d,d,d,d,d,dero,intmem,imax,jmax,kmax,0,
|
|
$1,1,nprimmax,ncontrmax,nprimmax,ncontrmax,nprimmax,ncontrmax,
|
|
$l3der)
|
|
endif
|
|
intmem=intmem*xyzomp+dfscrsz ! dfscr size
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
subroutine intmemcalc(intmem,nbset,ncontrmax,nprimmax,
|
|
$ibas,jbas,kbas,xyzomp,dfscrsz,cartg,omega)
|
|
************************************************************************
|
|
* Upper bound for the memory requirement of three-center ERI evaluation
|
|
************************************************************************
|
|
implicit none
|
|
integer intmem,nbset,ncontrmax,nprimmax
|
|
integer ibas,jbas,kbas,xyzomp,dfscrsz,d
|
|
integer imax,jmax,kmax,icart,jcart,kcart,ispher,jspher,kspher
|
|
integer nmax1,n1crt,routeang,nmcrt,nangmaxv(nbset)
|
|
real*8 omega
|
|
logical lbragen,lketgen ! max angular momenta are lower than the max ones for the generated codes or not
|
|
logical lsep ! df_primcalc subroutine if .false.
|
|
logical cartg
|
|
character*4 intalg
|
|
|
|
call getvar('nangmaxv ',nangmaxv)
|
|
imax=nangmaxv(ibas)
|
|
jmax=nangmaxv(jbas)
|
|
kmax=nangmaxv(kbas)
|
|
|
|
call getkey('intalg',6,intalg,4)
|
|
lsep=omega.eq.0.d0.and.intalg.ne.'rys '.and.intalg.ne.'herm'.and.
|
|
$.not.cartg
|
|
|
|
call lcodegen(max(imax,jmax),lbragen,kmax,lketgen)
|
|
call cartspher(imax,jmax,kmax,d,icart,jcart,kcart,d,ispher,
|
|
$jspher,kspher,d)
|
|
nmax1=imax+jmax
|
|
nmcrt=(nmax1+1)*(nmax1+2)*(nmax1+3)/6
|
|
n1crt=nmcrt-imax*icart/3
|
|
|
|
if(lsep) then
|
|
if(lbragen.and.lketgen) then ! only code generated integral subroutines will run
|
|
call intmem_gen(ispher,jspher,kspher,kcart,n1crt,ncontrmax,
|
|
$ncontrmax,nprimmax,nprimmax,nprimmax,intmem)
|
|
else ! general dfint routine
|
|
call intmem_dfint(nmcrt,ispher,jspher,kspher,nmcrt*kcart,
|
|
$ncontrmax,ncontrmax,ncontrmax,kmax,imax,jmax,nprimmax,nprimmax,
|
|
$nprimmax,kcart,intmem)
|
|
endif
|
|
elseif(intalg.eq."herm") then
|
|
intmem=0
|
|
call dprim_mem(
|
|
$d,d,d,d,d,d,d,d,d,d,d,d,d,0,intmem,imax,jmax,kmax,0,
|
|
$1,1,nprimmax,ncontrmax,nprimmax,ncontrmax,nprimmax,ncontrmax,
|
|
$.false.)
|
|
else
|
|
if(omega.ne.0.d0.and.intalg.ne.'rys '.and.intalg.ne.'herm'.and.
|
|
$.not.cartg.and.lbragen.and.lketgen) then ! range separated codegen ERIs
|
|
call intmem_gen(ispher,jspher,kspher,kcart,n1crt,ncontrmax,
|
|
$ncontrmax,nprimmax,nprimmax,nprimmax,intmem)
|
|
else
|
|
intmem=0
|
|
call df_primcalc_mem(d,d,d,d,d,d,d,intmem,
|
|
$imax.gt.1.or.jmax.gt.0,intalg.eq.'rys '.and.imax+jmax+kmax.le.40,
|
|
$imax,jmax,kmax,ncontrmax,ncontrmax,ncontrmax,nprimmax,nprimmax,
|
|
$nprimmax,cartg)
|
|
endif
|
|
endif
|
|
intmem=intmem*xyzomp+dfscrsz ! dfscr size
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
subroutine lcodegen(ijang,lbragen,kang,lketgen)
|
|
************************************************************************
|
|
C Code generated 3c ERI evaluation is possible or not: both have to be true
|
|
************************************************************************
|
|
implicit none
|
|
integer ijang,kang
|
|
logical lbragen,lketgen
|
|
|
|
if(ijang.le.5) then
|
|
lbragen=.true.
|
|
else
|
|
lbragen=.false.
|
|
endif
|
|
|
|
if(kang.le.6) then
|
|
lketgen=.true.
|
|
else
|
|
lketgen=.false.
|
|
endif
|
|
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
subroutine lcodegen2(kang,lketgen)
|
|
************************************************************************
|
|
C Code generated 3c ERI evaluation is possible or not: both have to be true
|
|
************************************************************************
|
|
implicit none
|
|
integer kang
|
|
logical lketgen
|
|
if(kang.le.6) then
|
|
lketgen=.true.
|
|
else
|
|
lketgen=.false.
|
|
endif
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
subroutine dlcodegen(ijang,lbragen,kang,lketgen)
|
|
************************************************************************
|
|
C Code generated 3c derivative ERI evaluation is possible or not: both have to be true
|
|
************************************************************************
|
|
implicit none
|
|
integer ijang,kang
|
|
logical lbragen,lketgen
|
|
|
|
if(ijang.le.4) then
|
|
lbragen=.true.
|
|
else
|
|
lbragen=.false.
|
|
endif
|
|
|
|
if(kang.le.5) then
|
|
lketgen=.true.
|
|
else
|
|
lketgen=.false.
|
|
endif
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
subroutine intmem_gen(nispher,njspher,nkspher,nkcart,n1crt,
|
|
$njcontr,nkcontr,niprim,njprim,nkprim,intmem)
|
|
************************************************************************
|
|
C Memory for 3c ERIs with the generated codes
|
|
************************************************************************
|
|
implicit none
|
|
integer nispher,njspher,nkspher,nkcart,n1crt,
|
|
$njcontr,nkcontr,niprim,njprim,nkprim
|
|
integer intmem
|
|
|
|
intmem=max(nispher*njspher*nkspher,nkcart*n1crt)* ! length of one uncontracted clss, (ij|k) spherical or (e0|k) cartesian
|
|
$(nkprim+ ! uncontracted ERIs for all kprmi
|
|
$1+ ! buffer for k contraction
|
|
$nkcontr*njprim+ ! k-contracted ERIs for all kcotr,jprim
|
|
$nkcontr+ ! buffer for j contraction
|
|
$nkcontr*njcontr*niprim+ ! j-contracted ERIs for all kcotr,jcontr,iprim
|
|
$nkcontr*njcontr) ! buffer for i contraction
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
subroutine intmem_dfint(nmcrt,nispher,njspher,nkspher,nc12,
|
|
$nicontr,njcontr,nkcontr,kang,iang,jang,niprim,njprim,nkprim,
|
|
$nkcart,intmem)
|
|
************************************************************************
|
|
C Memory for 3c ERIs with the general dfint routine
|
|
************************************************************************
|
|
implicit none
|
|
integer nispher,njspher,nkspher,nkcart,nmcrt,nc12,iang,jang,kang,
|
|
$nicontr,njcontr,nkcontr,niprim,njprim,nkprim
|
|
integer intmem
|
|
|
|
intmem=4*nmcrt*nispher*njspher+1+ ! (e0|k) cartesian bra -> (ij|k) spherical bra transformation matrix: sparse, dense, and two index arrays for the dense matrix
|
|
$nc12*nicontr*njcontr*nkcontr+ ! (e0|k) i,j,k contracted ERIs
|
|
$nispher*njspher*nkcart*nicontr*njcontr*nkcontr+ ! (ij|k) contracted ERIs, spherical bra
|
|
$nc12+ ! legacy, undefine
|
|
$max(nispher*njspher*nkspher, ! legacy, undefine
|
|
$nmcrt*max(nkcart*(kang+3)/3,iang+jang+kang+1)+ ! bra and ket VRR in dfvrr subroutine
|
|
$nc12*(nkprim+ ! uncontracted ERIs
|
|
$nkcontr*njprim+ ! k-contracted ERIs
|
|
$nkcontr*njcontr*niprim)) ! j,k-contracted ERIs
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
subroutine memerr(mreq,maxmem,msg)
|
|
************************************************************************
|
|
* print additional memory requirement if there is not enough memory available
|
|
************************************************************************
|
|
implicit none
|
|
integer mreq,maxmem
|
|
character*40 msg
|
|
|
|
write(*,*) "Error: ", trim(msg)
|
|
write(*,*)'Required memory:',int(mreq*8.d0/1024**2)+1,'MB'
|
|
write(*,*)'Available memory:',int(maxmem*8.d0/1024**2),'MB'
|
|
write(*,*)'Increase memory with:',
|
|
$ int((mreq-maxmem)*8.d0/1024**2)+1,'MB'
|
|
flush(6)
|
|
call mrccend(1)
|
|
end
|
|
************************************************************************
|
|
|
|
***********************************************************************
|
|
subroutine dprim_mem(it1,it2,it3,it4,itd4,it5,it6,it10,it12,it13,
|
|
$it14,it15,it16,dero,imem,iang,jang,kang,lang,nlprim,nlcontr,
|
|
$nkprim,nkcontr,njprim,njcontr,niprim,nicontr,l3der)
|
|
***********************************************************************
|
|
C Memory required by subroutine dprimcalc
|
|
***********************************************************************
|
|
implicit none
|
|
integer it1,it2,it3,it4,itd4,it5,it6,it10,it12,it13,it14,it15
|
|
integer it16
|
|
integer dero,imem,iang,jang,kang,lang
|
|
integer nlprim,nlcontr,nkprim,nkcontr,njprim,njcontr,niprim
|
|
integer nicontr
|
|
integer nnder,nder,ijkls,ccontr,nmax1,nmax2,nmax,nd
|
|
integer nicart,njcart,nkcart,nlcart
|
|
integer nispher,njspher,nkspher,nlspher
|
|
integer di,dj
|
|
logical l3der
|
|
|
|
nnder=(dero+1)*(dero+2)/2
|
|
nder=0
|
|
do di=0,dero
|
|
dj=dero-di
|
|
nder=max(
|
|
$ nder,(di+1)*(di+2)*(dj+1)*(dj+2)/4)
|
|
enddo
|
|
call cartspher(iang,jang,kang,lang,nicart,njcart,nkcart,nlcart,
|
|
$nispher,njspher,nkspher,nlspher)
|
|
ijkls=nispher*njspher*nkspher*nlspher
|
|
ccontr=nicontr*njcontr*nkcontr*nlcontr
|
|
nmax1=iang+jang
|
|
nmax2=kang+lang
|
|
nmax=nmax1+nmax2
|
|
if(l3der) then
|
|
nd=2
|
|
else
|
|
nd=1
|
|
endif
|
|
|
|
it6=imem
|
|
it5=imem
|
|
if(dero.eq.0) imem=imem+nd*nnder*ijkls*ccontr ! Final contracted integrals in spherical basis: only used when dero.eq.0
|
|
it1=imem
|
|
imem=imem+(nmax1+1+dero)**3*
|
|
$ (nmax2+1+dero)**3*
|
|
$ (nmax+1+dero)! 7 index array for vertical recurrence of < i+j 0 | k+l 0 > types
|
|
it16=imem
|
|
imem=imem+
|
|
$max((nmax1+1+dero)**3*(jang+1+dero)**3,! 6 index array for horziontal recurrence of < i j | k+l 0 > or < i j | k l > final integrals: holds only bra or ket side intermediates
|
|
$ (nmax2+1+dero)**3*(lang+1+dero)**3)
|
|
it15=imem
|
|
imem=imem+
|
|
$ (nmax2+1+dero)**3*njspher*nispher*nnder ! < i j | k+l 0 > type integrals, bra in spherical basis
|
|
it12=imem
|
|
imem=imem+
|
|
$max(njcart*nicart,nlcart*nkcart) ! Final integrals in cartesian basis
|
|
it13=imem
|
|
imem=imem+
|
|
$max(nder*njcart*nispher,nder*nlcart*nkspher) ! Final integrals in "mixed" basis
|
|
it14=imem
|
|
imem=imem+
|
|
$nnder*nlspher*nkspher ! Final integrals in spherical basis
|
|
it10=imem
|
|
imem=imem+nd*nnder*ijkls*nlprim ! Final primitive dERIs for all lprim
|
|
it2=imem
|
|
imem=imem+nd*nnder*ijkls*nlcontr*nkprim ! l-contracted dERIs
|
|
it3=imem
|
|
imem=imem+nd*nnder*ijkls*nlcontr*nkcontr*njprim ! l,k-contracted dERIs
|
|
it4=imem
|
|
imem=imem+
|
|
$ nd*nnder*ijkls*nlcontr*nkcontr*njcontr*niprim ! l,k,j-contractded dERIs
|
|
itd4=imem
|
|
if(dero.gt.0) imem=imem+nd*nnder*ijkls*ccontr ! Final dERIs: used if dero.gt.0
|
|
|
|
return
|
|
end
|
|
***********************************************************************
|
|
|
|
************************************************************************
|
|
integer function dfintder1cmem(iang,jang,kang,niprim,
|
|
$njcontr,njprim,nkcontr,nkprim,nc12)
|
|
************************************************************************
|
|
C Memory requirement of dfintder1c subroutine
|
|
************************************************************************
|
|
implicit none
|
|
integer iang,jang,kang
|
|
integer niprim,njcontr,njprim,nkcontr,nkprim
|
|
integer nispher,njspher,nkspher
|
|
integer nicart,njcart,nkcart
|
|
integer nc12,nc12A,nc12B,nc12C,d
|
|
|
|
call cartspher(iang+1,jang+1,kang+1,d,nicart,njcart,nkcart,d,
|
|
$nispher,njspher,nkspher,d)
|
|
nispher=nispher-2
|
|
njspher=njspher-2
|
|
nkspher=nkspher-2
|
|
nc12A=nicart*njspher*nkspher
|
|
nc12B=njcart*nispher*nkspher
|
|
nc12C=nkcart*nispher*njspher
|
|
|
|
nc12=max(nc12A,nc12B,nc12C)
|
|
|
|
dfintder1cmem= nc12*nkprim ! primitive dERIs
|
|
$ +nc12 ! buffer for k contraction
|
|
$ +nc12*nkcontr*njprim ! k contracted dERIs
|
|
$ +nc12*nkcontr ! buffer for j contraction
|
|
$ +nc12*nkcontr*njcontr*niprim ! j contracted dERIs
|
|
$ +nc12*nkcontr*njcontr ! buffer for i contraction
|
|
$ +nc12 ! rearrange dERIs
|
|
|
|
return
|
|
end function dfintder1cmem
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
integer function dfint3dermem(iang,jang,kang,niprim,
|
|
$njcontr,njprim,nkcontr,nkprim,nc12)
|
|
************************************************************************
|
|
C Memory requirement of dfintder1c subroutine
|
|
************************************************************************
|
|
implicit none
|
|
integer iang,jang,kang
|
|
integer niprim,njcontr,njprim,nkcontr,nkprim
|
|
integer nkspher,nicart,nmax1,nmcrtp1,nmcrtm1,nc12in,nc12out,nc12
|
|
|
|
nkspher=2*kang+1
|
|
nicart=(iang+1)*(iang+2)/2
|
|
nmax1=iang+jang
|
|
nmcrtp1=(nmax1+2)*(nmax1+3)*(nmax1+4)/6
|
|
nmcrtm1=nmax1*(nmax1+1)*(nmax1+2)/6
|
|
nc12in=2*3*(2*iang+1)*(2*jang+1)*nkspher
|
|
nc12out=nkspher*(
|
|
$nmcrtp1-nicart*(iang+3)/3+ ! intermediates for 2a*([i+1]j|k)
|
|
$nmcrtp1-iang*nicart/3+ ! intermediates for 2b*(i[j+1]|k)
|
|
$nmcrtm1-(iang-1)*iang*(iang+1)/6) ! intermediates for ([i-1]j|k) and (i[j-1]|k)
|
|
nc12=max(nc12in,nc12out)
|
|
|
|
dfint3dermem= nc12*nkprim ! primitive dERIs
|
|
$ +nc12 ! buffer for k contraction
|
|
$ +nc12*nkcontr*njprim ! k contracted dERIs
|
|
$ +nc12*nkcontr ! buffer for j contraction
|
|
$ +nc12*nkcontr*njcontr*niprim ! j contracted dERIs
|
|
$ +nc12*nkcontr*njcontr ! buffer for i contraction
|
|
|
|
return
|
|
end function dfint3dermem
|
|
************************************************************************
|
|
|
|
|
|
************************************************************************
|
|
subroutine df_primcalc_mem(it0,it1,it2,it3,it4,it5,it6,imem,lhrr,
|
|
$rys,iang,jang,kang,nicontr,njcontr,nkcontr,niprim,njprim,nkprim,
|
|
$cartg)
|
|
************************************************************************
|
|
implicit none
|
|
integer it0,it1,it2,it3,it4,it5,it6,imem,iang,jang,kang
|
|
integer nicontr,njcontr,nkcontr,niprim,njprim,nkprim
|
|
logical lhrr,rys,cartg
|
|
integer nicart,njcart,nkcart,nispher,njspher,nkspher,d
|
|
integer nmcrt,nmax1,ccontr,nc12
|
|
|
|
call cartspher(iang,jang,kang,d,nicart,njcart,nkcart,d,
|
|
$nispher,njspher,nkspher,d)
|
|
nmax1=iang+jang
|
|
nmcrt=(nmax1+1)*(nmax1+2)*(nmax1+3)/6
|
|
nc12=(nmcrt-iang*nicart/3)*nkcart
|
|
ccontr=nicontr*njcontr*nkcontr
|
|
if(cartg) then
|
|
nispher=nicart
|
|
njspher=njcart
|
|
nkspher=nkcart
|
|
endif
|
|
|
|
it5=imem
|
|
imem=imem+nc12*ccontr
|
|
if(lhrr) then
|
|
it6=imem
|
|
imem=imem+nispher*njspher*nkcart*ccontr
|
|
else
|
|
it6=it5
|
|
endif
|
|
it0=imem
|
|
imem=imem+nc12
|
|
it1=imem
|
|
if(rys) then
|
|
imem=imem+1
|
|
else
|
|
imem=imem+nmcrt*max(nkcart*(kang+3)/3,nmax1+kang+1)
|
|
endif
|
|
it2=imem
|
|
imem=imem+nc12*nkprim
|
|
it3=imem
|
|
imem=imem+nc12*nkcontr*njprim
|
|
it4=imem
|
|
imem=imem+nc12*nkcontr*njcontr*niprim
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine primdf2_mem(imem,iang,kang,niprim,nkprim,nicontr,
|
|
$nkcontr)
|
|
************************************************************************
|
|
C Memory required by subroutine primdf2int (assuming contracted DF basis)
|
|
***********************************************************************
|
|
implicit none
|
|
integer imem,iang,kang
|
|
integer niprim,nkprim,nicontr,nkcontr
|
|
integer nicart,nkcart,nispher,d
|
|
|
|
call cartspher(iang,d,kang,d,nicart,d,nkcart,d,nispher,d,d,d)
|
|
|
|
imem=imem+
|
|
$ nicart*nkcart*nicontr*nkcontr+ ! Final ERIs
|
|
$ nicart*nkcart*niprim*nkcontr+ ! k-contracted Cartesian ERIs
|
|
$ nicart*nkcart*nkprim+ ! primitive Cartesian ERIs
|
|
$ (iang+1)*(iang+2)*(iang+3)/6*
|
|
$ max(iang+kang+1,(kang+1)*(kang+2)*(kang+3)/6) ! dfvrr recursion array
|
|
|
|
if(iang.gt.1) imem=imem+nispher*nkcart*nicontr*nkcontr ! i,k-contracted i-solid.harm. ERIs
|
|
|
|
return
|
|
end
|
|
************************************************************************
|
|
|
|
***********************************************************************
|
|
subroutine cartspher(i,j,k,l,nic,njc,nkc,nlc,nis,njs,nks,nls)
|
|
***********************************************************************
|
|
C Cartesian and solid harmonic components
|
|
***********************************************************************
|
|
implicit none
|
|
integer i,j,k,l,nic,njc,nkc,nlc,nis,njs,nks,nls
|
|
|
|
nic=(i+1)*(i+2)/2
|
|
njc=(j+1)*(j+2)/2
|
|
nkc=(k+1)*(k+2)/2
|
|
nlc=(l+1)*(l+2)/2
|
|
nis=2*i+1
|
|
njs=2*j+1
|
|
nks=2*k+1
|
|
nls=2*l+1
|
|
|
|
return
|
|
end
|
|
***********************************************************************
|
|
|
|
************************************************************************
|
|
subroutine prim_mem(imem,it0,it1,it2,it3,it4,it5,it6,it7,niprim,
|
|
$njprim,nkprim,nlprim,nicontr,njcontr,nkcontr,nlcontr,
|
|
$iang,jang,kang,lang,rys,inc12,cartg)
|
|
************************************************************************
|
|
C Memory required by subroutine primcalc
|
|
************************************************************************
|
|
implicit none
|
|
integer imem,it0,it1,it2,it3,it4,it5,it6,it7,niprim,
|
|
$njprim,nkprim,nlprim,nicontr,njcontr,nkcontr,nlcontr,
|
|
$iang,jang,kang,lang,inc12
|
|
logical rys,cartg
|
|
integer nicart,njcart,nkcart,nlcart
|
|
integer nispher,njspher,nkspher,nlspher
|
|
integer ccontr,nmax1,nmax2,n1crt,n2crt,nc12
|
|
|
|
call cartspher(iang,jang,kang,lang,nicart,njcart,nkcart,nlcart,
|
|
$nispher,njspher,nkspher,nlspher)
|
|
nmax1=iang+jang
|
|
nmax2=kang+lang
|
|
n1crt=(nmax1+1)*(nmax1+2)*(nmax1+3)/6-iang*nicart/3
|
|
n2crt=(nmax2+1)*(nmax2+2)*(nmax2+3)/6-kang*nkcart/3
|
|
nc12=n1crt*n2crt
|
|
ccontr=nicontr*njcontr*nkcontr*nlcontr
|
|
if(cartg) then
|
|
nispher=nicart
|
|
njspher=njcart
|
|
nkspher=nkcart
|
|
nlspher=nlcart
|
|
endif
|
|
|
|
it5=imem
|
|
imem=imem+nc12*ccontr
|
|
it6=imem
|
|
imem=imem+nispher*njspher*n2crt*ccontr
|
|
it0=imem
|
|
imem=imem+nc12*nlprim
|
|
it7=imem
|
|
imem=imem+max(n1crt*nispher*njspher,
|
|
$ n2crt*nkspher*nlspher)
|
|
it1=imem
|
|
if(rys)then
|
|
imem=imem+1
|
|
else
|
|
imem=imem+(nmax1+nmax2+1)**4*(nmax2+1)**3
|
|
endif
|
|
it2=imem
|
|
imem=imem+nc12*nlcontr*nkprim
|
|
it3=imem
|
|
imem=imem+nc12*nlcontr*nkcontr*njprim
|
|
it4=imem
|
|
imem=imem+nc12*nlcontr*nkcontr*njcontr*niprim
|
|
inc12=it0-nc12
|
|
|
|
return
|
|
end
|