      module mod_sto
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer(2),save :: ni(4096),nj(4096),nk(4096),nl(4096)
      double precision,save :: aa(4096)
      integer,save :: isto=0
      contains
       subroutine stoijkl(i,j,k,l,a,ifil)
      use mod_licost
      yw=.false.
      if(ycl) then
         ii=i
         jj=j
         kk=k
         ll=l
         call reor_ind_int(ii,jj,kk,ll)
         write(73,'(4i4,d20.12)') ii,jj,kk,ll,a
         return
      endif
      if(yw) print*,'ifil',ifil
      if(ifil==0) then
         isto=0
         return
      endif
      isto=isto+1
      if(isto>4096) then
         call filesplit('WRITE',ifil,65536,ichange,idum2)
         write(ifil)ni,nj,nk,nl,aa
         !do k=1,4096
         !print*,'wifil',ni(k),nj(k),nk(k),nl(k)
         !enddo
         isto=1
      endif
      ii=i
      jj=j
      kk=k
      ll=l
      call reor_ind_int(ii,jj,kk,ll)
      ni(isto)=ii
      nj(isto)=jj
      nk(isto)=kk
      nl(isto)=ll
      aa(isto)=a
      if(yw)print'(''sto_ijkl'',4i4,f12.8,i6)',ii,jj,kk,ll,a,isto
      return
      end subroutine
       subroutine stoijklf(ifil)
      use mod_licost
      yw=.false.
      if(ycl) return
      isto=isto+1
      if(isto>4096) then
         call filesplit('WRITE',ifil,65536,ichange,idum2)
         write(ifil)ni,nj,nk,nl,aa
         !do k=1,4096
         !print*,'Fifil',ni(k),nj(k),nk(k),nl(k)
         !enddo
         isto=1
      endif
      ni(isto)=0
      nj(isto)=0
      nk(isto)=0
      nl(isto)=0
      call filesplit('WRITE',ifil,65536,ichange,idum2)
      write(ifil)ni,nj,nk,nl,aa
      if(yw) print*,'ni,nj,nk,nl',ni,nj,nk,nl,aa
      return
      end subroutine
!       subroutine stomono(potnuc)
!      use mod_licost
!      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
!      double precision,allocatable :: h8(:)
!      allocate (h8(norb*(norb+1)/2))
!      rewind 26
!      do is=1,nsym
!         read(26) h8(1:isym(is))
!         ii=0
!         jj=sum(isym(1:is-1))
!         do i=1,isym(is)
!            do j=1,i
!               ii=ii+1
!               if(dabs(h8(i))>1.d-12)
!     *         write(73,'(4i4,d20.12)') jj+i,jj+j,0,0,h8(ii)
!            enddo
!         enddo
!      enddo
!      write(73,'(4i4,d20.12)') 0,0,0,0,potnuc
!      deallocate(h8)
!      return
!      end subroutine
       subroutine reor_ind_int(i,j,k,l)
      if(i<j) call ech(i,j)
      if(k<l) call ech(k,l)
      if(i<k) then
         call ech(i,k)
         call ech(j,l)
      else if(i==k) then
         if(j<l) call ech(j,l)
      endif
      return
      end subroutine
       subroutine ech(i,j)
      k=i
      i=j
      j=k
      return
      end subroutine
      end module
