src/dotmath.F90

   1 ! Copyright 2019 Wojciech Kosior
   2
   3 ! This is free and unencumbered software released into the public domain.
   4
   5 ! Anyone is free to copy, modify, publish, use, compile, sell, or
   6 ! distribute this software, either in source code form or as a compiled
   7 ! binary, for any purpose, commercial or non-commercial, and by any
   8 ! means.
   9
  10 ! In jurisdictions that recognize copyright laws, the author or authors
  11 ! of this software dedicate any and all copyright interest in the
  12 ! software to the public domain. We make this dedication for the benefit
  13 ! of the public at large and to the detriment of our heirs and
  14 ! successors. We intend this dedication to be an overt act of
  15 ! relinquishment in perpetuity of all present and future rights to this
  16 ! software under copyright law.
  17
  18 ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  21 ! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
  22 ! OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
  23 ! ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  24 ! OTHER DEALINGS IN THE SOFTWARE.
  25
  26 ! For more information, please refer to <http://unlicense.org/>
  27
  28 MODULE dotmat
  29   IMPLICIT none
  30   PRIVATE
  31
  32   PUBLIC :: dotmull
  33   PRIVATE :: dotmull_4, dotmull_8, dotmull_16
  34
  35   INTERFACE dotmull
  36      procedure dotmull_4, dotmull_8, dotmull_16
  37   END INTERFACE dotmull
  38
  39 CONTAINS
  40
  41   FUNCTION dotmull_4(A, B) result(C)
  42     IMPLICIT none
  43     real(kind=4), intent(in), dimension(1:,1:) :: A, B
  44     real(kind=4), dimension(size(A, 1), size(B, 2)) :: C
  45     integer :: i, j
  46
  47     DO j = 1, size(B, 2)
  48        DO i = 1, size(A, 1)
  49
  50           C(i,j) = dot_product(A(i,:), B(:,j))
  51        END DO
  52     END DO
  53
  54   END FUNCTION dotmull_4
  55
  56   FUNCTION dotmull_8(A, B) result(C)
  57     IMPLICIT none
  58     real(kind=8), intent(in), dimension(1:,1:) :: A, B
  59     real(kind=8), dimension(size(A, 1), size(B, 2)) :: C
  60     integer :: i, j
  61
  62     DO j = 1, size(B, 2)
  63        DO i = 1, size(A, 1)
  64
  65           C(i,j) = dot_product(A(i,:), B(:,j))
  66        END DO
  67     END DO
  68
  69   END FUNCTION dotmull_8
  70
  71   FUNCTION dotmull_16(A, B) result(C)
  72     IMPLICIT none
  73     real(kind=16), intent(in), dimension(1:,1:) :: A, B
  74     real(kind=16), dimension(size(A, 1), size(B, 2)) :: C
  75     integer :: i, j
  76
  77     DO j = 1, size(B, 2)
  78        DO i = 1, size(A, 1)
  79
  80           C(i,j) = dot_product(A(i,:), B(:,j))
  81        END DO
  82     END DO
  83
  84   END FUNCTION dotmull_16
  85
  86 END MODULE dotmat