BLAS solution

C

#include "stdio.h"
#include "stdlib.h"
#include "mkl.h"
#define M 12
#define N 8
#define K 4
int main()
{
  int m = M, n = N, k= K, incx = 1, incy = 1, incz = 1, incv = 1, i, j;
  double alpha = 1.0, beta = 0.0, da = 2.0;
  /* Matrices and vectors definitions */
  double x[M], y[N], z[N], v[K], c;
  double A[M*K], B[K*N], C[M*N], D[K*N];

  /* Vector and matrix elements generation */
  for( i = 0; i < n; i++ ){
    x[i] = (double)(i + 1);
    y[i] = (double)(n - i);
  }
  for( i = n; i < m; i++ ){
    x[i] = (double)(i + 1);
  }
  printf( "VECTOR x:\n" );
  for( i = 0; i < m; i++ ){
    printf( "%12.6f ", x[i] );
  }
  printf( "\n" );
  printf( "VECTOR y:\n" );
  for( i = 0; i < n; i++ ){
    printf( "%12.6f ", y[i] );
  }
  printf( "\n" );
  for( i = 0; i < m*k; i++ ){
    A[i] = (double)(i + 1);
  }
  printf( "MATRIX A:\n" );
  for( i = 0; i < m; i++ ){
    for( j = 0; j < k; j++ ){
      printf( "%12.6f ", A[k*i+j] );
    }
    printf( "\n" );
  }
  for( i = 0; i < k*n; i++ ){
    B[i] = (double)(k*n - i);
  }
  printf( "MATRIX B:\n" );
  for( i = 0; i < k; i++ ){
    for( j = 0; j < n; j++ ){
      printf( "%12.6f ", B[n*i+j] );
    }
    printf( "\n" );
  }

  /* DCOPY */
  cblas_dcopy( n, y, incy, z, incz );
  printf( "## dcopy ## VECTOR z:\n" );
  for( i = 0; i < n; i++ ){
    printf( "%12.6f ", z[i] );
  }
  printf( "\n" );

  /* DSCAL */
  cblas_dscal( n, da, z, incz);
  printf( "## dscal ## VECTOR z:\n" );
  for( i = 0; i < n; i++ ){
    printf( "%12.6f ", z[i] );
  }
  printf( "\n" );

  /* DNRM2 */
  c = cblas_dnrm2( n, z, incz);
  printf( "sqrt( z''*z ) = %12.6f\n", c );

  /* DDOT */
  c = cblas_ddot( n, z, incz, y, incy );
  printf( "z dot y = %12.6f\n", c );

  /* DGEMV */
  cblas_dgemv( CblasRowMajor, CblasNoTrans, k, n, alpha, B, n, y, incy, beta, v, incv );
  printf( "## dgemv ## VECTOR v:\n" );
  for( i = 0; i < k; i++ ){
    printf( "%12.6f ", v[i] );
  }
  printf( "\n" );

  /* DGER */
  cblas_dger( CblasRowMajor, k, n, alpha, v, incv, y, incy, D, n );
  printf( "## dger ## MATRIX D:\n" );
  for( i = 0; i < k; i++ ){
    for( j = 0; j < n; j++ ){
      printf( "%12.6f ", D[n*i+j] );
    }
    printf( "\n" );
  }

  /* DGEMM */
  cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans, m, n, k, alpha, A, k, B, n, beta, C, n );
  printf( "## dgemm ## MATRIX C:\n" );
  for( i = 0; i < n; i++ ){
    for( j = 0; j < m; j++ ){
      printf( "%12.6f ", C[m*i+j] );
    }
    printf( "\n" );
  }
  return 0;
}

FORTRAN

program es_blas
implicit none

integer :: i, j
character(len=*) , parameter :: FMT='(12E12.5)'
! BLAS routines and functions
external :: dcopy, dscal, dnrm2, ddot
external :: dgemv, dger, dgemm
real*8 :: dnrm2, ddot
! Matrices and vectors definitions
integer :: M, N, K
parameter ( M=12, N=8, K=4 )
real*8 :: A(M,K), B(K,N), C(M,N), D(K,N)
real*8 :: X(M), Y(N), Z(N), V(K)

! Vector and matrix elements generation
do i=1,N
  X(i) = dble(i)
  Y(i) = dble(N+1-i)
enddo
do i=N+1,M
  X(i) = dble(i)
enddo
write(*,*) 'VECTOR X:'
write(*,FMT) ( X(i), i=1,M )
write(*,*) 'VECTOR Y:'
write(*,FMT) ( Y(i), i=1,N )
do j=1,K
  do i=1,M
    A(i,j) = dble(K*(i-1)+j)
  enddo
enddo
write(*,*) 'MATRIX A:'
do i=1,M
   write(*,FMT) ( A(i,j), j=1,K )
enddo
do j=1,N
  do i=1,K
    B(i,j) = dble(N*(K-i+1)-j+1)
  enddo
enddo
write(*,*) 'MATRIX B:'
do i=1,K
   write(*,FMT) ( B(i,j), j=1,N )
enddo

!           N, DX, INCX, DY, INCY
call dcopy( N,  Y,    1,  Z,    1 )
write(*,*) '### DCOPY ###'
write(*,*) 'VECTOR Z:'
write(*,FMT) ( Z(i), i=1,N )

!           N,    DA, DX, INCX
call dscal( N, 2.0d0,  Z,    1 )
write(*,*) '### DSCAL ###'
write(*,*) 'VECTOR Z:'
write(*,FMT) ( Z(i), i=1,N )

write(*,*) '### DNRM2 ###'
!                                     N, X, INCX
write(*,*) 'sqrt( Z''*Z ) = ', dnrm2( N, Z,    1 )

write(*,*) '### DDOT ###'
!                              N, DX, INCX, DY, INCY
write(*,*) 'Z dot Y = ', ddot( N,  Z,    1,  Y,    1 )

!          TRANS, M, N, ALPHA, A, LDA, X, INCX,  BETA, Y, INCY
call dgemv(  'N', K, N, 1.0d0, B,   K, Y,    1, 0.0d0, V,    1 )
write(*,*) '### DGEMV ###'
write(*,*) 'VECTOR V:'
write(*,FMT) ( V(i), i=1,K )

!          M, N, ALPHA, X, INCX, Y, INCY, A, LDA
call dger( K ,N, 1.0d0, V,    1, Y,    1, D,   K )
write(*,*) '### DGER ###'
write(*,*) 'MATRIX D:'
do i=1,K
  write(*,FMT) ( D(i,j), j=1,N )
enddo

!          TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,  BETA, C, LDC
call dgemm(   'N',    'N', M, N, K, 1.0d0, A,   M, B,   K, 0.0d0, C,   M )
write(*,*) '### DGEMM ###'
write(*,*) 'MATRIX C:'
do i=1,M
  write(*,FMT) ( C(i,j), j=1,N )
enddo

end program es_blas