00001 subroutine calc_shift2rotshift
00002 use grid_parameter, only : nrg, ntg, npg
00003 use def_matter, only : omeg
00004 use def_matter_parameter, only : ber, radi
00005 use def_metric, only : bvxu, bvyu, bvzu, bvxd, bvyd, bvzd
00006 use coordinate_grav_r, only : rg
00007 use trigonometry_grav_phi, only : sinphig, cosphig
00008 use trigonometry_grav_theta, only : sinthg
00009 use def_metric_rotshift, only : ovxu, ovyu, ovzu, ovxd, ovyd, ovzd
00010 use def_metric_hij, only : hxxd, hxyd, hxzd, hyyd, hyzd, hzzd
00011 use def_vector_phi, only : vec_phig
00012 implicit none
00013 real(8) :: vphixg, vphiyg, vphizg, bvxgc, bvygc, bvzgc,
00014 gmxxd, gmxyd, gmxzd, gmyxd, gmyyd, gmyzd, &
00015 gmzxd, gmzyd, gmzzd, omegc
00016 integer :: ipg, itg, irg
00017
00018
00019
00020 do ipg = 0, npg
00021 do itg = 0, ntg
00022 do irg = 0, nrg
00023 vphixg = vec_phig(irg,itg,ipg,1)
00024 vphiyg = vec_phig(irg,itg,ipg,2)
00025 vphizg = vec_phig(irg,itg,ipg,3)
00026 bvxgc = bvxu(irg,itg,ipg)
00027 bvygc = bvyu(irg,itg,ipg)
00028 bvzgc = bvzu(irg,itg,ipg)
00029 omegc = omeg(irg,itg,ipg)
00030 ovxu(irg,itg,ipg) = bvxgc + omegc*vphixg
00031 ovyu(irg,itg,ipg) = bvygc + omegc*vphiyg
00032 ovzu(irg,itg,ipg) = bvzgc + omegc*vphizg
00033 end do
00034 end do
00035 end do
00036
00037
00038
00039 do ipg = 0, npg
00040 do itg = 0, ntg
00041 do irg = 0, nrg
00042 gmxxd = 1.0d0 + hxxd(irg,itg,ipg)
00043 gmxyd = hxyd(irg,itg,ipg)
00044 gmxzd = hxzd(irg,itg,ipg)
00045 gmyxd = hxyd(irg,itg,ipg)
00046 gmyyd = 1.0d0 + hyyd(irg,itg,ipg)
00047 gmyzd = hyzd(irg,itg,ipg)
00048 gmzxd = hxzd(irg,itg,ipg)
00049 gmzyd = hyzd(irg,itg,ipg)
00050 gmzzd = 1.0d0 + hzzd(irg,itg,ipg)
00051
00052 vphixg = vec_phig(irg,itg,ipg,1)
00053 vphiyg = vec_phig(irg,itg,ipg,2)
00054 vphizg = vec_phig(irg,itg,ipg,3)
00055 bvxgc = bvxd(irg,itg,ipg)
00056 bvygc = bvyd(irg,itg,ipg)
00057 bvzgc = bvzd(irg,itg,ipg)
00058 omegc = omeg(irg,itg,ipg)
00059
00060 ovxd(irg,itg,ipg) = bvxgc + gmxxd*omegc*vphixg &
00061 & + gmxyd*omegc*vphiyg &
00062 & + gmxzd*omegc*vphizg
00063 ovyd(irg,itg,ipg) = bvygc + gmyxd*omegc*vphixg &
00064 & + gmyyd*omegc*vphiyg &
00065 & + gmyzd*omegc*vphizg
00066 ovzd(irg,itg,ipg) = bvzgc + gmzxd*omegc*vphixg &
00067 & + gmzyd*omegc*vphiyg &
00068 & + gmzzd*omegc*vphizg
00069 end do
00070 end do
00071 end do
00072
00073 end subroutine calc_shift2rotshift
00074