Neko  0.8.99
A portable framework for high-order spectral element flow simulations
tensor_xsmm.F90
Go to the documentation of this file.
1 ! Copyright (c) 2008-2020, UCHICAGO ARGONNE, LLC.
2 !
3 ! The UChicago Argonne, LLC as Operator of Argonne National
4 ! Laboratory holds copyright in the Software. The copyright holder
5 ! reserves all rights except those expressly granted to licensees,
6 ! and U.S. Government license rights.
7 !
8 ! Redistribution and use in source and binary forms, with or without
9 ! modification, are permitted provided that the following conditions
10 ! are met:
11 !
12 ! 1. Redistributions of source code must retain the above copyright
13 ! notice, this list of conditions and the disclaimer below.
14 !
15 ! 2. Redistributions in binary form must reproduce the above copyright
16 ! notice, this list of conditions and the disclaimer (as noted below)
17 ! in the documentation and/or other materials provided with the
18 ! distribution.
19 !
20 ! 3. Neither the name of ANL nor the names of its contributors
21 ! may be used to endorse or promote products derived from this software
22 ! without specific prior written permission.
23 !
24 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
25 ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
26 ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
27 ! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
28 ! UCHICAGO ARGONNE, LLC, THE U.S. DEPARTMENT OF
29 ! ENERGY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
30 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
31 ! TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
32 ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
33 ! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
34 ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
35 ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 !
37 ! Additional BSD Notice
38 ! ---------------------
39 ! 1. This notice is required to be provided under our contract with
40 ! the U.S. Department of Energy (DOE). This work was produced at
41 ! Argonne National Laboratory under Contract
42 ! No. DE-AC02-06CH11357 with the DOE.
43 !
44 ! 2. Neither the United States Government nor UCHICAGO ARGONNE,
45 ! LLC nor any of their employees, makes any warranty,
46 ! express or implied, or assumes any liability or responsibility for the
47 ! accuracy, completeness, or usefulness of any information, apparatus,
48 ! product, or process disclosed, or represents that its use would not
49 ! infringe privately-owned rights.
50 !
51 ! 3. Also, reference herein to any specific commercial products, process,
52 ! or services by trade name, trademark, manufacturer or otherwise does
53 ! not necessarily constitute or imply its endorsement, recommendation,
54 ! or favoring by the United States Government or UCHICAGO ARGONNE LLC.
55 ! The views and opinions of authors expressed
56 ! herein do not necessarily state or reflect those of the United States
57 ! Government or UCHICAGO ARGONNE, LLC, and shall
58 ! not be used for advertising or product endorsement purposes.
59 !
62  use num_types
63  use mxm_wrapper
64  implicit none
65  private
66 
68 
69 contains
70 
71  subroutine tnsr2d_el_xsmm(v, nv, u, nu, A, Bt)
72  integer, intent(in) :: nv, nu
73  real(kind=rp), intent(inout) :: v(nv*nv), u(nu*nu)
74  real(kind=rp), intent(inout) :: a(nv,nu), bt(nu,nv)
75  real(kind=rp) :: work(0:nu**2*nv)
76 
77  call mxm(a, nv, u, nu, work, nu)
78  call mxm(work, nv, bt, nu, v, nv)
79 
80  end subroutine tnsr2d_el_xsmm
81 
82  subroutine tnsr3d_el_xsmm(v, nv, u, nu, A, Bt, Ct)
83  integer, intent(in) :: nv, nu
84  real(kind=rp), intent(inout) :: v(nv*nv*nv), u(nu*nu*nu)
85  real(kind=rp), intent(inout) :: a(nv,nu),bt(nu, nv),ct(nu,nv)
86  real(kind=rp) :: work(0:nu**2*nv), work2(0:nu*nv**2)
87  integer :: i, nunu, nvnu, nvnv
88 
89  nvnu = nv * nu
90  nunu = nu * nu
91  nvnv = nv * nv
92 
93  call mxm(a, nv, u(1), nu ,work, nunu)
94  do i = 0,nu-1
95  call mxm(work(nvnu*i), nv, bt, nu, work2(nv*nv*i), nv)
96  end do
97  call mxm(work2, nvnv, ct, nu, v(1), nv)
98 
99  end subroutine tnsr3d_el_xsmm
100 
101  subroutine tnsr3d_xsmm(v, nv, u, nu, A, Bt, Ct, nelv)
102  integer, intent(inout) :: nv, nu, nelv
103  real(kind=rp), intent(inout) :: v(nv*nv*nv,nelv), u(nu*nu*nu,nelv)
104  real(kind=rp), intent(inout) :: a(nv,nu), bt(nu, nv), ct(nu,nv)
105  real(kind=rp) :: work(0:nu**2*nv), work2(0:nu*nv**2)
106  integer :: ie, i, nunu, nvnu, nvnv
107 
108  nvnu = nv * nu
109  nunu = nu * nu
110  nvnv = nv * nv
111 
112  do ie = 1,nelv
113  call mxm(a, nv, u(1,ie), nu, work, nunu)
114  do i = 0,nu-1
115  call mxm(work(nvnu*i), nv, bt, nu, work2(nv*nv*i), nv)
116  end do
117  call mxm(work2, nvnv, ct, nu, v(1,ie), nv)
118  end do
119 
120  end subroutine tnsr3d_xsmm
121 
122  subroutine tnsr1_3d_xsmm(v, nv, nu, A, Bt, Ct, nelv)
123  integer, intent(in) :: nv, nu, nelv
124  real(kind=rp), intent(inout) :: v(nv*nv*nv*nelv)
125  real(kind=rp), intent(inout) :: a(nv,nu), bt(nu, nv), ct(nu,nv)
126  real(kind=rp) :: work(0:nu**2*nv), work2(0:nu*nv**2)
127  integer :: e, e0, ee, es, iu, iv, i, nu3, nv3
128 
129  e0 = 1
130  es = 1
131  ee = nelv
132 
133  if (nv.gt.nu) then
134  e0 = nelv
135  es = -1
136  ee = 1
137  endif
138 
139  nu3 = nu**3
140  nv3 = nv**3
141 
142  do e = e0,ee,es
143  iu = 1 + (e-1)*nu3
144  iv = 1 + (e-1)*nv3
145  call mxm(a, nv, v(iu), nu, work, nu*nu)
146  do i = 0,nu-1
147  call mxm(work(nv*nu*i), nv, bt, nu, work2(nv*nv*i), nv)
148  end do
149  call mxm(work2, nv*nv, ct, nu, v(iv), nv)
150  end do
151  end subroutine tnsr1_3d_xsmm
152 
153 end module tensor_xsmm
Wrapper for all matrix-matrix product implementations.
Definition: mxm_wrapper.F90:2
subroutine, public mxm(a, n1, b, n2, c, n3)
Compute matrix-matrix product for contiguously packed matrices A,B, and C.
Definition: mxm_wrapper.F90:29
integer, parameter, public rp
Global precision used in computations.
Definition: num_types.f90:12
Tensor operations libxsmm backend.
Definition: tensor_xsmm.F90:61
subroutine, public tnsr3d_el_xsmm(v, nv, u, nu, A, Bt, Ct)
Definition: tensor_xsmm.F90:83
subroutine, public tnsr2d_el_xsmm(v, nv, u, nu, A, Bt)
Definition: tensor_xsmm.F90:72
subroutine, public tnsr1_3d_xsmm(v, nv, nu, A, Bt, Ct, nelv)
subroutine, public tnsr3d_xsmm(v, nv, u, nu, A, Bt, Ct, nelv)