xref: /phasta/svLS/SPARMUL.f (revision 712d3df0b59ebebaaeaea358162c8d2c043c6e08)

!     This software is Copyright (c) 2012-2015 The Regents of the
!     University of California. All Rights Reserved.
!
!     Permission to copy and modify this software and its documentation
!     for educational, research and non-profit purposes, without fee,
!     and without a written agreement is hereby granted, provided that
!     the above copyright notice, this paragraph and the following three
!     paragraphs appear in all copies.
!
!     Permission to make commercial use of this software may be obtained
!     by contacting:
!
!     Technology Transfer Office
!     9500 Gilman Drive, Mail Code 0910
!     University of California
!     La Jolla, CA 92093-0910
!     (858) 534-5815
!     invent@ucsd.edu
!
!     This software program and documentation are copyrighted by The
!     Regents of the University of California. The software program and
!     documentation are supplied "as is", without any accompanying
!     services from The Regents. The Regents does not warrant that the
!     operation of the program will be uninterrupted or error-free. The
!     end-user understands that the program was developed for research
!     purposes and is advised not to rely exclusively on the program for
!     any reason.
!
!     IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY
!     PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
!     DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS
!     SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
!     CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!     THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY
!     WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
!     OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
!     SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE
!     UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE
!     MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

      SUBROUTINE SPARMULVV(dof, nNo, nnz, commu, cS, rowPtr, colPtr,
     2   K, U, KU)

      INCLUDE "svLS_STD.h"

      INTEGER, INTENT(IN) :: dof, nNo, nnz
      TYPE(svLS_commuType), INTENT(IN) :: commu
      TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks)
      INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz)
      REAL*8, INTENT(IN) :: K(dof*dof,nnz), U(dof,nNo)
      REAL*8, INTENT(OUT) :: KU(dof,nNo)

      INTEGER i, j, l, col, s, e

      KU = 0D0
      SELECT CASE (dof)
      CASE (1)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               KU(1,i) = KU(1,i) + K(1,j)*U(1,colPtr(j))
            END DO
         END DO
      CASE(2)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1,j)*U(1,col) + K(2,j)*U(2,col)
               KU(2,i) = KU(2,i) + K(3,j)*U(1,col) + K(4,j)*U(2,col)
            END DO
         END DO
      CASE(3)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1,j)*U(1,col) + K(2,j)*U(2,col)
     2                           + K(3,j)*U(3,col)
               KU(2,i) = KU(2,i) + K(4,j)*U(1,col) + K(5,j)*U(2,col)
     2                           + K(6,j)*U(3,col)
               KU(3,i) = KU(3,i) + K(7,j)*U(1,col) + K(8,j)*U(2,col)
     2                           + K(9,j)*U(3,col)
            END DO
         END DO
      CASE(4)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1 ,j)*U(1,col) + K(2 ,j)*U(2,col)
     2                           + K(3 ,j)*U(3,col) + K(4 ,j)*U(4,col)
               KU(2,i) = KU(2,i) + K(5 ,j)*U(1,col) + K(6 ,j)*U(2,col)
     2                           + K(7 ,j)*U(3,col) + K(8 ,j)*U(4,col)
               KU(3,i) = KU(3,i) + K(9 ,j)*U(1,col) + K(10,j)*U(2,col)
     2                           + K(11,j)*U(3,col) + K(12,j)*U(4,col)
               KU(4,i) = KU(4,i) + K(13,j)*U(1,col) + K(14,j)*U(2,col)
     2                           + K(15,j)*U(3,col) + K(16,j)*U(4,col)
            END DO
         END DO
      CASE DEFAULT
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               DO l=1, dof
                  e = l*dof
                  s = e - dof + 1
                  KU(l,i) = KU(l,i) + SUM(K(s:e,j)*U(:,col))
               END DO
            END DO
         END DO
      END SELECT

      CALL COMMUV(dof, nNo, commu, cS, KU)

      RETURN
      END SUBROUTINE SPARMULVV

