!** Copyright (c) 1989, NVIDIA CORPORATION.  All rights reserved.
!**
!** Licensed under the Apache License, Version 2.0 (the "License");
!** you may not use this file except in compliance with the License.
!** You may obtain a copy of the License at
!**
!**     http://www.apache.org/licenses/LICENSE-2.0
!**
!** Unless required by applicable law or agreed to in writing, software
!** distributed under the License is distributed on an "AS IS" BASIS,
!** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
!** See the License for the specific language governing permissions and
!** limitations under the License.

!* Tests for runtime library MATMUL routines

program p
  
  parameter(NbrTests=128)
  parameter(n_extent=6)
  parameter(m_extent=4)
  parameter(k_extent=8)
  
  COMPLEX*16, dimension(n_extent,m_extent) :: arr1
  COMPLEX*16, dimension(n_extent,k_extent) :: arr2
  COMPLEX*16, dimension(m_extent,k_extent) :: arr3
  
  COMPLEX*16 :: expect(NbrTests) 
  COMPLEX*16 :: results(NbrTests)
  
  integer:: i,j
  
  data arr1 /(0,4),(1,8),(2,11),(3,7),(4,4),(5,5),				&
             (6,4),(7,8),(8,11),(9,7),(10,2),(11,1),			&
             (12,2),(13,1),(14,4),(15,8),(16,11),(17,7),		&
             (18,2),(19,1),(20,4),(22,8),(22,11),(23,7)/
  data arr2 /(0,4),(1,8),(2,11),(3,7),(4,4),(5,5),				&
             (6,4),(7,8),(8,11),(9,7),(10,2),(11,1), 			&
             (12,2),(13,1),(14,4),(15,8),(16,11),(17,7),		&
             (18,2),(19,1),(20,4),(21,8),(22,11),(23,7),		&
             (24,2),(25,1),(26,4),(27,8),(28,11),(29,7),		&
             (30,2),(31,1),(32,4),(33,8),(34,11),(35,7),		&
             (36,2),(37,1),(38,4),(39,8),(40,11),(41,7),		&
             (42,2),(43,1),(44,4),(45,8),(46,11),(47,7)/
  data arr3 /(0,4),(1,8),(2,11),(3,7),(4,4),(5,5),				&
             (6,4),(7,8),(8,11),(9,7),(10,2),(11,1),			&
             (12,2),(13,1),(14,4),(15,8),(16,11),(17,7),		&
             (18,2),(19,1),(20,4),(21,8),(22,11),(23,7),		&
             (24,2),(25,1),(26,4),(27,8),(28,11),(29,7),               &
             (30,2),(31,1)/

  data expect / &
   !test 1,32
    (-236.0,184.0), (-118.0,390.0), (40.0,672.0), (133.0,913.0), &
    (-118.0,390.0), (196.0,524.0), (612.0,770.0), (927.0,975.0), &
    (40.0,672.0), (612.0,770.0), (1024.0,1016.0), (1561.0,1222.0), &
    (130.0,906.0), (918.0,968.0), (1546.0,1214.0), (2305.0,1420.0), &
    (220.0,1140.0), (1224.0,1166.0), (2068.0,1412.0), (3049.0,1618.0), &
    (310.0,1374.0), (1530.0,1364.0), (2590.0,1610.0), (3793.0,1816.0), &
    (400.0,1608.0), (1836.0,1562.0), (3112.0,1808.0), (4537.0,2014.0), &
    (490.0,1842.0), (2142.0,1760.0), (3634.0,2006.0), (5281.0,2212.0), &
   !test 33,64
    (-220.0,184.0), (-102.0,366.0), (48.0,624.0), (141.0,841.0), &
    (-102.0,366.0), (176.0,476.0), (548.0,710.0), (827.0,891.0), &
    (48.0,624.0), (548.0,710.0), (884.0,968.0), (1349.0,1162.0), &
    (138.0,834.0), (818.0,884.0), (1334.0,1154.0), (1985.0,1348.0), &
    (228.0,1044.0), (1088.0,1058.0), (1784.0,1340.0), (2621.0,1534.0), &
    (318.0,1254.0), (1358.0,1232.0), (2234.0,1526.0), (3257.0,1720.0), &
    (408.0,1464.0), (1628.0,1406.0), (2684.0,1712.0), (3893.0,1906.0), &
    (498.0,1674.0), (1898.0,1580.0), (3134.0,1898.0), (4529.0,2092.0), &
   !test 65,96
    (-236.0,134.0), (-168.0,330.0), (-10.0,552.0), (53.0,763.0), &
    (-168.0,330.0), (76.0,502.0), (432.0,676.0), (681.0,875.0), &
    (-10.0,552.0), (432.0,676.0), (784.0,778.0), (1219.0,942.0), &
    (50.0,756.0), (672.0,868.0), (1204.0,934.0), (1825.0,1098.0), &
    (110.0,960.0), (912.0,1060.0), (1624.0,1090.0), (2431.0,1254.0), &
    (170.0,1164.0), (1152.0,1252.0), (2044.0,1246.0), (3037.0,1410.0), &
    (230.0,1368.0), (1392.0,1444.0), (2464.0,1402.0), (3643.0,1566.0), &
    (290.0,1572.0), (1632.0,1636.0), (2884.0,1558.0), (4249.0,1722.0), &
   !test 97,128
    (0.0,0.0), (-118.0,390.0), (40.0,672.0), (133.0,913.0), &
    (0.0,0.0), (196.0,524.0), (612.0,770.0), (927.0,975.0), &
    (0.0,0.0), (612.0,770.0), (1024.0,1016.0), (1561.0,1222.0), &
    (0.0,0.0), (918.0,968.0), (1546.0,1214.0), (2305.0,1420.0), &
    (0.0,0.0), (1224.0,1166.0), (2068.0,1412.0), (3049.0,1618.0), &
    (0.0,0.0), (1530.0,1364.0), (2590.0,1610.0), (3793.0,1816.0), &
    (0.0,0.0), (1836.0,1562.0), (3112.0,1808.0), (4537.0,2014.0), &
    (0.0,0.0), (2142.0,1760.0), (3634.0,2006.0), (5281.0,2212.0)/
  
  !test 1-32
  arr3=0
  arr3 = matmul(transpose(arr1),arr2)
  call assign_result(1,32,arr3,results)
  !print *,"test 1,32"
  !print *,arr3
  
  ! test 33-64
  arr3=0
  arr3 = matmul(transpose(arr1(2:n_extent,:)),arr2(2:n_extent,:))
  call assign_result(33,64,arr3,results)
  !print *,"test 33,64"
  !print *,arr3
  
  ! test 65-96
  arr3=0
  arr3 = matmul(transpose(arr1(1:n_extent-1,:)),arr2(1:n_extent-1,:))
  call assign_result(65,96,arr3,results)
  !print *,"test 65,96"
  !print *,arr3
  
  ! test 97-128
  arr3=0
  arr3(2:m_extent,:) = matmul(transpose(arr1(:,2:m_extent)),arr2)
  call assign_result(97,128,arr3,results)
  !print *,"test 97,128"
  !print *,arr3
  

  call checkd(results, expect, NbrTests*2)

end program

subroutine assign_result(s_idx, e_idx , arr, rslt)
  COMPLEX*16, dimension(1:e_idx-s_idx+1) :: arr
  COMPLEX*16, dimension(e_idx) :: rslt
  integer:: s_idx, e_idx

  rslt(s_idx:e_idx) = arr

end subroutine