00001 subroutine interpo_fl2gr_linear(flv,grv)
00002   use phys_constant, only : long
00003   use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00004   use coordinate_grav_r, only : rg
00005   use def_matter, only : rs
00006   implicit none
00007   real(long), external :: lagint_4th
00008   real(long), pointer :: grv(:,:,:), flv(:,:,:)
00009   real(long) :: x(2), f(2)
00010   real(long) :: rrff, rrgg, small = 1.0d-14
00011   integer :: irf, irg, itg, ipg, ir0
00012 
00013   grv(0:nrg,0:ntg,0:npg) = 0.0d0
00014 
00015   do ipg = 0, npg
00016     do itg = 0, ntg
00017       rrff = rs(itg,ipg)
00018       do irg = 0, nrg
00019         if (rg(irg).gt.rrff*rg(nrf)) exit
00020         do irf = 0, nrf
00021           if (rg(irg).le.rrff*rg(irf)) then 
00022             ir0 = min0(max0(0,irf-1),nrf-1)
00023             exit
00024           end if
00025         end do
00026         x(1:2) = rrff*rg(ir0:ir0+1)
00027         f(1:2) = flv(ir0:ir0+1,itg,ipg)
00028         rrgg = rg(irg)
00029         grv(irg,itg,ipg) = ((x(2)-rrgg)*f(1)+(rrgg-x(1))*f(2))/(x(2)-x(1))
00030       end do
00031     end do
00032   end do
00033 
00034 end subroutine interpo_fl2gr_linear