35 #include "qrm_common.h" 113 integer :: parent(:), porder(:), rc(:)
118 integer,
allocatable :: fst_desc(:), stack(:)
119 integer,
allocatable :: first(:), hptr(:), hjcn(:), rcnt(:), last(:), ipord(:)
120 integer,
allocatable :: prev_f(:), prev_nbr(:), setpath(:)
121 integer :: i, curr, fd, hp, rlev, j, f, ptr, k, ii, u, ref, p_leaf, q, jj
124 character(len=*),
parameter :: name=
'qrm_rowcount' 126 call qrm_err_act_save(err_act)
130 __qrm_check_ret(name,
'qrm_aalloc',9999)
137 if(fst_desc(curr) .eq. -1)
then 146 if (fst_desc(curr) .gt. 0)
exit 148 if (parent(curr) .eq. 0)
exit 164 call move_alloc(stack, last)
165 __qrm_check_ret(name,
'qrm_aalloc',9999)
178 do ii=graph%jptr(j), graph%jptr(j+1)-1
183 else if (k .gt. last(f))
then 193 hptr(k+1) = hptr(k)+rcnt(k)
198 __qrm_check_ret(name,
'qrm_aalloc',9999)
205 do ii=graph%jptr(j), graph%jptr(j+1)-1
208 if ( (k .gt. ipord(f)) .and. (k .gt. last(f)) )
then 209 ptr = hptr(f) + rcnt(f)
221 call move_alloc(last, prev_f)
222 call move_alloc(rcnt, prev_nbr)
225 __qrm_check_ret(name,
'aalloc/dealloc',9999)
239 if(parent(j) .ne. 0)
then 240 rc(parent(j)) = rc(parent(j))-1
243 if(jj .ne. graph%n) porder(jj+1) = porder(jj+1)
246 do k=hptr(j), hptr(j+1)-1
248 if(prev_nbr(u) .eq. 0)
then 251 ref = ipord(prev_nbr(u))
254 if(ipord(fst_desc(j)) .gt. ref)
then 259 if (p_leaf .ne. 0)
then 269 call setunion(setpath, j, parent(j))
275 if(parent(j) .ne. 0) rc(parent(j)) = rc(parent(j)) + rc(j)
310 if(parent(f) .lt. 0) parent(i) = -parent(f)
321 __qrm_check_ret(name,
'qrm_adealloc',9999)
324 call qrm_err_act_restore(err_act)
328 call qrm_err_act_restore(err_act)
329 if(err_act .eq. qrm_abort_)
then 338 function setfind(setpath, p_leaf)
340 integer :: setpath(:), p_leaf, setfind
346 do while (setpath(q) .ne.q)
365 integer :: setpath(:), j, pj
366 if(pj .ne. 0) setpath(j) = pj
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 setunion(setpath, j, pj)
integer function setfind(setpath, p_leaf)
integer function unflip(i)
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.
subroutine _qrm_rowcount(graph, parent, porder, rc)
This subroutine computes the rowcount of the R factor.
This type defines the data structure used to store a matrix.
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...