

























































































































 


































































































































































 






















































































































































































 






















































 










 








































































































































































































































 










                                
                                

                                
                                

                                
                                

                                







































module ricci4
  implicit none
  private
  public calc_4connections
  public calc_4connectionderivs
  public calc_4ricci
  public calc_4riemann
  public calc_4weyl
  
contains
  
  subroutine calc_4connections (gu, dg, gamma)
    REAL*8, intent(in)  :: gu(4,4), dg(4,4,4)
    REAL*8, intent(out) :: gamma(4,4,4)
    integer :: i,j,k,l
    
    do i=1,4
       do j=1,4
          do k=1,4
             gamma(i,j,k) = 0
             do l=1,4
                gamma(i,j,k) = gamma(i,j,k) + 0.5d0 * gu(i,l) &
                     * (dg(l,j,k) + dg(l,k,j) - dg(j,k,l))
             end do
          end do
       end do
    end do
  end subroutine calc_4connections
  
  subroutine calc_4connectionderivs (gu, dgg, dgu, ddgg, dgamma)
    REAL*8, intent(in)  :: gu(4,4), dgg(4,4,4), dgu(4,4,4), ddgg(4,4,4,4)
    REAL*8, intent(out) :: dgamma(4,4,4,4)
    integer   :: i,j,k,l,m
    
    
    do i=1,4
       do j=1,4
          do k=1,4
             do l=1,4
                dgamma(i,j,k,l) = 0
                do m=1,4
                   dgamma(i,j,k,l) = dgamma(i,j,k,l) &
                        + 0.5d0 * dgu(i,m,l) * (dgg(m,j,k) + dgg(m,k,j) - dgg(j,k,m)) &
                        + 0.5d0 * gu(i,m) * (ddgg(m,j,k,l) + ddgg(m,k,j,l) - ddgg(j,k,m,l))
                end do
             end do
          end do
       end do
    end do
  end subroutine calc_4connectionderivs
  
  subroutine calc_4ricci (gamma, dgamma, ri)
    REAL*8, intent(in)  :: gamma(4,4,4), dgamma(4,4,4,4)
    REAL*8, intent(out) :: ri(4,4)



    integer :: i,j,k,l

    
    
    do i=1,4
       do j=1,4
          ri(i,j) = 0
          do k=1,4
             ri(i,j) = ri(i,j) + dgamma(k,i,j,k) - dgamma(k,i,k,j)
             do l=1,4
                ri(i,j) = ri(i,j) + gamma(k,l,k) * gamma(l,i,j) &
                     &            - gamma(k,l,j) * gamma(l,k,i)
             end do
          end do
       end do
    end do
  end subroutine calc_4ricci
  
  subroutine calc_4riemann (gg, gamma, dgamma, rm)
    REAL*8, intent(in)  :: gg(4,4), gamma(4,4,4), dgamma(4,4,4,4)
    REAL*8, intent(out) :: rm(4,4,4,4)
    REAL*8 :: rmu(4,4,4,4)



    integer :: i,j,k,l,m

    
    
    
    
    
    
    do i=1,4
       do j=1,4
          do k=1,4
             do l=1,4
                rmu(i,j,k,l) = dgamma(i,j,l,k) - dgamma(i,j,k,l)
                do m=1,4
                   rmu(i,j,k,l) = rmu(i,j,k,l) &
                        + gamma(m,j,l) * gamma(i,m,k) &
                        - gamma(m,j,k) * gamma(i,m,l)
                end do
             end do
          end do
       end do
    end do
    do i=1,4
       do j=1,4
          do k=1,4
             do l=1,4
                rm(i,j,k,l) = 0
                do m=1,4
                   rm(i,j,k,l) = rm(i,j,k,l) + gg(i,m) * rmu(m,j,k,l)
                end do
             end do
          end do
       end do
    end do
  end subroutine calc_4riemann
  
  subroutine calc_4weyl (gg, rm, ri, rsc, we)
    REAL*8, parameter :: one=1, half=one/2, third=one/3
    REAL*8, intent(in)  :: gg(4,4), rm(4,4,4,4), ri(4,4), rsc
    REAL*8, intent(out) :: we(4,4,4,4)



    integer :: i,j,k,l
    
    
    
    do i=1,4
       do j=1,4
          do k=1,4
             do l=1,4
                we(i,j,k,l) = rm(i,j,k,l) &
                     -        (  (gg(i,k) * ri(l,j) - gg(i,l) * ri(k,j)) &
                     &         - (gg(j,k) * ri(l,i) - gg(j,l) * ri(k,i))) &
                     + third * rsc * (gg(i,k) * gg(l,j) - gg(i,l) * gg(k,j))
             end do
          end do
       end do
    end do
  end subroutine calc_4weyl
  
end module ricci4
