00001 subroutine interpo_gr2fl(grv,flv)
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, small = 1.0d-14
00011 integer :: irg, irf, itf, ipf, ir0
00012
00013 flv(0:nrf,0:ntf,0:npf) = 0.0d0
00014
00015 do ipf = 0, npf
00016 do itf = 0, ntf
00017 do irf = 0, nrf
00018 rrff = rs(itf,ipf)*rg(irf)
00019 do irg = 0, nrg
00020 if (rrff.le.rg(irg)) then
00021 ir0 = min0(max0(0,irg-1),nrg-1)
00022 exit
00023 end if
00024 end do
00025 x(1:2) = rg(ir0:ir0+1)
00026 f(1:2) = grv(ir0:ir0+1,itf,ipf)
00027 flv(irf,itf,ipf) = ((x(2)-rrff)*f(1)+(rrff-x(1))*f(2))/(x(2)-x(1))
00028 end do
00029 end do
00030 end do
00031
00032 end subroutine interpo_gr2fl