      subroutine c_hii(ne,nt,np,it4,ip4,nocz,nvz,hii,
     *sttvpp,stvpp,sttvp,stvp,sttv,stv,sttppv,
     *sttpv,stppv,stpv,sppv,spv,stvtvpp,stvtvp,stvtv,sttpvpv,stpvpv,
     *spvpv,sttvppv,sttvpv,stvppv,stvpv,stvtvppv,stvtvpv,sttvpvpv,
     *stvpvpv,stvtvpvpv)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      parameter (nexci=2,ngru3=2048)
      parameter(maxsym=8)
      include 'maxorb.prm'
      parameter(maxorbcas=16)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/csc2/ nicdi,nv2,norbs,nocas,nvs,ii28,itptp1,itptp2
      common /cstes_hab/sttpp,sttp,stt,stpp,stp,st,spp,sp
      real*4 sttvpp(nocz),stvpp(nocz),sttvp(nocz),
     *stvp(nocz),sttv(nocz),stv(nocz),sttppv(nvz),sttpv(nvz),
     *stppv(nvz),stpv(nvz),sppv(nvz),spv(nvz)
      real*4 stvtvpp(nocz,nocz),stvtvp(nocz,nocz),
     *stvtv(nocz,nocz),
     *sttpvpv(nvz,nvz),stpvpv(nvz,nvz),spvpv(nvz,nvz),
     *sttvppv(nocz,nvz),sttvpv(nocz,nvz),stvppv(nocz,nvz),
     *stvpv(nocz,nvz)
      real*4 stvtvppv(nocz,nocz,nvz),
     *stvtvpv(nocz,nocz,nvz),
     *sttvpvpv(nocz,nvz,nvz),stvpvpv(nocz,nvz,nvz)
      real*4 stvtvpvpv(ii28)
c      real*4 stvtvpvpv(nocz*(nocz+1)/2,nvz*(nvz+1)/2)
c      real*4 stvtvpvpv(nocz,nocz,nvz,nvz)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common/l40/ hmono(maxorb*(maxorb+1)/2),aj(maxorb*(maxorb+1)/2)
     *,ak(maxorb*(maxorb+1)/2),f(maxorb*(maxorb+1)/2),e0
     *,ajk(maxorb*(maxorb+1)/2),escf
      dimension it4(maxorbcas+2),ip4(maxorbcas+2)
      real*4 fv
      yyw=.false.
      yw=.false.
      if(yw)print*,'nt,np',nt,np
      if(yw)write(6,*)'it4',(it4(k),k=1,ne)
      if(yw)write(6,*)'ip4',(ip4(k),k=1,ne)
      yw=.false.
      if(nt.eq.2)then
         if(np.eq.2)then
c******* nt=2 np=2
c      if(ne.eq.4)write(6,'('' nnndet'',8i3)')(it4(k),k=1,4),
c     *(ip4(k),k=1,4)
c      yyw=ne.eq.4.and.
c     *it4(1).eq.1.and.
c     *it4(2).eq.3.and.
c     *it4(3).eq.2.and.
c     *it4(4).eq.5
c     *.and.ip4(1).eq.2.and.
c     *ip4(2).eq.5.and.
c     *ip4(3).eq.1.and.
c     *ip4(4).eq.10
            if(yyw)open(98,status='unknown',file='detn',form='formatted'
     &      )
            if(yyw)write(98,*)'it4',it4
            if(yyw)write(98,*)'ip4',ip4
c ------ cstes
            hii=sttpp+sttp+stt+stpp+stp+st+spp+sp
            if(yyw)write(98,'(f12.8,a10)')sttpp,'sttpp'
            if(yyw)write(98,'(f12.8,a10)')sttp,'sttp'
            if(yyw)write(98,'(f12.8,a10)')stt,'stt'
            if(yyw)write(98,'(f12.8,a10)')stpp,'stpp'
            if(yyw)write(98,'(f12.8,a10)')stp,'stp'
            if(yyw)write(98,'(f12.8,a10)')st,'st'
            if(yyw)write(98,'(f12.8,a10)')spp,'spp'
            if(yyw)write(98,'(f12.8,a10)')sp,'sp'
c -CAS
c        ajout de tv
            do k1=3,ne
               hii=hii-sttvpp(it4(k1))-sttvp(it4(k1))-sttv(it4(k1))
     *         -stvpp(it4(k1))-stvp(it4(k1))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttvpp(it4(k1)),
     *         'sttvpp',it4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttvp(it4(k1)),
     *         'sttvp',it4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttv(it4(k1)),
     *         'sttv',it4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvpp(it4(k1)),
     *         'stvpp',it4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvp(it4(k1)),
     *         'stvp',it4(k1)
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+stvtvpp(it4(k1),it4(k2))
     *            +stvtvp(it4(k1),it4(k2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            +stvtvpp(it4(k1),it4(k2)),
     *            'stvtvpp',it4(k1),it4(k2)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            +stvtvp(it4(k1),it4(k2)),
     *            'stvtvp',it4(k1),it4(k2)
c              ajout de tvtvpv
                  do k3=3,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k3))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvppv(it4(k1),it4(k2),ip4(k3)),
     *               'stvtvppv',it4(k1),it4(k2),ip4(k3)
                  enddo
               enddo
c           ajout de tvpv
               do k2=3,ne
                  hii=hii+sttvppv(it4(k1),ip4(k2))+sttvpv(it4(k1),ip4(k2
     &            ))
     *            +stvppv(it4(k1),ip4(k2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvppv(it4(k1),ip4(k2)),
     *            'sttvppv',it4(k1),ip4(k2)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvpv(it4(k1),ip4(k2)),
     *            'sttvpv',it4(k1),ip4(k2)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvppv(it4(k1),ip4(k2)),
     *            'stvppv',it4(k1),ip4(k2)
c              ajout de tvpvpv
                  do k3=k2+1,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k2),ip4(k3))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -sttvpvpv(it4(k1),ip4(k2),ip4(k3)),
     *               'sttvpvpv',it4(k1),ip4(k2),ip4(k3)
                  enddo
               enddo
            enddo
c        ajout de pv
            do k1=3,ne
               hii=hii-sttppv(ip4(k1))-sttpv(ip4(k1))
     *         -stppv(ip4(k1))-stpv(ip4(k1))-sppv(ip4(k1))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttppv(ip4(k1)),
     *         'sttppv',ip4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttpv(ip4(k1)),
     *         'sttpv',ip4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stppv(ip4(k1)),
     *         'stppv',ip4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stpv(ip4(k1)),
     *         'stpv',ip4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sppv(ip4(k1)),
     *         'sppv',ip4(k1)
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+sttpvpv(ip4(k1),ip4(k2))
     *            +stpvpv(ip4(k1),ip4(k2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttpvpv(ip4(k1),ip4(k2)),
     *            'sttpvpv',ip4(k1),ip4(k2)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stpvpv(ip4(k1),ip4(k2)),
     *            'stpvpv',ip4(k1),ip4(k2)
               enddo
            enddo
c ------ epv : 1 dimension : 1t ou 1p
c        1t
            do k=1,2
               hii=hii-sttvpp(it4(k))-stvpp(it4(k))-sttvp(it4(k))
     *         -stvp(it4(k))-sttv(it4(k))-stv(it4(k))
               if(yyw)write(98,'(f12.8,a10,4i3)')-sttvpp(it4(k)),'sttvpp
     &         ',it4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')-stvpp(it4(k)),'stvpp',
     &         it4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')-sttvp(it4(k)),'sttvp',
     &         it4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')-stvp(it4(k)),'stvp',it
     &         4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')-sttv(it4(k)),'sttv',it
     &         4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')-stv(it4(k)),'stv',it4(
     &         k)
