xref: /phasta/svLS/LS.f (revision b4435cfe26b7e7385c644bc5a8218ede2d6189cd)
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_LS_CREATE(ls, LS_type, relTol, absTol, maxItr,
42     2   dimKry, relTolIn, absTolIn, maxItrIn)
43
44      INCLUDE "svLS_STD.h"
45
46      TYPE(svLS_lsType), INTENT(INOUT) :: ls
47      INTEGER, INTENT(IN) :: LS_type
48      REAL*8, INTENT(IN), OPTIONAL :: relTol, absTol, relTolIn(2),
49     2   absTolIn(2)
50      INTEGER, INTENT(IN), OPTIONAL :: maxItr, dimKry, maxItrIn(2)
51
52      IF (ls%foC) THEN
53         PRINT *, "LS is not free"
54         PRINT *, "You may use svLS_LS_FREE to free this structure"
55      END IF
56
57      ls%foC     = .TRUE.
58      ls%LS_type = LS_type
59
60      SELECT CASE (LS_type)
61         CASE (LS_TYPE_NS)
62            ls%RI%relTol = 4D-1
63            ls%GM%relTol = 1D-2
64            ls%CG%relTol = 1D-1
65            ls%RI%mItr = 10
66            ls%GM%mItr = 3
67            ls%CG%mItr = 500
68            ls%GM%sD   = 50
69         CASE (LS_TYPE_GMRES)
70            ls%RI%relTol = 1D-2
71            ls%RI%mItr   = 2
72            ls%RI%sD     = 150
73         CASE (LS_TYPE_CG)
74            ls%RI%reltol = 1D-4
75            ls%RI%mItr   = 1000
76         CASE DEFAULT
77            PRINT *, 'Solver type LS_TYPE is not defined'
78            STOP
79      END SELECT
80      ls%RI%absTol = 1D-10
81      ls%GM%absTol = 1D-10
82      ls%CG%absTol = 1D-10
83
84      IF (PRESENT(relTol)) ls%RI%relTol = relTol
85      IF (PRESENT(absTol)) ls%RI%absTol = absTol
86      IF (PRESENT(maxItr)) ls%RI%mItr   = maxItr
87
88      IF (PRESENT(dimKry)) THEN
89         ls%RI%sD = dimKry
90         ls%GM%sD = dimKry
91      END IF
92      IF (PRESENT(relTolIn)) THEN
93         ls%GM%relTol = relTolIn(1)
94         ls%CG%relTol = relTolIn(2)
95      END IF
96      IF (PRESENT(absTolIn)) THEN
97         ls%GM%absTol = absTolIn(1)
98         ls%CG%absTol = absTolIn(2)
99      END IF
100      IF (PRESENT(maxItrIn)) THEN
101         ls%GM%mItr = maxItrIn(1)
102         ls%CG%mItr = maxItrIn(2)
103      END IF
104
105      RETURN
106      END SUBROUTINE svLS_LS_CREATE
107
108!====================================================================
109
110      SUBROUTINE svLS_LS_FREE (ls)
111
112      INCLUDE "svLS_STD.h"
113
114      TYPE(svLS_lsType), INTENT(INOUT) :: ls
115
116      IF (.NOT.ls%foC) THEN
117         PRINT *, 'Cannot free LS'
118         PRINT *, 'It is not created yet'
119         STOP
120      END IF
121      ls%foC  = .FALSE.
122
123      RETURN
124      END SUBROUTINE svLS_LS_FREE
125
126