00001 subroutine sourceterm_surface_int(fnc,irg_surf,sou_surf,dsou_surf)
00002 use phys_constant, only : long
00003 use grid_parameter, only : ntg, npg
00004 use make_array_2d
00005 use interface_interpo_linear_type0_2Dsurf
00006 use interface_grdr_gridpoint_type0_nosym
00007
00008 implicit none
00009 real(long), pointer :: fnc(:,:,:), sou_surf(:,:), dsou_surf(:,:)
00010 real(long), pointer :: fnc_surf(:,:), dfnc_surf(:,:)
00011 real(long) :: deriv, val
00012 integer, intent(in) :: irg_surf
00013 integer :: itg, ipg
00014
00015 call alloc_array2d(fnc_surf, 0, ntg, 0, npg)
00016 call alloc_array2d(dfnc_surf, 0, ntg, 0, npg)
00017
00018 do ipg = 0, npg
00019 do itg = 0, ntg
00020 fnc_surf(itg,ipg) = fnc(irg_surf,itg,ipg)
00021 call grdr_gridpoint_type0_nosym(fnc,deriv,irg_surf,itg,ipg)
00022 dfnc_surf(itg,ipg) = deriv
00023 end do
00024 end do
00025
00026 do ipg = 1, npg
00027 do itg = 1, ntg
00028 call interpo_linear_type0_2Dsurf(val,fnc_surf,itg,ipg)
00029 sou_surf(itg,ipg) = val
00030 call interpo_linear_type0_2Dsurf(val,dfnc_surf,itg,ipg)
00031 dsou_surf(itg,ipg) = val
00032 end do
00033 end do
00034 deallocate(fnc_surf)
00035 deallocate(dfnc_surf)
00036
00037 end subroutine sourceterm_surface_int