c           ajout de tv
               do k1=3,ne
                  hii=hii+stvtvpp(it4(k),it4(k1))
     *            +stvtvp(it4(k),it4(k1))+stvtv(it4(k),it4(k1))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvtvpp(it4(k),it4(k1)),'stvtvpp',it4(k),it4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvtvp(it4(k),it4(k1)),'stvtvp',it4(k),it4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvtv(it4(k),it4(k1)),'stvtv',it4(k),it4(k1)
c              ajout de tvpv
                  do k2=3,ne
                     hii=hii-stvtvppv(it4(k),it4(k1),ip4(k2))
     *               -stvtvpv(it4(k),it4(k1),ip4(k2))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvppv(it4(k),it4(k1),ip4(k2)),'stvtvppv',
     *               it4(k),it4(k1),ip4(k2)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvpv(it4(k),it4(k1),ip4(k2)),'stvtvpv',it4(k),i
     &               t4(k1),ip4(k2)
c                 ajout de tvpvpv
                     do k3=k2+1,ne
                        hii=hii
     *                  +fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip4(k3))
                        if(yyw)write(98,'(f12.8,a10,4i3)')
     *                  fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip4
     &                  (k3)),
     *                  'ftvtvpvpv',it4(k),it4(k1),ip4(k2),ip4(k3)
                     enddo
                  enddo
               enddo
c           ajout de pv
               do k1=3,ne
                  hii=hii+sttvppv(it4(k),ip4(k1))+stvppv(it4(k),ip4(k1))
     *            +sttvpv(it4(k),ip4(k1))+stvpv(it4(k),ip4(k1))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvppv(it4(k),ip4(k1)),
     *            'sttvppv',it4(k),ip4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvppv(it4(k),ip4(k1)),
     *            'stvppv',it4(k),ip4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvpv(it4(k),ip4(k1)),
     *            'sttvpv',it4(k),ip4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvpv(it4(k),ip4(k1)),
     *            'stvpv',it4(k),ip4(k1)
c              ajout de pvpv
                  do k2=k1+1,ne
                     hii=hii-sttvpvpv(it4(k),ip4(k1),ip4(k2))
     *               -stvpvpv(it4(k),ip4(k1),ip4(k2))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -sttvpvpv(it4(k),ip4(k1),ip4(k2)),
     *               'sttvpvpv',it4(k),ip4(k1),ip4(k2)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvpvpv(it4(k),ip4(k1),ip4(k2)),
     *               'stvpvpv',it4(k),ip4(k1),ip4(k2)
                  enddo
               enddo
            enddo
c        1p
            do k=1,2
               hii=hii-sttppv(ip4(k))-sttpv(ip4(k))
     *         -stppv(ip4(k))-stpv(ip4(k))-sppv(ip4(k))-spv(ip4(k))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttppv(ip4(k)),
     *         'sttppv',ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttpv(ip4(k)),
     *         'sttpv',ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stppv(ip4(k)),
     *         'stppv',ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stpv(ip4(k)),
     *         'stpv',ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sppv(ip4(k)),
     *         'sppv',ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -spv(ip4(k)),
     *         'spv',ip4(k)
c           ajout de tv
               do k1=3,ne
                  hii=hii+sttvppv(it4(k1),ip4(k))+sttvpv(it4(k1),ip4(k))
     *            +stvppv(it4(k1),ip4(k))+stvpv(it4(k1),ip4(k))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvppv(it4(k1),ip4(k)),
     *            'sttvppv',it4(k1),ip4(k)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvpv(it4(k1),ip4(k)),
     *            'sttvpv',it4(k1),ip4(k)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvppv(it4(k1),ip4(k)),
     *            'stvppv',it4(k1),ip4(k)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvpv(it4(k1),ip4(k)),
     *            'stvpv',it4(k1),ip4(k)
c              ajout de tvtv
                  do k2=k1+1,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k))
     *               -stvtvpv(it4(k1),it4(k2),ip4(k))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvppv(it4(k1),it4(k2),ip4(k)),
     *               'stvtvppv',it4(k1),it4(k2),ip4(k)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvpv(it4(k1),it4(k2),ip4(k)),
     *               'stvtvpv',it4(k1),it4(k2),ip4(k)
c                 ajout de tvtvpv
                     do k3=3,ne
                        hii=hii
     *                  +fv(stvtvpvpv,
     *                  it4(k1),it4(k2),ip4(k),ip4(k3))
                        if(yyw)write(98,'(f12.8,a10,4i3)')
     *                  fv(stvtvpvpv,
     *                  it4(k1),it4(k2),ip4(k),ip4
     &                  (k3)),
     *                  'ftvtvpvpv',it4(k1),it4(k2),ip4(k),ip4(k3)
                     enddo
                  enddo
c              ajout de tvpv
                  do k2=3,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k),ip4(k2))
     *               -stvpvpv(it4(k1),ip4(k),ip4(k2))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -sttvpvpv(it4(k1),ip4(k),ip4(k2)),
     *               'sttvpvpv',it4(k1),ip4(k),ip4(k2)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvpvpv(it4(k1),ip4(k),ip4(k2)),
     *               'stvpvpv',it4(k1),ip4(k),ip4(k2)
                  enddo
               enddo
c           ajout de pv
               do k1=3,ne
                  hii=hii+sttpvpv(ip4(k),ip4(k1))
     *            +stpvpv(ip4(k),ip4(k1))+spvpv(ip4(k),ip4(k1))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttpvpv(ip4(k),ip4(k1)),
     *            'sttpvpv',ip4(k),ip4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stpvpv(ip4(k),ip4(k1)),
     *            'stpvpv',ip4(k),ip4(k1)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            spvpv(ip4(k),ip4(k1)),
     *            'spvpv',ip4(k),ip4(k1)
               enddo
            enddo
c ------ epv : 2 dimensions: 2t ou 2p ou 1t/1p
c        2t
            hii=hii+stvtvpp(it4(1),it4(2))+stvtvp(it4(1),it4(2))
     *      +stvtv(it4(1),it4(2))
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      stvtvpp(it4(1),it4(2)),
     *      'stvtvpp',it4(1),it4(2)
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      stvtvp(it4(1),it4(2)),
     *      'stvtvp',it4(1),it4(2)
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      stvtv(it4(1),it4(2)),
     *      'stvtv',it4(1),it4(2)
