From 913cb47f1c8b8f07e04799492c01a4a0afd23fc9 Mon Sep 17 00:00:00 2001 From: schnetter Date: Tue, 19 Feb 2008 05:49:53 +0000 Subject: Handle different sizes of integer and CCTK_INT correctly. Correct OpenMP error. git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinInitialData/NoExcision/trunk@17 4ec1db94-0e4f-0410-ada3-8bed251432c9 --- src/cg.F90 | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/src/cg.F90 b/src/cg.F90 index 316fe68..5900e87 100644 --- a/src/cg.F90 +++ b/src/cg.F90 @@ -499,6 +499,8 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) DECLARE_CCTK_PARAMETERS DECLARE_CCTK_FUNCTIONS + CCTK_INT, parameter :: izero = 0 + integer, parameter :: ik = kind (izero) CCTK_INT :: ierr if ( loop_control > 0 ) then @@ -509,25 +511,25 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) select case ( sym_selector ) case (1, 4) - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_d_lapse', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_d_lapse for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_d_shift', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_d_shift for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_d_curv', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_d_curv for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_d_metric', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_d_metric for boundary condition' ) @@ -536,25 +538,25 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) select case ( sym_selector ) case (1, 3) - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_res_lapse', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_res_lapse for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_res_shift', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_res_shift for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_res_curv', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_res_curv for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_res_metric', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_res_metric for boundary condition' ) @@ -563,7 +565,7 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) select case ( sym_selector ) case (1, 2, 3) - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_red_all', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_red_all for boundary condition' ) @@ -572,25 +574,25 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) select case ( sym_selector ) case (2) - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_q_lapse', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_q_lapse for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_q_shift', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_q_shift for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_q_curv', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_q_curv for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'NoExcision::cg_q_metric', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select cg_q_metric for boundary condition' ) @@ -599,25 +601,25 @@ subroutine NoExcision_CGApplySym(CCTK_ARGUMENTS) select case ( sym_selector ) case (3) - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'ADMBase::lapse', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select lapse for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'ADMBase::shift', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select shift for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'ADMBase::curv', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select curv for boundary condition' ) end if - ierr = Boundary_SelectGroupForBC ( cctkGH, CCTK_ALL_FACES, 1, -1, & + ierr = Boundary_SelectGroupForBC ( cctkGH, int(CCTK_ALL_FACES,ik), 1_ik, -1_ik, & 'ADMBase::metric', 'None' ) if ( ierr /= 0 ) then call CCTK_WARN ( 0, 'Could not select metric for boundary condition' ) @@ -648,7 +650,8 @@ subroutine NoExcision_Set_Zero(CCTK_ARGUMENTS) allocate ( dist2(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) ) -!$OMP PARALLEL PRIVATE(cx, cy, cz, radx, rady, radz) +! This cannot be parallel since dist2 is shared +! !$OMP PARALLEL PRIVATE(cx, cy, cz, radx, rady, radz) do n = 1, num_regions cx = centre_x(n) @@ -703,7 +706,7 @@ subroutine NoExcision_Set_Zero(CCTK_ARGUMENTS) end do -!$OMP END PARALLEL +! !$OMP END PARALLEL deallocate ( dist2 ) -- cgit v1.2.3