src/bettermath.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 bettmat
  29   IMPLICIT none
  30   PRIVATE
  31
  32   PUBLIC :: bettmull
  33   PRIVATE :: bettmull_4, bettmull_8, bettmull_16
  34
  35   INTERFACE bettmull
  36      procedure bettmull_4, bettmull_8, bettmull_16
  37   END INTERFACE bettmull
  38
  39 CONTAINS
  40
  41   FUNCTION bettmull_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, k
  46
  47     C = 0
  48
  49     DO j = 1, size(B, 2)
  50        DO k = 1, size(A, 2)
  51           DO i = 1, size(A, 1)
  52
  53              C(i,j) = C(i,j) + A(i,k) * B(k,j)
  54           END DO
  55        END DO
  56     END DO
  57
  58   END FUNCTION bettmull_4
  59
  60   FUNCTION bettmull_8(A, B) result(C)
  61     IMPLICIT none
  62     real(kind=8), intent(in), dimension(1:,1:) :: A, B
  63     real(kind=8), dimension(size(A, 1), size(B, 2)) :: C
  64     integer :: i, j, k
  65
  66     C = 0
  67
  68     DO j = 1, size(B, 2)
  69        DO k = 1, size(A, 2)
  70           DO i = 1, size(A, 1)
  71
  72              C(i,j) = C(i,j) + A(i,k) * B(k,j)
  73           END DO
  74        END DO
  75     END DO
  76
  77   END FUNCTION bettmull_8
  78
  79   FUNCTION bettmull_16(A, B) result(C)
  80     IMPLICIT none
  81     real(kind=16), intent(in), dimension(1:,1:) :: A, B
  82     real(kind=16), dimension(size(A, 1), size(B, 2)) :: C
  83     integer :: i, j, k
  84
  85     C = 0
  86
  87     DO j = 1, size(B, 2)
  88        DO k = 1, size(A, 2)
  89           DO i = 1, size(A, 1)
  90
  91              C(i,j) = C(i,j) + A(i,k) * B(k,j)
  92           END DO
  93        END DO
  94     END DO
  95
  96   END FUNCTION bettmull_16
  97
  98 END MODULE bettmat