c CAS
c        ajout de pv
            do k1=3,ne
               hii=hii-stvtvppv(it4(1),it4(2),ip4(k1))
     *         -stvtvpv(it4(1),it4(2),ip4(k1))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvtvppv(it4(1),it4(2),ip4(k1)),
     *         'stvtvppv',it4(1),it4(2),ip4(k1)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvtvpv(it4(1),it4(2),ip4(k1)),
     *         'stvtvpv',it4(1),it4(2),ip4(k1)
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2)),
     *            'ftvtvpvpv',it4(1),it4(2),ip4(k1),ip4(k2)
               enddo
            enddo
c        2p
            hii=hii+sttpvpv(ip4(1),ip4(2))+stpvpv(ip4(1),ip4(2))
     *      +spvpv(ip4(1),ip4(2))
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      sttpvpv(ip4(1),ip4(2)),
     *      'sttpvpv',ip4(1),ip4(2)
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      stpvpv(ip4(1),ip4(2)),
     *      'stpvpv',ip4(1),ip4(2)
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      spvpv(ip4(1),ip4(2)),
     *      'spvpv',ip4(1),ip4(2)
c        ajout de tv
            do k1=3,ne
               hii=hii-sttvpvpv(it4(k1),ip4(1),ip4(2))
     *         -stvpvpv(it4(k1),ip4(1),ip4(2))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttvpvpv(it4(k1),ip4(1),ip4(2)),
     *         'sttvpvpv',it4(k1),ip4(1),ip4(2)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvpvpv(it4(k1),ip4(1),ip4(2)),
     *         'stvpvpv',it4(k1),ip4(1),ip4(2)
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(k1),it4(k2),ip4(1),ip4(2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            fv(stvtvpvpv,
     *            it4(k1),it4(k2),ip4(1),ip4(2)),
     *            'ftvtvpvpv',it4(k1),it4(k2),ip4(1),ip4(2)
               enddo
            enddo
c        1t/1p
            do kt=1,2
               do kp=1,2
                  hii=hii+sttvppv(it4(kt),ip4(kp))+sttvpv(it4(kt),ip4(kp
     &            ))
     *            +stvppv(it4(kt),ip4(kp))+stvpv(it4(kt),ip4(kp))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvppv(it4(kt),ip4(kp))
     *            ,'sttvppv',it4(kt),ip4(kp)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            sttvpv(it4(kt),ip4(kp)),
     *            'sttvpv',it4(kt),ip4(kp)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            +stvppv(it4(kt),ip4(kp)),
     *            'stvppv',it4(kt),ip4(kp)
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            stvpv(it4(kt),ip4(kp)),
     *            'stvpv',it4(kt),ip4(kp)
c              ajout de tv
                  do k1=3,ne
                     hii=hii-stvtvppv(it4(kt),it4(k1),ip4(kp))
     *               -stvtvpv(it4(kt),it4(k1),ip4(kp))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvppv(it4(kt),it4(k1),ip4(kp)),
     *               'stvtvppv',it4(kt),it4(k1),ip4(kp)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvtvpv(it4(kt),it4(k1),ip4(kp)),
     *               'stvtvpv',it4(kt),it4(k1),ip4(kp)
c                 ajout de tvpv
                     do k2=3,ne
                        hii=hii
     *                  +fv(stvtvpvpv,
     *                  it4(kt),it4(k1),ip4(kp),ip4(k2))
                        if(yyw)write(98,'(f12.8,a10,4i3)')
     *                  fv(stvtvpvpv,
     *                  it4(kt),it4(k1),ip4(kp),ip
     &                  4(k2)),
     *                  'ftvtvpvpv',it4(kt),it4(k1),ip4(kp),ip4(k2)
                     enddo
                  enddo
c              ajout de pv
                  do k1=3,ne
                     hii=hii-sttvpvpv(it4(kt),ip4(kp),ip4(k1))
     *               -stvpvpv(it4(kt),ip4(kp),ip4(k1))
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -sttvpvpv(it4(kt),ip4(kp),ip4(k1)),
     *               'sttvpvpv',it4(kt),ip4(kp),ip4(k1)
                     if(yyw)write(98,'(f12.8,a10,4i3)')
     *               -stvpvpv(it4(kt),ip4(kp),ip4(k1)),
     *               'stvpvpv',it4(kt),ip4(kp),ip4(k1)
                  enddo
               enddo
            enddo
c ------ epv : 3 dimensions: 2t/1p ou 1t/2p
c        2t1p
            do k=1,2
               hii=hii-stvtvppv(it4(1),it4(2),ip4(k))
     *         -stvtvpv(it4(1),it4(2),ip4(k))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvtvppv(it4(1),it4(2),ip4(k)),
     *         'stvtvppv',it4(1),it4(2),ip4(k)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvtvpv(it4(1),it4(2),ip4(k)),
     *         'stvtvpv',it4(1),it4(2),ip4(k)
c           ajout de pv
               do k1=3,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k),ip4(k1))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k),ip4(k1)),
     *            'ftvtvpvpv',it4(1),it4(2),ip4(k),ip4(k1)
               enddo
            enddo
c        1t2p
            do k=1,2
               hii=hii-sttvpvpv(it4(k),ip4(1),ip4(2))
     *         -stvpvpv(it4(k),ip4(1),ip4(2))
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -sttvpvpv(it4(k),ip4(1),ip4(2)),
     *         'sttvpvpv',it4(k),ip4(1),ip4(2)
               if(yyw)write(98,'(f12.8,a10,4i3)')
     *         -stvpvpv(it4(k),ip4(1),ip4(2)),
     *         'stvpvpv',it4(k),ip4(1),ip4(2)
c           ajout de tv
               do k1=3,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(k),it4(k1),ip4(1),ip4(2))
                  if(yyw)write(98,'(f12.8,a10,4i3)')
     *            fv(stvtvpvpv,
     *            it4(k),it4(k1),ip4(1),ip4(2)),
     *            'ftvtvpvpv',it4(k),it4(k1),ip4(1),ip4(2)
               enddo
            enddo
c ------ epv : 4 dimensions: 2t/2p
            hii=hii+fv(stvtvpvpv,
     *      it4(1),it4(2),ip4(1),ip4(2))
            if(yyw)write(98,'(f12.8,a10,4i3)')
     *      fv(stvtvpvpv,it4(1),it4(2),ip4(1),ip4(2)),
     *      'ftvtvpvpv',it4(1),it4(2),ip4(1),ip4(2)
            if(yyw)write(98,*)'hii',hii
         else if(np.eq.1)then
c******* nt=2 np=1
c ------ cstes
            hii=hii+sttpp+sttp+stt+stpp+stp+st+spp
c -CAS
c        ajout de tv
            do k1=3,ne
               hii=hii-sttvpp(it4(k1))-sttvp(it4(k1))-sttv(it4(k1))
     *         -stvpp(it4(k1))
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+stvtvpp(it4(k1),it4(k2))
               enddo
c           ajout de tvpv
               do k2=2,ne
                  hii=hii+sttvppv(it4(k1),ip4(k2))+sttvpv(it4(k1),ip4(k2
     &            ))
c              ajout de tvpvpv
                  do k3=k2+1,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k2),ip4(k3))
                  enddo
               enddo
            enddo
c        ajout de pv
            do k1=2,ne
               hii=hii-sttppv(ip4(k1))-sttpv(ip4(k1))-stppv(ip4(k1))
     *         -stpv(ip4(k1))
