      SUBROUTINE stover(i,j,a)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(ngru3=2048)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |               |               |               | |
c
      common/dim/iadri ; integer(8) iadri
      common/ver3/ itab(ngru3),jtab(ngru3),d(ngru3)
      real*4 d
      COMMON/VER2/nelem
      common /det/ndet,mdet(50),nbdet_cas
      common/test/itest(100)
      common/pr/nprint,mprint(10)
      common/g2/lg2,ig2,lg2p,ig2p,lg2m,ig2m,ng2,yg2,yga2
      yw=.false.
      yw1=.false.
      if(yga2) return
      if(itest(5).eq.1) then
         if(itest(6).eq.0) return
      endif
c      if(imat.eq.0) return
      nelem=nelem+1
      if(nelem.gt.ngru3) then
         nelem=1
         if(itest(83).eq.0) write(1)itab,jtab,d
      endif
      if(yw)write(6,*)'-----'
      if(yw)write(6,*)'stover nelem,i,j'
     *,nelem,i,j
      if(yw1.or.mprint(3).eq.1) then
         if(itest(84).eq.0.or.(itest(84).eq.i.and.itest(85).eq.j).or.
     *   (itest(84).eq.i.and.itest(85).eq.j))
     *   write(6,'('' adresses numeros signes'',4i5,f10.6,i10)')
     *   i,j,i,j,a,nelem
      endif
c      if(i.eq.827.and.j.eq.1271)stop
      itab(nelem)=i
      jtab(nelem)=j
      d(nelem)=a
      if(yw)print*,'stover i,j,d',i,j,a,nelem
      if(i.le.0.or.j.le.0.or.i.gt.ndet.or.j.gt.ndet) then
         write(6,*)'stover erreur i,j,ndet',i,j,ndet
         stop
      endif
      return
      end
       subroutine finver2(iadrv,ysgn)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(ngru3=2048)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    | iadrv | |
c             ysgn
      common/dim/iadri ; integer(8) iadri
      common/test/itest(100)
      common/ver3/ itab(ngru3),jtab(ngru3),d(ngru3)
      dimension iadrv(iadri),ysgn(iadri)
      real*4 d
c     COMMON/VER/IADRV(IADRI)
      COMMON/VER2/nelem
      common /det/ndet,mdet(50),nbdet_cas
      yw=.false.
      yw1=.false.
      write(6,*)'debut finver2'
      nelem=nelem+1
      write(6,*)'finver nelem',nelem
      if(nelem.gt.ngru3) then
         nelem=1
         if(itest(83).eq.0) write(1)itab,jtab,d
      endif
      itab(ngru3)=-1
      jtab(ngru3)=nelem-1
      if(itest(83).eq.0) write(1)itab,jtab,d
      rewind 1
      rewind 87
      rewind 85
      call liry(ysgn,ndet,85)
      call lirbl(iadrv,ndet,87)
c       do k=1,ndet
c       print*,'finver2',k,iadrv(k)
c       enddo
      if(itest(83).ne.0) return
 1    read(1) itab,jtab,d
      nm=ngru3
      if(itab(ngru3).eq.-1) nm=jtab(ngru3)
      do k=1,nm
         if(itest(73).eq.0.and.(ysgn(itab(k)).and..not.ysgn(jtab(k)).or.
     *   ysgn(jtab(k)).and..not.ysgn(itab(k)))) d(k)=-d(k)
         itab(k)=iadrv(itab(k))
         jtab(k)=iadrv(jtab(k))
      enddo
      write(83)itab,jtab,d
c       do k=1,2048
c       print*,k,itab(k),jtab(k),d(k)
c       enddo
      if(itab(ngru3).eq.-1) then
         close(1,status='DELETE')
         return
      endif
      goto 1
      end
       subroutine stoga2(iad1,iad2,a,ab)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/dim/iadri ; integer(8) iadri
      dimension ab(iadri)
      common/pr/nprint,mprint(10)
      yw=nprint.ge.3
      isgn=1
      if(iad1.lt.0) then
         iad1=-iad1
         isgn=-1
      endif
      a=a+ab(iad1)*ab(iad2)*isgn
      if(yw) print'(a12,2i5,4f12.8,i2)'
     *,'iad1,iad2,a',iad1,iad2,a,ab(iad1),ab(iad2),
     *ab(iad1)*ab(iad2)*isgn,isgn
      return
      end
 
