00001 subroutine calc_surface(rsnew,emd)
00002   use phys_constant, only  : long
00003   use grid_parameter, only : nrf, ntf, npf
00004   use coordinate_grav_r, only : drg
00005   use def_matter, only : rs
00006 
00007   implicit none
00008   real(long), pointer :: emd(:,:,:)
00009   real(long), pointer :: rsnew(:,:)
00010   real(long) :: delta
00011   integer    :: itf, ipf
00012   do ipf = 0, npf
00013     do itf = 0, ntf
00014       delta = drg(nrf)*(0.0d0            - emd(nrf  ,itf,ipf)) &
00015     &                 /(emd(nrf,itf,ipf) - emd(nrf-1,itf,ipf))
00016       rsnew(itf,ipf) = rs(itf,ipf)*(1.0d0 + delta)
00017     end do
00018   end do
00019   rsnew(0,1:npf) = rsnew(0,0)
00020 end subroutine calc_surface