Untitled

program lab8
integer:: output_,seed,nl,nr,i,r,max_, key,k0,k1,j,p,min_,temp, e,m,p1,j1,j2,sp,usize
integer,dimension(:),allocatable:: arr(:)
integer,dimension(:),allocatable:: szp(:)
integer,dimension(:),allocatable:: karr(:)
integer,dimension(:),allocatable:: arr1(:),arr_right(:),arr_left(:), arr_end(:)
open(newunit=output_,file='lab8.2.txt',status='replace',action='write')
call srand(seed)
nl=1
nr=100
allocate(arr(nl:nr))
do i= nl,nr
    r=aint(rand()*10)
    arr(i)=r
end do
write(output_,'(a10)') 'key=='
read(*,*) key
write(output_,'(i3)') key
key=arr(key)
arr1=arr

write(output_,10) (arr(i),i=1,100)
10 format(10(2x,i3))
do i=nl,nr+1
  do j=i+1, nr
      k0=j
      if (arr1(i)==arr1(k0)) then
         do k1= k0,nr
           arr1(k1)=arr1(k1+1)
          end do
         nr=nr-1
         k0=k0-1
        end if
     end do
end do
do i=nl,nr+1
  do j=i+1,nr
      k0=j
      if (arr1(i)==arr1(k0)) then
         do k1= k0,nr
           arr1(k1)=arr1(k1+1)
          end do
         nr=nr-1
         k0=k0-1
        end if
     end do
end do
write(*,'(a70)') 'массив без повторяющихся элементов'
write(*,10) (arr1(i),i=1,nr)
write(output_,*) ''
allocate(karr(nl:nr))
nl=1
nr=10
usize=nr
m=1
e=10
p1=0
do
  write(*,*) 'arr1'
  write(*,10) arr1(nl:nr)
  p=(nr+1)/2
  write(*,*) 'p='
  write(*,10) p

  sp=arr1(p)
  m=1
 e=10
   do i= 1,usize+1
     if(sp>arr1(i)) then
        karr(nl+m)=arr1(i)
        m=m+1

       else  if  (sp<arr1(i)) then
            e=e-1
            karr(nl+e)=arr1(i)

       end if
    end do
   p1=nl+m
   karr(nl+e)=sp
   if (key==p1) then
      write(*,*) 'found',sp
      exit

    else  if (p1<key) then
       nl=p1
    else
       nr=nl+e
     end if
  usize=nr-nl+1
  arr1=karr(nl:nr)
  write(*,*) 'karr'
  write(*,10) karr(nl:nr)
end do
!write(output_,10) (arr_left(i),i=nl,nr)
!write(output_,*) ''
!write(output_,10) (arr_right(i),i=nl,nr)
write(*,'(a50)') 'отсорт массив'
write(*,10) (arr1(i),i=1,10)
deallocate(arr_left)
deallocate(arr1)


end program lab8