!$Id: adm_constraint.f90,v 1.1 2012/12/01 04:03:15 zjcao Exp $
!-------------------------------------------------------------------------------!
! computed constraint for ADM formalism                                         !
!-------------------------------------------------------------------------------!
  subroutine constraint_adm(ex, X, Y, Z,&
               dxx,gxy,gxz,dyy,gyz,dzz, &
               Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, &
               Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,&
               ham_Res, movx_Res, movy_Res, movz_Res, &
               Symmetry)

  implicit none
!~~~~~~> Input parameters:

  integer,intent(in ):: ex(1:3),symmetry
  real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3))
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res
!~~~~~~> Other variables:
!  inverse metric
  real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz
! first order derivative of metric, @_k g_ij
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,trK,fx,fy,fz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxxx, Gamxxy, Gamxxz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamxyy, Gamxyz, Gamxzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyxx, Gamyxy, Gamyxz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamyyy, Gamyyz, Gamyzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzxx, Gamzxy, Gamzxz
  real*8, dimension(ex(1),ex(2),ex(3)) :: Gamzyy, Gamzyz, Gamzzz

  integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2
  real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0
  real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0
  real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0
  real*8            :: PI

  call adm_ricci_gamma(ex, X, Y, Z,                        &
               dxx    ,   gxy    ,   gxz    ,   dyy    ,   gyz    ,   dzz,&
               Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,&
               Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,&
               Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,&
               Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,&
               Symmetry)

  PI = dacos(-ONE)

  gxx = dxx + ONE
  gyy = dyy + ONE
  gzz = dzz + ONE
! invert metric
  gupzz =  gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - &
           gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz
  gupxx =   ( gyy * gzz - gyz * gyz ) / gupzz
  gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz
  gupxz =   ( gxy * gyz - gyy * gxz ) / gupzz
  gupyy =   ( gxx * gzz - gxz * gxz ) / gupzz
  gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz
  gupzz =   ( gxx * gyy - gxy * gxy ) / gupzz

  trK =          gupxx * Kxx + gupyy * Kyy + gupzz * Kzz &
        + TWO * (gupxy * Kxy + gupxz * Kxz + gupyz * Kyz)

! ham_Res = trR + K^2 - K_ij * K^ij - 16 * PI * rho
  ham_Res =   gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + &
        TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz )

  ham_Res = ham_Res + trK * trK -(&
       gupxx * ( &
       gupxx * Kxx * Kxx + gupyy * Kxy * Kxy + gupzz * Kxz * Kxz + &
       TWO * (gupxy * Kxx * Kxy + gupxz * Kxx * Kxz + gupyz * Kxy * Kxz) ) + &
       gupyy * ( &
       gupxx * Kxy * Kxy + gupyy * Kyy * Kyy + gupzz * Kyz * Kyz + &
       TWO * (gupxy * Kxy * Kyy + gupxz * Kxy * Kyz + gupyz * Kyy * Kyz) ) + &
       gupzz * ( &
       gupxx * Kxz * Kxz + gupyy * Kyz * Kyz + gupzz * Kzz * Kzz + &
       TWO * (gupxy * Kxz * Kyz + gupxz * Kxz * Kzz + gupyz * Kyz * Kzz) ) + &
       TWO * ( &
       gupxy * ( &
       gupxx * Kxx * Kxy + gupyy * Kxy * Kyy + gupzz * Kxz * Kyz + &
       gupxy * (Kxx * Kyy + Kxy * Kxy) + &
       gupxz * (Kxx * Kyz + Kxz * Kxy) + &
       gupyz * (Kxy * Kyz + Kxz * Kyy) ) + &
       gupxz * ( &
       gupxx * Kxx * Kxz + gupyy * Kxy * Kyz + gupzz * Kxz * Kzz + &
       gupxy * (Kxx * Kyz + Kxy * Kxz) + &
       gupxz * (Kxx * Kzz + Kxz * Kxz) + &
       gupyz * (Kxy * Kzz + Kxz * Kyz) ) + &
       gupyz * ( &
       gupxx * Kxy * Kxz + gupyy * Kyy * Kyz + gupzz * Kyz * Kzz + &
       gupxy * (Kxy * Kyz + Kyy * Kxz) + &
       gupxz * (Kxy * Kzz + Kyz * Kxz) + &
       gupyz * (Kyy * Kzz + Kyz * Kyz) ) ))- F16 * PI * rho

