      subroutine stoecr(i1)
      use mod_casdint
      IMPLICIT REAL*8(A-H,O-x,z),logical*1(y)
      character(80) :: name
      yw=.false.
      open(99,form='unformatted',file=stoname(i1),status='old',
     *access='DIRECT',recl=max_stoind*12)
      inquire(99,name=name)
      if(yw)print*,'name ',name
      !do
      !   read(99,end=1)
      !   print*,'lect 99'
      !enddo
 1    continue
      long=min(max_stolong(i1),max_stoind)
      sto_pointer(i1)=sto_pointer(i1)+1
      write(99,rec=sto_pointer(i1)) stoad(1:long,i1),stoint(1:long,i1)
      close(99)
      if(yw)print*,'write(99)',i1
      if(yw) then
         print*,'*****************stoecr',i1
         do k=1,max_stolong(i1)
            print*,'stoecr',k,stoint(k,i1),stoad(k,i1)
         enddo
      endif
      return
      end
