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