c          ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+sttpvpv(ip4(k1),ip4(k2))+stpvpv(ip4(k1),ip4(k2
     &            ))
               enddo
            enddo
c ------ epv : 1 dimension : 1t ou 1p
c        1t
            do k=1,2
               hii=hii-sttvpp(it4(k))-sttvp(it4(k))-sttv(it4(k))
     *         -stvpp(it4(k))-stvp(it4(k))-stv(it4(k))
c          ajout de tv
               do k1=3,ne
                  hii=hii+stvtvpp(it4(k),it4(k1))+stvtvp(it4(k),it4(k1))
     *            +stvtv(it4(k),it4(k1))
c             ajout de tvpv
                  do k2=2,ne
                     hii=hii-stvtvppv(it4(k),it4(k1),ip4(k2))
     *               -stvtvpv(it4(k),it4(k1),ip4(k2))
c                 ajout de tvpvpv
                     do k3=k2+1,ne
                        hii=hii+fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip4(k3))
                     enddo
                  enddo
               enddo
c          ajout de pv
               do k1=2,ne
                  hii=hii+sttvppv(it4(k),ip4(k1))+sttvpv(it4(k),ip4(k1))
     *            +stvppv(it4(k),ip4(k1))+stvpv(it4(k),ip4(k1))
c             ajout de pvpv
                  do k2=k1+1,ne
                     hii=hii-sttvpvpv(it4(k),ip4(k1),ip4(k2))
     *               -stvpvpv(it4(k),ip4(k1),ip4(k2))
                  enddo
               enddo
            enddo
c        1p
            hii=hii-sttppv(ip4(1))-sttpv(ip4(1))-stppv(ip4(1))
     *      -stpv(ip4(1))-sppv(ip4(1))
c        ajout de tv
            do k1=3,ne
               hii=hii+sttvppv(it4(k1),ip4(1))+sttvpv(it4(k1),ip4(1))
     *         +stvppv(it4(k1),ip4(1))
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii-stvtvppv(it4(k1),it4(k2),ip4(1))
               enddo
c           ajout de tvpv
               do k2=2,ne
                  hii=hii-sttvpvpv(it4(k1),ip4(1),ip4(k2))
               enddo
            enddo
c        ajout de pv
            do k1=2,ne
               hii=hii+sttpvpv(ip4(1),ip4(k1))+stpvpv(ip4(1),ip4(k1))
            enddo
c ------ epv : 2 dimensions: 2t ou 1t/1p
c        2t
            hii=hii+stvtvpp(it4(1),it4(2))+stvtvp(it4(1),it4(2))
     *      +stvtv(it4(1),it4(2))
c        ajout de pv
            do k1=2,ne
               hii=hii-stvtvppv(it4(1),it4(2),ip4(k1))
     *         -stvtvpv(it4(1),it4(2),ip4(k1))
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2))
               enddo
            enddo
c        1t/1p
            do k=1,2
               hii=hii+sttvppv(it4(k),ip4(1))+sttvpv(it4(k),ip4(1))
     *         +stvppv(it4(k),ip4(1))+stvpv(it4(k),ip4(1))
c -CAS
c           ajout de tv
               do k1=3,ne
                  hii=hii-stvtvppv(it4(k),it4(k1),ip4(1))
     *            -stvtvpv(it4(k),it4(k1),ip4(1))
c              ajout de tvpv
                  do k2=2,ne
                     hii=hii+fv(stvtvpvpv,
     *               it4(k),it4(k1),ip4(1),ip4(k2))
                  enddo
               enddo
c           ajout de pv
               do k2=2,ne
                  hii=hii-sttvpvpv(it4(k),ip4(1),ip4(k2))
     *            -stvpvpv(it4(k),ip4(1),ip4(k2))
               enddo
            enddo
c ------ epv : 3 dimensions: 2t/1p
            hii=hii-stvtvppv(it4(1),it4(2),ip4(1))
     *      -stvtvpv(it4(1),it4(2),ip4(1))
c        ajout de pv
            do k1=2,ne
               hii=hii+fv(stvtvpvpv,
     *         it4(1),it4(2),ip4(1),ip4(k1))
            enddo
         else if(np.eq.0)then
c******* nt=2 np=0
c ------ cstes
c        yyw=ne.eq.2.and.
c     *   it4(1).eq.1.and.
c     *   it4(2).eq.2.and.
c     *   ip4(1).eq.1.and.
c     *   ip4(2).eq.2
c        yyw=yyw.or.
c     *   (ne.eq.2.and.it4(1).eq.6.and.
c     *   it4(2).eq.7.and.
c     *   ip4(1).eq.6.and.
c     *   ip4(2).eq.7)
c        write(6,*)'it4,ip4',(it4(k),k=1,2),(ip4(k),k=1,2)
            if(yyw)write(6,*)'it4,ip4',(it4(k),k=1,2),(ip4(k),k=1,2)
            hii1=hii
            hii=hii+sttpp+sttp+stt+stpp+stp+st
            if(yyw)write(6,*)'sttpp',sttpp
            if(yyw)write(6,*)'sttp',sttp
            if(yyw)write(6,*)'stt',stt
            if(yyw)write(6,*)'stpp',stpp
            if(yyw)write(6,*)'stp',stp
            if(yyw)write(6,*)'st',st
c CAS
c        ajout de tv
            do k1=3,ne
               hii=hii-sttvpp(it4(k1))-sttvp(it4(k1))-sttv(it4(k1))
               if(yyw)write(6,*)'-sttvpp(it4(k1))',-sttvpp(it4(k1))
               if(yyw)write(6,*)'-sttvp(it4(k1))',-sttvp(it4(k1))
               if(yyw)write(6,*)'-sttv(it4(k1))',-sttv(it4(k1))
               if(yyw)write(6,*)'hii',hii
c           ajout de tvpv
               do k2=1,ne
                  hii=hii+sttvppv(it4(k1),ip4(k2))+sttvpv(it4(k1),ip4(k2
     &            ))
                  if(yyw)write(6,*)'sttvppv(it4(k1),ip4(k2))'
     *            ,sttvppv(it4(k1),ip4(k2))
                  if(yyw)write(6,*)'hii',hii
                  if(yyw)write(6,*)'sttvpv(it4(k1),ip4(k2))'
     *            ,sttvpv(it4(k1),ip4(k2))
c              ajout de tvpvpv
                  do k3=k2+1,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k2),ip4(k3))
                     if(yyw)write(6,*)'-sttvpvpv(it4(k1),ip4(k2),ip4(k3)
     &               )',
     *               -sttvpvpv(it4(k1),ip4(k2),ip4(k3))
                     if(yyw)write(6,*)'hii',hii
                  enddo
               enddo
            enddo
