diff options
Diffstat (limited to 'src/covderivs2.F90')
| -rw-r--r-- | src/covderivs2.F90 | 204 |
1 files changed, 204 insertions, 0 deletions
diff --git a/src/covderivs2.F90 b/src/covderivs2.F90 new file mode 100644 index 0000000..15e0143 --- /dev/null +++ b/src/covderivs2.F90 @@ -0,0 +1,204 @@ +! $Header$ + +#include "cctk.h" +#include "cctk_Parameters.h" + +module covderivs2 + implicit none + DECLARE_CCTK_PARAMETERS + private + + public calc_2scalargrad + public calc_2covectorgrad + public calc_2vectorgrad + public calc_2tensorgrad + + public calc_2scalargradgrad + public calc_2covectorgradgrad + public calc_2vectorgradgrad + + public calc_2longitudinal + public calc_2gradlongitudinal + +contains + + subroutine calc_2scalargrad (f, df, gamma, gf) + CCTK_REAL, intent(in) :: f + CCTK_REAL, intent(in) :: df(2) + CCTK_REAL, intent(in) :: gamma(2,2,2) + CCTK_REAL, intent(out) :: gf(2) + integer :: i + ! f;i = f,i + do i=1,2 + gf(i) = df(i) + end do + end subroutine calc_2scalargrad + + subroutine calc_2covectorgrad (f, df, gamma, gf) + CCTK_REAL, intent(in) :: f(2) + CCTK_REAL, intent(in) :: df(2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2) + CCTK_REAL, intent(out) :: gf(2,2) + integer :: i,j,k + ! f_i;j = f_i,j - Gamma^k_ij f_k + do i=1,2 + do j=1,2 + gf(i,j) = df(i,j) + do k=1,2 + gf(i,j) = gf(i,j) - gamma(k,i,j) * f(k) + end do + end do + end do + end subroutine calc_2covectorgrad + + subroutine calc_2vectorgrad (f, df, gamma, gf) + CCTK_REAL, intent(in) :: f(2) + CCTK_REAL, intent(in) :: df(2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2) + CCTK_REAL, intent(out) :: gf(2,2) + integer :: i,j,k + ! f^i;j = f^i,j + Gamma^i_kj f^k + do i=1,2 + do j=1,2 + gf(i,j) = df(i,j) + do k=1,2 + gf(i,j) = gf(i,j) + gamma(i,k,j) * f(k) + end do + end do + end do + end subroutine calc_2vectorgrad + + subroutine calc_2tensorgrad (f, df, gamma, gf) + CCTK_REAL, intent(in) :: f(2,2) + CCTK_REAL, intent(in) :: df(2,2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2) + CCTK_REAL, intent(out) :: gf(2,2,2) + integer :: i,j,k,l + ! f_ij;k = f_ij,k - Gamma^l_ik f_lj - Gamma^l_jk f_il + do i=1,2 + do j=1,2 + do k=1,2 + gf(i,j,k) = df(i,j,k) + do l=1,2 + gf(i,j,k) = gf(i,j,k) - gamma(l,i,k) * f(l,j) & + & - gamma(l,j,k) * f(i,l) + end do + end do + end do + end do + end subroutine calc_2tensorgrad + + + + subroutine calc_2scalargradgrad (f, df, ddf, gamma, ggf) + CCTK_REAL, intent(in) :: f + CCTK_REAL, intent(in) :: df(2) + CCTK_REAL, intent(in) :: ddf(2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2) + CCTK_REAL, intent(out) :: ggf(2,2) + integer :: i,j,k + ! f;ij = f,ij - Gamma^k_ij f,k + do i=1,2 + do j=1,2 + ggf(i,j) = ddf(i,j) + do k=1,2 + ggf(i,j) = ggf(i,j) - gamma(k,i,j) * df(k) + end do + end do + end do + end subroutine calc_2scalargradgrad + + subroutine calc_2covectorgradgrad (f, df, ddf, gamma, dgamma, ggf) + CCTK_REAL, intent(in) :: f(2) + CCTK_REAL, intent(in) :: df(2,2) + CCTK_REAL, intent(in) :: ddf(2,2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2), dgamma(2,2,2,2) + CCTK_REAL, intent(out) :: ggf(2,2,2) + CCTK_REAL :: gf(2,2) + integer :: i,j,k,l + ! f_i;j = f_i,j - Gamma^l_ij f_l + ! f_i;jk = f_i,jk - Gamma^l_ij,k f_l - Gamma^l_ij f_l,k + ! - Gamma^l_ik f_l;j - Gamma^l_jk f_i;l + call calc_2covectorgrad (f, df, gamma, gf) + do i=1,2 + do j=1,2 + do k=1,2 + ggf(i,j,k) = ddf(i,j,k) + do l=1,2 + ggf(i,j,k) = ggf(i,j,k) & + - dgamma(l,i,j,k) * f(l) - gamma(l,i,j) * df(l,k) & + - gamma(l,i,k) * gf(l,j) - gamma(l,j,k) * gf(i,l) + end do + end do + end do + end do + end subroutine calc_2covectorgradgrad + + subroutine calc_2vectorgradgrad (f, df, ddf, gamma, dgamma, ggf) + CCTK_REAL, intent(in) :: f(2) + CCTK_REAL, intent(in) :: df(2,2) + CCTK_REAL, intent(in) :: ddf(2,2,2) + CCTK_REAL, intent(in) :: gamma(2,2,2), dgamma(2,2,2,2) + CCTK_REAL, intent(out) :: ggf(2,2,2) + CCTK_REAL :: gf(2,2) + integer :: i,j,k,l + ! f^i;j = f^i,j + Gamma^i_lj f^l + ! f^i;jk = f^i,jk + Gamma^i_lj,k f^l + Gamma^i_lj f^l,k + ! - Gamma^i_lk f^l;j - Gamma^l_jk f^i;l + call calc_2vectorgrad (f, df, gamma, gf) + do i=1,2 + do j=1,2 + do k=1,2 + ggf(i,j,k) = ddf(i,j,k) + do l=1,2 + ggf(i,j,k) = ggf(i,j,k) & + + dgamma(i,l,j,k) * f(l) + gamma(i,l,j) * df(l,k) & + - gamma(i,l,k) * gf(l,j) - gamma(l,j,k) * gf(i,l) + end do + end do + end do + end do + end subroutine calc_2vectorgradgrad + + + + subroutine calc_2longitudinal (gf, gg, gu, lf) + CCTK_REAL, intent(in) :: gf(2,2) + CCTK_REAL, intent(in) :: gg(2,2), gu(2,2) + CCTK_REAL, intent(out) :: lf(2,2) + integer :: i,j,k,l + ! (Lf)_ij = D_i f_j + D_j f_i - 2/3 g_ij D^l f_l + do i=1,2 + do j=1,2 + lf(i,j) = gf(i,j) + gf(j,i) + do k=1,2 + do l=1,2 + lf(i,j) = lf(i,j) - (2.d0/3.d0) * gg(i,j) * gu(k,l) * gf(k,l) + end do + end do + end do + end do + end subroutine calc_2longitudinal + + subroutine calc_2gradlongitudinal (ggf, gg, gu, glf) + CCTK_REAL, intent(in) :: ggf(2,2,2) + CCTK_REAL, intent(in) :: gg(2,2), gu(2,2) + CCTK_REAL, intent(out) :: glf(2,2,2) + integer :: i,j,k,l,m + ! D_k (Lf)_ij = D_k (D_i f_j + D_j f_i - 2/3 g_ij D^l f_l) + do i=1,2 + do j=1,2 + do k=1,2 + glf(i,j,k) = ggf(j,i,k) + ggf(i,j,k) + do l=1,2 + do m=1,2 + glf(i,j,k) = glf(i,j,k) & + - (2.d0/3.d0) * gg(i,j) * gu(l,m) * ggf(l,m,k) + end do + end do + end do + end do + end do + end subroutine calc_2gradlongitudinal + +end module covderivs2 |