solver_all.f90 7.68 KB
Newer Older
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
! solver_all.f90 --- provides a high-level solve function
!
! Copyright  (C)  2010  Florian Wilhelm <Florian.Wilhelm@kit.edu>
!
! Version: 1.0
! Keywords: scales ppm solver
! Author: Florian Wilhelm <Florian.Wilhelm@kit.edu>
! Maintainer: Florian Wilhelm <Florian.Wilhelm@kit.edu>
! URL: https://www.dkrz.de/redmine/projects/show/scales-ppm
!
! Redistribution and use in source and binary forms, with or without
! modification, are  permitted provided that the following conditions are
! met:
!
! Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
!
! Neither the name of the DKRZ GmbH nor the names of its contributors
! may be used to endorse or promote products derived from this software
! without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Commentary:
!
! Code:
!

43
44
MODULE solver_all
    USE solver_config
45
46
    USE linear_algebra
    USE solvers
47
    USE preconditioners
48
    USE spectral_methods
Florian Wilhelm's avatar
Florian Wilhelm committed
49

50
    IMPLICIT NONE
Florian Wilhelm's avatar
Florian Wilhelm committed
51

52
    CONTAINS
Florian Wilhelm's avatar
Florian Wilhelm committed
53

54
55
    ! Dispatcher solve function which calls the appropiate solver/preconditioner
    ! according to the config settings
56
57
    FUNCTION solve(A, b, x, ext_x, exchange, tol_opt, maxiter_opt) RESULT(kiter)
        USE solver_internal
58
        USE ppm_extents, ONLY: extent_type => extent
59
        USE ppm_base, ONLY: abort_ppm
60
        USE mo_kind, ONLY: wp, dp
Florian Wilhelm's avatar
Florian Wilhelm committed
61

62
63
64
65
66
67
68
69
70
71
        REAL(wp), INTENT(IN) :: b(:,:)                  ! right-hand-side b
        REAL(wp), INTENT(INOUT) :: x(:,:)               ! startvalue and result
        TYPE(extent_type), INTENT(IN) :: ext_x(:)       ! extent of x
        REAL(wp), OPTIONAL, INTENT(IN) :: tol_opt       ! tolerance for residual
        INTEGER, OPTIONAL, INTENT(IN) :: maxiter_opt    ! maximum iterations
        INTEGER :: kiter, maxiter
        REAL(wp) :: tol

        INTERFACE
            ! Matrix-Vector multiplication of the linear system to solve
Florian Wilhelm's avatar
Florian Wilhelm committed
72
            SUBROUTINE A(field, res_field)
73
                USE mo_kind, ONLY: wp, dp
74
75
76
77
78
                REAL(wp), INTENT(IN) :: field(:,:)
                REAL(wp), INTENT(OUT) :: res_field(:,:)
            END SUBROUTINE
            ! Function to exchange boundaries if necessary
            SUBROUTINE exchange(a0, text)
79
                USE mo_kind, ONLY: wp, dp
80
81
82
83
84
85
86
87
88
89
90
91
                REAL(wp), INTENT(INOUT) :: a0(:,:)
                CHARACTER (LEN=*), INTENT(IN), OPTIONAL :: text
            END SUBROUTINE exchange
        END INTERFACE

        ! Check and set optional arguments
        IF ( PRESENT(maxiter_opt) ) THEN
            maxiter = maxiter_opt
        ELSE
            maxiter = config%maxiter
        ENDIF
        IF ( PRESENT(tol_opt) ) THEN
Florian Wilhelm's avatar
Florian Wilhelm committed
92
            tol = tol_opt
93
94
95
        ELSE
            tol = config%tol
        ENDIF
Florian Wilhelm's avatar
Florian Wilhelm committed
96

97
98
        ! Make sure stencil is set up
        IF (.NOT. stencil_defined()) THEN
Thomas Jahns's avatar
Thomas Jahns committed
99
100
101
            CALL abort_ppm("Stencil is not defined! Use set_stencil() first.", &
                 __FILE__, &
                 __LINE__)
102
        ENDIF
Florian Wilhelm's avatar
Florian Wilhelm committed
103

104
105
106
        ! Make sure preconditioner is initialized
        IF (.NOT. precond_prepared(config%preconditioner)) THEN
            SELECT CASE (config%preconditioner)
