64-BitBrainstorm_2026/AMSS-NCKU
8
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

asc26 amss-ncku initialized

Browse Source
This commit is contained in:
CGH0S7
2026-01-13 15:01:15 +08:00
commit f2fc9af70e
272 changed files with 262274 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

382
AMSS_NCKU_source/adm_constraint.f90 Normal file
View File

@@ -0,0 +1,382 @@
!-------------------------------------------------------------------------------!
! 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