35 #include "qrm_common.h" 55 _qrm_data,
intent(inout) :: b(:,:)
58 integer :: nth, thn, info, f, dones, qrm_nth
63 type(_qrm_front_type),
pointer :: front
64 integer,
allocatable :: status(:)
65 type(qrm_adata_type),
pointer :: adata
66 type(_qrm_fdata_type),
pointer :: fdata
69 integer(kind=omp_lock_kind),
allocatable :: locks(:)
70 integer(kind=omp_lock_kind) :: dlock
75 character(len=*),
parameter :: name=
'qrm_apply_q' 77 call qrm_err_act_save(err_act)
79 __qrm_prnt_dbg(
'("Applying Q")')
82 adata => qrm_mat%adata
83 fdata => qrm_mat%fdata
92 __qrm_check_ret(name,
'qrm_aalloc',9999)
95 do f = 1, adata%nnodes
96 status(f) = qrm_ready_
99 if(p .eq. 0 .and. (adata%rc(f).ge.0))
call qrm_queue_push(ready_q, f)
104 if(adata%ncsing .gt. 0)
then 111 call omp_set_num_threads(1)
112 qrm_nth = qrm_mat%icntl(qrm_nthreads_)
121 nth = omp_get_num_threads()
122 thn = omp_get_thread_num()
134 if(qrm_err_stack%nelem .gt. 0)
goto 9998
143 if(.not. got_task) cycle taskloop
164 #if defined (_OPENMP) 168 if(qrm_err_stack%nelem .gt. 0)
then 169 call qrm_err_push(22, name)
173 call qrm_err_act_restore(err_act)
177 call qrm_err_act_restore(err_act)
178 if(err_act .eq. qrm_abort_)
then 192 type(_qrm_front_type),
pointer :: front
198 #if defined (_OPENMP) 199 thn = omp_get_thread_num()
212 front => fdata%front_list(f)
214 #if defined (_OPENMP) 215 if(.not. omp_test_lock(locks(f))) cycle
218 if(status(f) .eq. qrm_ready_)
then 223 status(f) = qrm_busy_
227 #if defined (_OPENMP) 228 call omp_unset_lock(locks(f))
255 #if defined (_OPENMP) 256 call omp_set_lock( dlock )
258 if(dones .eq. fdata%nfronts)
then 262 #if defined (_OPENMP) 263 call omp_unset_lock( dlock )
281 type(_qrm_front_type),
pointer :: front
282 integer :: f, p, c, info
287 front => qrm_mat%fdata%front_list(task%front)
293 status(task%front) = qrm_done_
302 do p = adata%childptr(front%num), adata%childptr(front%num+1)-1
304 if(adata%small(c) .eq. 1)
then 306 if(info .ne. 0)
goto 9997
327 integer :: fnum, info
329 type(_qrm_front_type),
pointer :: front
330 integer :: node, c, acc, thn, p
344 front => qrm_mat%fdata%front_list(node)
352 status(node) = qrm_done_
356 do p = adata%childptr(front%num), adata%childptr(front%num+1)-1
375 subroutine front_q(front, info)
383 type(_qrm_front_type) :: front
387 integer :: pv1, c, k, m, pv2, n, cnt, j, jp, pk
388 _qrm_data,
allocatable :: work(:,:), in_b(:,:), t(:,:)
390 character(len=*),
parameter :: name=
'front_q' 393 if (min(front%m, front%n) .le. 0)
goto 9999
405 __qrm_check_ret(name,
'qrm_aalloc',9999)
408 in_b = b(front%rows,:)
445 outer:
do jp = front%ne - mod(front%ne, front%nb)+1, 1, -front%nb
446 pk = min(front%nb, front%ne-jp+1)
450 inner:
do j = jp+pk-mod(pk,front%ib), jp, -front%ib
451 k = min(front%ib, jp+pk - j)
453 m = max(front%stair(j+k-1),j+k-1) - j+1
456 call _xlarfb(
'l',
'n',
'f',
'c', m, n, k, front%h(cnt), m, &
457 & front%h(cnt), m, in_b(j,1), front%m, work(1,1), n)
463 b(front%rows,:) = in_b
469 __qrm_check_ret(name,
'qrm_adelloc',9999)
subroutine qrm_clean_task_queue(h)
Destroyes a set of queues.
subroutine front_q(front, info)
This module contains generic interfaces for a number of auxiliary tools.
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 all the facilities for front queues.
subroutine _qrm_apply_q(qrm_mat, b)
This function applies Q to a vector/matrix.
This type defines the handle for the queues attached to a family of threads.
This module contains the interfaces of all non-typed routines.
A data type meant to to define a queue.
subroutine qrm_par_mem_finalize()
subroutine fill_queue_q()
subroutine qrm_par_mem_init()
This routine has to be called at the beginning of a parallel section. Afterwards, each thread will up...
This module contains the definition of a task type that is used for scheduling tasks during the facto...
logical function qrm_sched_task(h, tsk, pol, q)
Pushes a task on a queue.
integer, parameter qrm_task_exit_
subroutine qrm_queue_rm(q, n)
Removes (without returning it) an element from a queue.
subroutine do_subtree_q(fnum, info)
subroutine qrm_init_task_queue(h)
Inititalizes a set of queues attached to a family of threads referenced through the handle h...
integer function qrm_queue_pop(q)
Pops an element from a queue.
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.
logical function qrm_get_task(h, tsk)
Pops a task from a queue. Tasks are always popped from the head of the queue. The return value is ...
This type defines a computational task.
subroutine qrm_queue_push(q, elem)
Pushes an element on a queue.
This type defines the data structure used to store a matrix.
integer, parameter qrm_fifo_
parameter to define the policy of the queue: FIFO
integer function qrm_task_queue_card(h)
Returns the number of tasks present on a set of queues referenced by a handle.
subroutine apply_q(task, thn)
This module contains the definition of the basic sparse matrix type and of the associated methods...
subroutine qrm_queue_free(q)
Frees a queue.
integer, parameter qrm_lifo_
parameter to define the policy of the queue: LIFO
integer, parameter qrm_task_sol_
subroutine check_applyq_over()
This module implements the memory handling routines. Pretty mucch allocations and deallocations...
This module contains an implementation of some operations on triangular/trapezoidal matrices stored i...
integer function qrm_queue_next(q, n)
Returns the element that follows n in the queue q. Very useful for sweeping through a queue...