program y275 implicit none integer(8)::N real(8),allocatable::A(:) read*,N allocate(A(N)) read*,A call heapsort(N,A) if(mod(N,2)==1)print*,A(N/2+1) if(mod(N,2)==0)print*,(A(N/2)+A(N/2+1))/2 end program y275 subroutine heapsort(n,array) implicit none integer(8),intent(in) :: n double precision,intent(inout) :: array(1:n) integer(8) ::i,k,j,l double precision :: t if(n.le.0)then write(6,*)"Error, at heapsort"; stop endif if(n.eq.1)return l=n/2+1 k=n do while(k.ne.1) if(l.gt.1)then l=l-1 t=array(L) else t=array(k) array(k)=array(1) k=k-1 if(k.eq.1) then array(1)=t exit endif endif i=l j=l+l do while(j.le.k) if(j.lt.k)then if(array(j).lt.array(j+1))j=j+1 endif if (t.lt.array(j))then array(i)=array(j) i=j j=j+j else j=k+1 endif enddo array(i)=t enddo return end subroutine heapsort