Program m01edfe
! M01EDF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: m01daf, m01edf, nag_wp, x04daf
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Integer :: i, ifail, j, k, m1, m2, n
Character (30) :: string
! .. Local Arrays ..
Complex (Kind=nag_wp), Allocatable :: cm(:,:)
Real (Kind=nag_wp), Allocatable :: cmod(:)
Integer, Allocatable :: irank(:)
! .. Intrinsic Procedures ..
Intrinsic :: abs
! .. Executable Statements ..
Write (nout,*) 'M01EDF Example Program Results'
Flush (nout)
! Skip heading in data file
Read (nin,*)
Read (nin,*) m2, n, k
If (k<1 .Or. k>n) Then
Go To 100
End If
Allocate (cm(m2,n),cmod(m2),irank(m2))
m1 = 1
Do i = m1, m2
Read (nin,*)(cm(i,j),j=1,n)
End Do
! Calculate the moduli of the elements in the K-th column.
Do i = m1, m2
cmod(i) = abs(cm(i,k))
End Do
! Rearrange the rows so that the elements in the K-th column
! are in ascending order of modulus.
ifail = 0
Call m01daf(cmod,m1,m2,'Ascending',irank,ifail)
! Rearrange each column into the order specified by IRANK.
Do j = 1, n
ifail = 0
Call m01edf(cm(m1,j),m1,m2,irank,ifail)
End Do
! Print the results.
Write (nout,*)
Write (string,99999) 'Matrix sorted on column', k
Flush (nout)
ifail = 0
Call x04daf('General',' ',m2-m1+1,n,cm(m1,1),m2,string,ifail)
100 Continue
99999 Format (1X,A,I3)
End Program m01edfe