      subroutine ecry(ymat,long,ifil)
      IMPLICIT logical*1(y)
      dimension ymat(long)
      write(ifil) ymat
      return
      end
c**********************************************************************
       subroutine epv_ecr(nocz,nvz,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,ii28,stvtvpvpv)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      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)
c     real*4 stvtvpvpv(nocz*(nocz+1)/2,nvz*(nvz+1)/2)
      real*4 stvtvpvpv(ii28)
      ia(i)=i*(i-1)/2
C
c------------------------------------------------------------------
c     Ecriture des epv
c------------------------------------------------------------------
C
      open(97,form='formatted',file='habn',status='unknown')
      write(6,*)'sttpp ',sttpp,'sttp ',sttp,'stt ',stt,'stpp ',stpp,
     *'stp ',stp,'st ',st,'spp ',spp,'sp ',sp
c
      write(6,*)'--------------------------------------'
      write(97,*)'sttvpp',(sttvpp(k),k=1,nocz)
c      write(97,*)'sttvpp',(sttvpp(k),k=nocz+1,nocz*2)
      write(97,*)'stvpp',(stvpp(k),k=1,nocz)
c      write(97,*)'stvpp',(stvpp(k),k=nocz+1,nocz*2)
      write(97,*)'sttppv',(sttppv(k),k=1,nvz)
c      write(97,*)'sttppv',(sttppv(k),k=9+1,nvz*2)
      write(97,*)'stppv',(stppv(k),k=1,nvz)
c      write(97,*)'stppv',(stppv(k),k=nvz+1,nvz*2)
      write(97,*)'sppv',(sppv(k),k=1,nvz)
c      write(97,*)'sppv',(sppv(k),k=nvz+1,nvz*2)
      do k=1,nocz
         write(97,*)'sttvppv',(sttvppv(k,l),l=1,nvz)
      enddo
      print*,'stv ',(stv(k),k=1,nocz)
      print*,'spv ',(spv(k),k=1,nvz)
      print*,'sttv ',(sttv(k),k=1,nocz)
      print*,'sppv ',(sppv(k),k=1,nvz)
      print*,'stvp ',(stvp(k),k=1,nocz)
      print*,'stpv ',(stpv(k),k=1,nvz)
      print*,'sttvp ',(sttvp(k),k=1,nocz)
      print*,'sttpv ',(sttpv(k),k=1,nvz)
      print*,'stvpp ',(stvpp(k),k=1,nocz)
      print*,'stppv ',(stppv(k),k=1,nvz)
      print*,'sttvpp ',(sttvpp(k),k=1,nocz)
      print*,'sttppv ',(sttppv(k),k=1,nvz)
 
      print*,'stvtv ',stvtv
      print*,' stvpv     ',  stvpv
      print*,' spvpv     ',  spvpv
      print*,' sttvpv     ',  sttvpv
      print*,' stvtvp     ',  stvtvp
      print*,' stpvpv     ',  stpvpv
      print*,' stvppv     ',  stvppv
      print*,' stvtvpp     ',  stvtvpp
      print*,' sttvppv     ',  sttvppv
      print*,' sttpvpv     ',  sttpvpv
 
      print*,' stvtvpv     ',  stvtvpv
      print*,' stvpvpv     ',  stvpvpv
      print*,' stvtvppv     ',  stvtvppv
      print*,' sttvpvpv     ',  sttvpvpv
 
      print*,' stvtvpvpv     ',  stvtvpvpv
 
      open(99,status='unknown',file='inter')
      write(99,'(a15,200(4e10.4,/))')'stv ',stv
      write(99,'(a15,200(4e10.4,/))')'spv ',spv
      write(99,'(a15,200(4e10.4,/))')'sttv ',sttv
      write(99,'(a15,200(4e10.4,/))')'sppv ',sppv
      write(99,'(a15,200(4e10.4,/))')'stvp ',stvp
      write(99,'(a15,200(4e10.4,/))')'stpv ',stpv
      write(99,'(a15,200(4e10.4,/))')'sttvp ',sttvp
      write(99,'(a15,200(4e10.4,/))')'sttpv ',sttpv
      write(99,'(a15,200(4e10.4,/))')'stvpp ',stvpp
      write(99,'(a15,200(4e10.4,/))')'stppv ',stppv
      write(99,'(a15,200(4e10.4,/))')'sttvpp ',sttvpp
      write(99,'(a15,200(4e10.4,/))')'sttppv ',sttppv
 
      write(99,'(a15,200(4e10.4,/))')'stvtv ',stvtv
      write(99,'(a15,200(4e10.4,/))')' stvpv     ',  stvpv
      write(99,'(a15,200(4e10.4,/))')' spvpv     ',  spvpv
      write(99,'(a15,200(4e10.4,/))')' sttvpv     ',  sttvpv
      write(99,'(a15,200(4e10.4,/))')' stvtvp     ',  stvtvp
      write(99,'(a15,200(4e10.4,/))')' stpvpv     ',  stpvpv
      write(99,'(a15,200(4e10.4,/))')' stvppv     ',  stvppv
      write(99,'(a15,200(4e10.4,/))')' stvtvpp     ',  stvtvpp
      write(99,'(a15,200(4e10.4,/))')' sttvppv     ',  sttvppv
      write(99,'(a15,200(4e10.4,/))')' sttpvpv     ',  sttpvpv
 
      write(99,'(a15,200(4e10.4,/))')' stvtvpv     ',  stvtvpv
      write(99,'(a15,200(4e10.4,/))')' stvpvpv     ',  stvpvpv
      write(99,'(a15,200(4e10.4,/))')' stvtvppv     ',  stvtvppv
      write(99,'(a15,200(4e10.4,/))')' sttvpvpv     ',  sttvpvpv
 
      write(99,'(a15,200(4e10.4,/))')' stvtvpvpv     ',  stvtvpvpv
      close(99)
 
