1!---------------------------------------------------------------
2subroutine outward(y,f,g,mesh,imatch,ncross)
3!---------------------------------------------------------------
4   ! outward integration. numerov method.
5   !
6   use kinds, only: DP
7   use radial_grids, only: ndmx
8   implicit none
9   !
10   ! I/O variables
11   !
12   integer,intent(in) :: mesh
13   integer, intent(in) :: imatch
14   integer, intent(out) ::  ncross  ! num of axis crosses
15   real(DP),intent(in) :: f(ndmx), g(ndmx)
16   real (DP),intent(out) :: y(ndmx)
17
18   !
19   ! local variables
20   !
21   integer :: n ! lopp variable
22   real (DP) :: ymx ! max value of the function over the grid
23
24   if (ndmx.lt.mesh) stop ' outward : ndmx .lt. mesh !!!!'
25   !
26   ncross=0
27   ymx=0.d0
28   do n=2,imatch-1
29      y(n+1)=((12.d0-10.d0*f(n))*y(n)-f(n-1)*y(n-1)+g(n))/f(n+1)
30      if ( y(n) .ne. sign(y(n),y(n+1)) ) ncross = ncross + 1
31      ymx=max(ymx,abs(y(n)))
32   end do
33   if(ymx.ge.1.0d10) write (*,*) ' ******** ymx.ge.1.0e10 ********'
34!
35   return
36end subroutine outward
37
38