00001 subroutine invhij_up2down
00002 use grid_parameter, only : nrg, ntg, npg
00003 use def_metric_hij, only : hxxd, hxyd, hxzd, hyyd, hyzd, hzzd, &
00004 & hxxu, hxyu, hxzu, hyyu, hyzu, hzzu
00005 implicit none
00006 real(8) :: hxx, hxy, hxz, hyx, hyy, hyz, hzx, hzy, hzz,
00007 hod1, hod2, hod3, detgm, detgmi, &
00008 gmxxd, gmxyd, gmxzd, gmyxd, gmyyd, gmyzd, &
00009 gmzxd, gmzyd, gmzzd
00010 integer :: ipg, itg, irg
00011
00012 do ipg = 0, npg
00013 do itg = 0, ntg
00014 do irg = 0, nrg
00015
00016 hxx = hxxu(irg,itg,ipg)
00017 hxy = hxyu(irg,itg,ipg)
00018 hxz = hxzu(irg,itg,ipg)
00019 hyx = hxy
00020 hyy = hyyu(irg,itg,ipg)
00021 hyz = hyzu(irg,itg,ipg)
00022 hzx = hxz
00023 hzy = hyz
00024 hzz = hzzu(irg,itg,ipg)
00025
00026 hod1 = hxx + hyy + hzz
00027 hod2 = hxx*hyy + hxx*hzz + hyy*hzz &
00028 & - hxy*hyx - hxz*hzx - hyz*hzy
00029 hod3 = hxx*hyy*hzz + hxy*hyz*hzx + hxz*hyx*hzy &
00030 & - hxx*hyz*hzy - hxy*hyx*hzz - hxz*hyy*hzx
00031 detgm = 1.0d0 + hod1 + hod2 + hod3
00032 detgmi = 1.0d0/detgm
00033
00034 hod1 = + hyy + hzz
00035 hod2 = + hyy*hzz - hyz*hzy
00036 gmxxd = (1.0d0 + hod1 + hod2)*detgmi
00037 hod1 = - hxy
00038 hod2 = + hxz*hzy - hxy*hzz
00039 gmxyd = (hod1 + hod2)*detgmi
00040 hod1 = - hxz
00041 hod2 = + hxy*hyz - hxz*hyy
00042 gmxzd = (hod1 + hod2)*detgmi
00043 hod1 = + hxx + hzz
00044 hod2 = + hxx*hzz - hxz*hzx
00045 gmyyd = (1.0d0 + hod1 + hod2)*detgmi
00046 hod1 = - hyz
00047 hod2 = + hxz*hyx - hxx*hyz
00048 gmyzd = (hod1 + hod2)*detgmi
00049 hod1 = + hxx + hyy
00050 hod2 = + hxx*hyy - hxy*hyx
00051 gmzzd = (1.0d0 + hod1 + hod2)*detgmi
00052 gmyxd = gmxyd
00053 gmzxd = gmxzd
00054 gmzyd = gmyzd
00055
00056 hxxd(irg,itg,ipg) = gmxxd - 1.0d0
00057 hxyd(irg,itg,ipg) = gmxyd
00058 hxzd(irg,itg,ipg) = gmxzd
00059 hyyd(irg,itg,ipg) = gmyyd - 1.0d0
00060 hyzd(irg,itg,ipg) = gmyzd
00061 hzzd(irg,itg,ipg) = gmzzd - 1.0d0
00062
00063 end do
00064 end do
00065 end do
00066
00067 end subroutine invhij_up2down