c        do k=nocz+1,nocz*2
c           write(97,*)'sttvppv',(sttvppv(k,l),l=nvz+1,nvz*2)
c        enddo
      close(97)
      write(6,*)'ect,ecp'
c ECT(IT11) ET ECT(IT22)
      do k=1,nocz
         it11=ia(k)+k
         write(6,'(a5,i4,f12.8,i4)')' ect',it11,sttvpp(k)+sttvp(k)
     *   +sttv(k)+stvpp(k)+stvp(k)+stv(k),k
      enddo
c ECP(IP11) ET ECP(IP22)
      do k=1,nvz
         it11=ia(k)+k
         write(6,'(a5,i4,f12.8,i4)')' ecp',it11,sttppv(k)+stppv(k)
     *   +sppv(k)+sttpv(k)+stpv(k)+spv(k),k
      enddo
      write(6,*)'ect(it12),ecp(ip12)'
c ECT(IT12)
      do k=1,nocz
         do k2=1,nocz
            if(k.gt.k2) then
               it12=ia(k)+k2
            else
               it12=ia(k2)+k
            end if
            ect=stvtvpp(k,k2)+stvtvp(k,k2)+stvtv(k,k2)
            if(ect.ne.0.d0)then
               write(6,'(a5,i4,f12.8,2i4)')' ect',it12,stvtvpp(k,k2)
     *         +stvtvp(k,k2)+stvtv(k,k2),k,k2
            endif
         enddo
      enddo
c ECP(IP12)
      do k=1,nvz
         do k2=1,nvz
            if(k.gt.k2) then
               it12=ia(k)+k2
            else
               it12=ia(k2)+k
            end if
            ecp=sttpvpv(k,k2)+stpvpv(k,k2)+spvpv(k,k2)
            if(ecp.ne.0.d0)then
               write(6,'(a5,i4,f12.8,2i4)')' ecp',it12,sttpvpv(k,k2)
     *         +stpvpv(k,k2)+spvpv(k,k2),k,k2
            endif
         enddo
      enddo
c ECTP
      do k2=1,nvz
         do k=1,nocz
            write(6,'(a5,2i4,f12.8,2i4)')' ectp',k,k2,sttvppv(k,k2)
     *      +sttvpv(k,k2)+stvppv(k,k2)+stvpv(k,k2),k,k2
         enddo
      enddo
c EOOV
      do k2=1,nvz
         do k1=1,nocz
            do k=1,nocz
               eoov=stvtvppv(k,k1,k2)+stvtvpv(k,k1,k2)
               if(eoov.ne.0.d0)then
                  if(k.gt.k1) then
                     it12=ia(k)+k1
                  else
                     it12=ia(k1)+k
                  end if
                  write(6,'(a5,2i4,f12.8,3i4)')' eoov',it12,k,
     *            stvtvppv(k,k1,k2)+stvtvpv(k,k1,k2),k,k1,k2
               endif
            enddo
         enddo
      enddo
c EOVV
      do k2=1,nvz
         do k1=1,nvz
            do k=1,nocz
               eovv=sttvpvpv(k,k1,k2)+stvpvpv(k,k1,k2)
               if(eovv.ne.0.d0)then
                  if(k1.gt.k2) then
                     it12=ia(k1)+k2
                  else
                     it12=ia(k2)+k1
                  end if
                  write(6,'(a5,2i4,f12.8,3i4)')' eovv',k,it12,
     *            sttvpvpv(k,k1,k2)+stvpvpv(k,k1,k2),k,k1,k2
               endif
            enddo
         enddo
      enddo
      return
      end
