PROGRAM f01cwfe ! F01CWF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : f01cwf, nag_wp, x04daf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. COMPLEX (KIND=nag_wp) :: alpha, beta INTEGER :: i, ifail, lda, ldb, ldc, m, n, & ncola, ncolb, nrowa, nrowb CHARACTER (1) :: transa, transb ! .. Local Arrays .. COMPLEX (KIND=nag_wp), ALLOCATABLE :: a(:,:), b(:,:), c(:,:) ! .. Intrinsic Functions .. INTRINSIC max ! .. Executable Statements .. WRITE (nout,*) 'F01CWF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Skip Subexample heading 20 READ (nin,*,END=40) 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 f01cwf(transa,transb,m,n,alpha,a,lda,beta,b,ldb,c,ldc,ifail) ! Print the result matrix C. WRITE (nout,99999) transa, transb WRITE (nout,99998) alpha, beta FLUSH (nout) CALL x04daf('G','X',m,n,c,ldc,'Matrix C:',ifail) WRITE (nout,*) DEALLOCATE (a,b,c) GO TO 20 40 CONTINUE 99999 FORMAT (1X,'TRANSA = ''',A,''', TRANSB = ''',A,''',') 99998 FORMAT (1X,'ALPHA = (',1P,E11.4,',',E11.4,'), BETA = (',E11.4,',', & E11.4,')') END PROGRAM f01cwfe