Penalty function on discrete mesh using Laplace-Beltrami operator?

If you insist on using my code from the other post, this can be done as follows; note that you have to settle with first order FEM in that case:

Needs["NDSolve`FEM`"];

mesh0 = ToElementMesh[RegionUnion[Disk[], Rectangle[{0, 0}, {2, 2}]],
  MaxCellMeasure -> 0.125, AccuracyGoal -> 2, "MeshOrder" -> 1]
pts = mesh0["Coordinates"];
faces = mesh0["MeshElements"][[1, 1]];
pat = Partition[Flatten[getSurfaceLaplacianCombinatorics[faces]], 2];
flist = Flatten[faces];
laplacian = SurfaceLaplaceBeltrami[pts, flist, pat];
mass = SurfaceMassMatrix[pts, flist, pat];
lumpedmass = Total[mass];
invlumpedmass = 
  SparseArray[
    Partition[Union @@ mesh0["BoundaryElements"][[1, 1]], 1] -> 0., 
    Length[mass], 1.]/Total[mass];
bilaplacian = laplacian.(invlumpedmass laplacian);

Then the matrix bilaplacian is a somewhat crude approximation to what you are looking for. It is crude because it uses nonconforming (first order) finite elements and because it uses mass lumping. But it should be quite fast because of this (inverting the mass matrix mass would lead to a dense matrix). You only require it as a regularizer, so this should work out well.

In general, you can use the stiffness matrix laplacian and the mass matrix mass provided by any other FEM tool (e.g., you can obtain them from the low level FEM tools in Mathematica, too). The only other ingredient would be a diagonal matrix A with ones on the diagonal for interior degrees of freedom and zeroes for the boundary degrees of freedom. Then the matrix that you seek should be

bilaplacian = laplacian.A.Inverse[mass].A.laplacian

Typically, Inverse[mass] is a dense matrix, so one should avoid inverting mass if possible. With first order FEM, one can employ mass lumping (as I did above). From what I heard, mass lumping does not work well for higher order FEM (but I could be wrong). Hence I would suggest Mathematica first order low level FEM tools for the 3D case. For the 2D case with a planar mesh, it is up to you which one you want to use. I do not know whether Mathematica supports surface FEM in version 12.1; it does not in version 12. So if you want to use that for surfaces, you are doomed to use my code, I guess. ;)


Following @HenrikSchumacher's and @user21's advice, I have extracted from the FEM tutorial a computation of stiffness matrix on the mesh as follows

Needs["NDSolve`FEM`"];
mesh = ToElementMesh[RegionUnion[Disk[], Rectangle[{0, 0}, {2, 2}]], 
       MaxCellMeasure -> 0.125, AccuracyGoal -> 1, "MeshOrder" -> 1];
 nr = ToNumericalRegion[mesh];
coefficients={"DiffusionCoefficients"->{{IdentityMatrix[2]}},"LoadCoefficients"->{{1}}};
vd = NDSolve`VariableData[{"DependentVariables" -> {u},"Space" -> {x, y}}];
sd = NDSolve`SolutionData[{"Space" -> nr}];
initCoeffs = InitializePDECoefficients[vd, sd, coefficients];
methodData = InitializePDEMethodData[vd, sd];
finiteElements=DiscretizePDE[initCoeffs,methodData, sd,"SaveFiniteElements" -> True];
discretePDE = DiscretizePDE[initCoeffs, methodData, sd];
{load, stiffness, damping, mass} = discretePDE["SystemMatrices"];

Then

    stiffness // MatrixPlot

Mathematica graphics

is (hopefully!) a matrix which applies a Laplacian to the coefficients of the (piecewise linear) 1-spline evaluated on the vertices of the mesh.

Nicely, the method works for 3D meshes as well

Needs["NDSolve`FEM`"];
mesh = ToElementMesh[Ball[],MaxCellMeasure->0.125/8,AccuracyGoal->1, "MeshOrder" -> 1];
Show[{mesh["Wireframe"],  mesh["Coordinates"] // 
   ListPointPlot3D[#, PlotStyle -> AbsolutePointSize[10],
     ColorFunction -> Function[{x, y, z}, RGBColor[x, y, z]]] &}]

Mathematica graphics

nr = ToNumericalRegion[mesh];
coefficients = {"DiffusionCoefficients" -> {{IdentityMatrix[3]}}, 
   "LoadCoefficients" -> {{1}}};
vd = NDSolve`VariableData[{"DependentVariables" -> {u}, 
    "Space" -> {x, y, z}}];
sd = NDSolve`SolutionData[{"Space" -> nr}];
initCoeffs = InitializePDECoefficients[vd, sd, coefficients];
methodData = InitializePDEMethodData[vd, sd];
finiteElements=DiscretizePDE[initCoeffs, methodData, sd,"SaveFiniteElements" -> True];
discretePDE = DiscretizePDE[initCoeffs, methodData, sd];
{load, stiffness, damping, mass} = discretePDE["SystemMatrices"];
stiffness // MatrixPlot

Mathematica graphics