c        ajout de pv
            do k1=1,ne
               hii=hii-sttppv(ip4(k1))-sttpv(ip4(k1))-stppv(ip4(k1))
     *         -stpv(ip4(k1))
               if(yyw)write(6,*)'-sttppv(ip4(k1))',-sttppv(ip4(k1))
               if(yyw)write(6,*)'-sttpv(ip4(k1))',-sttpv(ip4(k1))
               if(yyw)write(6,*)'-stppv(ip4(k1))',-stppv(ip4(k1))
               if(yyw)write(6,*)'-stpv(ip4(k1))',-stpv(ip4(k1))
               if(yyw)write(6,*)'hii',hii
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+sttpvpv(ip4(k1),ip4(k2))+stpvpv(ip4(k1),ip4(k2
     &            ))
                  if(yyw)write(6,*)'sttpvpv(ip4(k1),ip4(k2))'
     *            ,sttpvpv(ip4(k1),ip4(k2))
                  if(yyw)write(6,*)'stpvpv(ip4(k1),ip4(k2))'
     *            ,stpvpv(ip4(k1),ip4(k2))
                  if(yyw)write(6,*)'hii',hii
               enddo
            enddo
c ------ epv : 1 dimension : 1t
            do k=1,2
               hii=hii-sttvpp(it4(k))-sttvp(it4(k))-sttv(it4(k))
     *         -stvpp(it4(k))-stvp(it4(k))-stv(it4(k))
               if(yyw)write(6,*)'-sttvpp(it4(k))',-sttvpp(it4(k))
               if(yyw)write(6,*)'-sttvp(it4(k))',-sttvp(it4(k))
               if(yyw)write(6,*)'-sttv(it4(k))',-sttv(it4(k))
               if(yyw)write(6,*)'-stvpp(it4(k))',-stvpp(it4(k))
               if(yyw)write(6,*)'-stvp(it4(k))',-stvp(it4(k))
               if(yyw)write(6,*)'-stv(it4(k))',-stv(it4(k))
               if(yyw)write(6,*)'hii',hii
c CAS
c          ajout de tv
               do k1=3,ne
                  hii=hii+stvtvpp(it4(k),it4(k1))
     *            +stvtvp(it4(k),it4(k1))+stvtv(it4(k),it4(k1))
                  if(yyw)write(6,*)'stvtvpp(it4(k),it4(k1))'
     *            ,stvtvpp(it4(k),it4(k1))
                  if(yyw)write(6,*)'stvtvp(it4(k),it4(k1))'
     *            ,stvtvp(it4(k),it4(k1))
                  if(yyw)write(6,*)'+stvtv(it4(k),it4(k1))'
     *            ,+stvtv(it4(k),it4(k1))
                  if(yyw)write(6,*)'hii',hii
c             ajout de tvpv
                  do k2=1,ne
                     hii=hii-stvtvppv(it4(k),it4(k1),ip4(k2))
     *               -stvtvpv(it4(k),it4(k1),ip4(k2))
                     if(yyw)write(6,*)'-stvtvppv(it4(k),it4(k1),ip4(k2))
     &               '
     *               ,-stvtvppv(it4(k),it4(k1),ip4(k2))
                     if(yyw)write(6,*)'-stvtvpv(it4(k),it4(k1),ip4(k2))'
     *               ,-stvtvpv(it4(k),it4(k1),ip4(k2))
                     if(yyw)write(6,*)'hii',hii
c                ajout de tvpvpv
                     do k3=k2+1,ne
                        hii=hii+fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip4(k3))
                        if(yyw)write(6,*)
     *                  'fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip
     &                  4(k3))'
     *                  ,fv(stvtvpvpv,
     *                  it4(k),it4(k1),ip4(k2),ip
     &                  4(k3))
                        if(yyw)write(6,*)'hii',hii
                     enddo
                  enddo
               enddo
c          ajout de pv
               do k1=1,ne
                  hii=hii+sttvppv(it4(k),ip4(k1))+sttvpv(it4(k),ip4(k1))
     *            +stvppv(it4(k),ip4(k1))+stvpv(it4(k),ip4(k1))
                  if(yyw)write(6,*)'sttvppv(it4(k),ip4(k1))'
     *            ,sttvppv(it4(k),ip4(k1))
                  if(yyw)write(6,*)'sttvpv(it4(k),ip4(k1))'
     *            ,sttvpv(it4(k),ip4(k1))
                  if(yyw)write(6,*)'istvppv(it4(k),ip4(k1))'
     *            ,stvppv(it4(k),ip4(k1))
                  if(yyw)write(6,*)'stvpv(it4(k),ip4(k1))'
     *            ,stvpv(it4(k),ip4(k1))
                  if(yyw)write(6,*)'hii',hii
c             ajout de pvpv
                  do k2=k1+1,ne
                     hii=hii-sttvpvpv(it4(k),ip4(k1),ip4(k2))
     *               -stvpvpv(it4(k),ip4(k1),ip4(k2))
                     if(yyw)write(6,*)'-sttvpvpv(it4(k),ip4(k1),ip4(k2))
     &               '
     *               ,-sttvpvpv(it4(k),ip4(k1),ip4(k2))
                     if(yyw)write(6,*)'-stvpvpv(it4(k),ip4(k1),ip4(k2))'
     *               ,-stvpvpv(it4(k),ip4(k1),ip4(k2))
                     if(yyw)write(6,*)'hii',hii
                  enddo
               enddo
            enddo
c ------ epv : 2 dimensions: 2t
            hii=hii+stvtvpp(it4(1),it4(2))+stvtvp(it4(1),it4(2))
     *      +stvtv(it4(1),it4(2))
            if(yyw)write(6,*)'stvtvpp(it4(1),it4(2))'
     *      ,stvtvpp(it4(1),it4(2))
            if(yyw)write(6,*)'stvtvp(it4(1),it4(2))'
     *      ,stvtvp(it4(1),it4(2))
            if(yyw)write(6,*)'stvtv(it4(1),it4(2))',stvtv(it4(1),it4(2))
            if(yyw)write(6,*)'hii',hii
c CAS
c        ajout de pv
            do k1=1,ne
               hii=hii-stvtvppv(it4(1),it4(2),ip4(k1))
     *         -stvtvpv(it4(1),it4(2),ip4(k1))
               if(yyw)write(6,*)'-stvtvppv(it4(1),it4(2),ip4(k1))'
     *         ,-stvtvppv(it4(1),it4(2),ip4(k1))
               if(yyw)write(6,*)'-stvtvpv(it4(1),it4(2),ip4(k1))'
     *         ,-stvtvpv(it4(1),it4(2),ip4(k1))
               if(yyw)write(6,*)'hii',hii
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2))
                  if(yyw)write(6,*)
     *            'fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2))'
     *            ,fv(stvtvpvpv,
     *            it4(1),it4(2),ip4(k1),ip4(k2))
                  if(yyw)write(6,*)'hii',hii
               enddo
            enddo
         endif
      else if(nt.eq.1)then
         if(np.eq.2)then
c******* nt=1 np=2
c ------ cstes
            hii=hii+sttpp+sttp+stt+stpp+stp+spp+sp
c CAS
c        ajout de tv
            do k1=2,ne
               hii=hii-sttvpp(it4(k1))-sttvp(it4(k1))-stvpp(it4(k1))
     *         -stvp(it4(k1))
corr     *     -sttv(it4(k1))
c          ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+stvtvpp(it4(k1),it4(k2))+stvtvp(it4(k1),it4(k2
     &            ))
c             ajout de tvtvpv
                  do k3=3,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k3))
                  enddo
               enddo
