anchor.diff:        dimension aax(nbls1),bbx(nbls1),ccx(nbls1),expo(nbls1,6)
   C
         dimension buf2(10,nbls,lt1,lt2)
  +c
   c               buf2(1,nbls,lt1,lt2) - ordinary contraction
   c               buf2(2,nbls,lt1,lt2) - rescaled with 2*a_exp
   c               buf2(3,nbls,lt1,lt2) - rescaled with 2*b_exp
  
positive.code:           expo(4)=aax(1)*aax(1)
            expo(5)=bbx(1)*bbx(1)
            expo(6)=ccx(1)*ccx(1)
  c
          ijs=nfu(nqij)+1
          lnijx=nfu(nsij)
          lnklx=nfu(nskl)
          IF (FIRSTC) THEN
             DO 551 KL=nfu(nqkl)+1,nfu(nskl)
             DO 551 ij=ijs,nfu(nsij)
             do 551 i=1,nbls1
             ijkl=indx(i)
  c
  c
             buf2(1,ijkl,IJ,KL)=  XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(5)
             buf2(10,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(6)
  c
    551      CONTINUE
             DO 552 KL=nfu(nqkl)+1,nfu(nskl)
             DO 552 ij=nfu(nsij)+1,nfu(nsij+1)
             do 552 i=1,nbls1
             ijkl=indx(i)
             buf2(1,ijkl,IJ,KL)=  XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(5)
             buf2(10,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(6)
  c
    552      CONTINUE
             DO 553 KL=nfu(nskl)+1,nfu(nskl+1)
             DO 553 ij=nfu(nqij)+1,nfu(nsij)
             do 553 i=1,nbls1
             ijkl=indx(i)
             buf2(1,ijkl,IJ,KL)=  XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =XT1(i,IJ,KL)*expo(5)
             buf2(10,ijkl,IJ,KL)=XT1(i,IJ,KL)*expo(6)
  c
    553      CONTINUE
             FIRSTC=.FALSE.
          ELSE
             DO 651 KL=nfu(nqkl)+1,lnklx
             DO 651 ij=ijs,lnijx
             do 651 i=1,nbls1
             ijkl=indx(i)
             buf2(1,ijkl,IJ,KL)=buf2(1,ijkl,ij,kl)  +XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=buf2(2,ijkl,ij,kl)+XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=buf2(3,ijkl,ij,kl)+XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=buf2(4,ijkl,ij,kl)+XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=buf2(5,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=buf2(6,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=buf2(7,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =buf2(8,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =buf2(9,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(5)
            buf2(10,ijkl,IJ,KL)=buf2(10,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(6)
  c
    651      CONTINUE
             DO 652 KL=nfu(nqkl)+1,lnklx
             DO 652 ij=nfu(nsij)+1,nfu(nsij+1)
             do 652 i=1,nbls1
             ijkl=indx(i)
             buf2(1,ijkl,IJ,KL)=buf2(1,ijkl,ij,kl)  +XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=buf2(2,ijkl,ij,kl)+XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=buf2(3,ijkl,ij,kl)+XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=buf2(4,ijkl,ij,kl)+XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=buf2(5,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=buf2(6,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=buf2(7,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =buf2(8,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =buf2(9,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(5)
            buf2(10,ijkl,IJ,KL)=buf2(10,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(6)
  c
    652      CONTINUE
             DO 653 KL=nfu(nskl)+1,nfu(nskl+1)
             DO 653 ij=nfu(nqij)+1,nfu(nsij)
             do 653 i=1,nbls1
             ijkl=indx(i)
             buf2(1,ijkl,IJ,KL)=buf2(1,ijkl,ij,kl)  +XT1(i,IJ,KL)
             buf2(2,ijkl,IJ,KL)=buf2(2,ijkl,ij,kl)+XT1(i,IJ,KL)*aax(1)
             buf2(3,ijkl,IJ,KL)=buf2(3,ijkl,ij,kl)+XT1(i,IJ,KL)*bbx(1)
             buf2(4,ijkl,IJ,KL)=buf2(4,ijkl,ij,kl)+XT1(i,IJ,KL)*ccx(1)
  c
             buf2(5,ijkl,IJ,KL)=buf2(5,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(1)
             buf2(6,ijkl,IJ,KL)=buf2(6,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(2)
             buf2(7,ijkl,IJ,KL)=buf2(7,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(3)
  c
             buf2(8,ijkl,IJ,KL) =buf2(8,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(4)
             buf2(9,ijkl,IJ,KL) =buf2(9,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(5)
            buf2(10,ijkl,IJ,KL)=buf2(10,ijkl,ij,kl)+XT1(i,IJ,KL)*expo(6)
  c
    653      CONTINUE
          ENDIF
  ctest-test-test
  c
  c       write(6,*)' From assemb NBLS=',nbls,' NBLS1=',nbls1
  c       do 9876 kl=nfu(nqkl)+1,nfu(nskl+1)
  c       do 9876 kl= 1, 1
  c       do 9876 ij=nfu(nqij)+1,nfu(nsij+1)
  c       do 9876 i=1,nbls1
  c          ijkl=indx(i)
  c          ai=aax(i)
  c          bi=bbx(i)
  c          ci=ccx(i)
  c          do m=1,10
  c          do m=1,1
  c          bf2m=buf2(m,ijkl,IJ,KL)
  c          if(abs(bf2m).gt.0) then
  c          write(6,66) ij,kl, ijkl,m, buf2(m,ijkl,IJ,KL)
  c          endif
  c          enddo
  c  66 format('ij,kl=',2(i2,1x),' ijkl=',i3,' m=',i2,2x,f12.7)
  c9876 continue
  c
  c23456789.123456789.123456789.123456789.123456789.123456789.123456789.12
  c
        end
  c=======================================================================
  
negative.code: * $Id: assemblx.f,v 1.11 2002-09-23 17:56:43 windus Exp $
  c----------------------------------------------------------------
  c All routines of the type name_2 are used when 
  c          IROUTE=2
  