!====================================================================

      SUBROUTINE SPARMULVS(dof, nNo, nnz, commu, cS, rowPtr, colPtr,
     2   K, U, KU)

      INCLUDE "svLS_STD.h"

      INTEGER, INTENT(IN) :: dof, nNo, nnz
      TYPE(svLS_commuType), INTENT(IN) :: commu
      TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks)
      INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz)
      REAL*8, INTENT(IN) :: K(dof,nnz), U(dof,nNo)
      REAL*8, INTENT(OUT) :: KU(nNo)

      INTEGER i, j, col

      KU = 0D0
      SELECT CASE (dof)
      CASE (1)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               KU(i) = KU(i) + K(1,j)*U(1,colPtr(j))
            END DO
         END DO
      CASE(2)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col)
            END DO
         END DO
      CASE(3)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col)
     2                       + K(3,j)*U(3,col)
            END DO
         END DO
      CASE(4)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col)
     2                       + K(3,j)*U(3,col) + K(4,j)*U(4,col)
            END DO
         END DO
      CASE DEFAULT
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               KU(i) = KU(i) + SUM(K(:,j)*U(:,colPtr(j)))
            END DO
         END DO
      END SELECT

      CALL COMMUS(nNo, commu, cS, KU)

      RETURN
      END SUBROUTINE SPARMULVS

!====================================================================

      SUBROUTINE SPARMULSV(dof, nNo, nnz, commu, cS, rowPtr, colPtr,
     2   K, U, KU)

      INCLUDE "svLS_STD.h"

      INTEGER, INTENT(IN) :: dof, nNo, nnz
      TYPE(svLS_commuType), INTENT(IN) :: commu
      TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks)
      INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz)
      REAL*8, INTENT(IN) :: K(dof,nnz), U(nNo)
      REAL*8, INTENT(OUT) :: KU(dof,nNo)

      INTEGER i, j, col

      KU = 0D0
      SELECT CASE (dof)
      CASE (1)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               KU(1,i) = KU(1,i) + K(1,j)*U(colPtr(j))
            END DO
         END DO
      CASE(2)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1,j)*U(col)
               KU(2,i) = KU(2,i) + K(2,j)*U(col)
            END DO
         END DO
      CASE(3)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1,j)*U(col)
               KU(2,i) = KU(2,i) + K(2,j)*U(col)
               KU(3,i) = KU(3,i) + K(3,j)*U(col)
            END DO
         END DO
      CASE(4)
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               col = colPtr(j)
               KU(1,i) = KU(1,i) + K(1,j)*U(col)
               KU(2,i) = KU(2,i) + K(2,j)*U(col)
               KU(3,i) = KU(3,i) + K(3,j)*U(col)
               KU(4,i) = KU(4,i) + K(4,j)*U(col)
            END DO
         END DO
      CASE DEFAULT
         DO i=1, nNo
            DO j=rowPtr(1,i), rowPtr(2,i)
               KU(:,i) = KU(:,i) + K(:,j)*U(colPtr(j))
            END DO
         END DO
      END SELECT

      CALL COMMUV(dof, nNo, commu, cS, KU)

      RETURN
      END SUBROUTINE SPARMULSV

!====================================================================

      SUBROUTINE SPARMULSS(nNo, nnz, commu, cS, rowPtr, colPtr,
     2   K, U, KU)

      INCLUDE "svLS_STD.h"

      INTEGER, INTENT(IN) :: nNo, nnz
      TYPE(svLS_commuType), INTENT(IN) :: commu
      TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks)
      INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz)
      REAL*8, INTENT(IN) :: K(nnz), U(nNo)
      REAL*8, INTENT(OUT) :: KU(nNo)

      INTEGER i, j

      KU = 0D0
      DO i=1, nNo
         DO j=rowPtr(1,i), rowPtr(2,i)
            KU(i) = KU(i) + K(j)*U(colPtr(j))
         END DO
      END DO

      CALL COMMUS(nNo, commu, cS, KU)

      RETURN
      END SUBROUTINE SPARMULSS