Commit c0650690 authored by Henderson, Shane's avatar Henderson, Shane
Browse files

Merge branch 'gcc12update' into 'master' 

GCC 12 debug builds introduced some more stringent enforcement of Fortran standards. This addresses those differences, while maintaining gcc 8.3 compatibility.

See merge request https://code.ornl.gov/futility/Futility/-/merge_requests/402
parents 70947fa1 af042c28

src/Geom_Poly.f90

+5 −2
Original line number Diff line number Diff line
@@ -1009,8 +1009,11 @@ FUNCTION polygon_inside_PolygonType(thisPoly,thatPoly) RESULT(bool) 
    ENDIF

    !3. make sure smaller polygon centroid is inside larger polygon

    IF(bool) THEN

      IF((.NOT. thisPoly%pointInside(thatPoly%centroid) .AND. &

          thatPoly%pointInside(thatPoly%centroid))) bool=.FALSE.

      IF(.NOT. thisPoly%pointInside(thatPoly%centroid)) THEN

        IF(thatPoly%pointInside(thatPoly%centroid)) THEN

          bool=.FALSE.

        ENDIF

      ENDIF

    ENDIF

    !4. Evaluate against subregions (for each subregion)

    IF(bool) THEN

src/LinearSolverTypes_Multigrid.f90

