Program f06wpfe ! F06WPF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: nag_wp, x04daf, ztfsm, ztrttf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Complex (Kind=nag_wp) :: alpha Integer :: i, ifail, info, lda, ldb, m, n Character (1) :: side, trans, transr, uplo ! .. Local Arrays .. Complex (Kind=nag_wp), Allocatable :: a(:,:), af(:), b(:,:), work(:) ! .. Executable Statements .. Write (nout,*) 'F06WPF 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 ztrttf is f01vef Call ztrttf(transr,uplo,m,a,lda,af,info) Write (nout,*) Flush (nout) ! The NAG name equivalent of ztfsm is f06wpf Call ztfsm(transr,side,uplo,trans,'N',m,n,alpha,af,b,ldb) Call x04daf('General',' ',m,n,b,ldb,'The Solution',ifail) End Program f06wpfe