# 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(4) on IA-32 architecture; INTEGER(8) on Intel® 64 architecture. Number of elements in array.
isize | (Input) INTEGER(4) on IA-32 architecture; INTEGER(8) on Intel® 64 architecture. 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