+19 −11
Original line number Diff line number Diff line
@@ -440,6 +440,7 @@ SUBROUTINE fillInterpMats_LinearSolverType_Multigrid(solver,myMMeshes, & 
  REAL(SRK),ALLOCATABLE :: wts(:,:)



  INTEGER(SIK),ALLOCATABLE :: dnnz(:)

  LOGICAL(SBK) :: lPrealloc

#endif



  IF(solver%TPLType /= PETSC) &
@@ -463,7 +464,11 @@ SUBROUTINE fillInterpMats_LinearSolverType_Multigrid(solver,myMMeshes, & 
      !Allocate the interpolation matrix:

      !Note that if there is interpolation across processors, this does not

      !  work

      IF(.NOT.PRESENT(preallocated) .OR. .NOT.preallocated) THEN

      lPrealloc = .FALSE.

      IF(PRESENT(preallocated)) THEN

        lPrealloc = preallocated

      ENDIF

      IF(.NOT. lPrealloc) THEN

        IF(num_eqns == 1) THEN

          CALL solver%preAllocPETScInterpMat(iLevel-1, &

              2**myMMeshes%meshes(iLevel)%interpDegrees)
@@ -541,11 +546,7 @@ SUBROUTINE setupPETScMG_LinearSolverType_Multigrid(solver,Params) 
  !KSPRICHARDSON + any inexact "PC" method in petsc =

  !                                       Use that PC method as a solver.

  !KSPRICHARDSON+PCMG = Multigrid linear solver, not multigrid precon.

  precond_flag=.FALSE.

  IF(Params%has('LinearSolverType->Multigrid->precond_flag')) THEN

      CALL Params%get('LinearSolverType->Multigrid->precond_flag', &

      precond_flag)

  ENDIF

      CALL Params%get('LinearSolverType->Multigrid->precond_flag', precond_flag, .FALSE.)

  IF(precond_flag) THEN

    CALL KSPSetType(solver%ksp,KSPGMRES,iperr)

  ELSE
@@ -565,7 +566,9 @@ SUBROUTINE setupPETScMG_LinearSolverType_Multigrid(solver,Params) 
  CALL KSPSetInitialGuessNonzero(solver%ksp,PETSC_TRUE,iperr)



  !Set # of levels:

#if (((PETSC_VERSION_MAJOR>=3) && (PETSC_VERSION_MINOR>7)) || (PETSC_VERSION_MAJOR>=4))

#if (((PETSC_VERSION_MAJOR>=3) && (PETSC_VERSION_MINOR>12)) || (PETSC_VERSION_MAJOR>=4))

  CALL PCMGSetLevels(solver%pc,solver%nLevels,solver%MPIParallelEnv%comm,iperr)

#elif (((PETSC_VERSION_MAJOR>=3) && (PETSC_VERSION_MINOR>7)) || (PETSC_VERSION_MAJOR>=4))

  CALL PCMGSetLevels(solver%pc,solver%nLevels,PETSC_NULL_PC,iperr)

#else

  CALL PCMGSetLevels(solver%pc,solver%nLevels,PETSC_NULL_OBJECT,iperr)
@@ -682,7 +685,7 @@ SUBROUTINE setSmoother_LinearSolverType_Multigrid(solver,smoother,iLevel,num_smo 


#ifdef FUTILITY_HAVE_PETSC

  CHARACTER(LEN=*),PARAMETER :: myName='setSmoother_LinearSolverType_Multigrid'

  INTEGER(SIK) :: i,istt,istp

  INTEGER(SIK) :: i,istt,istp,local_num_smooth

  KSP :: ksp_temp

  PC :: pc_temp

  PetscErrorCode  :: iperr
@@ -709,8 +712,12 @@ SUBROUTINE setSmoother_LinearSolverType_Multigrid(solver,smoother,iLevel,num_smo 
    ENDIF

  ENDIF



  local_num_smooth = 0

  IF(PRESENT(num_smooth)) THEN

    local_num_smooth = num_smooth

  ENDIF

  DO i=istt,istp

    IF(i == 0 .OR. (PRESENT(num_smooth) .AND. num_smooth > 0)) THEN

    IF(i == 0 .OR. local_num_smooth > 0) THEN

      CALL PCMGGetSmoother(solver%pc,i,ksp_temp,iperr)

    ELSE

      CALL PCMGGetSmootherUp(solver%pc,i,ksp_temp,iperr)
@@ -771,9 +778,10 @@ SUBROUTINE setSmoother_LinearSolverType_Multigrid(solver,smoother,iLevel,num_smo 
          "Unrecognized smoother option!")

    ENDIF



    IF(PRESENT(num_smooth)) &

    IF(PRESENT(num_smooth)) THEN

      CALL KSPSetTolerances(ksp_temp,PETSC_DEFAULT_REAL,PETSC_DEFAULT_REAL, &

        PETSC_DEFAULT_REAL,num_smooth,iperr)

    ENDIF



    !On all levels except the finest, the initial guess should be zero

    !  since it is an error equation.

unit_tests/testAndersonAcceleration/testAndersonAcceleration.f90

+3 −0
Original line number Diff line number Diff line
@@ -27,6 +27,7 @@ CLASS(VectorType),ALLOCATABLE :: mySol,exSol,inSol,tmpvec 
TYPE(StochasticSamplingType) :: NativeRNG

TYPE(ParamType) :: pList,vecparams

REAL(SRK) :: tmp1,tmp2

TYPE(MPI_EnvType) :: pe



ALLOCATE(RealVectorType :: mySol,exSol,inSol,tmpvec)

CALL vecparams%add("VectorType->n",10000_SIK)
@@ -45,6 +46,7 @@ CALL pList%add('SolutionAcceleration->starting_iteration',1) 
ce%exceptHandler => exceptHandler

CALL ce%exceptHandler%setStopOnError(.FALSE.)

CALL ce%exceptHandler%setQuietMode(.FALSE.)

CALL pe%init(PE_COMM_SELF)



CREATE_TEST('Test Anderson Acceleration Solver')
@@ -97,6 +99,7 @@ CALL vecparams%clear() 
FINALIZE_TEST()



CALL ce%clear()

CALL pe%finalize()

!

!===============================================================================

CONTAINS

unit_tests/testLinearSolver/testLinearSolverParallel.f90

+1 −2
Original line number Diff line number Diff line
@@ -65,11 +65,10 @@ FINALIZE_TEST() 


#ifdef FUTILITY_HAVE_PETSC

  CALL PetscFinalize(ierr)

#else

#endif

#ifdef HAVE_MPI

  CALL MPI_Finalize(ierr)

#endif

#endif

!

!===============================================================================

CONTAINS

unit_tests/testMeshTransfer/testMeshTransfer.f90

+7 −0
Original line number Diff line number Diff line
@@ -20,6 +20,10 @@ USE LinearSolverTypes 
USE MeshTransfer



IMPLICIT NONE

#ifdef HAVE_MPI

INTEGER(SIK) :: mpierr

CALL MPI_Init(mpierr)

#endif

!

!Check the timer resolution

CREATE_TEST('Mesh Transfer')
@@ -34,6 +38,9 @@ REGISTER_SUBTEST('Test 1DCart MeshTransfer',Test1DCart) 
REGISTER_SUBTEST('Test 1DCyl MeshTransfer',Test1DCyl)



FINALIZE_TEST()

#ifdef HAVE_MPI

CALL MPI_Finalize(mpierr)

#endif

!

!

!===============================================================================