module triangle ! triangle smoothing use adj_mod use cdoubint use triple use fold implicit none real ,private, dimension (:), allocatable :: tmp1 real ,private, dimension (:), allocatable :: tmp2 contains subroutine triangle_init ( nbox,ndat ) integer nbox,ndat,np if (.not. allocated(tmp1)) then allocate(tmp1 ( ndat+2*nbox)) end if if (.not. allocated(tmp2)) then allocate(tmp2 ( ndat+2*nbox)) end if np = ndat + 2*nbox call triple_init (nbox,ndat,-nbox*nbox) call cdoubint_init (np) end subroutine function triangle_lop ( adj, add, x, y) result(stat) integer :: stat logical,intent(in) :: adj,add real,dimension(:) :: x,y call adjnull (adj,add,x,y ) call triangle_lop2(adj,add,x,y ) stat=0 end function subroutine triangle_lop2(adj,add,x,y) logical,intent(in) :: adj,add real, dimension (:) :: x real, dimension (:) :: y call chain (fold_lop, cdoubint_lop, triple_lop, adj, .true., x, y,& & tmp1, tmp2) end subroutine subroutine triangle_close() deallocate( tmp1 ,tmp2) call cdoubint_close () end subroutine end module