Program f01ctfe ! F01CTF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f01ctf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: alpha, beta Integer :: i, ifail, lda, ldb, ldc, m, n, & ncola, ncolb, nrowa, nrowb Character (1) :: transa, transb ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:,:), b(:,:), c(:,:) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'F01CTF Example Program Results' ! Skip heading in data file Read (nin,*) ! Skip Subexample heading 100 Read (nin,*,End=110) Read (nin,*) nrowa, ncola, transa, alpha Read (nin,*) nrowb, ncolb, transb, beta lda = max(nrowa,ncola) ldb = max(nrowb,ncolb) ldc = lda Allocate (a(lda,max(nrowa,ncola)),b(ldb,max(nrowb, & ncolb)),c(ldc,max(nrowa,ncola))) ! Read matrices A and B. Do i = 1, nrowa Read (nin,*) a(i,1:ncola) End Do Do i = 1, nrowb Read (nin,*) b(i,1:ncolb) End Do If (transa=='N' .Or. transa=='n') Then m = nrowa n = ncola Else m = ncola n = nrowa End If ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 ! Add the two matrices A and B. Call f01ctf(transa,transb,m,n,alpha,a,lda,beta,b,ldb,c,ldc,ifail) ! Print the result matrix C. Write (nout,99999) transa, transb, alpha, beta Flush (nout) Call x04caf('G','X',m,n,c,ldc,'Matrix C:',ifail) Write (nout,*) Deallocate (a,b,c) Go To 100 110 Continue 99999 Format (1X/1X,'TRANSA = ''',A,''', TRANSB = ''',A,''', ALPHA = ',1P, & E11.3,', BETA = ',E11.3) End Program f01ctfe