35 #include "qrm_common.h"
128 integer,
optional,
target :: work(:)
130 integer :: n_rows_orig,
i, j, row, col, c, child, roff, f
131 integer :: m, n, npiv, k, p, ne, cbr, cbc
132 integer :: nb, b, father
134 integer,
allocatable :: first(:)
135 integer,
pointer :: gcolmap(:)
138 type(qrm_adata_type
),
pointer :: adata
140 logical :: map, sfront
144 character(len=*),
parameter :: name=
'qrm_init_front'
153 adata => qrm_mat%adata
154 fdata => qrm_mat%fdata
155 front => fdata%front_list(fnum)
156 front%m = adata%nfrows(fnum)
157 front%n = adata%rc(fnum)
159 front%nb = qrm_mat%icntl(
qrm_nb_)
161 front%nb = qrm_mat%icntl(
qrm_ib_)
163 front%ib = qrm_mat%icntl(
qrm_ib_)
164 father = adata%parent(fnum)
166 if( (front%n .le. 0) .or. (front%m .le. 0))
then
168 front%status = qrm_done_
172 if (fnum .eq. 1)
then
175 roff = adata%stair(fnum-1)
185 front%np = max((front%ne-1)/front%nb + 1,0)
187 front%nc = (front%n-1)/front%nb + 1
189 front%npiv = min(adata%cp_ptr(fnum+1)-adata%cp_ptr(fnum),front%ne)
190 cbr = front%m-front%npiv
191 cbc = front%n-front%npiv
195 sfront = front%ne .lt. front%ib
199 __qrm_check_ret(name,
'qrm_aalloc',9999)
201 front%cols(1:front%n) = adata%fcol(adata%fcol_ptr(fnum): &
202 & adata%fcol_ptr(fnum+1)-1)
209 __qrm_check_ret(name,
'qrm_aalloc',9999)
215 if(present(work))
then
219 __qrm_check_ret(name,
'qrm_palloc',9999)
228 __qrm_check_ret(name,
'qrm_aalloc',9999)
230 if(.not. sfront)
then
233 __qrm_check_ret(name,
'qrm_aalloc',9999)
239 do p=front%aiptr(
i), front%aiptr(
i+1)-1
240 j = gcolmap(front%ajcn(p))
242 if (j .lt. first(
i)) first(
i)=j
244 front%stair(first(
i)+1) = front%stair(first(
i)+1)+1
248 do p = adata%childptr(fnum), adata%childptr(fnum+1)-1
250 cfront => fdata%front_list(c)
260 f = gcolmap(cfront%cols(npiv+
i))
261 front%stair(f+1) = front%stair(f+1)+1
267 front%stair(
i) = front%stair(
i)+front%stair(
i-1)
270 front%stair = front%m
274 call
qrm_aalloc(front%front, front%m, front%n)
275 __qrm_check_ret(name,
'qrm_aalloc',9999)
287 front%stair(f) = front%stair(f)+1
291 front%rows(row) = adata%rperm(roff+
i)
293 do p=front%aiptr(
i), front%aiptr(
i+1)-1
294 col = gcolmap(front%ajcn(p))
295 front%front(row,col) = front%front(row,col)+front%aval(p)
302 do p = adata%childptr(fnum), adata%childptr(fnum+1)-1
304 cfront => fdata%front_list(c)
306 map = par .and. (adata%small(c) .ne. 1)
321 f = gcolmap(cfront%cols(
i))
322 front%stair(f) = front%stair(f)+1
325 front%rows(row) = cfront%rows(
i)
326 cfront%rowmap(
i-npiv) = row
330 do j=npiv+1, cfront%n
334 cfront%colmap(j-npiv) = gcolmap(cfront%cols(j))
337 do i=npiv+1, min(j,ne)
338 row = cfront%rowmap(
i-npiv)
339 col = cfront%colmap(j-npiv)
340 front%front(row, col) = cfront%front(
i,j)
345 do j=1, cfront%n - npiv
349 cfront%colmap(j) = gcolmap(cfront%cols(npiv+j))
353 b = (cfront%colmap(j)-1)/front%nb+1
354 front%ptable(b) = front%ptable(b)-1
360 if(present(work))
then
366 __qrm_check_ret(name,
'qrm_adealloc',9999)
371 __qrm_check_ret(name,
'qrm_aalloc',9999)
378 if (father .ne. 0)
then
381 __qrm_check_ret(name,
'qrm_aalloc',9999)
388 __qrm_check_ret(name,
'qrm_adealloc',9999)
393 if (father .ne. 0)
then
394 front => fdata%front_list(father)
396 front%status = front%status+1
408 if(present(work))
then
424 if(err_act .eq. qrm_abort_)
then
Generic interface for the qrm_adealloc_i, qrm_adealloc_2i, qrm_adealloc_s, qrm_adealloc_2s, qrm_adealloc_3s, qrm_adealloc_d, qrm_adealloc_2d, qrm_adealloc_3d, qrm_adealloc_c, qrm_adealloc_2c, qrm_adealloc_3c, qrm_adealloc_z, qrm_adealloc_2z, qrm_adealloc_3z, routines.
This module contains the interfaces of all non-typed routines.
subroutine qrm_err_act_restore(err_act)
Restores the value of the qrm_err_act variable.
This module contains the definition of the basic sparse matrix type and of the associated methods...
This module contains generic interfaces for a number of auxiliary tools.
subroutine qrm_err_check()
This subroutine checks the errors stack. If something is found all the entries in the stack are poppe...
The data structure meant to store all the results of the factorization phase.
subroutine dqrm_init_front(qrm_mat, fnum, par, work)
This routine initializes a front.
This module contains the definition of all the data related to the factorization phase.
Generic interface for the qrm_aalloc_i, qrm_aalloc_2i, qrm_aalloc_s, qrm_aalloc_2s, qrm_aalloc_3s, qrm_aalloc_d, qrm_aalloc_2d, qrm_aalloc_3d, qrm_aalloc_c, qrm_aalloc_2c, qrm_aalloc_3c, qrm_aalloc_z, qrm_aalloc_2z, qrm_aalloc_3z, routines.
Generic interface for the qrm_pdealloc_i, qrm_pdealloc_2i, qrm_pdealloc_s, qrm_pdealloc_2s, qrm_pdealloc_d, qrm_pdealloc_2d, qrm_pdealloc_c, qrm_pdealloc_2c, qrm_pdealloc_z, qrm_pdealloc_2z, routines.
This type defines the data structure used to store a matrix.
This type defines a data structure containing all the data related to a front.
This module implements the memory handling routines. Pretty mucch allocations and deallocations...
Generic interface for the qrm_palloc_i, qrm_palloc_2i, qrm_palloc_s, qrm_palloc_2s, qrm_palloc_d, qrm_palloc_2d, qrm_palloc_c, qrm_palloc_2c, qrm_palloc_z, qrm_palloc_2z, routines.
This module contains routines for sorting.
subroutine qrm_err_act_save(err_act)
Saves a copy of the qrm_err_act variable.