diff options
Diffstat (limited to 'src/sor_wrapper.c')
-rw-r--r-- | src/sor_wrapper.c | 92 |
1 files changed, 66 insertions, 26 deletions
diff --git a/src/sor_wrapper.c b/src/sor_wrapper.c index a0b3eac..d1ce7fa 100644 --- a/src/sor_wrapper.c +++ b/src/sor_wrapper.c @@ -22,24 +22,47 @@ #include "cctk_parameters.h" #include "cctk_FortranString.h" -void FORTRAN_NAME(sor_confmetric_core3d)(_CCTK_C2F_PROTO(GH), - int *, CCTK_REAL *, - int *, CCTK_REAL *, - CCTK_REAL *, - CCTK_REAL *,CCTK_REAL *,CCTK_REAL *, - CCTK_REAL *,CCTK_REAL *,CCTK_REAL *, - CCTK_REAL *, int *, CCTK_REAL *, CCTK_REAL *); - -void FORTRAN_NAME(sor_flat_core3d)(_CCTK_C2F_PROTO(GH), - int *, CCTK_REAL *, - int *, CCTK_REAL *, - CCTK_REAL *, int *, CCTK_REAL *, CCTK_REAL *); +void FORTRAN_NAME(sor_confmetric_core3d) + (_CCTK_C2F_PROTO(GH), + int *, + CCTK_REAL *, + int *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + CCTK_REAL *, + int *, + CCTK_REAL *, + CCTK_REAL *); + +void FORTRAN_NAME(sor_flat_core3d) + (int *ierr, + _CCTK_C2F_PROTO(GH), + int *, + CCTK_REAL *, + int *, + CCTK_REAL *, + CCTK_REAL *, + int *, + CCTK_REAL *, + CCTK_REAL *); /* We pass in the arguments that are neccessary for this class of elliptic eq. this solver is intended to solve. See ./CactusElliptic/EllBase/src/ for the classes of elliptic eq. */ -void sor_confmetric(cGH *GH, int *MetricPsiI, int FieldIndex, - int MIndex, int NIndex, CCTK_REAL *AbsTol,CCTK_REAL *RelTol) { +void sor_confmetric(cGH *GH, + int *MetricPsiI, + int FieldIndex, + int MIndex, + int NIndex, + CCTK_REAL *AbsTol, + CCTK_REAL *RelTol) +{ CCTK_REAL *gxx=NULL, *gxy=NULL, *gxz=NULL; CCTK_REAL *gyy=NULL, *gyz=NULL, *gzz=NULL; @@ -58,6 +81,7 @@ void sor_confmetric(cGH *GH, int *MetricPsiI, int FieldIndex, /* derive the metric data pointer from the index array. Note the ordering. Also get datapointers to the field to solve for. All of these are mandatory */ + gxx = (CCTK_REAL*) CCTK_VarDataPtrI(GH, 0, MetricPsiI[0]); gxy = (CCTK_REAL*) CCTK_VarDataPtrI(GH, 0, MetricPsiI[1]); gxz = (CCTK_REAL*) CCTK_VarDataPtrI(GH, 0, MetricPsiI[2]); @@ -69,8 +93,10 @@ void sor_confmetric(cGH *GH, int *MetricPsiI, int FieldIndex, Field = (CCTK_REAL*) CCTK_VarDataPtrI(GH,0,FieldIndex); if ((!gxx)||(!gxy)||(!gxz)||(!gyy)||(!gyz)||(!gzz)||(!psi)||(!Field)) + { CCTK_WARN(0,"SOR_WRAPPER: One of the metric data fields, or the GF to solve could not be found!"); - + } + /* derive the data pointer for the fields. the M/N fields are not allocated (better: are of size 1), if the passed index is negative, or we get back an empty GF of size 1 */ @@ -85,7 +111,8 @@ void sor_confmetric(cGH *GH, int *MetricPsiI, int FieldIndex, if (GH->cctk_dim>3) CCTK_WARN(0,"This elliptic solver implementation does not do dimension>3!"); - for (i=0;i<GH->cctk_dim;i++) { + for (i=0;i<GH->cctk_dim;i++) + { if((MIndex<0)) Mlinear_lsh[i]=1; else Mlinear_lsh[i]=GH->cctk_lsh[i]; if((NIndex<0)) Nsource_lsh[i]=1; @@ -103,20 +130,24 @@ void sor_confmetric(cGH *GH, int *MetricPsiI, int FieldIndex, } -void sor_flat(cGH *GH, int FieldIndex, int MIndex, - int NIndex, CCTK_REAL *AbsTol, CCTK_REAL *RelTol) { - +int sor_flat(cGH *GH, + int FieldIndex, + int MIndex, + int NIndex, + CCTK_REAL *AbsTol, + CCTK_REAL *RelTol) +{ + int ierr; + int retval=0; CCTK_REAL *Mlinear=NULL, *Nsources=NULL; CCTK_REAL *Field=NULL; CCTK_REAL tolerance; int i; - int toltype; - int Mlinear_lsh[3], Nsource_lsh[3]; - int retcode; Field = (CCTK_REAL*) CCTK_VarDataPtrI(GH,0,FieldIndex); + if (MIndex>0) Mlinear = (CCTK_REAL*) CCTK_VarDataPtrI(GH,0,MIndex); if (NIndex>0) Nsources = (CCTK_REAL*) CCTK_VarDataPtrI(GH,0,NIndex); @@ -131,10 +162,19 @@ void sor_flat(cGH *GH, int FieldIndex, int MIndex, } /* call the fortran routine */ - FORTRAN_NAME(sor_flat_core3d)(_PASS_CCTK_C2F(GH), - Mlinear_lsh, Mlinear, - Nsource_lsh, Nsources, - Field, &FieldIndex, AbsTol, RelTol); + FORTRAN_NAME(sor_flat_core3d) + (&ierr, + _PASS_CCTK_C2F(GH), + Mlinear_lsh, + Mlinear, + Nsource_lsh, + Nsources, + Field, + &FieldIndex, + AbsTol, + RelTol); + + return ierr; } |