program f90_SORT
    implicit none
    integer::nd=100000
    real(8),allocatable::datax(:),datay(:)
    integer::i
    real(4) :: t1,t2,dif1,dif2

    allocate(datax(1:nd),datay(1:nd))

    call random_number(datax)
    do i=1,nd
        datay(i)=datax(i)
    end do

    call cpu_time(t1)
    call BSORT(nd,datax)
    call cpu_time(t2)
    dif1=t2-t1

    call cpu_time(t1)
    call SSORT(nd,datay)
    call cpu_time(t2)
    dif2=t2-t1

    do i=1,nd
        write(6,*) datax(i),datay(i),datax(i)-datay(i)
    end do
    write(6,*) 'Bubble sort=',dif1,'(sec)'
    write(6,*) 'Shell  sort=',dif2,'(sec)'
    stop

contains
!---------------------------------------------------------------------------*/
    subroutine SSORT(nd,datat)
        integer,intent(in)::nd
        real(8),intent(inout)::datat(:)
        integer::i,kh,kv
        real(8)::temp

        kv=1
        do
            kv=3*kv+1
            if(nd<kv)exit
        end do
        do
            kv=kv/3
            do i=kv+1,nd
                temp=datat(i)
                kh=i
                do while(datat(kh-kv)>temp)
                    datat(kh)=datat(kh-kv)
                    kh=kh-kv
                    if(kh<kv)exit
                end do
                datat(kh)=temp
            end do
            if(kv==1)exit
        end do
    end subroutine SSORT
!---------------------------------------------------------------------------*/
    subroutine BSORT(nd,datat)
        ! Sorting in small order */
        integer,intent(in)::nd
        real(8),intent(inout)::datat(:)
        integer::i,j
        real(8)::work

        do i=1,nd
            do j=i+1,nd
                if(datat(i)>datat(j))then
                    work=datat(i)
                    datat(i)=datat(j)
                    datat(j)=work
                end if
            end do
        end do
    end subroutine BSORT
!---------------------------------------------------------------------------*/
end program f90_SORT