[Commits] [svn:einsteintoolkit] NullSHRExtract/branches/tapir/src/ (Rev. 30)

[bela at caltech.edu]

User: szilagyi
Date: 2013/11/14 02:11 PM

Modified:
 /branches/tapir/src/
  NullSHRE_WTSphHarm.F90

Log:
 work on debugging output

File Changes:

Directory: /branches/tapir/src/
===============================

File [modified]: NullSHRE_WTSphHarm.F90
Delta lines: +62 -34
===================================================================
--- branches/tapir/src/NullSHRE_WTSphHarm.F90	2013-11-12 20:52:32 UTC (rev 29)
+++ branches/tapir/src/NullSHRE_WTSphHarm.F90	2013-11-14 20:11:15 UTC (rev 30)
@@ -5,38 +5,6 @@
 #include "cctk_Functions.h"
 
 
-
-subroutine NullSHRE_ConvertAngVector(&
-     ip, Stereo_Vector, Spherical_Vector)
-  ! f^{theta,phi} = f^{q,p} d(theta,phi)/d(q,p)
-  use NullSHRE_modGFdef
-  use NullSHRE_modAnaCoord
-  use NullGrid_Vars, only: lsh
-  CCTK_INT, intent(in) :: ip
-  type (gf2d), dimension (2), intent(in)    :: Stereo_Vector
-  type (gf2d), dimension (2), intent(inout) :: Spherical_Vector
-
-  CCTK_REAL, dimension(lsh(1),lsh(2),4),target :: tmp
-  type (gf2d), dimension(2,2) :: dspherical_dstereo
-
-  dspherical_dstereo(1,1)%d => tmp(:,:,1)
-  dspherical_dstereo(1,2)%d => tmp(:,:,2)
-  dspherical_dstereo(2,1)%d => tmp(:,:,3)
-  dspherical_dstereo(2,2)%d => tmp(:,:,4)
-
-  call wt_dspherical_dstereo(ip, dspherical_dstereo)
-
-  Spherical_Vector(1)%d = &
-       Stereo_Vector(1)%d * dspherical_dstereo(1,1)%d + &
-       Stereo_Vector(2)%d * dspherical_dstereo(2,1)%d 
-
-  Spherical_Vector(2)%d = &
-       Stereo_Vector(1)%d * dspherical_dstereo(1,2)%d + &
-       Stereo_Vector(2)%d * dspherical_dstereo(2,2)%d 
-
-end subroutine NullSHRE_ConvertAngVector
-
-
 subroutine NullSHRE_ConvertAngOneForm(&
      ip, Stereo_OneForm, Spherical_OneForm)
   ! f_{theta,phi} = f_{q,p} d(q,p)/d(theta,phi)
@@ -103,6 +71,11 @@
   CCTK_REAL, dimension(null_lsh(1), null_lsh(2)) :: fx_n,fy_n,fz_n
   CCTK_REAL, dimension(null_lsh(1), null_lsh(2)) :: fx_s,fy_s,fz_s
 
+  CCTK_REAL, dimension(null_lsh(1), null_lsh(2)) :: &
+    w_1_n, w_2_n, w_3_n, w_4_n, w_5_n, &
+    w_1_s, w_2_s, w_3_s, w_4_s, w_5_s
+
+
   CCTK_REAL, dimension(null_lsh(1),null_lsh(2),4),target :: tmp1
   CCTK_REAL, dimension(null_lsh(1),null_lsh(2),6),target :: &
        tmp2, tmp3, tmp4, tmp5
@@ -492,10 +465,10 @@
   call NullDecomp_WriteCoefsForRealFunc('r_phi_wt', cctkGH, truncate, &
        null_lsh, zeta, angular_tensor_1_n(2)%d, angular_tensor_1_s(2)%d, cctk_time)
 
