Untitled
unknown
fortran
a month ago
2.2 kB
2
Indexable
Never
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