c          ajout de tvpv
               do k2=3,ne
                  hii=hii+sttvppv(it4(k1),ip4(k2))+stvppv(it4(k1),ip4(k2
     &            ))
               enddo
            enddo
c        ajout de pv
            do k1=3,ne
               hii=hii-sttppv(ip4(k1))-sttpv(ip4(k1))-stppv(ip4(k1))
     *         -sppv(ip4(k1))
c          ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+sttpvpv(ip4(k1),ip4(k2))
               enddo
            enddo
c ------ epv : 1 dimension : 1t ou 1p
c--      1tv
            hii=hii-sttvpp(it4(1))-stvpp(it4(1))-sttvp(it4(1))
     *      -stvp(it4(1))-sttv(it4(1))
c CAS
c        ajout de tv
            do k=2,ne
               hii=hii+stvtvpp(it4(1),it4(k))+stvtvp(it4(1),it4(k))
c           ajout de tvpv
               do k1=3,ne
                  hii=hii-stvtvppv(it4(1),it4(k),ip4(k1))
               enddo
            enddo
c        ajout de pv
            do k=3,ne
               hii=hii+sttvppv(it4(1),ip4(k))+stvppv(it4(1),ip4(k))
     *         +sttvpv(it4(1),ip4(k))
c           ajout de pvpv
               do k1=k+1,ne
                  hii=hii-sttvpvpv(it4(1),ip4(k),ip4(k1))
               enddo
            enddo
c--      1pv
            do k=1,2
               hii=hii-sttppv(ip4(k))-sttpv(ip4(k))-stppv(ip4(k))
     *         -stpv(ip4(k))-sppv(ip4(k))-spv(ip4(k))
c CAS
c           ajout de tv
               do k1=2,ne
                  hii=hii+sttvppv(it4(k1),ip4(k))+sttvpv(it4(k1),ip4(k))
     *            +stvppv(it4(k1),ip4(k))+stvpv(it4(k1),ip4(k))
c              ajout de tvtv
                  do k2=k1+1,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k))
     *               -stvtvpv(it4(k1),it4(k2),ip4(k))
c                 ajout de tvtvpv
                     do k3=3,ne
                        hii=hii
     *                  +fv(stvtvpvpv,
     *                  it4(k1),it4(k2),ip4(k),ip4(k3))
                     enddo
                  enddo
c              ajout de tvpv
                  do k2=3,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k),ip4(k2))
     *               -stvpvpv(it4(k1),ip4(k),ip4(k2))
                  enddo
               enddo
c           ajout de pv
               do k1=3,ne
                  hii=hii+sttpvpv(ip4(k),ip4(k1))+stpvpv(ip4(k),ip4(k1))
     *            +spvpv(ip4(k),ip4(k1))
               enddo
            enddo
c ------ epv : 2 dimensions: 2p ou 1t/1p
c--      2pv
            hii=hii+sttpvpv(ip4(1),ip4(2))+stpvpv(ip4(1),ip4(2))
     *      +spvpv(ip4(1),ip4(2))
c CAS
c        ajout de tv
            do k=2,ne
               hii=hii-sttvpvpv(it4(k),ip4(1),ip4(2))
     *         -stvpvpv(it4(k),ip4(1),ip4(2))
c           ajout de tvtv
               do k1=k+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(k),it4(k1),ip4(1),ip4(2))
               enddo
            enddo
c--      1tv1pv
            do kp=1,2
               hii=hii+sttvppv(it4(1),ip4(kp))
     *         +sttvpv(it4(1),ip4(kp))
     *         +stvppv(it4(1),ip4(kp))
     *         +stvpv(it4(1),ip4(kp))
c CAS
c           ajout de tv
               do k=2,ne
                  hii=hii-stvtvppv(it4(1),it4(k),ip4(kp))
     *            -stvtvpv(it4(1),it4(k),ip4(kp))
c              ajout de tvpv
                  do k1=3,ne
                     hii=hii+fv(stvtvpvpv,
     *               it4(1),it4(k),ip4(kp),ip4(k1))
                  enddo
               enddo
c           ajout de pv
               do k=3,ne
                  hii=hii-sttvpvpv(it4(1),ip4(kp),ip4(k))
     *            -stvpvpv(it4(1),ip4(kp),ip4(k))
               enddo
            enddo
c ------ epv : 3 dimensions: 1t/2p
            hii=hii-sttvpvpv(it4(1),ip4(1),ip4(2))
     *      -stvpvpv(it4(1),ip4(1),ip4(2))
c        ajout de tv
            do k=2,ne
               hii=hii+fv(stvtvpvpv,
     *         it4(1),it4(k),ip4(1),ip4(2))
            enddo
         else if(np.eq.1)then
c******* nt=1 np=1
            yyw=ne.eq.3.and.
     *      it4(1).eq.7.and.
     *      it4(2).eq.10
     *      .and.ip4(1).eq.2.and.
     *      ip4(2).eq.5
c ------ cstes
            hii=hii+sttpp+sttp+stt+stpp+spp
            if(yyw)write(6,'(f12.8,a10)')sttpp,'sttpp'
            if(yyw)write(6,'(f12.8,a10)')sttp,'sttp'
            if(yyw)write(6,'(f12.8,a10)')stt,'stt'
            if(yyw)write(6,'(f12.8,a10)')stpp,'stpp'
            if(yyw)write(6,'(f12.8,a10)')spp,'spp'
            if(yyw) write(6,'('' hii'',f12.8)') hii
c CAS
c        ajout de pv,tv
            do k=2,ne
               hii=hii-sttppv(ip4(k))-sttpv(ip4(k))
     *         -sttvpp(it4(k))-stvpp(it4(k))
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         -sttppv(ip4(k)),
     *         'sttppv',ip4(k)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         -sttpv(ip4(k)),
     *         'sttpv',ip4(k)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         -sttvpp(it4(k)),
     *         'sttvpp',it4(k)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         -stvpp(it4(k)),
     *         'stvpp',it4(k)
               if(yyw) write(6,'('' hii'',f12.8)') hii
c           ajout de pvpv,tvtv
               do k2=k+1,ne
                  hii=hii+sttpvpv(ip4(k),ip4(k2))+stvtvpp(it4(k),it4(k2)
     &            )
                  if(yyw)write(6,'(f12.8,a10,4i3)')
     *            +sttpvpv(it4(k),ip4(k2)),
     *            'sttpvpv',it4(k),ip4(k2)
                  if(yyw)write(6,'(f12.8,a10,4i3)')
     *            +stvtvpp(it4(k),it4(k2)),
     *            'stvtvpp',it4(k),it4(k2)
                  if(yyw) write(6,'('' hii'',f12.8)') hii
               enddo
c           ajout de tvpv impossible
            enddo
