PROGRAM f06wbfe ! F06WBF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : dtfsm, dtrttf, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: alpha INTEGER :: i, ifail, info, lda, ldb, m, n CHARACTER (1) :: side, trans, transr, uplo ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:,:), af(:), b(:,:), work(:) ! .. Executable Statements .. WRITE (nout,*) 'F06WBF Example Program Results' ! Skip heading in data file READ (nin,*) READ (nin,*) m, n, uplo, transr, side, alpha, trans lda = m ldb = m ALLOCATE (a(lda,m),af((m*(m+1))/2),work(m),b(ldb,n)) ! Read upper or lower triangle of matrix A from data file IF (uplo=='L' .OR. uplo=='l') THEN DO i = 1, m READ (nin,*) a(i,1:i) END DO ELSE DO i = 1, m READ (nin,*) a(i,i:m) END DO END IF ! Read matrix B from data file READ (nin,*) (b(i,1:n),i=1,m) ! Convert A to rectangular full packed storage in AF ! The NAG name equivalent of dtrttf is f01vef CALL dtrttf(transr,uplo,m,a,lda,af,info) WRITE (nout,*) FLUSH (nout) ! Perform the matrix-matrix operation ! The NAG name equivalent of dtfsm is f06wbf CALL dtfsm(transr,side,uplo,trans,'N',m,n,alpha,af,b,ldb) ! Print the result ifail = 0 CALL x04caf('General',' ',m,n,b,ldb,'The Solution',ifail) END PROGRAM f06wbfe