PROGRAM f01vafe ! F01VAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dtrttp, nag_wp, x04cbf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: inc1 = 1, indent = 0, ncols = 80, & nin = 5, nout = 6 CHARACTER (1), PARAMETER :: diag = 'N', intlabel = 'I', & matrix = 'G', nolabel = 'N' CHARACTER (4), PARAMETER :: form = 'F5.2' ! .. Local Scalars .. INTEGER :: i, ifail, info, lda, lenap, n CHARACTER (18) :: title CHARACTER (1) :: uplo ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), ap(:) CHARACTER (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. WRITE (nout,*) 'F01VAF Example Program Results' ! Skip heading in data file READ (nin,*) WRITE (nout,*) FLUSH (nout) READ (nin,*) n, uplo lda = n lenap = (n*(n+1))/2 ALLOCATE (a(lda,n),ap(lenap)) ! Read a triangular matrix of order n DO i = 1, n READ (nin,*) a(i,1:n) END DO ! Print the unpacked matrix title = 'Unpacked Matrix A:' ifail = 0 CALL x04cbf(uplo,diag,n,n,a,lda,form,title,intlabel,rlabs,intlabel, & clabs,ncols,indent,ifail) WRITE (nout,*) FLUSH (nout) ! Convert to packed vector form info = 0 ! The NAG name equivalent of dtrttp is f01vaf CALL dtrttp(uplo,n,a,lda,ap,info) ! Print the packed vector title = 'Packed Matrix AP: ' ifail = 0 CALL x04cbf(matrix,diag,lenap,inc1,ap,lenap,form,title,intlabel,rlabs, & nolabel,clabs,ncols,indent,ifail) END PROGRAM f01vafe