
  program check_blas_works
    !=========================================================================!
    ! Test for the common build problem of linking against an incompatibly-   !
    ! compiled version of the BLAS library, and abort gracefully if so.       !
    !-------------------------------------------------------------------------!
    ! Arguments: none                                                         !
    !-------------------------------------------------------------------------!
    ! Modules used:                                                           !
    !  constants                                                              !
    !  io                                                                     !
    !-------------------------------------------------------------------------!
    ! Key Internal Variables: none                                            !
    !-------------------------------------------------------------------------!
    ! Necessary conditions: none                                              !
    !-------------------------------------------------------------------------!
    ! Known worries: none                                                     !
    !-------------------------------------------------------------------------!
    ! Written by Keith Refson, April 2013                                     !
    !=========================================================================!

    implicit none

    integer, parameter :: dp = 8
    integer, parameter :: stderr = 0

    complex(kind=dp), dimension(1) :: x, y
    complex(kind=dp)               :: result
    complex(kind=dp), parameter    :: cmplx_0 = (0.0_dp,0.0_dp)
    complex(kind=dp), parameter    :: r1 = (0.5_dp,-1.0_dp), r2 = (0.5_dp,1.0_dp)
    complex(kind=dp), parameter    :: expected_result = (-0.75_dp,1.0_dp)
    integer                        :: one(4) = 1 ! Integer 1, but stored in R/W variable as large a s complex(dp)
    
    interface
       function zdotc(N, X, INCX, Y, INCY)
         integer, parameter :: dp = 8
         integer :: n, incx, incy
         complex(kind=dp), dimension(*) :: X, Y
         complex(kind=dp) :: zdotc
       end function zdotc
    end interface
    
    x(1) = r1
    y(1) = r2

    ! Initialise result to value that will fail check test
    result = cmplx_0
    
    ! Call zdotc.  The call is correct and will succeed with a working and compatible BLAS
    !
    ! All arguments are passed as variables rather than constants.
    ! If BLAS is compiled with g77/ifort calling conventions the result is
    ! returned in the first argument and will overwrite ONE. As we declared it
    ! large enough, this will probably not cause a crash, and we can 
    ! simply test the against the expected value.

    result = zdotc(one(1), x, one(1), y, one(1))
    
    if( abs(result - expected_result) > 2.0_dp*epsilon(1.0_dp) ) then
          write(*,*)
          write(*,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(*,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(*,*)
          write(*,*) '   An internal test has determined that this CASTEP executable is '
          write(*,*) '   faulty and can not be used. The run has been ABORTED.'
          write(*,*)
          write(*,*) '       ZDOTC returned ',result, '  Expected ',expected_result
          write(*,*)
          write(*,*) '   A test of correct functioning of ZDOTC has FAILED.  Most likely '
          write(*,*) '   this is because the CASTEP executable was linked against a BLAS '
          write(*,*) '   library with an incompatible calling convention. '
          write(*,*) '   Please see file README.INSTALL in source code for more information.'
          write(*,*)
          write(*,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(*,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(*,*)

          write(stderr,*)
          write(stderr,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(stderr,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(stderr,*)
          write(stderr,*) '   An internal test has determined that this CASTEP executable is '
          write(stderr,*) '   faulty and can not be used. The run has been ABORTED.'
          write(stderr,*)
          write(stderr,*) '       ZDOTC returned ',result, '  Expected ',expected_result
          write(stderr,*)
          write(stderr,*) '   A test of correct functioning of ZDOTC has FAILED.  '
          write(stderr,*) '   Most likely this is because the CASTEP executable was linked '
          write(stderr,*) '   against a BLAS library with an incompatible calling convention. '
          write(stderr,*) '   Please see file README.INSTALL in source code for more information.'
          write(stderr,*)
          write(stderr,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(stderr,*) ' C A S T E P    C O M P I L A T I O N    E R R O R    D E T E C T E D     '
          write(stderr,*)
          
    else
       write(stderr,*) ' BLAS Link test passed'
    end if

  end program check_blas_works
