PROGRAM nag_sort_ex03 ! 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_write_mat, ONLY : nag_write_gen_mat USE nag_sort, ONLY : nag_check_perm, nag_rank_mat, nag_decomp_perm ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, j, k, l, m, n ! .. Local Arrays .. INTEGER, ALLOCATABLE :: cycles(:), rank(:), tmp(:) REAL (wp), ALLOCATABLE :: a(:,:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_sort_ex03' WRITE (nag_std_out,*) READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) m, n, l ALLOCATE (a(m,n),rank(n),cycles(n),tmp(m)) ! Allocate storage READ (nag_std_in,*) (a(i,:),i=1,m) ! Rank the matrix by row, in ascending order CALL nag_rank_mat(a(l:l,:),rank,row=.FALSE.) ! Check the validity of the permutation IF (nag_check_perm(rank)) THEN ! Decompose rank into cycles CALL nag_decomp_perm(rank,cycles) ! Rearrange matrix DO k = 1, n i = cycles(k) IF (i<0) THEN j = -i ELSE ! Swap columns i and j tmp = a(:,j) a(:,j) = a(:,i) a(:,i) = tmp END IF END DO CALL nag_write_gen_mat(a,format='F6.1',title='Matrix sorted on row 3') END IF DEALLOCATE (a,rank,cycles,tmp) ! Deallocate storage END PROGRAM nag_sort_ex03