- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
When I read the QSORT doc I wondered if there were a way to do a derived type qsort. Anyway, how crazy is this:
!x86 not x64
! xsortf.f90 ! ! FUNCTIONS: ! xsortf - Entry point of console application. ! !**************************************************************************** ! ! PROGRAM: xsortf ! ! PURPOSE: Entry point for the console application. ! !**************************************************************************** module mrecf use kernel32 use iso_c_binding implicit none integer, save, volatile :: lv type recf integer :: i double precision :: d integer :: t integer :: v end type recf contains subroutine Zrecf(this) ! recf constructor type (recf), intent (out) :: this this%i = -1 this%d = 0.0 this%t = -1 this%v = interlockedexchangeadd(LOC(lv),1) end subroutine Zrecf function comp_recf(i0,i1) result(i2comp) integer*2 :: i2comp TYPE(recf), pointer, intent(in) :: i0 TYPE(recf), pointer, intent(in) :: i1 !Negative if arg1 should precede arg2 !Zero if arg1 is equivalent to arg2 !Positive if arg1 should follow arg2 if (i0%i < i1%i) then i2comp=-1 elseif (i0%i == i1%i) then if (i0%t < i1%t) then i2comp=-1 else if (i0%t == i1%t) then if (i0%v < i1%v) then i2comp=-1 ! not ever equal elseif (i0%v > i1%v)then i2comp=1 else i2comp=0 endif else i2comp=1 endif else i2comp=1 endif ! end function comp_recf end module mrecf program xsortf use mrecf implicit none ! Variables integer, parameter :: nrecs = 256 integer, parameter :: nirecs = 8 integer, parameter :: ntrecs = 512 double precision, parameter :: dmax = 1000.0 type(recf), dimension(:), pointer :: arecf integer*4, dimension(:), pointer :: airecf_sort type(recf), dimension(:), pointer :: arecf_sort real, dimension(:), pointer :: arrecf integer :: ix type(recf) ::t pointer (p,t) !integer ! Body of xsortf allocate(arecf(nrecs)) allocate(airecf_sort(nrecs)) allocate(arecf_sort(nrecs)) allocate(arrecf(nrecs)) do ix=1,nrecs call zrecf(arecf(ix)) call random_number(arrecf(ix)) arecf(ix)%i = int(real(nirecs)*arrecf(ix)) call random_number(arrecf(ix)) arecf(ix)%d = dmax*arrecf(ix) call random_number(arrecf(ix)) arecf(ix)%t = int(real(ntrecs)*arrecf(ix)) end do do ix=1,nrecs print *, arecf(ix)%i, arecf(ix)%d, arecf(ix)%t, arecf(ix)%v end do do ix=1,nrecs airecf_sort(ix)=LOC(arecf(ix)) end do call qsort(airecf_sort, nrecs, 4, comp_recf) do ix=1,nrecs p=airecf_sort(ix) arecf_sort(ix)= t end do print *,'Sorted:' do ix=1,nrecs print *,arecf_sort(ix)%i, arecf_sort(ix)%d, arecf_sort(ix)%t, arecf_sort(ix)%v end do end program xsortf
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This works on both x86 and x64:
!**************************************************************************** ! ! PROGRAM: xsortf ! ! PURPOSE: Entry point for the console application. ! !**************************************************************************** module mrecf use kernel32 use iso_c_binding implicit none integer, save, volatile :: lv type recf integer :: i double precision :: d integer :: t integer :: v end type recf contains subroutine Zrecf(this) ! recf constructor type (recf), intent (out) :: this this%i = -1 this%d = 0.0 this%t = -1 this%v = interlockedexchangeadd(LOC(lv),1) end subroutine Zrecf function comp_recf(i0,i1) result(i2comp) integer*2 :: i2comp TYPE(recf), pointer, intent(in) :: i0 TYPE(recf), pointer, intent(in) :: i1 integer(pointer_len) :: precf0 integer(pointer_len) :: precf1 !Negative if arg1 should precede arg2 !Zero if arg1 is equivalent to arg2 !Positive if arg1 should follow arg2 precf0=loc(i0) precf1=loc(i1) if (i0%i < i1%i) then i2comp=-1 elseif (i0%i == i1%i) then if (i0%t < i1%t) then i2comp=-1 else if (i0%t == i1%t) then if (i0%v < i1%v) then i2comp=-1 ! not ever equal elseif (i0%v > i1%v)then i2comp=1 else i2comp=0 endif else i2comp=1 endif else i2comp=1 endif ! end function comp_recf end module mrecf program xsortf use mrecf implicit none ! Variables integer, parameter :: nrecs = 256 integer, parameter :: nirecs = 8 integer, parameter :: ntrecs = 512 double precision, parameter :: dmax = 1000.0 integer(pointer_len), parameter :: ipl_len = pointer_len integer(pointer_len), parameter :: ipl_sz = nrecs integer :: iplen = 0 type(recf), dimension(:), pointer :: arecf integer(pointer_len), dimension(:), pointer :: airecf_sort !integer, dimension(:), pointer :: airecf_sort type(recf), dimension(:), pointer :: arecf_sort real, dimension(:), pointer :: arrecf integer :: ix type(recf) ::t pointer (p,t) !integer ! Body of xsortf allocate(arecf(nrecs)) allocate(airecf_sort(nrecs)) allocate(arecf_sort(nrecs)) allocate(arrecf(nrecs)) do ix=1,nrecs call zrecf(arecf(ix)) call random_number(arrecf(ix)) arecf(ix)%i = int(real(nirecs)*arrecf(ix)) call random_number(arrecf(ix)) arecf(ix)%d = dmax*arrecf(ix) call random_number(arrecf(ix)) arecf(ix)%t = int(real(ntrecs)*arrecf(ix)) end do do ix=1,nrecs print *, arecf(ix)%i, arecf(ix)%d, arecf(ix)%t, arecf(ix)%v end do do ix=1,nrecs airecf_sort(ix)=LOC(arecf(ix)) end do iplen=pointer_len !call qsort(airecf_sort, nrecs, pointer_len, comp_recf) call qsort(airecf_sort, ipl_sz, ipl_len, comp_recf) do ix=1,nrecs p=airecf_sort(ix) arecf_sort(ix)= t end do print *,'Sorted:' do ix=1,nrecs print *,arecf_sort(ix)%i, arecf_sort(ix)%d, arecf_sort(ix)%t, arecf_sort(ix)%v end do end program xsortf
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This isn't much different from the example in the ifort documentation on QSORT, though I was initially puzzled in that the documentation has you create an alternate interface whose external procedure is _qsort (this example hasn't been updated for x64!) You're not using module IFPORT so you get a symbol named QSORT which happens to be defined in libifport.lib. The documentation warns against unintentionally linking to the C library's qsort (I haven't looked to see what its external name is) as the interface is different.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I left the ifport out by mistake and went after making a multi- key sort which I thought the fortran qsort would not do. Can it use different members of a derived type to sort? Also, I have not yet found docs on the qsort I used.
if the last print statement is changed to
print * ,arecf_sort(ix)%i, arecf_sort(ix)%t, arecf_sort(ix)%v, arecf_sort(ix)%d
the sort is easier to see.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
It would appear 'use kernel32' caused problem. First error with ifport was pointer_len multiple definition. Below is code without kernel32:
module mrecfq use ifport !use kernel32 use iso_c_binding implicit none integer, save, volatile :: lv type recf integer :: i double precision :: d integer :: t integer :: v end type recf contains subroutine Zrecf(this) ! recf constructor type (recf), intent (out) :: this this%i = -1 this%d = 0.0 this%t = -1 !this%v = interlockedexchangeadd(LOC(lv),1) this%v = lv lv=lv+1 end subroutine Zrecf function comp_recf(i0,i1) result(i2comp) integer*2 :: i2comp TYPE(recf), pointer, intent(in) :: i0 TYPE(recf), pointer, intent(in) :: i1 integer(pointer_len) :: precf0 integer(pointer_len) :: precf1 !Negative if arg1 should precede arg2 !Zero if arg1 is equivalent to arg2 !Positive if arg1 should follow arg2 precf0=loc(i0) precf1=loc(i1) if (i0%i < i1%i) then i2comp=-1 elseif (i0%i == i1%i) then if (i0%t < i1%t) then i2comp=-1 else if (i0%t == i1%t) then if (i0%v < i1%v) then i2comp=-1 ! not ever equal elseif (i0%v > i1%v)then i2comp=1 else i2comp=0 endif else i2comp=1 endif else i2comp=1 endif ! end function comp_recf end module mrecfq program xsortfq use mrecfq implicit none ! Variables integer, parameter :: nrecs = 256 integer, parameter :: nirecs = 8 integer, parameter :: ntrecs = 512 double precision, parameter :: dmax = 1000.0 integer(pointer_len), parameter :: ipl_len = pointer_len integer(pointer_len), parameter :: ipl_sz = nrecs integer :: iplen = 0 type(recf), dimension(:), pointer :: arecf integer(pointer_len), dimension(:), pointer :: airecf_sort !integer, dimension(:), pointer :: airecf_sort type(recf), dimension(:), pointer :: arecf_sort real, dimension(:), pointer :: arrecf integer :: ix type(recf) ::t pointer (p,t) !integer ! Body of xsortf allocate(arecf(nrecs)) allocate(airecf_sort(nrecs)) allocate(arecf_sort(nrecs)) allocate(arrecf(nrecs)) do ix=1,nrecs call zrecf(arecf(ix)) call random_number(arrecf(ix)) arecf(ix)%i = int(real(nirecs)*arrecf(ix)) call random_number(arrecf(ix)) arecf(ix)%d = dmax*arrecf(ix) call random_number(arrecf(ix)) arecf(ix)%t = int(real(ntrecs)*arrecf(ix)) end do do ix=1,nrecs print *, arecf(ix)%t, arecf(ix)%i, arecf(ix)%d, arecf(ix)%v end do do ix=1,nrecs airecf_sort(ix)=LOC(arecf(ix)) end do iplen=pointer_len !call qsort(airecf_sort, nrecs, pointer_len, comp_recf) call qsort(airecf_sort, ipl_sz, ipl_len, comp_recf) do ix=1,nrecs p=airecf_sort(ix) arecf_sort(ix)= t end do print *,'Sorted:' do ix=1,nrecs print * ,arecf_sort(ix)%i, arecf_sort(ix)%t, arecf_sort(ix)%v, arecf_sort(ix)%d end do end program xsortfq
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I would crash all x64 until qsort was called with integer('pointer_len) variables explicitly declared for len and isize in QSORT (array,len,isize,compar).
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I wonder if the QSORT without ifport is the c crt:
https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/qsort?view=vs-2019
but intel c/c++ version?
It looks like the fortran one as c.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I wondered that too, but QSORT in uppercase, which is what you get (unless you compiled with options you didn't show) is resolved from the IFPORT library. IFPORT declares a generic QSORT with entries for various intrinsic data types. Yes, you need to use 64-bit length and size on x64.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
xsortf, using kernel32(no ifport), x86
_QSORT 0040524a f libifportmd:libifportMD.dll
xsortf, using kernel32(no ifport), x64
__imp_QSORT 000000014000b248 libifportmd:libifportMD.dll
xsortfq, using ifport, x86
_QSORT 00405244 f libifportmd:libifportMD.dll
xsortfq, using ifport, x64
__imp_QSORT 000000014000a1b0 libifportmd:libifportMD.dll

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page