PROGRAM f01vgfe ! F01VGF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dtfttr, 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 :: ifail, info, lda, lenarf, n CHARACTER (21) :: title CHARACTER (1) :: transr, uplo ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), arf(:) CHARACTER (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. WRITE (nout,*) 'F01VGF Example Program Results' ! Skip heading in data file READ (nin,*) WRITE (nout,*) FLUSH (nout) READ (nin,*) n, uplo, transr lda = n lenarf = n*(n+1)/2 ALLOCATE (a(lda,n),arf(lenarf)) ! Read an RFP matrix into array ARF READ (nin,*) arf ! Print the Rectangular Full Packed array title = 'RFP Packed Array ARF:' ifail = 0 CALL x04cbf(matrix,diag,lenarf,inc1,arf,lenarf,form,title,intlabel, & rlabs,nolabel,clabs,ncols,indent,ifail) WRITE (nout,*) FLUSH (nout) ! Convert to triangular form info = 0 ! The NAG name equivalent of dtfttr is f01vgf CALL dtfttr(transr,uplo,n,arf,a,lda,info) ! Print the unpacked array ifail = 0 title = 'Unpacked Matrix A: ' ifail = 0 CALL x04cbf(uplo,diag,n,n,a,lda,form,title,intlabel,rlabs,intlabel, & clabs,ncols,indent,ifail) END PROGRAM f01vgfe