35 #include "qrm_common.h" 82 integer :: i, j, f, p, pp, ppp, root, node, roff, ne, np
83 integer :: first, c, ib, nlz, nth, leaves, totleaves
84 integer :: m, n, k, cyc, nb, fm, fn, fk
85 real(kind(1.d0)),
allocatable :: n_weight(:), t_weight(:), lzero_w(:), proc_w(:)
86 real(kind(1.d0)) :: rm, rk, rn, totflops, smallth
87 integer,
allocatable :: col_map(:), mark(:), stair(:), lzero(:), aux(:)
88 integer,
pointer :: porder(:), rc(:), parent(:), fcol(:), fcol_ptr(:)
92 integer(kind=8) :: hsize, rsize
95 character(len=*),
parameter :: name=
'qrm_symbolic' 101 porder => adata%cperm
103 parent => adata%parent
106 call qrm_aalloc(adata%fcol_ptr, adata%nnodes+1)
107 call qrm_aalloc(adata%fcol, sum(rc))
108 __qrm_check_ret(name,
'qrm_aalloc',9999)
112 fcol_ptr => adata%fcol_ptr
119 call qrm_aalloc(col_map, graph%n)
120 call qrm_aalloc(mark, adata%nnodes)
121 __qrm_check_ret(name,
'qrm_aalloc2',9999)
129 do p=adata%cp_ptr(f), adata%cp_ptr(f+1)-1
135 fcol_ptr(f+1) = fcol_ptr(f)+max(rc(f-1),0)
136 do p=adata%cp_ptr(f), adata%cp_ptr(f+1)-1
143 if(p .ne. graph%n+1)
then 144 __qrm_prnt_dbg(.ne.
'("Error in symbolic. i n ",i5,2x,i5)')p, graph%n
151 __qrm_check_ret(name,
'qrm_spmat_convert',9999)
154 g_csr%jcn(i) = adata%icperm(g_csr%jcn(i))
160 g_csr%jcn(i) = adata%cperm(g_csr%jcn(i))
168 do p=adata%cp_ptr(f), adata%cp_ptr(f+1)-1
174 fcol(fcol_ptr(f+1)) = i
175 fcol_ptr(f+1) = fcol_ptr(f+1)+1
177 do pp = graph%jptr(i), graph%jptr(i+1)-1
182 do ppp=g_csr%iptr(k), g_csr%iptr(k+1)-1
184 if(adata%icperm(j) .ge. adata%icperm(i))
exit 192 if((mark(node) .eq. i) .or. (node .eq. f))
exit 194 fcol(fcol_ptr(node+1)) = i
195 fcol_ptr(node+1) = fcol_ptr(node+1)+1
205 call qrm_adealloc(mark)
206 call qrm_aalloc(adata%nfrows, adata%nnodes)
207 __qrm_check_ret(name,
'qrm_aalloc2.5',9999)
212 call qrm_aalloc(n_weight, adata%nnodes)
213 call qrm_aalloc(t_weight, adata%nnodes)
218 call qrm_aalloc(stair, maxval(rc)+1)
219 __qrm_check_ret(name,
'qrm_aalloc',9999)
221 call qrm_get(graph,
'qrm_ib', ib)
222 call qrm_get(graph,
'qrm_nb', nb)
240 k = fcol(fcol_ptr(f)+j-1)
247 roff = adata%stair(f-1)+1
252 do p=roff, adata%stair(f)
256 first = col_map(g_csr%jcn(g_csr%iptr(i)))
263 stair(first) = stair(first)+1
267 do ppp=adata%childptr(f), adata%childptr(f+1)-1
272 ne = min(rc(c), adata%nfrows(c))
273 np = adata%cp_ptr(c+1)-adata%cp_ptr(c)
277 j = fcol(fcol_ptr(c)+i-1)
279 stair(first) = stair(first)+1
285 stair(i) = stair(i)+stair(i-1)
288 adata%nfrows(f) = stair(rc(f))
292 ne = min(rc(f),adata%nfrows(f))
294 n_weight(f) = n_weight(f)+
qrm_count_flops(max(stair(i)-i+1,0),rc(f)-i,1,
'panel')
295 n_weight(f) = n_weight(f)+
qrm_count_flops(max(stair(i)-i+1,0),rc(f)-i,1,
'update')
296 hsize = hsize+max(stair(i)-i+1,0)
300 np = adata%cp_ptr(f+1)-adata%cp_ptr(f)
301 rsize = rsize + np*(np+1)/2 + np*(rc(f)-np)
303 t_weight(f) = t_weight(f)+n_weight(f)
305 if(p .ne. 0) t_weight(p) = t_weight(p)+t_weight(f)
309 totflops = sum(n_weight)
316 __qrm_prnt_dbg(
'("Total estimated number of MFLOPS: ",i10)')floor(totflops)
321 __qrm_check_ret(name,
'qrm_spmat_destroy',9999)
324 call qrm_adealloc(col_map)
325 call qrm_adealloc(stair)
326 call qrm_aalloc(lzero, adata%nnodes)
327 call qrm_aalloc(adata%small, adata%nnodes)
334 call qrm_aalloc(lzero_w, adata%nnodes)
335 call qrm_aalloc(aux, adata%nnodes+2, lbnd=0)
336 call qrm_get(graph,
'qrm_nthreads', nth)
338 if(nth .gt. adata%nnodes) nth = adata%nnodes
340 call qrm_aalloc(proc_w, nth)
353 if(parent(i) .eq. 0)
then 354 if(t_weight(i) .gt. smallth*totflops)
then 357 lzero_w(nlz) = t_weight(i)
362 if(adata%childptr(i+1) .eq. adata%childptr(i)) totleaves = totleaves+1
370 if(nlz .gt. nth*max(2.d0,(log(
real(nth,kind(1.d0)))/log(2.d0))**2)) exit
374 call qrm_mergesort(nlz, lzero_w(1:nlz), aux(0:nlz+1), order=-1)
375 call qrm_mergeswap(nlz, aux(0:nlz+1), lzero(1:nlz), lzero_w(1:nlz))
381 proc_w(p) = proc_w(p) + lzero_w(i)
385 rm = minval(proc_w)/maxval(proc_w)
388 if((rm .gt. 0.9) .and. (nlz .ge. 1*nth))
exit 393 if(leaves .eq. totleaves)
exit godown
395 if(leaves .eq. nlz)
then 396 if(nlz .ge. nth*max(2.d0,(log(
real(nth,kind(1.d0)))/log(2.d0))**2)) then
399 smallth = smallth/2.d0
400 if(smallth .lt. 0.0001)
then 410 do p=adata%childptr(n), adata%childptr(n+1)-1
412 if(t_weight(c) .gt. smallth*totflops)
then 417 lzero_w(nlz) = t_weight(c)
427 lzero(leaves+1) = lzero(nlz)
428 lzero_w(leaves+1) = lzero_w(nlz)
436 do p=adata%childptr(n), adata%childptr(n+1)-1
444 t_weight = t_weight/totflops * 100
448 call qrm_adealloc(lzero)
449 call qrm_adealloc(lzero_w)
450 call qrm_adealloc(proc_w)
451 call qrm_adealloc(aux)
452 call qrm_adealloc(n_weight)
453 call qrm_adealloc(t_weight)
474 integer,
allocatable :: aux(:)
475 integer :: i, n, k1, k2
479 allocate(aux(0:mat%n+1))
This module contains routines for sorting.
This module contains the interfaces of all non-typed routines.
subroutine _qrm_spmat_destroy(qrm_spmat, all)
This subroutine destroyes a qrm_spmat instance.
This module contains the definition of the analysis data type.
subroutine qrm_err_act_save(err_act)
Saves a copy of the qrm_err_act variable.
This module contains all the error management routines and data.
The main data type for the analysis phase.
integer, parameter qrm_abort_
Possible actions to be performed upon detection of an error.
subroutine qrm_err_check()
This subroutine checks the errors stack. If something is found all the entries in the stack are poppe...
This type defines the data structure used to store a matrix.
Generic interface for the ::qrm_count_realflops ::qrm_count_pureflops.
This module contains the definition of the basic sparse matrix type and of the associated methods...
Generif interface for the ::_qrm_pgeti, ::_qrm_pgetr and.
subroutine _qrm_spmat_convert(in_mat, out_mat, fmt, values)
This subroutine converts an input matrix into a different storage format. Optionally the values may b...
subroutine _qrm_symbolic(graph)
This subroutine computes the symbolic QR factorization of a matrix.
subroutine qrm_err_act_restore(err_act)
Restores the value of the qrm_err_act variable.