1! This software is Copyright (c) 2012-2015 The Regents of the 2! University of California. All Rights Reserved. 3! 4! Permission to copy and modify this software and its documentation 5! for educational, research and non-profit purposes, without fee, 6! and without a written agreement is hereby granted, provided that 7! the above copyright notice, this paragraph and the following three 8! paragraphs appear in all copies. 9! 10! Permission to make commercial use of this software may be obtained 11! by contacting: 12! 13! Technology Transfer Office 14! 9500 Gilman Drive, Mail Code 0910 15! University of California 16! La Jolla, CA 92093-0910 17! (858) 534-5815 18! invent@ucsd.edu 19! 20! This software program and documentation are copyrighted by The 21! Regents of the University of California. The software program and 22! documentation are supplied "as is", without any accompanying 23! services from The Regents. The Regents does not warrant that the 24! operation of the program will be uninterrupted or error-free. The 25! end-user understands that the program was developed for research 26! purposes and is advised not to rely exclusively on the program for 27! any reason. 28! 29! IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY 30! PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL 31! DAMAGES, INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS 32! SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF 33! CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 34! THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY 35! WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 36! OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 37! SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" BASIS, AND THE 38! UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE 39! MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. 40 41 SUBROUTINE SPARMULVV(dof, nNo, nnz, commu, cS, rowPtr, colPtr, 42 2 K, U, KU) 43 44 INCLUDE "svLS_STD.h" 45 46 INTEGER, INTENT(IN) :: dof, nNo, nnz 47 TYPE(svLS_commuType), INTENT(IN) :: commu 48 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 49 INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz) 50 REAL*8, INTENT(IN) :: K(dof*dof,nnz), U(dof,nNo) 51 REAL*8, INTENT(OUT) :: KU(dof,nNo) 52 53 INTEGER i, j, l, col, s, e 54 55 KU = 0D0 56 SELECT CASE (dof) 57 CASE (1) 58 DO i=1, nNo 59 DO j=rowPtr(1,i), rowPtr(2,i) 60 KU(1,i) = KU(1,i) + K(1,j)*U(1,colPtr(j)) 61 END DO 62 END DO 63 CASE(2) 64 DO i=1, nNo 65 DO j=rowPtr(1,i), rowPtr(2,i) 66 col = colPtr(j) 67 KU(1,i) = KU(1,i) + K(1,j)*U(1,col) + K(2,j)*U(2,col) 68 KU(2,i) = KU(2,i) + K(3,j)*U(1,col) + K(4,j)*U(2,col) 69 END DO 70 END DO 71 CASE(3) 72 DO i=1, nNo 73 DO j=rowPtr(1,i), rowPtr(2,i) 74 col = colPtr(j) 75 KU(1,i) = KU(1,i) + K(1,j)*U(1,col) + K(2,j)*U(2,col) 76 2 + K(3,j)*U(3,col) 77 KU(2,i) = KU(2,i) + K(4,j)*U(1,col) + K(5,j)*U(2,col) 78 2 + K(6,j)*U(3,col) 79 KU(3,i) = KU(3,i) + K(7,j)*U(1,col) + K(8,j)*U(2,col) 80 2 + K(9,j)*U(3,col) 81 END DO 82 END DO 83 CASE(4) 84 DO i=1, nNo 85 DO j=rowPtr(1,i), rowPtr(2,i) 86 col = colPtr(j) 87 KU(1,i) = KU(1,i) + K(1 ,j)*U(1,col) + K(2 ,j)*U(2,col) 88 2 + K(3 ,j)*U(3,col) + K(4 ,j)*U(4,col) 89 KU(2,i) = KU(2,i) + K(5 ,j)*U(1,col) + K(6 ,j)*U(2,col) 90 2 + K(7 ,j)*U(3,col) + K(8 ,j)*U(4,col) 91 KU(3,i) = KU(3,i) + K(9 ,j)*U(1,col) + K(10,j)*U(2,col) 92 2 + K(11,j)*U(3,col) + K(12,j)*U(4,col) 93 KU(4,i) = KU(4,i) + K(13,j)*U(1,col) + K(14,j)*U(2,col) 94 2 + K(15,j)*U(3,col) + K(16,j)*U(4,col) 95 END DO 96 END DO 97 CASE DEFAULT 98 DO i=1, nNo 99 DO j=rowPtr(1,i), rowPtr(2,i) 100 col = colPtr(j) 101 DO l=1, dof 102 e = l*dof 103 s = e - dof + 1 104 KU(l,i) = KU(l,i) + SUM(K(s:e,j)*U(:,col)) 105 END DO 106 END DO 107 END DO 108 END SELECT 109 110 CALL COMMUV(dof, nNo, commu, cS, KU) 111 112 RETURN 113 END SUBROUTINE SPARMULVV 114 115!==================================================================== 116 117 SUBROUTINE SPARMULVS(dof, nNo, nnz, commu, cS, rowPtr, colPtr, 118 2 K, U, KU) 119 120 INCLUDE "svLS_STD.h" 121 122 INTEGER, INTENT(IN) :: dof, nNo, nnz 123 TYPE(svLS_commuType), INTENT(IN) :: commu 124 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 125 INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz) 126 REAL*8, INTENT(IN) :: K(dof,nnz), U(dof,nNo) 127 REAL*8, INTENT(OUT) :: KU(nNo) 128 129 INTEGER i, j, col 130 131 KU = 0D0 132 SELECT CASE (dof) 133 CASE (1) 134 DO i=1, nNo 135 DO j=rowPtr(1,i), rowPtr(2,i) 136 KU(i) = KU(i) + K(1,j)*U(1,colPtr(j)) 137 END DO 138 END DO 139 CASE(2) 140 DO i=1, nNo 141 DO j=rowPtr(1,i), rowPtr(2,i) 142 col = colPtr(j) 143 KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col) 144 END DO 145 END DO 146 CASE(3) 147 DO i=1, nNo 148 DO j=rowPtr(1,i), rowPtr(2,i) 149 col = colPtr(j) 150 KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col) 151 2 + K(3,j)*U(3,col) 152 END DO 153 END DO 154 CASE(4) 155 DO i=1, nNo 156 DO j=rowPtr(1,i), rowPtr(2,i) 157 col = colPtr(j) 158 KU(i) = KU(i) + K(1,j)*U(1,col) + K(2,j)*U(2,col) 159 2 + K(3,j)*U(3,col) + K(4,j)*U(4,col) 160 END DO 161 END DO 162 CASE DEFAULT 163 DO i=1, nNo 164 DO j=rowPtr(1,i), rowPtr(2,i) 165 KU(i) = KU(i) + SUM(K(:,j)*U(:,colPtr(j))) 166 END DO 167 END DO 168 END SELECT 169 170 CALL COMMUS(nNo, commu, cS, KU) 171 172 RETURN 173 END SUBROUTINE SPARMULVS 174 175!==================================================================== 176 177 SUBROUTINE SPARMULSV(dof, nNo, nnz, commu, cS, rowPtr, colPtr, 178 2 K, U, KU) 179 180 INCLUDE "svLS_STD.h" 181 182 INTEGER, INTENT(IN) :: dof, nNo, nnz 183 TYPE(svLS_commuType), INTENT(IN) :: commu 184 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 185 INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz) 186 REAL*8, INTENT(IN) :: K(dof,nnz), U(nNo) 187 REAL*8, INTENT(OUT) :: KU(dof,nNo) 188 189 INTEGER i, j, col 190 191 KU = 0D0 192 SELECT CASE (dof) 193 CASE (1) 194 DO i=1, nNo 195 DO j=rowPtr(1,i), rowPtr(2,i) 196 KU(1,i) = KU(1,i) + K(1,j)*U(colPtr(j)) 197 END DO 198 END DO 199 CASE(2) 200 DO i=1, nNo 201 DO j=rowPtr(1,i), rowPtr(2,i) 202 col = colPtr(j) 203 KU(1,i) = KU(1,i) + K(1,j)*U(col) 204 KU(2,i) = KU(2,i) + K(2,j)*U(col) 205 END DO 206 END DO 207 CASE(3) 208 DO i=1, nNo 209 DO j=rowPtr(1,i), rowPtr(2,i) 210 col = colPtr(j) 211 KU(1,i) = KU(1,i) + K(1,j)*U(col) 212 KU(2,i) = KU(2,i) + K(2,j)*U(col) 213 KU(3,i) = KU(3,i) + K(3,j)*U(col) 214 END DO 215 END DO 216 CASE(4) 217 DO i=1, nNo 218 DO j=rowPtr(1,i), rowPtr(2,i) 219 col = colPtr(j) 220 KU(1,i) = KU(1,i) + K(1,j)*U(col) 221 KU(2,i) = KU(2,i) + K(2,j)*U(col) 222 KU(3,i) = KU(3,i) + K(3,j)*U(col) 223 KU(4,i) = KU(4,i) + K(4,j)*U(col) 224 END DO 225 END DO 226 CASE DEFAULT 227 DO i=1, nNo 228 DO j=rowPtr(1,i), rowPtr(2,i) 229 KU(:,i) = KU(:,i) + K(:,j)*U(colPtr(j)) 230 END DO 231 END DO 232 END SELECT 233 234 CALL COMMUV(dof, nNo, commu, cS, KU) 235 236 RETURN 237 END SUBROUTINE SPARMULSV 238 239!==================================================================== 240 241 SUBROUTINE SPARMULSS(nNo, nnz, commu, cS, rowPtr, colPtr, 242 2 K, U, KU) 243 244 INCLUDE "svLS_STD.h" 245 246 INTEGER, INTENT(IN) :: nNo, nnz 247 TYPE(svLS_commuType), INTENT(IN) :: commu 248 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 249 INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz) 250 REAL*8, INTENT(IN) :: K(nnz), U(nNo) 251 REAL*8, INTENT(OUT) :: KU(nNo) 252 253 INTEGER i, j 254 255 KU = 0D0 256 DO i=1, nNo 257 DO j=rowPtr(1,i), rowPtr(2,i) 258 KU(i) = KU(i) + K(j)*U(colPtr(j)) 259 END DO 260 END DO 261 262 CALL COMMUS(nNo, commu, cS, KU) 263 264 RETURN 265 END SUBROUTINE SPARMULSS 266 267