c ------ epv : 1 dimension : 1t ou 1p
            hii=hii-sttvpp(it4(1))-stvpp(it4(1))-sttvp(it4(1))-sttv(it4(
     &      1))
     *      -sttppv(ip4(1))-sttpv(ip4(1))-stppv(ip4(1))-sppv(ip4(1))
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sttvpp(it4(1)),
     *      'sttvpp',it4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -stvpp(it4(1)),
     *      'stvpp',it4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sttvp(it4(1)),
     *      'sttvp',it4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sttv(it4(1)),
     *      'sttv',it4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sttppv(ip4(1)),
     *      'sttppv',ip4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sttpv(ip4(1)),
     *      'sttpv',ip4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -stppv(ip4(1)),
     *      'stppv',ip4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      -sppv(ip4(1)),
     *      'sppv',ip4(1)
            if(yyw) write(6,'('' hii'',f12.8)') hii
c CAS
            do k2=2,ne
c           ajout de tv
               hii=hii+stvtvpp(it4(1),it4(k2))+sttvppv(it4(k2),ip4(1))
     *         +stvppv(it4(k2),ip4(1))
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +stvtvpp(it4(1),it4(k2)),
     *         'stvtvpp',it4(1),it4(k2)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +sttvppv(it4(k2),ip4(1)),
     *         'sttvppv',it4(k2),ip4(1)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +stvppv(it4(k2),ip4(1)),
     *         'stvppv',it4(k2),ip4(1)
               if(yyw) write(6,'('' hii'',f12.8)') hii
c           ajout de pv
               hii=hii+sttvppv(it4(1),ip4(k2))+sttvpv(it4(1),ip4(k2))
     *         +sttpvpv(ip4(1),ip4(k2))
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +sttvppv(it4(1),ip4(k2)),
     *         'sttvppv',it4(1),ip4(k2)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +sttvpv(it4(1),ip4(k2)),
     *         'sttvpv',it4(1),ip4(k2)
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         +sttpvpv(ip4(1),ip4(k2)),
     *         'sttpvpv',ip4(1),ip4(k2)
               if(yyw) write(6,'('' hii'',f12.8)') hii
               do k3=k2+1,ne
c              ajout de tvtv
                  hii=hii-stvtvppv(it4(k2),it4(k3),ip4(1))
                  if(yyw)write(6,'(f12.8,a10,4i3)')
     *            -stvtvppv(it4(k2),ip4(k3),ip4(1)),
     *            'stvtvppv',it4(k2),ip4(k3),ip4(1)
                  if(yyw) write(6,'('' hii'',f12.8)') hii
c              ajout de pvpv
                  hii=hii-sttvpvpv(it4(1),ip4(k2),ip4(k3))
                  if(yyw)write(6,'(f12.8,a10,4i3)')
     *            -sttvpvpv(it4(1),ip4(k2),ip4(k3)),
     *            'sttvpvpv',it4(1),ip4(k2),ip4(k3)
                  if(yyw) write(6,'('' hii'',f12.8)') hii
               enddo
            enddo
c ------ epv : 2 dimensions: 1t/1p
            hii=hii+sttvppv(it4(1),ip4(1))+sttvpv(it4(1),ip4(1))+
     *      stvppv(it4(1),ip4(1))
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      +sttvppv(it4(1),ip4(1)),
     *      'sttvppv',it4(1),ip4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      +sttvpv(it4(1),ip4(1)),
     *      'sttvpv',it4(1),ip4(1)
            if(yyw)write(6,'(f12.8,a10,4i3)')
     *      +stvppv(it4(1),ip4(1)),
     *      'stvppv',it4(1),ip4(1)
            if(yyw) write(6,'('' hii'',f12.8)') hii
            do k=2,ne
c           ajout de tv,pv
               hii=hii-stvtvppv(it4(1),it4(k),ip4(1))
     *         -sttvpvpv(it4(1),ip4(1),ip4(k))
               if(yyw)write(6,'(f12.8,a10,4i3)')
     *         -sttvpvpv(it4(1),it4(k),ip4(1)),
     *         'sttvpvpv',it4(1),it4(k),ip4(1)
               if(yyw) write(6,'('' hii'',f12.8)') hii
            enddo
         else if(np.eq.0)then
c******* nt=1 np=0
c ------ cstes
            hii=hii+sttpp+sttp+stt
c CAS
c        ajout de pv
            do k1=1,ne
               hii=hii-sttppv(ip4(k1))-sttpv(ip4(k1))
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii+sttpvpv(ip4(k1),ip4(k2))
               enddo
            enddo
c ------ epv : 1 dimension : 1t
            hii=hii-sttvpp(it4(1))-sttvp(it4(1))-sttv(it4(1))
c        ajout de pv
            do k1=1,ne
               hii=hii+sttvppv(it4(1),ip4(k1))+sttvpv(it4(1),ip4(k1))
c           ajout de pvpv
               do k2=k1+1,ne
                  hii=hii-sttvpvpv(it4(1),ip4(k1),ip4(k2))
               enddo
            enddo
         endif
      else if(nt.eq.0)then
         if(np.eq.2)then
c******* nt=0 np=2
c ------ cstes
            hii=hii+sttpp+sttp+stpp+stp+spp+sp
c CAS
c        ajout de tv
            do k1=1,ne
               hii=hii-sttvpp(it4(k1))-sttvp(it4(k1))-stvpp(it4(k1))
     *         -stvp(it4(k1))
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+stvtvpp(it4(k1),it4(k2))
     *            +stvtvp(it4(k1),it4(k2))
c             ajout de tvtvpv
                  do k3=3,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k3))
                  enddo
               enddo
c           ajout de tvpv
               do k2=3,ne
                  hii=hii+sttvppv(it4(k1),ip4(k2))
     *            +stvppv(it4(k1),ip4(k2))
               enddo
            enddo
c        ajout de pv
            do k1=3,ne
               hii=hii-sttppv(ip4(k1))-stppv(ip4(k1))-sppv(ip4(k1))
            enddo
c ------ epv : 1 dimension : 1p
            do k=1,2
               hii=hii-sttppv(ip4(k))-sttpv(ip4(k))-stppv(ip4(k))
     *         -stpv(ip4(k))-sppv(ip4(k))-spv(ip4(k))
c CAS
c           ajout de tv
               do k1=1,ne
                  hii=hii+sttvppv(it4(k1),ip4(k))
     *            +sttvpv(it4(k1),ip4(k))+stvppv(it4(k1),ip4(k))
     *            +stvpv(it4(k1),ip4(k))
c              ajout de tvtv
                  do k2=k1+1,ne
                     hii=hii-stvtvppv(it4(k1),it4(k2),ip4(k))
     *               -stvtvpv(it4(k1),it4(k2),ip4(k))
c                 ajout de tvtvpv
                     do k3=3,ne
                        hii=hii
     *                  +fv(stvtvpvpv,
     *                  it4(k1),it4(k2),ip4(k),ip4(k3))
                     enddo
                  enddo
c              ajout de tvpv
                  do k2=3,ne
                     hii=hii-sttvpvpv(it4(k1),ip4(k),ip4(k2))
     *               -stvpvpv(it4(k1),ip4(k),ip4(k2))
                  enddo
               enddo
c           ajout de pv
               do k1=3,ne
                  hii=hii+sttpvpv(ip4(k),ip4(k1))
     *            +stpvpv(ip4(k),ip4(k1))+spvpv(ip4(k),ip4(k1))
               enddo
            enddo
c ------ epv : 1 dimension : 2p
            hii=hii+sttpvpv(ip4(1),ip4(2))+stpvpv(ip4(1),ip4(2))
     *      +spvpv(ip4(1),ip4(2))