107
108
            CASE (JACOBI_PRECOND)
                CALL prep_jacobi()
109
110
111
            CASE (ILU0_PRECOND)
                CALL prep_ilu0()
            CASE (SSOR_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
112
113
114
                CALL abort_ppm("No SSOR parameter provided!", &
                     __FILE__, &
                     __LINE__)
115
116
117
            CASE (ICC_PRECOND)
                CALL prep_icc(config%icc_param)
            CASE DEFAULT
Thomas Jahns's avatar
Thomas Jahns committed
118
119
120
121
122
                CALL abort_ppm("Selected preconditioner [" &
                     // int2str(config%preconditioner) &
                     // "]  does not exist!", &
                     __FILE__, &
                     __LINE__)
123
124
            END SELECT
        ENDIF
125

126
        ! Call right preconditioner/solver combination
127
128
129
130
        SELECT CASE (config%solver)
        CASE (CG_SOLVER)
            SELECT CASE (config%preconditioner)
            CASE (NONE_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
131
132
                kiter = precond_cg_method(A, b, x, ext_x, identity, &
                     exchange, tol, maxiter)
133
            CASE (JACOBI_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
134
135
                kiter = precond_cg_method(A, b, x, ext_x, jacobi, &
                     exchange, tol, maxiter)
136
            CASE (ILU0_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
137
138
                kiter = precond_cg_method(A, b, x, ext_x, ilu0, &
                     exchange, tol, maxiter)
139
            CASE (SSOR_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
140
141
                kiter = precond_cg_method(A, b, x, ext_x, ssor, &
                     exchange, tol, maxiter)
142
            CASE (ICC_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
143
144
                kiter = precond_cg_method(A, b, x, ext_x, icc, &
                     exchange, tol, maxiter)
145
            CASE DEFAULT
Thomas Jahns's avatar
Thomas Jahns committed
146
147
148
149
150
                CALL abort_ppm("Selected preconditioner [" &
                     // int2str(config%preconditioner) &
                     // "] does not exist!", &
                     __FILE__, &
                     __LINE__)
151
152
            END SELECT
        CASE (CHEBYSHEV_SOLVER)
153
            IF (config%lambda_min == 0._wp .OR. config%lambda_max == 0._wp) THEN
Thomas Jahns's avatar
Thomas Jahns committed
154
155
156
                CALL abort_ppm("Lambda_min and lambda_max not provided!", &
                     __FILE__, &
                     __LINE__)
157
            ENDIF
158
159
            SELECT CASE (config%preconditioner)
            CASE (NONE_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
160
161
162
                kiter = precond_chebyshev_method(A, b, x, ext_x, &
                     config%lambda_min, config%lambda_max, identity, &
                     exchange, tol, maxiter)
163
            CASE (JACOBI_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
164
165
166
                kiter = precond_chebyshev_method(A, b, x, ext_x, &
                     config%lambda_min, config%lambda_max, jacobi, &
                     exchange, tol, maxiter)
167
            CASE (ILU0_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
168
169
170
                kiter = precond_chebyshev_method(A, b, x, ext_x, &
                     config%lambda_min, config%lambda_max, ilu0, &
                     exchange, tol, maxiter)
171
            CASE (SSOR_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
172
173
174
                kiter = precond_chebyshev_method(A, b, x, ext_x, &
                     config%lambda_min, config%lambda_max, ssor, &
                     exchange, tol, maxiter)
175
            CASE (ICC_PRECOND)
Thomas Jahns's avatar
Thomas Jahns committed
176
177
178
                kiter = precond_chebyshev_method(A, b, x, ext_x, &
                     config%lambda_min, config%lambda_max, icc, &
                     exchange, tol, maxiter)
179
            CASE DEFAULT
Thomas Jahns's avatar
Thomas Jahns committed
180
181
182
183
184
                CALL abort_ppm("Selected preconditioner [" &
                     // int2str(config%preconditioner) &
                     // "] does not exist!", &
                     __FILE__, &
                     __LINE__)
185
186
            END SELECT
        CASE DEFAULT
Thomas Jahns's avatar
Thomas Jahns committed
187
188
189
190
            CALL abort_ppm("Selected solver [" // int2str(config%solver) &
                 // "]  does not exist!", &
                 __FILE__, &
                 __LINE__)
191
192
        END SELECT
    END FUNCTION solve
193
194

END MODULE solver_all