PROGRAM f01vlfe ! F01VLF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dtfttp, 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, lenap, lenarf, n CHARACTER (21) :: title CHARACTER (1) :: transr, uplo ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: ap(:), arf(:) CHARACTER (1) :: clabs(1), rlabs(1) ! .. Executable Statements .. WRITE (nout,*) 'F01VLF Example Program Results' ! Skip heading in data file READ (nin,*) WRITE (nout,*) FLUSH (nout) READ (nin,*) n, uplo, transr lenap = (n*(n+1))/2 lenarf = lenap ALLOCATE (ap(lenap),arf(lenarf)) ! Read an RFP matrix into array ARF READ (nin,*) arf(1:lenarf) ! 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 packed vector form info = 0 ! The NAG name equivalent of dtfttp is f01vlf CALL dtfttp(transr,uplo,n,arf,ap,info) ! Print the packed vector title = 'Packed Array AP: ' ifail = 0 CALL x04cbf(matrix,diag,lenap,inc1,ap,lenap,form,title,intlabel,rlabs, & nolabel,clabs,ncols,indent,ifail) END PROGRAM f01vlfe