1C> \ingroup selci 2C> @{ 3 subroutine selci_inicij(w1,w2) 4* 5* $Id$ 6* 7#include "implicit.fh" 8#include "errquit.fh" 9#include "ciinfo.fh" 10#include "ceij.fh" 11c 12 dimension w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1) 13 data big /0.17976931348623132d+309/ 14c 15c make the coupling coefficient arrays <*|eij|*> for 16c up to 8 unpaired electrons (hard dimensions in ceij) 17c 18c make sure of unambiguous disaster if unitialized 19c elements are accessed 20c 21 call dfill(nfc*nfc*nsc*(nsc+1),big,case1,1) 22 call dfill(nfc*nfc2*nsc*nsc,big,case1,1) 23 call dfill(nfc*nfc*nsc*(nsc+1),big,case4,1) 24c 25 do 5 ns = nsmax,0,-2 26 if (ns.le.8) then 27 nseij = ns 28 ns4eij = min(ns,nsmax-2) 29 goto 6 30 endif 31 5 continue 32 write(6,*) ' nsmax, nseij, ns4eij ',nsmax, nseij, ns4eij 33 call errquit('inicij: failed to initialize nseij etc. ',nseij, 34 & CALC_ERR) 35 6 continue 36 numf = nf(nseij) 37 numf2 = nf(nseij-2) 38 ns = nseij 39 nsdiff = nsmax - ns 40c 41c case 1: iocc(i)=1, iocc(j)=0 42c 43 do 10 iib = 1,ns 44 do 20 jjb = 1,ns+1 45 jb = jjb + nsdiff 46 if (jjb.gt.iib) jb = jb - 1 47 ib = iib + nsdiff 48 call selci_axbt(w1(1,1,ib),nfmax, w1(1,1,jb),nfmax, 49 $ case1(1,1,iib,jjb),nfc, numf, numf, numf) 50 20 continue 51 10 continue 52c 53c case 2: iocc(i) = 1, iocc(j) = 1 54c 55c case 3: iocc(i) = 3, iocc(j) = 0 is the same as swapping the 56c indices ib and jb and then transposing the matrix 57c 58 do 30 iib = 1,ns 59 do 40 jjb = 1,ns 60 if (iib.eq.jjb) goto 40 61 jb = jjb + nsdiff 62 if (jjb.gt.iib) jb = jb - 1 63 ib = iib + nsdiff 64 call selci_axbt(w1(1,1,ib),nfmax, w2(1,1,jb),nfmax2, 65 $ case2(1,1,iib,jjb),nfc, numf, numf, numf2) 66 40 continue 67 30 continue 68c 69c case 4: iocc(i) = 3, iocc(j) = 1 70c 71 ns = ns4eij 72 numf = nf(ns4eij) 73 numf2 = nf(ns+2) 74 nsdiff = nsmax - (ns+2) 75c 76 do 50 iib = 1,ns+1 77 do 60 jjb = 1,ns 78 jb = jjb + nsdiff 79 if (jjb.ge.iib) jb = jb + 1 80 ib = iib + nsdiff 81 call selci_axbt(w2(1,1,ib),nfmax2, w2(1,1,jb),nfmax2, 82 $ case4(1,1,iib,jjb),nfc, numf, numf2, numf) 83 60 continue 84 50 continue 85c 86 end 87C> @} 88