1!
2! Copyright (c) 2017, NVIDIA CORPORATION.  All rights reserved.
3!
4! Licensed under the Apache License, Version 2.0 (the "License");
5! you may not use this file except in compliance with the License.
6! You may obtain a copy of the License at
7!
8!     http://www.apache.org/licenses/LICENSE-2.0
9!
10! Unless required by applicable law or agreed to in writing, software
11! distributed under the License is distributed on an "AS IS" BASIS,
12! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13! See the License for the specific language governing permissions and
14! limitations under the License.
15!
16
17
18
19#include "mmul_dir.h"
20
21subroutine F90_matmul_cplx8_str1_t(dest,s1,s2, &
22      k_extnt,m_extnt,n_extnt,                  &
23      s1_d1_extnt,s2_d1_extnt,d_d1_extnt,       &
24      d_d1_lstride)
25
26  DESC_INT  n_extnt,m_extnt,k_extnt
27  DESC_INT  s1_d1_extnt,s2_d1_extnt,d_d1_extnt,d_d1_lstride
28  COMPLEX*8 s1(s1_d1_extnt,m_extnt)
29  COMPLEX*8 s2(s2_d1_extnt,k_extnt)
30  COMPLEX*8 dest(d_d1_extnt,n_extnt*d_d1_lstride)
31
32  DESC_INT  k,n,m
33
34  if (d_d1_lstride .eq. 1) then
35     do k = 1, k_extnt
36        do n = 1, n_extnt
37           dest(n,k) = 0.0d0
38        enddo
39     enddo
40     do k = 1, k_extnt
41        do m = 1, m_extnt
42           do n = 1, n_extnt
43              dest(n,k) = dest(n,k) + s1(m,n) * s2(m,k)
44           enddo
45        enddo
46     enddo
47  else
48     do k = 1, k_extnt
49        do n = 1, n_extnt
50           dest(1+(n-1)*d_d1_lstride,k) = 0.0d0
51        enddo
52     enddo
53     do k = 1, k_extnt
54       do m = 1, m_extnt
55           do n = 1, n_extnt
56              dest(1+(n-1)*d_d1_lstride,k) =                 &
57                              dest(1+(n-1)*d_d1_lstride,k) + &
58                                         s1(m,n) * s2(m,k)
59           enddo
60        enddo
61     enddo
62  endif
63end subroutine
64
65
66subroutine F90_matmul_cplx8_str1_mxv_t(dest, s1,s2,  &
67                   n_extent,m_extent, ld1,dlstride)
68
69  DESC_INT  n_extent,m_extent,ld1,ld2,dlstride
70  COMPLEX*8 s1(ld1,m_extent)
71  COMPLEX*8 s2(m_extent)
72  COMPLEX*8 dest(ld1)
73
74  DESC_INT  i,j,k
75
76  if (dlstride .eq. 1) then
77        do k = 1, m_extent
78           dest(k) = 0.0d0
79        enddo
80        do j = 1, n_extent
81           do k = 1, m_extent
82              dest(k) = dest(k) + s1(j,k) * s2(j)
83           enddo
84        enddo
85  else
86        do k = 1, m_extent
87           dest(1+(k-1)*dlstride) = 0.0d0
88        enddo
89        do j = 1, n_extent
90           do k = 1, m_extent
91              dest(1+(k-1)*dlstride) = dest(1+(k-1)*dlstride) +  &
92                                       s1(j,k) * s2(j)
93           enddo
94        enddo
95  endif
96end
97