Sort_dble Subroutine

public subroutine Sort_dble(x, N)

Subroutine to perform an insertion sort on a vector (double)

Arguments

Type IntentOptional Attributes Name
real(kind=8), intent(inout) :: x(:)
integer, intent(in) :: N

Called by

proc~~sort_dble~~CalledByGraph proc~sort_dble Sort_dble interface~sort Sort interface~sort->proc~sort_dble proc~readraybearingangles ReadRayBearingAngles proc~readraybearingangles->interface~sort proc~readrayelevationangles ReadRayElevationAngles proc~readrayelevationangles->interface~sort proc~readvector ReadVector proc~readvector->interface~sort proc~readenvironment ReadEnvironment proc~readenvironment->proc~readraybearingangles proc~readenvironment->proc~readrayelevationangles proc~readrcvrbearings ReadRcvrBearings proc~readenvironment->proc~readrcvrbearings proc~readrcvrranges ReadRcvrRanges proc~readenvironment->proc~readrcvrranges proc~readsxsy ReadSxSy proc~readenvironment->proc~readsxsy proc~readszrz ReadSzRz proc~readenvironment->proc~readszrz proc~readrcvrbearings->proc~readvector proc~readrcvrranges->proc~readvector proc~readsxsy->proc~readvector proc~readszrz->proc~readvector program~bellhop BELLHOP program~bellhop->proc~readenvironment program~bellhop3d BELLHOP3D program~bellhop3d->proc~readenvironment

Source Code

  SUBROUTINE Sort_dble( x, N )
    !! Subroutine to perform an insertion sort on a vector (double)

    INTEGER, INTENT( IN )          :: N
    REAL (KIND=8), INTENT( INOUT ) :: x(:)
    REAL (KIND=8)                  :: xTemp

    IF ( N == 1 ) RETURN

    DO I = 2, N

       xTemp = x( I )

       IF ( xTemp < x( 1 ) ) THEN
          x( 2 : I ) = x( 1 : I - 1 )
          x( 1 )     = xTemp  ! goes in the first position
       ELSE IF ( xTemp < x( I - 1 ) ) THEN ! Binary search for its place

          IRight = I - 1
          ILeft  = 1

          DO WHILE ( IRight > ILeft + 1 )
             IMiddle = ( ILeft + IRight ) / 2
             IF ( xTemp < x( IMiddle ) ) THEN
                IRight = IMiddle
             ELSE
                ILeft  = IMiddle
             ENDIF
          END DO

          ! Shift and insert
          x( IRight + 1 : I ) = x( IRight : I - 1 )
          x( IRight ) = xTemp

       ENDIF

    END DO

  END SUBROUTINE Sort_dble