QSORT

Developer Guide and Reference

Download PDF

ID 767251

Date 10/31/2024

Version

Public

Visible to Intel only — GUID: GUID-B235E210-3449-4003-A455-6E20DD56D52C

View Details

QSORT

Portability Subroutine: Performs a quick sort on an array of rank one.

Module

USE IFPORT

CALL QSORT (array,len,isize,compar)

array	(Input) Any type except assumed-length character. A one-dimensional array to be sorted. If the data type does not conform to one of the predefined interfaces for QSORT, you may have to create a new interface (see Note and Example below).
len	(Input) INTEGER(8). Number of elements in array.
isize	(Input) INTEGER(8). Size, in bytes, of a single element of array: 4 if array is of type REAL(4) 8 if array is of type REAL(8) or complex 16 if array is of type COMPLEX(8)
compar	(Input) INTEGER(2). Name of a user-defined ordering function that determines sort order. The type declaration of compar takes the form: INTEGER(2) FUNCTION `compar`(`arg1`, `arg2`) where `arg1` and `arg2` have the same type as array (above) and are not assumed-length character. Assume-length characters should be wrapped in a derived type. After you have created an ordering scheme, implement your sorting function so that it returns the following: Negative if arg1 should precede arg2 Zero if arg1 is equivalent to arg2 Positive if arg1 should follow arg2 Dummy argument compar must be declared as external. In place of an INTEGER kind, you can specify the constant SIZEOF_SIZE_T, defined in `IFPORT.F90`, for argument len or isize. Use of this constant ensures correct compilation.

NOTE:

If you use QSORT with different data types, your program must have a USE IFPORT statement so that all the calls work correctly. In addition, if you wish to use QSORT with a derived type or a type that is not in the predefined interfaces, you must include an overload for the generic subroutine QSORT. Examples of how to do this are in the portability module's source file, IFPORT.F90.

Example


! program showing how to call 'QSORT' on
! a user-defined type.
!
! Define the type to be shared.
!
module share_type
    type element_type
        integer       :: data
        character(10) :: key
    end type
end module

! Main program calls QSORT.
!
program main

    use, intrinsic :: iso_c_binding, only: c_size_t
    use IFPORT       ! To get QSORT
    use share_type   ! To get shared type

    ! Define an overload of the default QSORT signature
    ! with a signature using the shared type.
    !
    interface
        subroutine QSORT_element_types(array, len, isize, comp)
           use, intrinsic :: iso_c_binding, only:c_size_t
           use share_type
           type(element_type) array(len)
           integer(C_SIZE_T) len, isize
           integer(2), external :: comp
           !
           ! Hook the overload to the real thing but be careful
           ! to connect to the correct qsort: the Fortran one, not
           ! the C one!
           !
           ! We need to call the _Fortran_ qsort, not the _C_ one, or
           ! there will be errors from the 1-origin vs. 0-origin indexing
           ! and the row-major vs. column-major ordering.
           !
           ! The symptom is that "OrderCharCI" is called with pointer values
           ! which are outside the bounds of the array to be sorted.
           !
           !DIR$ IF DEFINED(_WIN64)
           !DIR$ ATTRIBUTES ALIAS:'QSORT' :: QSORT_element_types
           !DIR$ ELSE
           !DIR$ ATTRIBUTES ALIAS: '_QSORT' :: QSORT_element_types
           !DIR$ ENDIF
        end subroutine QSORT_element_types
    end interface

    type(element_type) :: c(7)

    integer(2), external :: OrderCharCI

    integer (C_SIZE_T) :: size_of_element, size_of_array
    ! Fill in the array to be sorted.  The data value is chosen so
    ! that the sorted array will have the values in numeric order.
    ! Thus we can check the result of the sort.
    !
    c(1)%key  = 'aisjdop'
    c(1)%data = 3
    c(2)%key  = '35djf2'
    c(2)%data = 1
    c(3)%key  = 'ss:ss'
    c(3)%data = 6
    c(4)%key  = 'MMhQQ'
    c(4)%data = 4
    c(5)%key  = 'mmHqq'
    c(5)%data = 5
    c(6)%key  = 'aaaa'
    c(6)%data = 2
    c(7)%key  = '["\/'
    c(7)%data = 7

    size_of_array   = size(c)         !  7
    size_of_element = sizeof(c(1))    ! 16

    write(*,*) '"C" is:'
    do i = 1, 7
        write(*,*) ' "', c(i)%key, '" value ', c(i)%data
    end do

    write(*,*) ' '
    write(*,*) 'size of C is            ', size_of_array, ' elements'
    write(*,*) 'size of element C(1) is ', size_of_element, ' bytes'
    write(*,*) 'len of key in C(1) is   ',   len(c(1)%key)
    write(*,*) ' '

    ! Call the overloaded QSORT routine.
    !
    Call QSort_element_types(C, size_of_array, size_of_element, OrderCharCI)

    write(*,*) 'Sorted "C" is '
    do i = 1, 7
         write(*,*) ' "', c(i)%key, '" value ', c(i)%data
    end do