c CAS
c        ajout de tv
            do k1=1,ne
               hii=hii-sttvpvpv(it4(k1),ip4(1),ip4(2))
     *         -stvpvpv(it4(k1),ip4(1),ip4(2))
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+fv(stvtvpvpv,
     *            it4(k1),it4(k2),ip4(1),ip4(2))
               enddo
            enddo
         else if(np.eq.1)then
c******* nt=0 np=1
c ------ cstes
c      yyw=ne.eq.2.and.
c     *it4(1).eq.3.and.
c     *it4(2).eq.7.and.
c     *ip4(1).eq.2.and.
c     *ip4(2).eq.4
            if(yyw)open(98,status='unknown',file='detn',form='formatted'
     &      )
            if(yyw)write(98,*)'it4',it4
            if(yyw)write(98,*)'ip4',ip4
            if(yyw)write(6,*)'it4',it4
            if(yyw)write(6,*)'ip4',ip4
c ------ cstes
            if(yyw)write(98,'(f12.8,a10)')sttpp,'sttpp'
            if(yyw)write(98,'(f12.8,a10)')stpp,'stpp'
            if(yyw)write(98,'(f12.8,a10)')spp,'spp'
            hii=hii+sttpp+stpp+spp
c CAS
c        ajout tv
            do k1=1,ne
               hii=hii-sttvpp(it4(k1))-stvpp(it4(k1))
               if(yyw)write(98,'(f12.8,a55)')-sttvpp(it4(k1)),'-sttvpp(i
     &         t4(k1))'
               if(yyw)write(98,'(f12.8,a55)')-stvpp(it4(k1)),'-stvpp(it4
     &         (k1))'
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii+stvtvpp(it4(k1),it4(k2))
                  if(yyw)write(98,'(f12.8,a55)')stvtvpp(it4(k1),it4(k2))
     &            ,
     *            'stvtvpp(it4(k1),it4(k2))'
               enddo
            enddo
c ------ epv : 1 dimension : 1p
            hii=hii-sttppv(ip4(1))-stppv(ip4(1))-sppv(ip4(1))
            if(yyw)write(98,'(f12.8,a55)')-sttppv(ip4(1)),'-sttppv(ip4(1
     &      ))'
            if(yyw)write(98,'(f12.8,a55)')-stppv(ip4(1)),'-stppv(ip4(1))
     &      '
            if(yyw)write(98,'(f12.8,a55)')-sppv(ip4(1)),'-sppv(ip4(1))'
c CAS
c        ajout de tv
            do k1=1,ne
               hii=hii+sttvppv(it4(k1),ip4(1))+stvppv(it4(k1),ip4(1))
               if(yyw)write(98,'(f12.8,a55)')sttvppv(it4(k1),ip4(1)),
     *         'sttvppv(it4(k1),ip4(1))'
               if(yyw)write(98,'(f12.8,a55)')+stvppv(it4(k1),ip4(1)),
     *         '+stvppv(it4(k1),ip4(1))'
c           ajout de tvtv
               do k2=k1+1,ne
                  hii=hii-stvtvppv(it4(k1),it4(k2),ip4(1))
                  if(yyw)write(98,'(f12.8,a55)')-stvtvppv(it4(k1),it4(k2
     &            ),ip4(1)),
     *            '-stvtvppv(it4(k1),it4(k2),ip4(1))'
               enddo
            enddo
            if(yyw)write(98,'(f12.8,a55)')hii,'hii'
         endif
      endif
      return
      end
       function fv(stvtvpvpv,jt1,jt2,jp1,jp2)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      real*4 fv
      parameter(maxsym=8)
      include 'maxorb.prm'
      common/csc2/ nicdi,nv2,norbs,nocas,nvs,ii28,itptp1,itptp2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
c      real*4 stvtvpvpv(nocz*(nocz+1)/2,nvz*(nvz+1)/2)
      real*4 stvtvpvpv(ii28)
      yw=.false.
      it1=max0(jt1,jt2)
      it2=min(jt1,jt2)
      ip1=max0(jp1,jp2)
      ip2=min(jp1,jp2)
      if(yw)
     *write(6,'('' fv noca,nocb,nv2,nv2b'',4i6)')noca,nocb,nv2,nv2b
      if(yw)write(6,'('' fv1 it1,it2,ip1,ip2'',4i6)')it1,it2,ip1,ip2
      nv2b=norb-nocb
      fv=0.
      if(it1.gt.noca.and.ip1.le.nv2) return
      if(it1.le.noca.and.ip1.gt.nv2) return
      if(it2.gt.noca.and.ip2.le.nv2) return
      if(it2.le.noca.and.ip2.gt.nv2) return
      if(it1.gt.noca) then
         it1=it1-noca
         ip1=ip1-nv2
         if(ip1.le.0) return
         if(it2.gt.noca) then
c           D+ tout beta
            it2=it2-noca
            ip2=ip2-nv2
            if(ip2.le.0) return
            itp=(it1-2)*(it1-1)/2+it2+(nocb*(nocb-1)/2)*
     *      ((ip1-2)*(ip1-1)/2+ip2-1)
     *      +itptp2
         else
c           D+ alpha beta
c            it1=jt1
c            it2=jt2
c            ip1=jp1
c            ip2=jp2
c            if(it1.gt.noca) it1=it1-noca
c            if(it2.gt.noca) it2=it2-noca
c            if(ip1.gt.nv2) ip1=ip1-nv2
c            if(ip2.gt.nv2) ip2=ip2-nv2
c            if(ip2.gt.nv2) return
c             if(it1.gt.noca.or.it2.gt.nv2) stop 'h_cii'
            itp=it2+(it1-1)*noca+(ip2-1)*noca*nocb+(ip1-1)*noca*nocb*nv2
     *      +itptp1
         endif
      else
         if(ip1.gt.nv2) return
c        D+ tout alpha
         itp=(it1-2)*(it1-1)/2+it2+(noca*(noca-1)/2)*
     *   ((ip1-2)*(ip1-1)/2+ip2-1)
      endif
      if(yw)write(6,'('' fv2 it1,it2,ip1,ip2'',4i6)')it1,it2,ip1,ip2
      if(yw)write(6,'('' fv itp'',i6)')itp
c     itt=it1*(it1-1)/2+it2
c     ipp=ip1*(ip1-1)/2+ip2
c     print*,'fv jt1,jt2,jp1,jp2',jt1,jt2,jp1,jp2
c     print*,'fv it1,it2,ip1,ip2,itp',it1,it2,ip1,ip2,itp
c     fv=stvtvpvpv(itt,ipp)
      fv=stvtvpvpv(itp)
      if(abs(fv).gt.100.d0) then
         print*,'itp',itp
         print*,'it1,it2,ip1,ip2',it1,it2,ip1,ip2
         print*,'fv',fv
         print*,'ii28,itptp1,itptp2',ii28,itptp1,itptp2
         print*,'noca,nocb,nv2b',noca,nocb,nv2b
         print*,'fv jt1,jt2,jp1,jp2',jt1,jt2,jp1,jp2
         stop
      endif
      return
      end
