- 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