subroutine FormVRR3e(ExpZ,ExpG,CenterZ,DY0,DY1,D2Y0,D2Y1,delta0,delta1,Y0,Y1) ! Form stuff we need... implicit none include 'parameters.h' ! Input variables double precision,intent(in) :: ExpZ(3),ExpG(3,3) double precision,intent(in) :: CenterZ(3,3) ! Local variables integer :: i,j,k,l double precision :: ZetaMat(3,3) double precision :: CMat(3,3),GMat(3,3) double precision :: Delta0Mat(3,3),Delta1Mat(3,3) double precision :: InvDelta0Mat(3,3),InvDelta1Mat(3,3) double precision :: CenterY(3,3,3) double precision :: YMat(3,3),Y2Mat(3,3) double precision :: DYMat(3,3,3),D2YMat(3,3,3,3) double precision :: D0Mat(3,3),D1Mat(3,3) double precision :: KappaCross ! Output variables double precision,intent(out) :: DY0(3),DY1(3),D2Y0(3,3),D2Y1(3,3) double precision,intent(out) :: delta0,delta1,Y0,Y1 ! Initalize arrays ZetaMat = 0d0 CMat = 0d0 GMat = 0d0 YMat = 0d0 Y2Mat = 0d0 D0Mat = 0d0 D1Mat = 0d0 ! Form the zeta matrix Eq. (15a) do i=1,3 ZetaMat(i,i) = ExpZ(i) end do ! print*,'Zeta' ! call matout(3,3,ZetaMat) ! Form the C matrix Eq. (15a) CMat(1,1) = 1d0 CMat(2,2) = 1d0 CMat(1,2) = -1d0 CMat(2,1) = -1d0 ! print*,'C' ! call matout(3,3,CMat) ! Form the G matrix Eq. (15b) do i=1,3 do j=1,i-1 GMat(i,j) = - ExpG(j,i) end do do j=i+1,3 GMat(i,j) = - ExpG(i,j) end do end do do i=1,3 do j=1,i-1 GMat(i,i) = GMat(i,i) + ExpG(j,i) end do do j=i+1,3 GMat(i,i) = GMat(i,i) + ExpG(i,j) end do end do ! print*,'G' ! call matout(3,3,GMat) ! Form the Y and Y^2 matrices Eq. (16b) do i=1,3 do j=i+1,3 do k=1,3 CenterY(i,j,k) = CenterZ(i,k) - CenterZ(j,k) Y2Mat(i,j) = Y2Mat(i,j) + CenterY(i,j,k)**2 end do YMat(i,j) = sqrt(Y2Mat(i,j)) end do end do ! print*,'Y' ! call matout(3,3,YMat) ! print*,'Y2' ! call matout(3,3,Y2Mat) ! Form the delta0 and delta1 matrices Eq. (14) do i=1,3 do j=1,3 Delta0Mat(i,j) = ZetaMat(i,j) + GMat(i,j) Delta1Mat(i,j) = Delta0Mat(i,j) + CMat(i,j) end do end do ! Form the DY and D2Y matrices do i=1,3 do j=1,3 do k=1,3 DYMat(i,j,k) = KappaCross(i,j,k)*YMat(j,k)/ExpZ(i) do l=1,3 D2YMat(i,j,k,l) = 0.5d0*KappaCross(i,k,l)*KappaCross(j,k,l)/(ExpZ(i)*ExpZ(j)) end do end do end do end do ! Compute the inverse of the Delta0 and Delta1 matrices ! InvDelta0Mat = Delta0Mat ! InvDelta1Mat = Delta1Mat do i=1,3 do j=1,3 InvDelta0Mat(i,j) = Delta0Mat(i,j) InvDelta1Mat(i,j) = Delta1Mat(i,j) end do end do ! call amove(3,3,Delta0Mat,InvDelta0Mat) ! call amove(3,3,Delta1Mat,InvDelta1Mat) call CalcInv3(InvDelta0Mat,delta0) call CalcInv3(InvDelta1Mat,delta1) ! call matout(3,3,InvDelta0Mat) ! call matout(3,3,InvDelta1Mat) ! print*, 'delta0,delta1 = ',delta0,delta1 ! Form the Delta matrix Eq. (16a) do i=1,3 do j=1,3 do k=1,3 do l=1,3 D0Mat(i,j) = D0Mat(i,k) + ZetaMat(i,k)*InvDelta0Mat(k,l)*ZetaMat(l,j) D1Mat(i,j) = D1Mat(i,k) + ZetaMat(i,k)*InvDelta1Mat(k,l)*ZetaMat(l,j) end do end do end do end do ! Form the derivative matrices do i=1,3 call CalcTrAB(3,D0Mat,D2YMat,DY0(i)) call CalcTrAB(3,D1Mat,D2YMat,DY1(i)) do j=1,3 call CalcTrAB(3,D0Mat,D2YMat,D2Y0(i,j)) call CalcTrAB(3,D1Mat,D2YMat,D2Y1(i,j)) end do end do ! Compute Y0 and Y1 call CalcTrAB(3,D0Mat,Y2Mat,Y0) call CalcTrAB(3,D1Mat,Y2Mat,Y1) end subroutine FormVRR3e