00001 subroutine index_vec_down2up_midpoint(vecxu,vecyu,veczu,vecxd,vecyd,veczd)
00002 use grid_parameter, only : nrg, ntg, npg
00003 use def_metric_hij, only : hxxu, hxyu, hxzu, hyyu, hyzu, hzzu
00004 use interface_interpo_linear_type0
00005 implicit none
00006 real(8), pointer :: vecxu(:,:,:), vecyu(:,:,:), veczu(:,:,:),
00007 vecxd(:,:,:), vecyd(:,:,:), veczd(:,:,:)
00008 real(8) :: hhxxu, hhxyu, hhxzu, hhyyu, hhyzu, hhzzu
00009 real(8) :: gmxxu, gmxyu, gmxzu, gmyxu, gmyyu, gmyzu,
00010 gmzxu, gmzyu, gmzzu
00011 integer :: ipg, itg, irg
00012
00013
00014
00015 do ipg = 1, npg
00016 do itg = 1, ntg
00017 do irg = 1, nrg
00018 call interpo_linear_type0(hhxxu,hxxu,irg,itg,ipg)
00019 call interpo_linear_type0(hhxyu,hxyu,irg,itg,ipg)
00020 call interpo_linear_type0(hhxzu,hxzu,irg,itg,ipg)
00021 call interpo_linear_type0(hhyyu,hyyu,irg,itg,ipg)
00022 call interpo_linear_type0(hhyzu,hyzu,irg,itg,ipg)
00023 call interpo_linear_type0(hhzzu,hzzu,irg,itg,ipg)
00024 gmxxu = 1.0d0 + hhxxu
00025 gmxyu = hhxyu
00026 gmxzu = hhxzu
00027 gmyxu = hhxyu
00028 gmyyu = 1.0d0 + hhyyu
00029 gmyzu = hhyzu
00030 gmzxu = hhxzu
00031 gmzyu = hhyzu
00032 gmzzu = 1.0d0 + hhzzu
00033 vecxu(irg,itg,ipg) = gmxxu*vecxd(irg,itg,ipg) &
00034 & + gmxyu*vecyd(irg,itg,ipg) &
00035 & + gmxzu*veczd(irg,itg,ipg)
00036 vecyu(irg,itg,ipg) = gmyxu*vecxd(irg,itg,ipg) &
00037 & + gmyyu*vecyd(irg,itg,ipg) &
00038 & + gmyzu*veczd(irg,itg,ipg)
00039 veczu(irg,itg,ipg) = gmzxu*vecxd(irg,itg,ipg) &
00040 & + gmzyu*vecyd(irg,itg,ipg) &
00041 & + gmzzu*veczd(irg,itg,ipg)
00042 end do
00043 end do
00044 end do
00045
00046 end subroutine index_vec_down2up_midpoint
00047