

























































































































 


































































































































































 






















































































































































































 






















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                





































module covderivs2
  implicit none
  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)
    REAL*8, intent(in)  :: f
    REAL*8, intent(in)  :: df(2)
    REAL*8, intent(in)  :: gamma(2,2,2)
    REAL*8, intent(out) :: gf(2)
    integer :: i
    
    do i=1,2
       gf(i) = df(i)
    end do
  end subroutine calc_2scalargrad
  
  subroutine calc_2covectorgrad (f, df, gamma, gf)
    REAL*8, intent(in)  :: f(2)
    REAL*8, intent(in)  :: df(2,2)
    REAL*8, intent(in)  :: gamma(2,2,2)
    REAL*8, intent(out) :: gf(2,2)
    integer :: i,j,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)
    REAL*8, intent(in)  :: f(2)
    REAL*8, intent(in)  :: df(2,2)
    REAL*8, intent(in)  :: gamma(2,2,2)
    REAL*8, intent(out) :: gf(2,2)
    integer :: i,j,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)
    REAL*8, intent(in)  :: f(2,2)
    REAL*8, intent(in)  :: df(2,2,2)
    REAL*8, intent(in)  :: gamma(2,2,2)
    REAL*8, intent(out) :: gf(2,2,2)
    integer :: i,j,k,l
    
    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)
    REAL*8, intent(in)  :: f
    REAL*8, intent(in)  :: df(2)
    REAL*8, intent(in)  :: ddf(2,2)
    REAL*8, intent(in)  :: gamma(2,2,2)
    REAL*8, intent(out) :: ggf(2,2)
    integer :: i,j,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)
    REAL*8, intent(in)  :: f(2)
    REAL*8, intent(in)  :: df(2,2)
    REAL*8, intent(in)  :: ddf(2,2,2)
    REAL*8, intent(in)  :: gamma(2,2,2), dgamma(2,2,2,2)
    REAL*8, intent(out) :: ggf(2,2,2)
    REAL*8 :: gf(2,2)
    integer :: i,j,k,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)
    REAL*8, intent(in)  :: f(2)
    REAL*8, intent(in)  :: df(2,2)
    REAL*8, intent(in)  :: ddf(2,2,2)
    REAL*8, intent(in)  :: gamma(2,2,2), dgamma(2,2,2,2)
    REAL*8, intent(out) :: ggf(2,2,2)
    REAL*8 :: gf(2,2)
    integer :: i,j,k,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)
    REAL*8, intent(in)  :: gf(2,2)
    REAL*8, intent(in)  :: gg(2,2), gu(2,2)
    REAL*8, intent(out) :: lf(2,2)
    integer :: i,j,k,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)
    REAL*8, intent(in)  :: ggf(2,2,2)
    REAL*8, intent(in)  :: gg(2,2), gu(2,2)
    REAL*8, intent(out) :: glf(2,2,2)
    integer :: i,j,k,l,m
    
    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
