00001 subroutine sourceterm_surface_int_homosol(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 use interface_grdr_gridpoint_type0_3rd_nosym
00008
00009 implicit none
00010 real(long), pointer :: fnc(:,:,:), sou_surf(:,:), dsou_surf(:,:)
00011 real(long), pointer :: fnc_surf(:,:), dfnc_surf(:,:)
00012 real(long) :: deriv, val
00013 integer, intent(in) :: irg_surf
00014 integer :: itg, ipg
00015
00016 call alloc_array2d(fnc_surf, 0, ntg, 0, npg)
00017 call alloc_array2d(dfnc_surf, 0, ntg, 0, npg)
00018
00019 do ipg = 0, npg
00020 do itg = 0, ntg
00021 fnc_surf(itg,ipg) = fnc(irg_surf,itg,ipg)
00022
00023 call grdr_gridpoint_type0_nosym(fnc,deriv,irg_surf,itg,ipg)
00024 dfnc_surf(itg,ipg) = deriv
00025 end do
00026 end do
00027
00028
00029
00030 do ipg = 1, npg
00031 do itg = 1, ntg
00032 call interpo_linear_type0_2Dsurf(val,fnc_surf,itg,ipg)
00033 sou_surf(itg,ipg) = sou_surf(itg,ipg) - val
00034 call interpo_linear_type0_2Dsurf(val,dfnc_surf,itg,ipg)
00035 dsou_surf(itg,ipg) = dsou_surf(itg,ipg) - val
00036 end do
00037 end do
00038 deallocate(fnc_surf)
00039 deallocate(dfnc_surf)
00040
00041 end subroutine sourceterm_surface_int_homosol