! M01DZF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
Module m01dzfe_mod
! M01DZF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: compar
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable, Public, Save :: rv(:)
Integer, Allocatable, Public, Save :: iv(:)
Contains
Function compar(i,j)
! .. Function Return Value ..
Logical :: compar
! .. Scalar Arguments ..
Integer, Intent (In) :: i, j
! .. Executable Statements ..
If (iv(i)/=iv(j)) Then
compar = iv(i) > iv(j)
Else
If (iv(i)<0) Then
compar = rv(i) < rv(j)
Else If (iv(i)>0) Then
compar = rv(i) > rv(j)
Else
compar = i < j
End If
End If
Return
End Function compar
End Module m01dzfe_mod
Program m01dzfe
! M01DZF Example Main Program
! .. Use Statements ..
Use m01dzfe_mod, Only: compar, iv, nin, nout, rv
Use nag_library, Only: m01dzf, m01zaf
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Integer :: i, ifail, m1, m2
! .. Local Arrays ..
Integer, Allocatable :: irank(:)
! .. Executable Statements ..
Write (nout,*) 'M01DZF Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) m2
Allocate (iv(m2),rv(m2),irank(m2))
m1 = 1
Read (nin,*)(iv(i),rv(i),i=m1,m2)
ifail = 0
Call m01dzf(compar,m1,m2,irank,ifail)
ifail = 0
Call m01zaf(irank,m1,m2,ifail)
Write (nout,*)
Write (nout,*) ' Data in sorted order'
Write (nout,*)
Write (nout,99999)(iv(irank(i)),rv(irank(i)),i=m1,m2)
Deallocate (iv,rv)
99999 Format (1X,I7,F7.1)
End Program m01dzfe