# 1 "" # 1 "" # 1 "" # 1 "" module binpull2 ! From each bin on model mesh, pull nearest data value. use adj_mod implicit none integer, private :: m1 integer, private :: m2 integer ,private, dimension (:,:), allocatable :: jd contains subroutine binpull2_init ( m1_in,m2_in,o1,d1,o2,d2,xy ) integer :: m1_in integer :: m2_in real, dimension (:,:) :: xy real o1,d1, o2,d2, x,y, near,dist integer i1,i2, id m1 = m1_in m2 = m2_in if (.not. allocated(jd)) then allocate(jd ( m1,m2)) end if do i1= 1, m1 x = o1 + (i1-1)*d1 do i2= 1, m2 y = o2 + (i2-1)*d2 near = 1.e30 do id= 1, size(xy,1) dist = (x-xy(id,1))**2 + (y-xy(id,2))**2 if ( dist < near) then near = dist jd(i1,i2) = id end if end do end do end do end subroutine function binpull2_lop ( adj, add, mm, dd) result(stat) integer :: stat logical,intent(in) :: adj,add real,dimension(:) :: mm,dd call adjnull (adj,add,mm,dd ) call binpull2_lop2(adj,add,mm,dd ) stat=0 end function subroutine binpull2_lop2(adj,add,mm,dd) logical,intent(in) :: adj,add real, dimension (m1,m2) :: mm real, dimension (:) :: dd integer i1,i2, id do i1= 1, m1 do i2= 1, m2 id = jd(i1,i2) if ( adj) then mm(i1,i2) = mm(i1,i2) + dd(id) else dd(id) = dd(id) + mm(i1,i2) end if end do end do end subroutine subroutine binpull2_close() deallocate( jd ) end subroutine end module