! mov_Res_j = gupkj*D_k K_ij - d_j trK - 8 PI s_j where D respect to physical metric
! store D_i K_jk
  call fderivs(ex,Kxx,gxxx,gxxy,gxxz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0)
  call fderivs(ex,Kxy,gxyx,gxyy,gxyz,X,Y,Z,ANTI,ANTI,SYM ,Symmetry,0)
  call fderivs(ex,Kxz,gxzx,gxzy,gxzz,X,Y,Z,ANTI,SYM ,ANTI,Symmetry,0)
  call fderivs(ex,Kyy,gyyx,gyyy,gyyz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0)
  call fderivs(ex,Kyz,gyzx,gyzy,gyzz,X,Y,Z,SYM ,ANTI,ANTI,Symmetry,0)
  call fderivs(ex,Kzz,gzzx,gzzy,gzzz,X,Y,Z,SYM ,SYM ,SYM ,Symmetry,0)

  gxxx = gxxx - (  Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz &
                 + Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz)
  gxyx = gxyx - (  Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz &
                 + Gamxxx * Kxy + Gamyxx * Kyy + Gamzxx * Kyz)
  gxzx = gxzx - (  Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz &
                 + Gamxxx * Kxz + Gamyxx * Kyz + Gamzxx * Kzz)
  gyyx = gyyx - (  Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz &
                 + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz)
  gyzx = gyzx - (  Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz &
                 + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz)
  gzzx = gzzx - (  Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz &
                 + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz)
  gxxy = gxxy - (  Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz &
                 + Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz)
  gxyy = gxyy - (  Gamxyy * Kxx + Gamyyy * Kxy + Gamzyy * Kxz &
                 + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz)
  gxzy = gxzy - (  Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz &
                 + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz)
  gyyy = gyyy - (  Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz &
                 + Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz)
  gyzy = gyzy - (  Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz &
                 + Gamxyy * Kxz + Gamyyy * Kyz + Gamzyy * Kzz)
  gzzy = gzzy - (  Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz &
                 + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz)
  gxxz = gxxz - (  Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz &
                 + Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz)
  gxyz = gxyz - (  Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz &
                 + Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz)
  gxzz = gxzz - (  Gamxzz * Kxx + Gamyzz * Kxy + Gamzzz * Kxz &
                 + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz)
  gyyz = gyyz - (  Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz &
                 + Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz)
  gyzz = gyzz - (  Gamxzz * Kxy + Gamyzz * Kyy + Gamzzz * Kyz &
                 + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz)
  gzzz = gzzz - (  Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz &
                 + Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz)
movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz &
          +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy &
          +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz
movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz &
          +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy &
          +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz
movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz &
          +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy &
          +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz

  call fderivs(ex,trK,fx,fy,fz,X,Y,Z,SYM,SYM,SYM,Symmetry,0)

movx_Res = movx_Res - fx - F8*PI*sx
movy_Res = movy_Res - fy - F8*PI*sy
movz_Res = movz_Res - fz - F8*PI*sz

  return

  end subroutine constraint_adm
