Line data    Source code

       1             : !/*************************************************************************
       2             : ! *
       3             : ! *  Project
       4             : ! *                        __  __ _______ _____  _  __
       5             : ! *                       |  \/  |__   __|  __ \| |/ /
       6             : ! *  ___  _ __   ___ _ __ | \  / |  | |  | |__) | ' /
       7             : ! * / _ \| '_ \ / _ \ '_ \| |\/| |  | |  |  ___/|  <
       8             : ! *| (_) | |_) |  __/ | | | |  | |  | |  | |    | . \
       9             : ! * \___/| .__/ \___|_| |_|_|  |_|  |_|  |_|    |_|\_\
      10             : ! *      | |
      11             : ! *      |_|
      12             : ! *
      13             : ! *
      14             : ! * Copyright (C) Akiel Aries, <akiel@akiel.org>, et al.
      15             : ! *
      16             : ! * This software is licensed as described in the file LICENSE, which
      17             : ! * you should have received as part of this distribution. The terms
      18             : ! * among other details are referenced in the official documentation
      19             : ! * seen here : https://akielaries.github.io/openGPMP/ along with
      20             : ! * important files seen in this project.
      21             : ! *
      22             : ! * You may opt to use, copy, modify, merge, publish, distribute
      23             : ! * and/or sell copies of the Software, and permit persons to whom
      24             : ! * the Software is furnished to do so, under the terms of the
      25             : ! * LICENSE file. As this is an Open Source effort, all implementations
      26             : ! * must be of the same methodology.
      27             : ! *
      28             : ! *
      29             : ! *
      30             : ! * This software is distributed on an AS IS basis, WITHOUT
      31             : ! * WARRANTY OF ANY KIND, either express or implied.
      32             : ! *
      33             : ! ************************************************************************/
      34             : !> FORTRAN subroutine testing the Matrix Addition subroutine
      35           1 : subroutine test_mtx_add()
      36             :     IMPLICIT NONE
      37             : 
      38             :     !< declare variables
      39             :     integer(kind=8) :: nrows, ncols
      40           1 :     real(kind=8), allocatable :: a(:, :), b(:, :), c(:, :)
      41             :     integer(kind=8) :: i, j
      42             :     logical :: failed
      43             : 
      44             :     !< initialize variables (e.g., set nrows and ncols)
      45           1 :     nrows = 3
      46           1 :     ncols = 3
      47             : 
      48             :     !< allocate memory for arrays
      49           1 :     allocate (a(nrows, ncols))
      50           1 :     allocate (b(nrows, ncols))
      51           1 :     allocate (c(nrows, ncols))
      52             : 
      53             :     !< initialize input arrays (a and b) with test data
      54          13 :     a = 1.0
      55          13 :     b = 2.0
      56             : 
      57             :     !< call the subroutine being tested (float version)
      58           1 :     call mtx_add_routine_float(a, b, c, nrows, ncols)
      59             : 
      60             :     !< check the output (c) against expected results
      61           1 :     failed = .false.
      62           4 :     do i = 1, nrows
      63           4 :         do j = 1, ncols
      64           3 :             if (c(i, j) /= a(i, j) + b(i, j)) then
      65           3 :                 print *, ''//achar(27)//'[34m [!] LINALG MTX ADD (FLOAT) FAILED'//achar(27)//'[0m'
      66           3 :                 failed = .true.
      67           3 :                 exit
      68             :             end if
      69             :         end do
      70             :     end do
      71             : 
      72             :     !< call the subroutine being tested (int version)
      73           1 :     call mtx_add_routine_int(a, b, c, nrows, ncols)
      74             : 
      75             :     !< check the output (c) against expected results
      76           4 :     do i = 1, nrows
      77           4 :         do j = 1, ncols
      78           3 :             if (c(i, j) /= a(i, j) + b(i, j)) then
      79           3 :                 print *, ''//achar(27)//'[34m [!] LINALG MTX ADD (INT) FAILED'//achar(27)//'[0m'
      80           3 :                 failed = .true.
      81           3 :                 exit
      82             :             end if
      83             :         end do
      84             :     end do
      85             : 
      86             :     !< free allocated memory for a,b,c
      87           1 :     deallocate (a, b, c)
      88             : 
      89             :     !< IF EXECUTION REACHES HERE, PASS!
      90           1 :     if (.not. failed) then
      91           0 :         print *, achar(27)//'[32m[LINALG MTX ADD PASSED]'//achar(27)//'[0m'
      92             :     end if
      93           1 : end subroutine test_mtx_add
      94             : 
      95             : !> FORTRAN Linear Alebra subroutine test driver
      96           1 : program main
      97             :     implicit none
      98           1 :     call test_mtx_add()
      99           1 : end program main
     100             :