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 PRECOND(nFaces, dof, nNo, nnz, commu, cS, face, 42 2 rowPtr, colPtr, diagPtr, Val, R, W) 43 44 INCLUDE "svLS_STD.h" 45 46 INTEGER, INTENT(IN) :: nFaces, dof, nNo, nnz 47 TYPE(svLS_commuType), INTENT(IN) :: commu 48 TYPE(svLS_cSType), INTENT(IN) :: cS(commu%nTasks) 49 TYPE(svLS_faceType), INTENT(INOUT) :: face(nFaces) 50 INTEGER, INTENT(IN) :: rowPtr(2,nNo), colPtr(nnz), diagPtr(nNo) 51 REAL*8, INTENT(INOUT) :: Val(dof*dof,nnz), R(dof,nNo) 52 REAL*8, INTENT(OUT) :: W(dof,nNo) 53 54 INTEGER i, j, a, b, d, Ac, faIn 55 56 SELECT CASE (dof) 57 CASE (1) 58 DO Ac=1, nNo 59 W(1,Ac) = Val(1,diagPtr(Ac)) 60 END DO 61 CASE(2) 62 DO Ac=1, nNo 63 d = diagPtr(Ac) 64 W(1,Ac) = Val(1,d) 65 W(2,Ac) = Val(4,d) 66 END DO 67 CASE(3) 68 DO Ac=1, nNo 69 d = diagPtr(Ac) 70 W(1,Ac) = Val(1,d) 71 W(2,Ac) = Val(5,d) 72 W(3,Ac) = Val(9,d) 73 END DO 74 CASE(4) 75 DO Ac=1, nNo 76 d = diagPtr(Ac) 77 W(1,Ac) = Val(1,d) 78 W(2,Ac) = Val(6,d) 79 W(3,Ac) = Val(11,d) 80 W(4,Ac) = Val(16,d) 81 END DO 82 CASE DEFAULT 83 DO Ac=1, nNo 84 d = diagPtr(Ac) 85 DO i=1, dof 86 W(i,Ac) = Val(i*dof-dof+i,d) 87 END DO 88 END DO 89 END SELECT 90 91 CALL COMMUV(dof, nNo, commu, cS, W) 92 93 DO Ac=1, nNo 94 d = diagPtr(Ac) 95 DO i=1, dof 96 IF (W(i,Ac) .EQ. 0D0) THEN 97 W(i,Ac) = 1D0 98 Val(i*dof-dof+i,d) = 1D0 99 END IF 100 END DO 101 END DO 102 103 W = 1D0/SQRT(ABS(W)) 104 DO faIn=1, nFaces 105 IF (.NOT.face(faIn)%incFlag) CYCLE 106 i = MIN(face(faIn)%dof,dof) 107 IF (face(faIn)%bGrp .EQ. BC_TYPE_Dir) THEN 108 DO a=1, face(faIn)%nNo 109 Ac = face(faIn)%glob(a) 110 W(1:i,Ac) = W(1:i,Ac)*face(faIn)%val(1:i,a) 111 END DO 112 END IF 113 END DO 114 115 SELECT CASE (dof) 116 CASE (1) 117 DO Ac=1, nNo 118 a = rowPtr(1,Ac) 119 b = rowPtr(2,Ac) 120 Val(1,a:b) = Val(1,a:b)*W(1,Ac) 121 END DO 122 CASE(2) 123 DO Ac=1, nNo 124 a = rowPtr(1,Ac) 125 b = rowPtr(2,Ac) 126 Val(1:2,a:b) = Val(1:2,a:b)*W(1,Ac) 127 Val(3:4,a:b) = Val(3:4,a:b)*W(2,Ac) 128 END DO 129 CASE(3) 130 DO Ac=1, nNo 131 a = rowPtr(1,Ac) 132 b = rowPtr(2,Ac) 133 Val(1:3,a:b) = Val(1:3,a:b)*W(1,Ac) 134 Val(4:6,a:b) = Val(4:6,a:b)*W(2,Ac) 135 Val(7:9,a:b) = Val(7:9,a:b)*W(3,Ac) 136 END DO 137 CASE(4) 138 DO Ac=1, nNo 139 a = rowPtr(1,Ac) 140 b = rowPtr(2,Ac) 141 Val(1:4,a:b) = Val(1:4,a:b)*W(1,Ac) 142 Val(5:8,a:b) = Val(5:8,a:b)*W(2,Ac) 143 Val(9:12,a:b) = Val(9:12,a:b)*W(3,Ac) 144 Val(13:16,a:b) = Val(13:16,a:b)*W(4,Ac) 145 END DO 146 CASE DEFAULT 147 DO Ac=1, nNo 148 a = rowPtr(1,Ac) 149 b = rowPtr(2,Ac) 150 DO i=1, dof 151 j = i*dof - dof + 1 152 Val(j:i*dof,a:b) = Val(j:i*dof,a:b)*W(i,Ac) 153 END DO 154 END DO 155 END SELECT 156 R = W*R 157 SELECT CASE (dof) 158 CASE (1) 159 DO Ac=1, nNo 160 DO i=rowPtr(1,Ac), rowPtr(2,Ac) 161 a = colPtr(i) 162 Val(1,i) = Val(1,i)*W(1,a) 163 END DO 164 END DO 165 CASE (2) 166 DO Ac=1, nNo 167 DO i=rowPtr(1,Ac), rowPtr(2,Ac) 168 a = colPtr(i) 169 Val(1:3:2,i) = Val(1:3:2,i)*W(1,a) 170 Val(2:4:2,i) = Val(2:4:2,i)*W(2,a) 171 END DO 172 END DO 173 CASE (3) 174 DO Ac=1, nNo 175 DO i=rowPtr(1,Ac), rowPtr(2,Ac) 176 a = colPtr(i) 177 Val(1:7:3,i) = Val(1:7:3,i)*W(1,a) 178 Val(2:8:3,i) = Val(2:8:3,i)*W(2,a) 179 Val(3:9:3,i) = Val(3:9:3,i)*W(3,a) 180 END DO 181 END DO 182 CASE (4) 183 DO Ac=1, nNo 184 DO i=rowPtr(1,Ac), rowPtr(2,Ac) 185 a = colPtr(i) 186 Val(1:13:4,i) = Val(1:13:4,i)*W(1,a) 187 Val(2:14:4,i) = Val(2:14:4,i)*W(2,a) 188 Val(3:15:4,i) = Val(3:15:4,i)*W(3,a) 189 Val(4:16:4,i) = Val(4:16:4,i)*W(4,a) 190 END DO 191 END DO 192 CASE DEFAULT 193 DO Ac=1, nNo 194 DO i=rowPtr(1,Ac), rowPtr(2,Ac) 195 a = colPtr(i) 196 DO b=1, dof 197 j = dof*(dof-1) + b 198 Val(b:j:dof,i) = Val(b:j:dof,i)*W(b,a) 199 END DO 200 END DO 201 END DO 202 END SELECT 203 204 DO Ac=1, nNo 205 i = diagPtr(Ac) 206 DO a=1, dof 207 b = (a-1)*dof + a 208 IF (Val(b,i) .EQ. 0D0) Val(b,i) = 1D0 209 END DO 210 END DO 211 212 DO faIn=1, nFaces 213 IF (face(faIn)%coupledFlag) THEN 214 DO a=1, face(faIn)%nNo 215 Ac = face(faIn)%glob(a) 216 DO i=1, MIN(face(faIn)%dof,dof) 217 face(faIn)%valM(i,a) = face(faIn)%val(i,a)*W(i,Ac) 218 END DO 219 END DO 220 END IF 221 END DO 222 223 RETURN 224 END SUBROUTINE PRECOND 225