Re: busting sp datatypes

"Richard Maine" <nospam@xxxxxxxxxxxxx> wrote in message
news:1imfh28.sw7q2dj88rkN%nospam@xxxxxxxxxxxxxxxx

LR <lruss@xxxxxxxxxxxxx> wrote:

Ok, thanks for that. So is there a nice way to sort character*7 calling
C's qsort from Fortran?

I haven't thought much about it. I wouldn't normally use C's qsort
anyway. Probably C_LOC is the simplest way. Note that this is not like
the other recent thread where C_LOC was suggested as a way to avoid
array descriptor passing. In that case, C_LOC was just a confusing and
unhelpful diversion. TYpe cheating is a different matter.

Possible implementation:

C:\gcc_mingw64a\clf\qsort>type qsort.f90
module funcs
implicit none
integer, private :: my_len = 7
interface
subroutine qsort(BasePtr, NoOfElements, Width, cmp_func) bind(C)
use ISO_C_BINDING
! import my_cmp_func ! doesn't work
type(C_PTR), value :: BasePtr
integer(C_SHORT), value :: NoOfElements
integer(C_SHORT), value :: Width
interface
function cmp_func(elem1, elem2) bind(C)
use ISO_C_BINDING
integer(C_LONG) cmp_func
type(C_PTR), value :: elem1
type(C_PTR), value :: elem2
end function cmp_func
end interface
! procedure(my_cmp_func) cmp_func ! doesn't work
end subroutine qsort
end interface
contains
function my_cmp_func(elem1, elem2) bind(C)
use ISO_C_BINDING
integer(C_LONG) my_cmp_func
type(C_PTR), value :: elem1
type(C_PTR), value :: elem2
character(my_len), pointer :: p1
character(my_len), pointer :: p2

call C_F_POINTER(elem1, p1)
call C_F_POINTER(elem2, p2)
if(p1 < p2) then
my_cmp_func = -1
else if(p1 == p2) then
my_cmp_func = -0
else ! p1 > p2
my_cmp_func = 1
end if
end function my_cmp_func
end module funcs

program test
use funcs
use ISO_C_BINDING
implicit none
integer, parameter :: prog_len = 7
integer(C_SHORT) NoOfElements
character(prog_len), target, allocatable :: jabberwocky(:)
integer(C_SHORT) Width

NoOfElements = 22
Width = prog_len
allocate(jabberwocky(NoOfElements))
jabberwocky = [character(prog_len) :: "beware", "the", "jabberwock", &
"my", "son", "the", "jaws", "that", "bite", "the", "claws" , &
"that", "catch", "beware", "the", "jubjub", "bird", "and", "shun", &
"the", "frumious", "bandersnatch"]
write(*,'(10(a:1x))') jabberwocky
call qsort(C_LOC(jabberwocky(1)(1:1)),NoOfElements,Width,my_cmp_func)
write(*,'(/10(a:1x))') jabberwocky
end program test

C:\gcc_mingw64a\clf\qsort>x86_64-pc-mingw32-gfortran qsort.f90 -oqsort

C:\gcc_mingw64a\clf\qsort>qsort
beware the jabberw my son the jaws that bite the
claws that catch beware the jubjub bird and shun the
frumiou banders

and banders beware beware bird bite catch claws frumiou
jabberw
jaws jubjub my shun son that that the the the
the the

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end


.

Relevant Pages

  • Re: Lewis Carroll - was:Ring of Truth - was: Take it to emai - Was: Monsieur Jaggers
    ... One ring to rule them all...and in the Darkness bind them. ... I did beware, but he snuck up behind me, and that's why I am what I am today. ... The Jabberwocky turned you into a retired French teacher with a passion for old coppers? ...
    (rec.collecting.coins)
  • Re: check
    ... like a little sound-check banter;o) ... I used to use "Jabberwocky", ... didn't know it and the nonsense words weren't very useful for ... "Beware the Jabberwock, my son! ...
    (rec.audio.pro)
  • Re: busting sp datatypes
    ... subroutine qsort(BasePtr, NoOfElements, Width, cmp_func) bind ... function cmp_func(elem1, elem2) bind ... end interface ...
    (comp.lang.fortran)
  • Re: WET Jabberwocky
    ... Outstanding Martin, enjoyed this to the max. Beware the JABBERWOCKY! ... To view my next WET please click on this illustration. ...
    (microsoft.public.windows.inetexplorer.ie6_outlookexpress.stationery)
  • Re: Ring of Truth - was: Take it to emai - Was: Monsieur Jaggers
    ... doesn't mean there isn't a ring of truth to it. ... Beware the Jabberwocky... ...
    (rec.collecting.coins)