

























































































































 


































































































































































 






















































































































































































 






















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                





































module covderivs
  implicit none
  private
  
  public calc_scalargrad
  public calc_covectorgrad
  public calc_vectorgrad
  public calc_tensorgrad
  public calc_scalargradgrad
  public calc_covectorgradgrad
  public calc_longitudinal
  public calc_gradlongitudinal
  
contains
  
  subroutine calc_scalargrad (f, df, gamma, gf)
    REAL*8, intent(in)  :: f
    REAL*8, intent(in)  :: df(3)
    REAL*8, intent(in)  :: gamma(3,3,3)
    REAL*8, intent(out) :: gf(3)
    integer :: i
    
    do i=1,3
       gf(i) = df(i)
    end do
  end subroutine calc_scalargrad
  
  subroutine calc_covectorgrad (f, df, gamma, gf)
    REAL*8, intent(in)  :: f(3)
    REAL*8, intent(in)  :: df(3,3)
    REAL*8, intent(in)  :: gamma(3,3,3)
    REAL*8, intent(out) :: gf(3,3)
    integer :: i,j,k
    
    do i=1,3
       do j=1,3
          gf(i,j) = df(i,j)
          do k=1,3
             gf(i,j) = gf(i,j) - gamma(k,i,j) * f(k)
          end do
       end do
    end do
  end subroutine calc_covectorgrad
  
  subroutine calc_vectorgrad (f, df, gamma, gf)
    REAL*8, intent(in)  :: f(3)
    REAL*8, intent(in)  :: df(3,3)
    REAL*8, intent(in)  :: gamma(3,3,3)
    REAL*8, intent(out) :: gf(3,3)
    integer :: i,j,k
    
    do i=1,3
       do j=1,3
          gf(i,j) = df(i,j)
          do k=1,3
             gf(i,j) = gf(i,j) + gamma(i,k,j) * f(k)
          end do
       end do
    end do
  end subroutine calc_vectorgrad
  
  subroutine calc_tensorgrad (f, df, gamma, gf)
    REAL*8, intent(in)  :: f(3,3)
    REAL*8, intent(in)  :: df(3,3,3)
    REAL*8, intent(in)  :: gamma(3,3,3)
    REAL*8, intent(out) :: gf(3,3,3)
    integer :: i,j,k,l
    
    do i=1,3
       do j=1,3
          do k=1,3
             gf(i,j,k) = df(i,j,k)
             do l=1,3
                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_tensorgrad
  
  
  
  subroutine calc_scalargradgrad (f, df, ddf, gamma, ggf)
    REAL*8, intent(in)  :: f
    REAL*8, intent(in)  :: df(3)
    REAL*8, intent(in)  :: ddf(3,3)
    REAL*8, intent(in)  :: gamma(3,3,3)
    REAL*8, intent(out) :: ggf(3,3)
    integer :: i,j,k
    
    do i=1,3
       do j=1,3
          ggf(i,j) = ddf(i,j)
          do k=1,3
             ggf(i,j) = ggf(i,j) - gamma(k,i,j) * df(k)
          end do
       end do
    end do
  end subroutine calc_scalargradgrad
  
  subroutine calc_covectorgradgrad (f, df, ddf, gamma, dgamma, ggf)
    REAL*8, intent(in)  :: f(3)
    REAL*8, intent(in)  :: df(3,3)
    REAL*8, intent(in)  :: ddf(3,3,3)
    REAL*8, intent(in)  :: gamma(3,3,3), dgamma(3,3,3,3)
    REAL*8, intent(out) :: ggf(3,3,3)
    REAL*8 :: gf(3,3)
    integer :: i,j,k,l
    
    
    
    call calc_covectorgrad (f, df, gamma, gf)
    do i=1,3
       do j=1,3
          do k=1,3
             ggf(i,j,k) = ddf(i,j,k)
             do l=1,3
                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_covectorgradgrad
  
  subroutine calc_vectorgradgrad (f, df, ddf, gamma, dgamma, ggf)
    REAL*8, intent(in)  :: f(3)
    REAL*8, intent(in)  :: df(3,3)
    REAL*8, intent(in)  :: ddf(3,3,3)
    REAL*8, intent(in)  :: gamma(3,3,3), dgamma(3,3,3,3)
    REAL*8, intent(out) :: ggf(3,3,3)
    REAL*8 :: gf(3,3)
    integer :: i,j,k,l
    
    
    
    call calc_vectorgrad (f, df, gamma, gf)
    do i=1,3
       do j=1,3
          do k=1,3
             ggf(i,j,k) = ddf(i,j,k)
             do l=1,3
                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_vectorgradgrad
  
  
  
  subroutine calc_longitudinal (gf, gg, gu, lf)
    REAL*8, intent(in)  :: gf(3,3)
    REAL*8, intent(in)  :: gg(3,3), gu(3,3)
    REAL*8, intent(out) :: lf(3,3)
    integer :: i,j,k,l
    
    do i=1,3
       do j=1,3
          lf(i,j) = gf(i,j) + gf(j,i)
          do k=1,3
             do l=1,3
                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_longitudinal
  
  subroutine calc_gradlongitudinal (ggf, gg, gu, glf)
    REAL*8, intent(in)  :: ggf(3,3,3)
    REAL*8, intent(in)  :: gg(3,3), gu(3,3)
    REAL*8, intent(out) :: glf(3,3,3)
    integer :: i,j,k,l,m
    
    do i=1,3
       do j=1,3
          do k=1,3
             glf(i,j,k) = ggf(j,i,k) + ggf(i,j,k)
             do l=1,3
                do m=1,3
                   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_gradlongitudinal
  
end module covderivs
