! M01DZF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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 ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: rv(:) INTEGER, ALLOCATABLE :: iv(:) CONTAINS FUNCTION compar(i,j) ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 nag_library, ONLY : m01dzf, m01zaf USE m01dzfe_mod, ONLY : compar, iv, nin, nout, rv ! .. 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