Program f11mkfe ! F11MKF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f11mkf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Real (Kind=nag_wp), Parameter :: alpha = 1.E0_nag_wp Real (Kind=nag_wp), Parameter :: beta = 0.E0_nag_wp Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: i, ifail, j, ldb, ldc, m, n, nnz Character (1) :: trans ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:), b(:,:), c(:,:) Integer, Allocatable :: icolzp(:), irowix(:) ! .. Executable Statements .. Write (nout,*) 'F11MKF Example Program Results' ! Skip heading in data file Read (nin,*) ! Read order of matrix Read (nin,*) n, m ldb = n ldc = n Allocate (b(ldb,m),c(ldc,m),icolzp(n+1)) ! Read the matrix A Read (nin,*) icolzp(1:n+1) nnz = icolzp(n+1) - 1 Allocate (a(nnz),irowix(nnz)) Do i = 1, nnz Read (nin,*) a(i), irowix(i) End Do ! Read the matrix B Do j = 1, m Read (nin,*) b(1:n,j) End Do ! Calculate matrix-matrix product trans = 'N' ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 Call f11mkf(trans,n,m,alpha,icolzp,irowix,a,b,ldb,beta,c,ldc,ifail) ! Output results Write (nout,*) Flush (nout) Call x04caf('G',' ',n,m,c,ldc,'Matrix-matrix product',ifail) ! Calculate transposed matrix-matrix product trans = 'T' ifail = 0 Call f11mkf(trans,n,m,alpha,icolzp,irowix,a,b,ldb,beta,c,ldc,ifail) ! Output results Write (nout,*) Flush (nout) Call x04caf('G',' ',n,m,c,ldc,'Transposed matrix-matrix product',ifail) End Program f11mkfe