MODULE sort_ex04_mod ! .. Implicit None Statement .. IMPLICIT NONE ! .. Default Accessibility .. PUBLIC ! .. Intrinsic Functions .. INTRINSIC KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Arrays .. INTEGER, ALLOCATABLE :: a(:) REAL (wp), ALLOCATABLE :: b(:) CONTAINS FUNCTION compare(i,j) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. INTEGER, INTENT (IN) :: i, j ! .. Function Return Value .. LOGICAL :: compare ! .. Executable Statements .. IF (a(i)/=a(j)) THEN compare = a(i) > a(j) ELSE IF (a(i)<0) THEN compare = b(i) < b(j) ELSE IF (a(i)>0) THEN compare = b(i) > b(j) ELSE compare = i < j END IF END IF END FUNCTION compare END MODULE sort_ex04_mod PROGRAM nag_sort_ex04 ! Example Program Text for nag_sort ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_sort, ONLY : nag_invert_perm, nag_rank_arb_data USE sort_ex04_mod, ONLY : compare, a, b ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. INTEGER :: i, n ! .. Local Arrays .. INTEGER, ALLOCATABLE :: rank(:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_sort_ex04' WRITE (nag_std_out,*) READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n ALLOCATE (a(n),b(n),rank(n)) ! Allocate storage READ (nag_std_in,*) (a(i),b(i),i=1,n) ! Rank data CALL nag_rank_arb_data(compare,rank) ! Convert the ranks to indices CALL nag_invert_perm(rank) WRITE (nag_std_out,*) 'Data in sorted order' WRITE (nag_std_out,'(1X,I4,F6.1)') (a(rank(i)),b(rank(i)),i=1,n) DEALLOCATE (a,b,rank) ! Deallocate storage END PROGRAM nag_sort_ex04