-
Notifications
You must be signed in to change notification settings - Fork 47
/
SOLVE.f
123 lines (109 loc) · 4.6 KB
/
SOLVE.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
! 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
!
! 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 svLS_SOLVE (lhs, ls, dof, Ri, Val, incL, res)
INCLUDE "svLS_STD.h"
TYPE(svLS_lhsType), INTENT(INOUT) :: lhs
TYPE(svLS_lsType), INTENT(INOUT) :: ls
INTEGER, INTENT(IN) :: dof
REAL*8, INTENT(INOUT) :: Ri(dof,lhs%nNo)
REAL*8, INTENT(INOUT) :: Val(dof*dof,lhs%nnz)
INTEGER, INTENT(IN), OPTIONAL :: incL(lhs%nFaces)
REAL*8, INTENT(IN), OPTIONAL :: res(lhs%nFaces)
LOGICAL flag
INTEGER faIn, a, nNo, nnz, nFaces
REAL*8, ALLOCATABLE :: R(:,:), W(:,:)
nNo = lhs%nNo
nnz = lhs%nnz
nFaces = lhs%nFaces
IF (lhs%nFaces .NE. 0) THEN
lhs%face%incFlag = .TRUE.
IF (PRESENT(incL)) THEN
DO faIn=1, lhs%nFaces
IF (incL(faIn) .EQ. 0) lhs%face(faIn)%incFlag = .FALSE.
END DO
END IF
flag = ANY(lhs%face%bGrp.EQ.BC_TYPE_Neu)
IF (.NOT.PRESENT(res) .AND. flag) THEN
PRINT *, "res is required when there is a Neu surface"
END IF
DO faIn=1, lhs%nFaces
lhs%face(faIn)%coupledFlag = .FALSE.
IF (.NOT.lhs%face(faIn)%incFlag) CYCLE
flag = lhs%face(faIn)%bGrp .EQ. BC_TYPE_Neu
IF (flag .AND. res(faIn).NE.0D0) THEN
lhs%face(faIn)%res = res(faIn)
lhs%face(faIn)%coupledFlag = .TRUE.
END IF
END DO
END IF
ALLOCATE(R(dof,nNo), W(dof,nNo))
DO a=1, nNo
R(:,lhs%map(a)) = Ri(:,a)
END DO
CALL COMMUV(dof, nNo, lhs%commu, lhs%cS, R)
CALL PRECOND(nFaces, dof, nNo, nnz, lhs%commu, lhs%cS,
2 lhs%face, lhs%rowPtr, lhs%colPtr, lhs%diagPtr, Val, R, W)
SELECT CASE (ls%LS_type)
CASE (LS_TYPE_NS)
CALL NSSOLVER(nFaces, lhs%gnNo, dof, nNo, nnz, lhs%mynNo,
2 lhs%commu, lhs%cS, lhs%face, ls, lhs%rowPtr, lhs%colPtr,
3 Val, R)
CASE (LS_TYPE_GMRES)
CALL GMRESV(nFaces, dof, nNo, nnz, lhs%mynNo, lhs%commu,
2 lhs%cS, lhs%face, ls%RI, lhs%rowPtr, lhs%colPtr, Val, R)
CASE (LS_TYPE_CG)
IF (dof .EQ. 1) THEN
CALL CGRADS(nNo, nnz, lhs%mynNo, lhs%commu, lhs%cS,
2 ls%RI, lhs%rowPtr, lhs%colPtr, Val, R)
ELSE
CALL CGRADV(dof, nNo, nnz, lhs%mynNo, lhs%commu, lhs%cS,
2 ls%RI, lhs%rowPtr, lhs%colPtr, Val, R)
END IF
CASE DEFAULT
PRINT *, 'LS_type not defined'
STOP
END SELECT
R = R*W
DO a=1, nNo
Ri(:,a) = R(:,lhs%map(a))
END DO
DEALLOCATE(R, W)
RETURN
END SUBROUTINE svLS_SOLVE