1C> \ingroup selci 2C> @{ 3C> 4 subroutine selci_eijeji(e,odonly,i,j,ns,indbar,iocc,w1,w2,work) 5* 6* $Id$ 7* 8#include "implicit.fh" 9#include "errquit.fh" 10#include "ciinfo.fh" 11 dimension e(*),indbar(*),iocc(*),work(*), 12 $ w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1) 13 logical odonly 14c 15 parameter (maxtmp = 2001) 16 dimension tmp(maxtmp) 17c 18c e(u,v) = <Iu|EijEji|Iv>, where u,v label the spin functions 19c and the orbital occupation of I is specified by ns, iocc 20c and indbar. Only for i.ne.j., and both i and j singly 21c occupied. 22c 23c if (odonly) only form the actual diagonal ... THE REST IS JUNK 24c (this to optimize select) 25c 26c e(u,v) = sum(q) <Iu|Eij|Sq><Sq|Eji|Iv> 27c 28c work must be at least nf(ns)*nf(ns-2) 29c e is at least nf(ns)*nf(ns) 30c 31 if (iocc(i).ne.1 .or. iocc(j).ne.1) 32 $ call errquit('eijeji: wrong occupancy',iocc(i)*10+iocc(j), 33 & INPUT_ERR) 34c 35 call selci_eij(work,i,j,ns,indbar,iocc,w1,w2) 36c 37 numf = nf(ns) 38 numf2 = nf(ns-2) 39c 40 if (odonly) then 41 if (numf .gt. maxtmp) call errquit 42 $ ('eijeji: hard dim failed',maxtmp, CALC_ERR) 43 do k = 1, numf 44 tmp(k) = 0.0d0 45 enddo 46 mm = 0 47 do m = 1, numf2 48 do k = 1, numf 49 wkm = work(k+mm) 50 tmp(k) = tmp(k) + wkm*wkm 51 enddo 52 mm = mm + numf 53 enddo 54 kk = 1 55 numfp1 = numf + 1 56 do k = 1, numf 57 e(kk) = tmp(k) 58 kk = kk + numfp1 59 enddo 60 else 61 call selci_axbt(work,numf,work,numf,e,numf,numf,numf2,numf) 62 endif 63c 64 end 65C> 66C> @} 67