module m_MEF90_baseClass #include "petsc/finclude/petsc.h" use petscsys use m_MEF90_Parameters use, intrinsic :: iso_c_binding implicit none(type, external) private public :: MEF90Object !!! author: Blaise Bourdin (2025, bourdin@mcmaster.ca) !!! !!! MEF90_baseClass: The base class for all MEF90 classes !!! !!! !!! NOTE FOR CLASSES THAT ARE HANDED TO PETSc AS AN APPLICATION CONTEXT !!! !!! Extending MEF90Object gives a type deferred bindings, hence type-bound procedures, and Fortran !!! forbids passing a derived type that has type-bound or final procedures to an assumed-type dummy !!! argument. All of the PETSc Fortran context arguments are assumed-type, !!! !!! subroutine SNESSetFunction(snes, r, f, ctx, ierr) !!! type(*) :: ctx !!! !!! so an extension of MEF90Object can no longer be passed to SNESSetFunction, SNESSetJacobian, !!! TSSetIFunction, TAOSetObjective, ... the way a plain derived type could before mef90 0.5.2. The !!! compiler rejects it with !!! !!! Error: Actual argument to assumed-type dummy has type parameters or is of derived type with !!! type-bound or FINAL procedures !!! !!! The way out, used by MEF90DefMech_Type and MEF90HeatXfer_Type, is to give the class a !!! !!! type(c_ptr) :: PETScCtx = C_NULL_PTR !!! !!! component, set once at creation with PETScCtx = c_loc(self), and to hand THAT to PETSc. The !!! callbacks then declare their context argument as type(c_ptr) and recover the object with !!! call c_f_pointer(PETScCtx, self). !!! !!! Two properties of that component are load-bearing, and both are easy to break: !!! !!! - It must OUTLIVE every callback. Fortran passes actual arguments by reference, so what PETSc !!! records is the address of the argument it was given, not the address that argument contains. !!! Passing a local of the routine that registers the callbacks, or an inline c_loc(self) whose !!! result lives in a compiler temporary, makes PETSc record a stack slot that is dead by the time !!! the solver calls back. That is a use-after-scope, and it only misbehaves once the frame has !!! been reused, so it can survive a short test and corrupt a long run. Giving the component the !!! lifetime of the object it points to is what makes this safe. !!! - It must be ONE PER INSTANCE, which is why a local with the save attribute will not do: a saved !!! local is shared by every call of its routine, so creating a second context would silently !!! repoint the first solver at it. !!! !!! The cost of the detour is that PETScCtx is an untyped address: c_f_pointer will happily reinterpret !!! whatever it is given, so handing a callback the wrong context is not a compile error. !!! type, abstract :: MEF90Object MPIU_Comm :: comm character(len=MEF90MXSTRLEN, kind=c_char) :: prefix character(len=MEF90MXSTRLEN, kind=c_char) :: name = "NULL" contains procedure, pass(self) :: setFromOptions => MEF90Object_setFromOptions procedure(MEF90ObjectViewInterface), pass(self), deferred :: view_internal procedure, pass(self) :: view => MEF90Object_view end type MEF90Object abstract interface subroutine MEF90ObjectViewInterface(self, viewer, ierr) use petscsys import :: MEF90Object class(MEF90Object), intent(in) :: self type(tPetscViewer), intent(in) :: viewer PetscErrorCode, intent(inout) :: ierr end subroutine MEF90ObjectViewInterface end interface contains #undef __FUNCT__ #define __FUNCT__ "MEF90Object_view" !!! author: Blaise Bourdin (2026, bourdin@mcmaster.ca) !!! !!! MEF90Object_view: Views a MEF90Object and flagged it as viewed so that it is not viewed multiple times when -verbose is set to a high value !!! subroutine MEF90Object_view(self, viewer, ierr) class(MEF90Object), intent(in) :: self type(tPetscViewer), intent(in) :: viewer PetscErrorCode, intent(inout) :: ierr PetscBool :: helpPrinted, flg PetscCall(PetscOptionsGetBool(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, "-" // trim(self%name) // "_viewed", helpPrinted, PETSC_NULL_BOOL, ierr)) if (.not. helpPrinted) then call self%view_internal(viewer, ierr) PetscCall(PetscOptionsSetValue(PETSC_NULL_OPTIONS, "-" //trim(self%name) // "_viewed", "true", ierr)) ! This is just to silence a warning about the option being set but not used. The option is used to prevent printing the same object multiple times when -verbose is set to a high value. PetscCall(PetscOptionsGetBool(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, "-" // trim(self%name) // "_viewed", flg, PETSC_NULL_BOOL, ierr)) end if end subroutine MEF90Object_view ! contains #undef __FUNCT__ #define __FUNCT__ "MEF90Object_setFromOptions" !!! author: Blaise Bourdin (2026, bourdin@mcmaster.ca) !!! !!! MEF90Object_setFromOptions: generic version of the setFromOptions method for all MEF90Objects, which just prints the object if -verbose is set to a high value !!! Can be overridden in classes if they have options to set. !!! subroutine MEF90Object_setFromOptions(self, ierr) class(MEF90Object), intent(inout) :: self PetscErrorCode, intent(inout) :: ierr PetscViewer :: stdoutViewer PetscInt :: verbose = 0 PetscCall(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, "-verbose", verbose, PETSC_NULL_BOOL, ierr)) if (verbose > 0) then PetscCall(PetscViewerASCIIGetStdout(self%comm, stdoutViewer, ierr)) call self%view(stdoutViewer, ierr) end if end subroutine MEF90Object_setFromOptions end module m_MEF90_baseClass