How can I have a single BarLegend in a grid of multiple DensityPlot, with color properly scaled in all plots relative to that coloured BarLegend?

Question

I have an amplitude distribution function like :

amplitude[x_, y_, a_] = Exp[-a x^2 - Sin[y^2]];

Table[DensityPlot[amplitude[x, y, a], {x, -1, 1}, {y, -3, 3},
  ColorFunction -> "Rainbow",
  PlotLegends -> Automatic,
  ImageSize -> Medium], {a, 1, 4, 1}]

and my results are :

I need a common color BarLegend for all multiple plots such that color distribution in all plots are properly scaled with respect to the the common colored BarLegend.

I have tried the solution offered on somewhat similar question. But the problem is that values of BarLegend is not PROPERLY connected with the colours of the DensityPlot.

Answer 1

$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global`*"]

amplitude[x_, y_, a_] = Exp[-a x^2 - Sin[y^2]];

The range of amplitude values is

{min, max} = #[{amplitude[x, y, a],
     -1 <= x <= 1, -3 <= y <= 3, 1 <= a <= 4}, {a, x, y}] & /@
  {MinValue, MaxValue}

(* {1/E^5, E} *)

The approximate numeric values are

{min, max} // N

(* {0.00673795, 2.71828} *)

Prepend[
  Partition[
   Table[
    DensityPlot[
     amplitude[x, y, a], {x, -1, 1}, {y, -3, 3},
     PlotLabel -> StringForm["a = ``", a],
     ColorFunction -> Function[{f},
       ColorData["Rainbow"][(f - min)/(max - min)]],
     ColorFunctionScaling -> False,
     ImageSize -> Small],
    {a, 1, 4, 1}],
   2],
  {BarLegend[{"Rainbow", {min, max}},
    LegendLayout -> "Row",
    LegendLabel -> Placed["amplitude", Before]],
   SpanFromLeft}] //
 Grid

Answer 2

NOTE: The following solution only seems to work - there is a single legend, but the different sub plots use different color schemes, so this doesn't really solve the question asked. I have submitted a report to WRI, so this will hopefully work as expected in the future

In newer versions (starting with 13.0), you can use a single DensityPlot together with the PlotLayout option:

amplitude[x_, y_, a_] = Exp[-a x^2 - Sin[y^2]];

DensityPlot[
 Evaluate@Table[amplitude[x, y, a], {a, 1, 4, 1}],
 {x, -1, 1}, {y, -3, 3},
 ColorFunction -> "Rainbow", PlotLegends -> Automatic, 
 ImageSize -> Medium,
 PlotLayout -> {"Row", 2}
 ]