00001 subroutine source_fnc_moment_asympto(fnc,sousfv,irg)
00002 use phys_constant, only : long
00003 use grid_parameter, only : ntg, npg
00004 use coordinate_grav_r, only : rg
00005 use def_vector_x, only : vec_xg
00006 use make_array_2d
00007 use interface_interpo_linear_type0_2Dsurf
00008 implicit none
00009 real(long), pointer :: fnc(:,:,:), sousfv(:,:,:)
00010 real(long), pointer :: sousf(:,:)
00011 integer :: irg
00012 real(long) :: na, fncgc, val, dfdx, dfdy, dfdz
00013 integer :: itg, ipg, ia, ib, ii
00014
00015 call alloc_array2d(sousf, 0,ntg, 0,npg)
00016
00017 do ii = 1, 3
00018
00019 do ipg = 0, npg
00020 do itg = 0, ntg
00021 fncgc = fnc(irg,itg,ipg)
00022
00023 na = vec_xg(irg,itg,ipg,ii)
00024 sousf(itg,ipg) = fncgc*na
00025 end do
00026 end do
00027
00028 do ipg = 1, npg
00029 do itg = 1, ntg
00030 call interpo_linear_type0_2Dsurf(val,sousf,itg,ipg)
00031 sousfv(itg,ipg,ii) = val
00032 end do
00033 end do
00034
00035 end do
00036
00037 deallocate(sousf)
00038
00039 end subroutine source_fnc_moment_asympto