From 5f9c8af5ec924ca4ed843cdb334174c0ec18403e Mon Sep 17 00:00:00 2001 From: Huub Van Dam Date: Thu, 7 Nov 2013 21:23:59 +0000 Subject: [PATCH] HvD: Added some more documentation. --- src/selci/bserch.F | 74 ++++++++++++++++++++++++++++++++++++++-- src/selci/cconf.fh | 4 +++ src/selci/conf.F | 35 +++++++++++++++++-- src/selci/e0mp2.F | 5 +++ src/selci/eij.F | 5 +++ src/selci/eijeji.F | 5 +++ src/selci/eijil.F | 5 +++ src/selci/eijkj.F | 5 +++ src/selci/eijkl.F | 5 +++ src/selci/eirerj.F | 5 +++ src/selci/makef.F | 6 +++- src/selci/makeh.F | 5 +++ src/selci/makehd.F | 5 +++ src/selci/makehs.F | 5 +++ src/selci/makhdb.F | 5 +++ src/selci/pkcon.F | 31 ++++++++++++++++- src/selci/selci.F | 6 ++-- src/selci/selci_check.f | 7 ++-- src/selci/selci_hpp.F | 5 +++ src/selci/selci_icopy.f | 5 +++ src/selci/selci_output.f | 5 +++ src/selci/selci_renorm.f | 5 +++ src/selci/selci_select.F | 5 +++ src/selci/selci_sread.f | 5 +++ src/selci/selci_swrite.f | 5 +++ src/selci/selci_yacobi.f | 5 +++ 26 files changed, 245 insertions(+), 13 deletions(-) diff --git a/src/selci/bserch.F b/src/selci/bserch.F index 05d85ff08a..7f03b37b7e 100644 --- a/src/selci/bserch.F +++ b/src/selci/bserch.F @@ -1,9 +1,30 @@ +C> \ingroup selci +C> @{ +C> +C> \brief Insert a new configuration into the list +C> +C> The routine works on a list of items where each item +C> `nintpo` integers long. This routine inserts a new item +C> at the position given by `ipos`. To make space for the new +C> item all subsequent items are shuffled to the right, +C> then the new item is inserted at the specifiedd position. +C> +C> Next the number of elements on the list `n` is increased +C> before the routine returns. +C> subroutine selci_insert(n,item,list,nintpo,ipos) + implicit none +c #include "errquit.fh" +c + integer n !< [In/Output] The number of items on the list + integer nintpo !< [Input] The number of integers in an item + integer ipos !< [Input] The position for the new item + integer list(*) !< [In/Output] The list of items + integer item(*) !< [Input] The new item * * $Id$ * - integer list(*),item(*) c c insert item into the list before position ipos c each item is nintpo integers long @@ -13,6 +34,10 @@ c c first shuffle the array to the right ... this can c be vectorized on some machines but NOT run concurrently c without modification +c +c Local +c + integer i, ilast, ifirst c ilast = n*nintpo ifirst = (ipos-1)*nintpo @@ -31,14 +56,40 @@ c n = n + 1 c end +C> +C> \brief Find the location for a configuration in the configuration table +C> +C> Perform a binary search through an ordered list of items (each item +C> is `nintpo` integers long). The result is returned in `ipos`. +C> if `ipos` is positive then it represents the element in the list the +C> new item should precede, if `ipos` is negative it is already present +C> in the list. +C> subroutine selci_bserch(n,item,list,nintpo,ipos) - integer list(nintpo,*),item(*) + implicit none +c +#include "errquit.fh" +c + integer n !< [Input] The length of the list + integer nintpo !< [Input] The number of integers per item + integer list(nintpo,*) !< [Input] The list of items + integer item(*) !< [Input] The new item + integer ipos !< [Output] The position + !< - if ipos > 0: the new item should precede + !< list(1:nintpo,ipos) + !< - if ipos < 0: then item(1:nintpo) equals + !< list(1:nintpo,-ipos) integer selci_icmp c c binary search thru ordered list of items (each nintpo integers). c return in ipos: c if +ve item should precede item at position ipos c if -ve item is already present at position |ipos| +c +c Local +c + integer middle, left, iright + integer ifist, ilast, i c if (n.lt.0) call errquit('bserch: n.lt.0 ',n, UNKNOWN_ERR) c @@ -83,12 +134,27 @@ c item>list(iright) return c end +C> +C> \brief Compare two configurations +C> +C> Compares two configurations stored in compressed form. +C> +C> \return Returns +C> - -1 if item1 < item2 +C> - 0 if item1 = item2 +C> - 1 if item1 > item2 +C> integer function selci_icmp(item1,item2,n) - dimension item1(*),item2(*) + implicit none + integer n !< [Input] The length of the items in number of integers + integer item1(n) !< [Input] Item1 + integer item2(n) !< [Input] Item2 c c item1 and item2 are packed orbital occupations c c icmp = -1 item1item2 +c + integer i !< Counter c do 10 i = 1,n if (item1(i).gt.item2(i)) then @@ -102,3 +168,5 @@ c selci_icmp = 0 c end +C> +C> @} diff --git a/src/selci/cconf.fh b/src/selci/cconf.fh index 463ff651fa..9d08667eb0 100644 --- a/src/selci/cconf.fh +++ b/src/selci/cconf.fh @@ -39,7 +39,11 @@ c indxci = csf index into ci vector from orbital conf c * parameter (nrefmx = 10000) ... now dynamically determined + integer ngenmx parameter (ngenmx=10) + integer nrefmx,nelec,multi,norbs,nref,ngen,nsym,issss,nnsmax + integer nintpo,nbitpi,nelpi,nci,iexcit,inttyp,nbpsy,isym + integer iocc,igen,nigen,nf,nsneed common/selci_cconf/ $ nrefmx, $ nelec,multi,norbs,nref,ngen,nsym,issss,nnsmax, diff --git a/src/selci/conf.F b/src/selci/conf.F index 2fe9f33886..313f268814 100644 --- a/src/selci/conf.F +++ b/src/selci/conf.F @@ -1,17 +1,38 @@ +C> \ingroup selci +C> @{ +C> +C> \brief The configuration generator +C> +C> A crude version of a configuration generator. +C> subroutine selci_conf(rtdb, q, lword) + implicit none * * $Id$ * -#include "implicit.fh" +*include "implicit.fh" #include "cconf.fh" #include "mptr.fh" #include "cselcifiles.fh" #include "rtdb.fh" #include "global.fh" - integer rtdb - dimension q(lword) +c + integer rtdb !< [Input] The RTDB handle + integer lword !< [Input] The length of the main memory array + double precision q(lword) !< [Scratch] Work space +c + integer mdtoi, mitod + external mdtoi, mitod external data_selci_conf ! For T3D to link block data c +c Local +c + integer junk + integer indxci, irefo, jrefo +c + double precision startc, startw + double precision endc, endw +c c Crude version of a configuration generation program c Needs much doing to it to be very useful c @@ -68,6 +89,9 @@ c endif c end +C> +C> \brief Construct the configuration table +C> subroutine selci_start(rtdb,title, irefo) #include "implicit.fh" #include "errquit.fh" @@ -257,6 +281,9 @@ c call selci_pkcon(norbs, iocc, irefo, nintpo, nbitpi) nref = 1 endif +cDEBUG + write(*,*)'*** selci: no. conf = ',nref +cDEBUG c c Determine state symmetry from the first conf c @@ -647,3 +674,5 @@ c $ inttyp/-1/ c end +C> +C> @} diff --git a/src/selci/e0mp2.F b/src/selci/e0mp2.F index d03dc8db3b..e873b7c739 100644 --- a/src/selci/e0mp2.F +++ b/src/selci/e0mp2.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_brdeig * * $Id$ @@ -106,3 +109,5 @@ c call selci_output(erefmp, 1, nroot, 1, 1, nroot, 1, 1) c end +C> +C> @} diff --git a/src/selci/eij.F b/src/selci/eij.F index b08c5caf15..fa03ec8d0f 100644 --- a/src/selci/eij.F +++ b/src/selci/eij.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eij(e,i,j,ns,indbar,iocc,w1,w2) * * $Id$ @@ -160,3 +163,5 @@ c $ numf,numf2,numf) return c end +C> +C> @} diff --git a/src/selci/eijeji.F b/src/selci/eijeji.F index 3b805b18e1..408308e865 100644 --- a/src/selci/eijeji.F +++ b/src/selci/eijeji.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eijeji(e,odonly,i,j,ns,indbar,iocc,w1,w2,work) * * $Id$ @@ -59,3 +62,5 @@ c endif c end +C> +C> @} diff --git a/src/selci/eijil.F b/src/selci/eijil.F index 5df0d4c57a..2a865a1b33 100644 --- a/src/selci/eijil.F +++ b/src/selci/eijil.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eijil(e,i,j,l,ns,indbar,iocc, $ w1,w2,work,numf,numf2) * @@ -93,3 +96,5 @@ c numf2 = numf2m c end +C> +C> @} diff --git a/src/selci/eijkj.F b/src/selci/eijkj.F index 6f2740cfac..1be7d229fa 100644 --- a/src/selci/eijkj.F +++ b/src/selci/eijkj.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eijkj(e,i,k,j,ns,indbar,iocc, $ w1,w2,work,numf,numf2) * @@ -104,3 +107,5 @@ c return c end +C> +C> @} diff --git a/src/selci/eijkl.F b/src/selci/eijkl.F index d8fde977ef..30d651f35b 100644 --- a/src/selci/eijkl.F +++ b/src/selci/eijkl.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eijkl(e,i,j,k,l,ns,indbar,iocc,w1,w2, $ work,numf,numf2) * @@ -82,3 +85,5 @@ c call selci_axb(work,numf,temp,numfin,e,numf,numf,numfin,numf2) c end +C> +C> @} diff --git a/src/selci/eirerj.F b/src/selci/eirerj.F index 35e362b79e..887a3a5845 100644 --- a/src/selci/eirerj.F +++ b/src/selci/eirerj.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_eirerj(e,i,ir,j,ns,indbar,iocc,w1,w2,work) * * $Id$ @@ -136,3 +139,5 @@ c same as 30 except for last mxma return c end +C> +C> @} diff --git a/src/selci/makef.F b/src/selci/makef.F index 79f12b94d8..e542082969 100644 --- a/src/selci/makef.F +++ b/src/selci/makef.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_makef(f,h,g,int12,int34,iocc,listd,lists,ns,nd, $ odonly) * @@ -76,4 +79,5 @@ c 10 continue c end - +C> +C> @} diff --git a/src/selci/makeh.F b/src/selci/makeh.F index bb93a73c7a..1a1444a415 100644 --- a/src/selci/makeh.F +++ b/src/selci/makeh.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_makeh(h,g,int12,int34,w1,w2,ioconf,indxci,hd, $ work1, work2, work3, f) * @@ -127,3 +130,5 @@ c if running in parallel need to get all the diags together close(iflham, status='keep') c end +C> +C> @} diff --git a/src/selci/makehd.F b/src/selci/makehd.F index cd895efaa2..77536709b7 100644 --- a/src/selci/makehd.F +++ b/src/selci/makehd.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_makehd(hii,odonly, $ ns,nd,indbar,iocc,lists,listd,w1,w2, $ work1,work2,f,h,g,int12,int34,numf) @@ -79,3 +82,5 @@ c endif c end +C> +C> @} diff --git a/src/selci/makehs.F b/src/selci/makehs.F index c37c7f8515..d9d4f2f714 100644 --- a/src/selci/makehs.F +++ b/src/selci/makehs.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_makehs(hij,i,j,ns,indbar,iocc,lists, $ w1,w2,work1,work2,f,g,int12,int34,numf,numf2) * @@ -46,3 +49,5 @@ c endif c end +C> +C> @} diff --git a/src/selci/makhdb.F b/src/selci/makhdb.F index 0e9a475f2a..47f6a5e669 100644 --- a/src/selci/makhdb.F +++ b/src/selci/makhdb.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_makhdb(hij,ind,icase,ns,indbar,iocc, $ w1,w2,work1,work2,g,int12,int34,numf,numf2) * @@ -79,3 +82,5 @@ c call daxpy(numf*numf2,gg,work2,1,hij,1) c end +C> +C> @} diff --git a/src/selci/pkcon.F b/src/selci/pkcon.F index c4b96f5dbc..19911e9181 100644 --- a/src/selci/pkcon.F +++ b/src/selci/pkcon.F @@ -1,9 +1,32 @@ +C> \ingroup selci +C> @{ +C> +C> \brief Pack electron configurations +C> +C> Initially a configuration is stored in a long array of integers +C> where each integer corresponds to an orbital. The occupation of +C> the orbital is specified by the value of the corresponding integer: +C> - 0 (uocc) - is un-occupied +C> - 1 (socc) - is singly occupied +C> - 3 (docc) - is doubly occupied +C> As a result we need two bits per orbital to store a configuration. +C> This routine eliminates the superflous bits and compresses the +C> relevant data into a much more compact data structure `mocc`. +C> subroutine selci_pkcon(norbs, iocc, mocc, nintpo, nbitpi) + implicit none #include "errquit.fh" * * $Id$ * - dimension iocc(norbs), mocc(nintpo) + integer norbs !< [Input] The number of orbitals + integer nintpo !< [Input] The number of integers per + !< output configuration + integer nbitpi !< [Input] The number of bits per integer + integer iocc(norbs) !< [Input] The decompressed electron + !< configuration + integer mocc(nintpo) !< [Output] The compressed electron + !< configuration #include "bitops.fh" c c scalar version @@ -14,6 +37,10 @@ c mocc(1:nintpo)= packed representation of iocc, 2 bits per element c nintpo = no. of integers needed to pack the occupancy c nbitpi = no. of bits in an integer c +c Local +c + integer i, ilo, ihi, itemp, iword, move, nelpi +c c no. of elements per integer c nelpi = nbitpi / 2 @@ -38,3 +65,5 @@ c write(6,1) mocc c 1 format(1x,5(z10,2x)) c end +C> +C> @} diff --git a/src/selci/selci.F b/src/selci/selci.F index fbc4bce3e3..193bcd94ce 100644 --- a/src/selci/selci.F +++ b/src/selci/selci.F @@ -1,8 +1,8 @@ -C> \defgroup selci Selected Configuration Interaction -C> C> \file selci.F C> The main driver for the selected CI module C> +C> \defgroup selci Selected Configuration Interaction +C> C> \brief The Selected Configuration Interaction Module C> C> The selected CI code dates back to Robert Harrison then based at @@ -10,7 +10,7 @@ C> Argonne [1]. C> C> [1] R.J. Harrison, "Approximating full configuration interaction C> with selected configuration interaction and perturbation theory", -C> J. Chem. Phys. 94 (1991), 5021, +C> J. Chem. Phys. 94 (1991), 5021-5031, C> C> 10.1063/1.460537. diff --git a/src/selci/selci_check.f b/src/selci/selci_check.f index 61111589fc..49f4545a63 100644 --- a/src/selci/selci_check.f +++ b/src/selci/selci_check.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_check(node) * * $Id$ @@ -14,5 +17,5 @@ endif enddo end - - +C> +C> @} diff --git a/src/selci/selci_hpp.F b/src/selci/selci_hpp.F index ed9b98f99d..bae4fc40b1 100644 --- a/src/selci/selci_hpp.F +++ b/src/selci/selci_hpp.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_hpp(rtdb, hpp,nbig,npvec,energy) c c modified from sigma.F @@ -108,4 +111,6 @@ c call ga_dgop (99, si(1, iroot), nci, '+') c 1010 continue c end +C> +C> @} c $Id$ diff --git a/src/selci/selci_icopy.f b/src/selci/selci_icopy.f index a0d85d2fa9..dda9357b5e 100644 --- a/src/selci/selci_icopy.f +++ b/src/selci/selci_icopy.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_icopy(n,x,ix,y,iy) implicit integer (a-z) * @@ -15,3 +18,5 @@ c c return end +C> +C> @} diff --git a/src/selci/selci_output.f b/src/selci/selci_output.f index a73b60fd2a..7e2f7a587a 100644 --- a/src/selci/selci_output.f +++ b/src/selci/selci_output.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_output(z,rowlow,rowhi,collow,colhi,rowdim,coldim, $ nctl) * @@ -61,3 +64,5 @@ c....................................................................... 1000 format (/1h ,16x,3(a6,i4,7x),(a6,i4)) 2000 format (a1,3hrow,i4,2x,4f17.11) end +C> +C> @} diff --git a/src/selci/selci_renorm.f b/src/selci/selci_renorm.f index 82f90b6014..ee3237c078 100644 --- a/src/selci/selci_renorm.f +++ b/src/selci/selci_renorm.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_renorm(n,a,ia,anorm) * * $Id$ @@ -18,3 +21,5 @@ c endif c end +C> +C> @} diff --git a/src/selci/selci_select.F b/src/selci/selci_select.F index dcbe8b7222..dcb3967d47 100644 --- a/src/selci/selci_select.F +++ b/src/selci/selci_select.F @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_select(q, lword, nroot_arg, iwpt_arg, $ thresh_arg, oupdate, energies) * @@ -248,3 +251,5 @@ c call ga_sync() c end +C> +C> @} diff --git a/src/selci/selci_sread.f b/src/selci/selci_sread.f index d390e87fc8..d4242b27f5 100644 --- a/src/selci/selci_sread.f +++ b/src/selci/selci_sread.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_sread(itape,a,n) * * $Id$ @@ -22,3 +25,5 @@ c read(itape) a c end +C> +C> @} diff --git a/src/selci/selci_swrite.f b/src/selci/selci_swrite.f index f59770f5dc..d249d89d61 100644 --- a/src/selci/selci_swrite.f +++ b/src/selci/selci_swrite.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_swrite(itape,a,n) * * $Id$ @@ -22,3 +25,5 @@ c write(itape) a c end +C> +C> @} diff --git a/src/selci/selci_yacobi.f b/src/selci/selci_yacobi.f index 673628f1f8..360a111608 100644 --- a/src/selci/selci_yacobi.f +++ b/src/selci/selci_yacobi.f @@ -1,3 +1,6 @@ +C> \ingroup selci +C> @{ +C> subroutine selci_yacobi(a,u,n,big,jb) implicit real*8(a-h,o-z) * @@ -152,3 +155,5 @@ c 10 continue return end +C> +C> @}