!-------------------------------------------------------------------------------!
! computed constraint for ADM formalism for shell                              !
!-------------------------------------------------------------------------------!
  subroutine constraint_adm_ss(ex,crho,sigma,R, X, Y, Z,&
               drhodx, drhody, drhodz,                                         &
               dsigmadx,dsigmady,dsigmadz,                                     &
               dRdx,dRdy,dRdz,                                                 &
               drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz,                &
               dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz,    &
               dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,                            &
               dxx,gxy,gxz,dyy,gyz,dzz, &
               Kxx,Kxy,Kxz,Kyy,Kyz,Kzz, &
               Lap,Sfx,Sfy,Sfz,rho,Sx,Sy,Sz,&
               Gamxxx, Gamxxy, Gamxxz,Gamxyy, Gamxyz, Gamxzz, &
               Gamyxx, Gamyxy, Gamyxz,Gamyyy, Gamyyz, Gamyzz, &
               Gamzxx, Gamzxy, Gamzxz,Gamzyy, Gamzyz, Gamzzz, &
               Rxx,Rxy,Rxz,Ryy,Ryz,Rzz, &
               ham_Res, movx_Res, movy_Res, movz_Res, &
               Symmetry,Lev,sst)

  implicit none
!~~~~~~> Input parameters:

  integer,intent(in ):: ex(1:3),symmetry,Lev,sst
  double precision,intent(in),dimension(ex(1))::crho
  double precision,intent(in),dimension(ex(2))::sigma
  double precision,intent(in),dimension(ex(3))::R
  real*8, intent(in ),dimension(ex(1),ex(2),ex(3)):: X,Y,Z
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodx, drhody, drhodz
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadx,dsigmady,dsigmadz
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdx,dRdy,dRdz
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz
  double precision,intent(in),dimension(ex(1),ex(2),ex(3))::dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dxx,gxy,gxz,dyy,gyz,dzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Kxx,Kxy,Kxz,Kyy,Kyz,Kzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Lap,Sfx,Sfy,Sfz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: rho,Sx,Sy,Sz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Rxx,Rxy,Rxz,Ryy,Ryz,Rzz
! second kind of Christofel symble Gamma^i_jk respect to physical metric
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxxx, Gamxxy, Gamxxz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamxyy, Gamxyz, Gamxzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyxx, Gamyxy, Gamyxz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamyyy, Gamyyz, Gamyzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzxx, Gamzxy, Gamzxz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: Gamzyy, Gamzyz, Gamzzz
  real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: ham_Res, movx_Res, movy_Res, movz_Res
!~~~~~~> Other variables:
!  inverse metric
  real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz
! first order derivative of metric, @_k g_ij
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxx,gxyx,gxzx
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyx,gyzx,gzzx
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxy,gxyy,gxzy
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyy,gyzy,gzzy
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxxz,gxyz,gxzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gyyz,gyzz,gzzz
  real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz,trK,fx,fy,fz

  integer, parameter :: NO_SYMM = 0, EQUATORIAL = 1, OCTANT = 2
  real*8, parameter :: ZERO = 0.D0, HALF = 0.5d0, ONE = 1.d0, TWO = 2.d0, FOUR = 4.d0
  real*8, parameter :: F2o3 = 2.d0/3.d0, F8 = 8.d0, F16 = 1.6d1, SIX = 6.d0
  real*8, parameter :: SYM = 1.D0, ANTI= - 1.D0
  real*8            :: PI

  call adm_ricci_gamma_ss(ex,crho,sigma,R,X, Y, Z,                      &
               drhodx, drhody, drhodz,                                         &
               dsigmadx,dsigmady,dsigmadz,                                     &
               dRdx,dRdy,dRdz,                                                 &
               drhodxx,drhodxy,drhodxz,drhodyy,drhodyz,drhodzz,                &
               dsigmadxx,dsigmadxy,dsigmadxz,dsigmadyy,dsigmadyz,dsigmadzz,    &
               dRdxx,dRdxy,dRdxz,dRdyy,dRdyz,dRdzz,                            &
               dxx    ,   gxy    ,   gxz    ,   dyy    ,   gyz    ,   dzz,&
               Gamxxx,Gamxxy,Gamxxz,Gamxyy,Gamxyz,Gamxzz,&
               Gamyxx,Gamyxy,Gamyxz,Gamyyy,Gamyyz,Gamyzz,&
               Gamzxx,Gamzxy,Gamzxz,Gamzyy,Gamzyz,Gamzzz,&
               Rxx,Rxy,Rxz,Ryy,Ryz,Rzz,&
               Symmetry,Lev,sst)

  PI = dacos(-ONE)

  gxx = dxx + ONE
  gyy = dyy + ONE
  gzz = dzz + ONE
