1       subroutine ga_screen(g_a, value)
2C$Id$
3       implicit none
4#include "mafdecls.fh"
5#include "global.fh"
6#include "msgids.fh"
7       integer g_a
8       double precision value
9c
10c
11c     set all elements whose absolute value is less than
12c     value to a hard zero
13c
14       integer ilo, ihi, jlo, jhi
15       integer ga_screenb
16       external ga_screenb
17c
18       call ga_sync()
19       call ga_distribution(g_a, ga_nodeid(), ilo, ihi, jlo, jhi)
20       if (ihi.gt.0 .and. jhi.gt.0) then
21         call ga_access_callback_release(
22     $        g_a, ilo, ihi, jlo, jhi,ga_screenb, value,
23     $        0, 0, 0, 0, 0,0)
24       endif
25c
26       call ga_sync()
27c
28       end
29      integer function ga_screenb(
30     $     g_a, ilo, ihi, jlo, jhi, a, ld, value,
31     $     idum2, idum3, idum4, idum5, idum6,idum7)
32      implicit none
33      integer g_a, ilo, ihi, jlo, jhi, ld,
34     $     idum2, idum3, idum4, idum5, idum6,idum7
35      double precision a(ilo:ilo+ld-1,jlo:jhi), value
36      integer i, j
37      double precision zero
38      parameter (zero = 0.0d0)
39c
40      do j = jlo, jhi
41         do i = ilo, ihi
42            if (abs(a(i,j)) .lt. value) a(i,j) = zero
43         end do
44      end do
45c
46      ga_screenb = 1    ! no update necessary
47c
48      end
49