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 svLS_SOLVE (lhs, ls, dof, Ri, Val, incL, res) 42 43 INCLUDE "svLS_STD.h" 44 45 TYPE(svLS_lhsType), INTENT(INOUT) :: lhs 46 TYPE(svLS_lsType), INTENT(INOUT) :: ls 47 INTEGER, INTENT(IN) :: dof 48 REAL*8, INTENT(INOUT) :: Ri(dof,lhs%nNo) 49 REAL*8, INTENT(INOUT) :: Val(dof*dof,lhs%nnz) 50 INTEGER, INTENT(IN), OPTIONAL :: incL(lhs%nFaces) 51 REAL*8, INTENT(IN), OPTIONAL :: res(lhs%nFaces) 52 53 LOGICAL flag 54 INTEGER faIn, a, nNo, nnz, nFaces 55 REAL*8, ALLOCATABLE :: R(:,:), W(:,:) 56 57 nNo = lhs%nNo 58 nnz = lhs%nnz 59 nFaces = lhs%nFaces 60 61 IF (lhs%nFaces .NE. 0) THEN 62 lhs%face%incFlag = .TRUE. 63 IF (PRESENT(incL)) THEN 64 DO faIn=1, lhs%nFaces 65 IF (incL(faIn) .EQ. 0) lhs%face(faIn)%incFlag = .FALSE. 66 END DO 67 END IF 68 69 flag = ANY(lhs%face%bGrp.EQ.BC_TYPE_Neu) 70 IF (.NOT.PRESENT(res) .AND. flag) THEN 71 PRINT *, "res is required when there is a Neu surface" 72 END IF 73 DO faIn=1, lhs%nFaces 74 lhs%face(faIn)%coupledFlag = .FALSE. 75 IF (.NOT.lhs%face(faIn)%incFlag) CYCLE 76 flag = lhs%face(faIn)%bGrp .EQ. BC_TYPE_Neu 77 IF (flag .AND. res(faIn).NE.0D0) THEN 78 lhs%face(faIn)%res = res(faIn) 79 lhs%face(faIn)%coupledFlag = .TRUE. 80 END IF 81 END DO 82 END IF 83 84 ALLOCATE(R(dof,nNo), W(dof,nNo)) 85 DO a=1, nNo 86 R(:,lhs%map(a)) = Ri(:,a) 87 END DO 88 89 CALL COMMUV(dof, nNo, lhs%commu, lhs%cS, R) 90 CALL PRECOND(nFaces, dof, nNo, nnz, lhs%commu, lhs%cS, 91 2 lhs%face, lhs%rowPtr, lhs%colPtr, lhs%diagPtr, Val, R, W) 92 93 SELECT CASE (ls%LS_type) 94 CASE (LS_TYPE_NS) 95 CALL NSSOLVER(nFaces, lhs%gnNo, dof, nNo, nnz, lhs%mynNo, 96 2 lhs%commu, lhs%cS, lhs%face, ls, lhs%rowPtr, lhs%colPtr, 97 3 Val, R) 98 CASE (LS_TYPE_GMRES) 99 CALL GMRESV(nFaces, dof, nNo, nnz, lhs%mynNo, lhs%commu, 100 2 lhs%cS, lhs%face, ls%RI, lhs%rowPtr, lhs%colPtr, Val, R) 101 CASE (LS_TYPE_CG) 102 IF (dof .EQ. 1) THEN 103 CALL CGRADS(nNo, nnz, lhs%mynNo, lhs%commu, lhs%cS, 104 2 ls%RI, lhs%rowPtr, lhs%colPtr, Val, R) 105 ELSE 106 CALL CGRADV(dof, nNo, nnz, lhs%mynNo, lhs%commu, lhs%cS, 107 2 ls%RI, lhs%rowPtr, lhs%colPtr, Val, R) 108 END IF 109 CASE DEFAULT 110 PRINT *, 'LS_type not defined' 111 STOP 112 END SELECT 113 R = R*W 114 115 DO a=1, nNo 116 Ri(:,a) = R(:,lhs%map(a)) 117 END DO 118 119 DEALLOCATE(R, W) 120 121 RETURN 122 END SUBROUTINE svLS_SOLVE 123 124