! invert metric
  gupzz =  gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - &
           gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz
  gupxx =   ( gyy * gzz - gyz * gyz ) / gupzz
  gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz
  gupxz =   ( gxy * gyz - gyy * gxz ) / gupzz
  gupyy =   ( gxx * gzz - gxz * gxz ) / gupzz
  gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz
  gupzz =   ( gxx * gyy - gxy * gxy ) / gupzz

  trK =          gupxx * Kxx + gupyy * Kyy + gupzz * Kzz &
        + TWO * (gupxy * Kxy + gupxz * Kxz + gupyz * Kyz)

! ham_Res = trR + K^2 - K_ij * K^ij - 16 * PI * rho
  ham_Res =   gupxx * Rxx + gupyy * Ryy + gupzz * Rzz + &
        TWO* ( gupxy * Rxy + gupxz * Rxz + gupyz * Ryz )

  ham_Res = ham_Res + trK * trK -(&
       gupxx * ( &
       gupxx * Kxx * Kxx + gupyy * Kxy * Kxy + gupzz * Kxz * Kxz + &
       TWO * (gupxy * Kxx * Kxy + gupxz * Kxx * Kxz + gupyz * Kxy * Kxz) ) + &
       gupyy * ( &
       gupxx * Kxy * Kxy + gupyy * Kyy * Kyy + gupzz * Kyz * Kyz + &
       TWO * (gupxy * Kxy * Kyy + gupxz * Kxy * Kyz + gupyz * Kyy * Kyz) ) + &
       gupzz * ( &
       gupxx * Kxz * Kxz + gupyy * Kyz * Kyz + gupzz * Kzz * Kzz + &
       TWO * (gupxy * Kxz * Kyz + gupxz * Kxz * Kzz + gupyz * Kyz * Kzz) ) + &
       TWO * ( &
       gupxy * ( &
       gupxx * Kxx * Kxy + gupyy * Kxy * Kyy + gupzz * Kxz * Kyz + &
       gupxy * (Kxx * Kyy + Kxy * Kxy) + &
       gupxz * (Kxx * Kyz + Kxz * Kxy) + &
       gupyz * (Kxy * Kyz + Kxz * Kyy) ) + &
       gupxz * ( &
       gupxx * Kxx * Kxz + gupyy * Kxy * Kyz + gupzz * Kxz * Kzz + &
       gupxy * (Kxx * Kyz + Kxy * Kxz) + &
       gupxz * (Kxx * Kzz + Kxz * Kxz) + &
       gupyz * (Kxy * Kzz + Kxz * Kyz) ) + &
       gupyz * ( &
       gupxx * Kxy * Kxz + gupyy * Kyy * Kyz + gupzz * Kyz * Kzz + &
       gupxy * (Kxy * Kyz + Kyy * Kxz) + &
       gupxz * (Kxy * Kzz + Kyz * Kxz) + &
       gupyz * (Kyy * Kzz + Kyz * Kyz) ) ))- F16 * PI * rho