-  call NullDecomp_WriteCoefsForRealFunc('AffineInvMetric_rr', cctkGH, truncate, &
+  call NullDecomp_WriteCoefsForRealFunc('AffineInvMetric_lambda_lambda', cctkGH, truncate, &
        null_lsh, zeta, etaup0_n(1,1)%d, etaup0_s(1,1)%d, cctk_time)
 
-  call NullDecomp_WriteCoefsForRealFunc('AffineInvMetric_ru', cctkGH, truncate, &
+  call NullDecomp_WriteCoefsForRealFunc('AffineInvMetric_lambda_u', cctkGH, truncate, &
        null_lsh, zeta, etaup0_n(1,4)%d, etaup0_s(1,4)%d, cctk_time)
 
   call NullDecomp_WriteCoefsForComplexFunc(&
@@ -533,6 +506,61 @@
   call NullDecomp_WriteCoefsForRealFunc('Wl_wt', cctkGH, truncate, &
        null_lsh, zeta, w_l_n%d, w_l_s%d, cctk_time)
 
+  ! bits of W
+
+
+  w_1_n = dr0_n(1)%d * etaup0_n(1,1)%d / r0_n%d
+  w_2_n = - 2.d0 * dr0_n(4)%d / r0_n%d
+  w_3_n =  &
+    + 2.d0 * ( dr0_n(2)%d * etaup0_n(1,2)%d &
+             + dr0_n(3)%d * etaup0_n(1,3)%d  ) / r0_n%d
+  w_4_n = &
+    + ( dr0_n(2)%d ** 2 * etaup0_n(2,2)%d &
+    + 2.d0 * dr0_n(2)%d * dr0_n(3)%d * etaup0_n(2,3)%d &
+    + dr0_n(3)%d ** 2 * etaup0_n(3,3)%d &
+      ) / (r0_n%d*dr0_n(1)%d)
+  w_5_n = - 1.d0 / r0_n%d
+
+
+  w_1_s = dr0_s(1)%d * etaup0_s(1,1)%d / r0_s%d
+  w_2_s = - 2.d0 * dr0_s(4)%d / r0_s%d
+  w_3_s =  &
+    + 2.d0 * ( dr0_s(2)%d * etaup0_s(1,2)%d &
+             + dr0_s(3)%d * etaup0_s(1,3)%d  ) / r0_s%d
+  w_4_s = &
+    + ( dr0_s(2)%d ** 2 * etaup0_s(2,2)%d &
+    + 2.d0 * dr0_s(2)%d * dr0_s(3)%d * etaup0_s(2,3)%d &
+    + dr0_s(3)%d ** 2 * etaup0_s(3,3)%d &
+      ) / (r0_s%d*dr0_s(1)%d)
+  w_5_s = - 1.d0 / r0_s%d
+
+  call NullDecomp_WriteCoefsForRealFunc(&
+    'W_part_rl_etaup_ll_over_r', cctkGH, truncate, &
+       null_lsh, zeta, w_1_n, w_1_s, cctk_time)
+
+  call NullDecomp_WriteCoefsForRealFunc(&
+    'W_part_negative_2ru_over_r', cctkGH, truncate, &
+       null_lsh, zeta, w_2_n, w_2_s, cctk_time)
+
+  call NullDecomp_WriteCoefsForRealFunc(&
+    'W_part_2rA_etaup_lA_over_r', cctkGH, truncate, &
+       null_lsh, zeta, w_3_n, w_3_s, cctk_time)
+
+  call NullDecomp_WriteCoefsForRealFunc(&
+    'W_part_rA_rB_etaup_AB_over_rl_over_r', cctkGH, truncate, &
+       null_lsh, zeta, w_4_n, w_4_s, cctk_time)
+
+  call NullDecomp_WriteCoefsForRealFunc(&
+    'W_part_negative_one_over_r', cctkGH, truncate, &
+       null_lsh, zeta, w_5_n, w_5_s, cctk_time)
+
+! write (*,*) 'diff_n = ' , &
+!   maxval(abs( -w_wt_n%d + w_1_n + w_2_n + w_3_n + w_4_n + w_5_n))
+  
+! write (*,*) 'diff_s = ' , &
+!   maxval(abs( -w_wt_s%d + w_1_s + w_2_s + w_3_s + w_4_s + w_5_s))
+  
+
 end subroutine NullSHRE_WTSphHarm