QR_MUMPS
 All Classes Files Functions Variables Enumerations Enumerator Pages
qrm_least_squares.F90
Go to the documentation of this file.
1 !! ##############################################################################################
2 !!
3 !! Copyright 2012 CNRS, INPT
4 !!
5 !! This file is part of qr_mumps.
6 !!
7 !! qr_mumps is free software: you can redistribute it and/or modify
8 !! it under the terms of the GNU Lesser General Public License as
9 !! published by the Free Software Foundation, either version 3 of
10 !! the License, or (at your option) any later version.
11 !!
12 !! qr_mumps is distributed in the hope that it will be useful,
13 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
14 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 !! GNU Lesser General Public License for more details.
16 !!
17 !! You can find a copy of the GNU Lesser General Public License
18 !! in the qr_mumps/doc directory.
19 !!
20 !! ##############################################################################################
21 
22 
23 !! ##############################################################################################
33 
34 #include "qrm_common.h"
35 
37 
49 subroutine _qrm_least_squares2d(qrm_mat, b, x)
50  use _qrm_spmat_mod
51  use qrm_mem_mod
52  use qrm_error_mod
55  use _qrm_solve_mod
56  implicit none
57 
58  type(_qrm_spmat_type) :: qrm_mat
59  _qrm_data :: b(:,:), x(:,:)
60 
61  ! error management
62  integer :: err_act
63  character(len=*), parameter :: name='qrm_least_squares'
64 
65  call qrm_err_act_save(err_act)
66 
67  __qrm_prnt_dbg('("Entering the least-squares driver")')
68 
69  call _qrm_check_spmat(qrm_mat)
70  __qrm_check_ret(name,'qrm_check_spmat',9999)
71 
72  if(qrm_mat%m .lt. qrm_mat%n) then
73  call qrm_err_push(30, name,ied=(/qrm_mat%m,qrm_mat%n,0,0,0/))
74  goto 9999
75  end if
76 
77  ! analysis
78  call _qrm_analyse(qrm_mat, 'n')
79  __qrm_check_ret(name,'qrm_analyse',9999)
80  ! factorization
81  call _qrm_factorize(qrm_mat, 'n')
82  __qrm_check_ret(name,'qrm_factorize',9999)
83 
84  call _qrm_apply2d(qrm_mat, 't', b)
85  __qrm_check_ret(name,'qrm_apply',9999)
86  call _qrm_solve2d(qrm_mat, 'n', b, x)
87  __qrm_check_ret(name,'qrm_solve',9999)
88 
89  call qrm_err_act_restore(err_act)
90  return
91 
92 9999 continue ! error management
93  call qrm_err_act_restore(err_act)
94  if(err_act .eq. qrm_abort_) then
95  call qrm_err_check()
96  end if
97  return
98 
99 end subroutine _qrm_least_squares2d
100 
101 
102 
103 
105 
117 subroutine _qrm_least_squares1d(qrm_mat, b, x)
118  use _qrm_spmat_mod
119  use qrm_mem_mod
120  use qrm_error_mod
123  use _qrm_solve_mod
124  implicit none
125 
126  type(_qrm_spmat_type) :: qrm_mat
127  _qrm_data :: b(:), x(:)
128 
129  ! error management
130  integer :: err_act
131  character(len=*), parameter :: name='qrm_least_squares'
132 
133  call qrm_err_act_save(err_act)
134 
135  __qrm_prnt_dbg('("Entering the least-squares driver")')
136 
137  call _qrm_check_spmat(qrm_mat)
138  __qrm_check_ret(name,'qrm_check_spmat',9999)
139 
140  if(qrm_mat%m .lt. qrm_mat%n) then
141  call qrm_err_push(30, name,ied=(/qrm_mat%m,qrm_mat%n,0,0,0/))
142  goto 9999
143  end if
144 
145  ! analysis
146  call _qrm_analyse(qrm_mat, 'n')
147  __qrm_check_ret(name,'qrm_analyse',9999)
148 
149  ! factorization
150  call _qrm_factorize(qrm_mat, 'n')
151  __qrm_check_ret(name,'qrm_factorize',9999)
152 
153  call _qrm_apply1d(qrm_mat, 't', b)
154  __qrm_check_ret(name,'qrm_apply',9999)
155  call _qrm_solve1d(qrm_mat, 'n', b, x)
156  __qrm_check_ret(name,'qrm_solve',9999)
157 
158  call qrm_err_act_restore(err_act)
159  return
160 
161 9999 continue ! error management
162  call qrm_err_act_restore(err_act)
163  if(err_act .eq. qrm_abort_) then
164  call qrm_err_check()
165  end if
166  return
167 
168 end subroutine _qrm_least_squares1d
This module contains all the error management routines and data.
subroutine _qrm_least_squares2d(qrm_mat, b, x)
This routine computes the least-squares solution of a problem.
This module contains all the generic interfaces for the typed routines in the factorization phase...
This module contains the generic interfaces for all the analysis routines.
subroutine qrm_err_act_restore(err_act)
Restores the value of the qrm_err_act variable.
subroutine _qrm_apply2d(qrm_mat, transp, b)
This function applies Q or Q^T to a set of vectors.
Definition: qrm_apply.F90:47
subroutine qrm_err_check()
This subroutine checks the errors stack. If something is found all the entries in the stack are poppe...
subroutine _qrm_analyse(qrm_mat, transp)
This is the driver routine for the analysis phase.
Definition: qrm_analyse.F90:64
subroutine _qrm_solve1d(qrm_mat, transp, b, x)
This function solves for R or R' against a single vector.
Definition: qrm_solve.F90:128
subroutine _qrm_apply1d(qrm_mat, transp, b)
This function applies Q or Q^T to a single vector.
Definition: qrm_apply.F90:135
This module contains all the interfaces for the typed routines in the solve phase.
subroutine _qrm_least_squares1d(qrm_mat, b, x)
This routine computes the least-squares solution of a problem.
This type defines the data structure used to store a matrix.
subroutine _qrm_check_spmat(qrm_spmat, op)
Check the compatibility and correctness of icntl and rcntl parameters.
This module contains the definition of the basic sparse matrix type and of the associated methods...
This module implements the memory handling routines. Pretty mucch allocations and deallocations...
Definition: qrm_mem_mod.F90:38
subroutine _qrm_factorize(qrm_mat, transp)
This routine is the main factorization driver.
subroutine _qrm_solve2d(qrm_mat, transp, b, x)
This function solves for R or R' against multiple vectors.
Definition: qrm_solve.F90:50
subroutine qrm_err_push(code, sub, ied, aed)
This subroutine pushes an error on top of the stack.
subroutine qrm_err_act_save(err_act)
Saves a copy of the qrm_err_act variable.