! mov_Res_j = gupkj*D_k K_ij - d_j trK - 8 PI s_j where D respect to physical metric
! store D_i K_jk
  call fderivs_shc(ex,Kxx,gxxx,gxxy,gxxz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst,          &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)
  call fderivs_shc(ex,Kxy,gxyx,gxyy,gxyz,crho,sigma,R,ANTI,ANTI,SYM,Symmetry,Lev,sst,          &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)
  call fderivs_shc(ex,Kxz,gxzx,gxzy,gxzz,crho,sigma,R,ANTI,SYM ,ANTI,Symmetry,Lev,sst,         &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)
  call fderivs_shc(ex,Kyy,gyyx,gyyy,gyyz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst,          &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)
  call fderivs_shc(ex,Kyz,gyzx,gyzy,gyzz,crho,sigma,R,SYM ,ANTI,ANTI,Symmetry,Lev,sst,         &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)
  call fderivs_shc(ex,Kzz,gzzx,gzzy,gzzz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst,          &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)

  gxxx = gxxx - (  Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz &
                 + Gamxxx * Kxx + Gamyxx * Kxy + Gamzxx * Kxz)
  gxyx = gxyx - (  Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz &
                 + Gamxxx * Kxy + Gamyxx * Kyy + Gamzxx * Kyz)
  gxzx = gxzx - (  Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz &
                 + Gamxxx * Kxz + Gamyxx * Kyz + Gamzxx * Kzz)
  gyyx = gyyx - (  Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz &
                 + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz)
  gyzx = gyzx - (  Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz &
                 + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz)
  gzzx = gzzx - (  Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz &
                 + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz)
  gxxy = gxxy - (  Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz &
                 + Gamxxy * Kxx + Gamyxy * Kxy + Gamzxy * Kxz)
  gxyy = gxyy - (  Gamxyy * Kxx + Gamyyy * Kxy + Gamzyy * Kxz &
                 + Gamxxy * Kxy + Gamyxy * Kyy + Gamzxy * Kyz)
  gxzy = gxzy - (  Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz &
                 + Gamxxy * Kxz + Gamyxy * Kyz + Gamzxy * Kzz)
  gyyy = gyyy - (  Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz &
                 + Gamxyy * Kxy + Gamyyy * Kyy + Gamzyy * Kyz)
  gyzy = gyzy - (  Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz &
                 + Gamxyy * Kxz + Gamyyy * Kyz + Gamzyy * Kzz)
  gzzy = gzzy - (  Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz &
                 + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz)
  gxxz = gxxz - (  Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz &
                 + Gamxxz * Kxx + Gamyxz * Kxy + Gamzxz * Kxz)
  gxyz = gxyz - (  Gamxyz * Kxx + Gamyyz * Kxy + Gamzyz * Kxz &
                 + Gamxxz * Kxy + Gamyxz * Kyy + Gamzxz * Kyz)
  gxzz = gxzz - (  Gamxzz * Kxx + Gamyzz * Kxy + Gamzzz * Kxz &
                 + Gamxxz * Kxz + Gamyxz * Kyz + Gamzxz * Kzz)
  gyyz = gyyz - (  Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz &
                 + Gamxyz * Kxy + Gamyyz * Kyy + Gamzyz * Kyz)
  gyzz = gyzz - (  Gamxzz * Kxy + Gamyzz * Kyy + Gamzzz * Kyz &
                 + Gamxyz * Kxz + Gamyyz * Kyz + Gamzyz * Kzz)
  gzzz = gzzz - (  Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz &
                 + Gamxzz * Kxz + Gamyzz * Kyz + Gamzzz * Kzz)
movx_Res = gupxx*gxxx + gupyy*gxyy + gupzz*gxzz &
          +gupxy*gxyx + gupxz*gxzx + gupyz*gxzy &
          +gupxy*gxxy + gupxz*gxxz + gupyz*gxyz
movy_Res = gupxx*gxyx + gupyy*gyyy + gupzz*gyzz &
          +gupxy*gyyx + gupxz*gyzx + gupyz*gyzy &
          +gupxy*gxyy + gupxz*gxyz + gupyz*gyyz
movz_Res = gupxx*gxzx + gupyy*gyzy + gupzz*gzzz &
          +gupxy*gyzx + gupxz*gzzx + gupyz*gzzy &
          +gupxy*gxzy + gupxz*gxzz + gupyz*gyzz

  call fderivs_shc(ex,trK,fx,fy,fz,crho,sigma,R, SYM, SYM,SYM,Symmetry,Lev,sst,                &
                       drhodx, drhody, drhodz,                                                 &
                       dsigmadx,dsigmady,dsigmadz,                                             &
                       dRdx,dRdy,dRdz)

movx_Res = movx_Res - fx - F8*PI*sx
movy_Res = movy_Res - fy - F8*PI*sy
movz_Res = movz_Res - fz - F8*PI*sz

  return

  end subroutine constraint_adm_ss
