testing_HPE_libs/blas_lapack_test.f90 at master · eleanor-broadway/testing_HPE_libs · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
! example.f90
program main
    implicit none
    ! integer, parameter :: dp = selected_real_kind(15,300)
    real :: blas_scale
    real, allocatable, dimension(:) :: blas_array, B
    integer, allocatable, dimension(:) :: pivot
    real, allocatable, dimension(:,:) :: A
    integer :: blas_size, istat, ok

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! X = a*X
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    print*, " "
    print*, " "
    print*, "Testing the BLAS library"
    print*, " "

    blas_scale = 5
    blas_size = 3

    allocate(blas_array(blas_size), stat=istat)
    if (istat.ne.0) stop 'Error: allocating blas'

    blas_array(1) = 1
    blas_array(2) = 2
    blas_array(3) = 3

    print*, "Original array =", blas_array(:)

    print*, " "
    print*, "Scaling the array using SSCAL:"
    call sscal(blas_size, blas_scale, blas_array, 1)
    print*, " "

    print*, "Array scaled by,", int(blas_scale), "=", blas_array(:)
    print*, " "
    print*, "DONE"
    print*, " "


    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! A*X = B
    ! Where A, X and B are matrices
    ! A = 3.0 -1.0  B = 4.0
    !     1.0  6.0      6.0
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    print*, " "
    print*, " "
    print*, "Testing the LAPACK library"
    print*, " "


    allocate(A(2,2), stat=istat)
    if (istat.ne.0) stop 'Error: allocating A'
    allocate(B(2), stat=istat)
    if (istat.ne.0) stop 'Error: allocating B'
    allocate(pivot(2), stat=istat)
    if (istat.ne.0) stop 'Error: allocating pivot'

    A(1,1) = 3.0
    A(1,2) = -1.0
    A(2,1) = 1.0
    A(2,2) = 6.0

    B(1) = 4.0
    B(2) = 6.0

    ! print*, A(:,:)
    ! print*, B(:)

    print*, "Solving a set of linear equations using SGESV"
    call SGESV(2,1,A,2,pivot,B,2,ok)
    print*, " "

    print*, "Correct answer: 1.57894742,  0.736842036"
    print*, "Answer:", B(:)
    print*, " "
    print*, "DONE"
    print*, " "


    deallocate(blas_array)
    deallocate(A)
    deallocate(B)
    deallocate(pivot)
end program main