00001 subroutine interpo_fl2gr(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(4), f(4)
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-2),nrf-3)
00023 exit
00024 end if
00025 end do
00026 x(1:4) = rrff*rg(ir0:ir0+3)
00027 f(1:4) = flv(ir0:ir0+3,itg,ipg)
00028 rrgg = rg(irg)
00029 grv(irg,itg,ipg) = lagint_4th(x,f,rrgg)
00030 end do
00031 end do
00032 end do
00033
00034 end subroutine interpo_fl2gr