module medbin2_mod use quantile_mod implicit none integer, private :: n1, n2, nd integer, dimension (:,:), allocatable, private :: ct, pt integer, dimension (:), allocatable, private :: j1, j2 logical, dimension (:), allocatable, private :: m real, dimension (:), allocatable, private :: bd contains subroutine medbin2_init (coord, o, d, n) real, dimension (:,:), intent (in) :: coord real, dimension (2), intent (in) :: o, d integer, dimension (2), intent (in) :: n integer :: id, i1, i2, start nd = size (coord, 1) ; n1 = n (1) ; n2 = n (2) allocate (ct (n1,n2), pt (n1, n2)) allocate (j1 (nd), j2 (nd), m (nd)) ct = 0 do id = 1, nd i1 = 1.5 + (coord (id,1) - o (1))/d (1) i2 = 1.5 + (coord (id,2) - o (2))/d (2) m (id) = (i1 >= 1) .and. (i1 <= n1) & .and. (i2 >= 1) .and. (i2 <= n2) if (m (id)) then ct (i1, i2) = ct (i1, i2) + 1 j1 (id) = i1 ; j2 (id) = i2 end if end do start = 1 do i2 = 1, n2 do i1 = 1, n1 pt (i1, i2) = start start = start + ct (i1, i2) end do end do end subroutine medbin2_init subroutine medbin2 (ord, model) real, dimension (nd), intent (in) :: ord real, dimension (n1, n2), intent (out) :: model integer :: i1, i2, id, p1, p2, np allocate (bd (nd)) do id = 1, nd if (m (id)) then i1 = j1 (id) i2 = j2 (id) bd (pt (i1, i2)) = ord (id) pt (i1, i2) = pt (i1, i2) + 1 end if end do do i2 = 1, n2 do i1 = 1, n1 np = ct (i1, i2) if (np > 0) then p2 = pt (i1, i2) ; p1 = p2 - np + 1 if(i1+i2<3) write (0,*) p1,p2,np ! stupid SGI compiler model (i1, i2) = (quantile ((np+1)/2, bd (p1:p2)) & + quantile ((np+2)/2, bd (p1:p2)))*0.5 if(i1+i2<3) write (0,*) i1,i2, model(i1,i2) ! stupid SGI compiler else model (i1, i2) = 0. end if end do end do end subroutine medbin2 subroutine medbin2_close () deallocate (ct, pt, j1, j2, m, bd) end subroutine medbin2_close end module medbin2_mod