end program main

! Computes order of character strings using a case insensitive ordering.
!
! Return -1 if C1 before C2, 0 if C1 = C2, and 1 if C1 after C2.
!
! Called first with the pair (2,3), then (1,2), then (1,3)...when passing
! character strings of length 10.
!
! Passing "element_type" objects, it's called first with the pair (1, <invalid>),
! and the second item has a address well before the beginning of "C".
!

function OrderCharCI(c1, c2)
    use share_type

    implicit none

    type(element_type), intent(in) :: c1 ! Character strings to be ordered.
    type(element_type), intent(in) :: c2 !

    ! Function result:
    !
    integer(2) :: OrderCharCI

    ! Locals:
    !
    character(10) :: c1L !} Local copies of c1 and c2.
    character(10) :: c2L !}

    integer :: i ! Loop index.

    write(*,*)'OrderCharCI, parameter C1 is "', c1%key, '" ', c1%data, ', len is ', len(c1%key)
    write(*,*)' len_trim is ', len_trim(c1%key)
    write(*,*) ' '
    
    ! SEGV on access to C2
    !
    write(*,*)'OrderCharCI, parameter C2 is "', c2%key, '" ', c2%data, ', len is ', len(c2%key)
    write(*,*)' len_trim is ', len_trim(c2%key)
    write(*,*) ' '
    c1L = c1%key
    c2L = c2%key

    write(*,*) 'about to start do loop'

    do i = 1, len_trim(C1L)
        if ('a' <= C1L(i:i) .and. c1L(i:i) <= 'z') c1L(i:i) = char(ichar(c1L(i:i)) - ichar('a') + ichar('A'))
    end do
    do i = 1, len_trim(C2L)
        if ('a' <= c2L(i:i) .and. c2L(i:i) <= 'z') c2L(i:i) = char(ichar(c2L(i:i)) - ichar('a') + ichar('A'))
    end do
    if (c1L == c2L) Then
        OrderCharCI = 0
        write(*,*) ' - equal'
    else if (c1L < c2L) Then
        OrderCharCI = -1
        write(*,*) ' - c1 is less'
    else
        OrderCharCI = 1
        write(*,*) ' - c1 is more'
    end if
end function OrderCharCI

The following shows another example:


 PROGRAM SORTQ
    use, intrinsic :: iso_c_binding, only: c_size_t
    use IFPORT
    integer(2), external :: cmp_function
    integer(2) insort(26), i
    integer (C_SIZE_T) array_len, array_size
    array_len = 26
    array_size = 2
    do i=90,65,-1
      insort(i-64)=91 - i
    end do
    print *, "Before: "
    print *,insort
    CALL qsort(insort,array_len,array_size,cmp_function)
    print *, 'After: '
    print *, insort
 END
 !
    integer(2) function cmp_function(a1, a2)
    integer(2) a1, a2
    cmp_function=a1-a2
    end function

Parent topic: Q to R

Select Your Language

Using Intel.com Search

Quick Links

Recent Searches

Advanced Search

Only search in

Developer Guide and Reference

QSORT

Module

Example