diff options
Diffstat (limited to 'src/sor_confmetric.F')
| -rw-r--r-- | src/sor_confmetric.F | 63 |
1 files changed, 39 insertions, 24 deletions
diff --git a/src/sor_confmetric.F b/src/sor_confmetric.F index fafc8a5..8d10c79 100644 --- a/src/sor_confmetric.F +++ b/src/sor_confmetric.F @@ -26,7 +26,7 @@ $ Mlinear_lsh,Mlinear, $ Nsource_lsh,Nsource, $ gxx,gxy,gxz,gyy,gyz,gzz, - & psi,var, + & psi,var, var_idx, $ abstol,reltol) implicit none @@ -46,6 +46,8 @@ CCTK_REAL gyz(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)), gzz(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) CCTK_REAL psi(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) CCTK_REAL var(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) + INTEGER var_idx + CCTK_REAL abstol(3),reltol(3) CCTK_REAL tol @@ -94,9 +96,19 @@ c Coeeficients for the solver: 19 point stencil... logical cheb, const, none, verb integer Mlinear_storage,Nsource_storage - + INTEGER reduction_handle,ierr + +c stencil size + INTEGER sw(3) + tol = AbsTol(1) +c Get the reduction handel for the sum operation + call CCTK_ReductionArrayHandle(reduction_handle,"sum"); + if (reduction_handle.lt.0) then + call CCTK_WARN(1,"Cannot get reduction handle.") + endif + c We have no storage for M/N if they are of size one in each direction if ((Mlinear_lsh(1).eq.1).and.(Mlinear_lsh(2).eq.1).and.(Mlinear_lsh(3).eq.1)) then Mlinear_storage=0 @@ -253,33 +265,36 @@ c Update end do end do c Reduce the norm -c#ifdef MPI -c call mpi_allreduce(resnorm,residual,1,MPI_DOUBLE_PRECISION, -c $ MPI_SUM,MPI_COMM_WORLD,ierror) -c call synconefunc(var) -c#else - residual = resnorm -c#endif -c write(*,*)'what is nx0: ',nx0 WHAT IS THIS ?? -c residual = residual / (nx0 * ny0 * nz0) -c Stop? +c Reduce the norm + call CCTK_ReduceLocalScalar(ierr, cctkGH, -1, reduction_handle, + $ resnorm, residual, CCTK_VARIABLE_REAL) + if (ierr.ne.0) then + call CCTK_WARN(1,"Reduction of norm failed!"); + endif + residual = resnorm + + call CCTK_SyncGroupWithVarI(cctkGH, var_idx) + if (residual .lt. tol) then goto 123 endif -c FIXME: what about boudnary conditions, like robin, etc. -c Apply octant Symmetries - if (octant) then - if (cctk_bbox(1) .eq. 1) then - var(1,:,:) = var(2,:,:) - endif - if (cctk_bbox(3) .eq. 1) then - var(:,1,:) = var(:,2,:) - endif - if (cctk_bbox(5) .eq. 1) then - var(:,:,1) = var(:,:,2) + +c Apply Robin boundary +c write (*,*) "Robin ?" + if (CCTK_EQUALS(sor_bound,"robin")) then +c write (*,*) "Robin" + sw(1)=1 + sw(2)=1 + sw(2)=1 + call RobinBCVarI(ierr, cctkGH, 1.0, 1, sw, var_idx); + if (ierr.ne.0) then + call CCTK_WARN(1,"Could not Robin BC !") endif - endif + endif + +c Apply octant Symmetries + call CartSymBCVarI(ierr, cctkGH, var_idx) enddo |