mathematicsoftsunamis-source.nb

simulate Tsunamis using mathematica

                    RowBox[{
                    SubscriptBox["\[Lambda]", "e"], ",", 
                    SubscriptBox["\[Phi]", "2"]}], "}"}]}], "]"}], "[", 
                    RowBox[{"{", 
                    RowBox[{"\[Lambda]", ",", "\[Phi]"}], "}"}], "]"}], 
                   "2"]}]]}], ",", 
               RowBox[{
                RowBox[{"u", "[", 
                 RowBox[{"\[Lambda]", ",", "\[Phi]", ",", "0"}], "]"}], 
                "\[Equal]", "0"}], ",", 
               RowBox[{
                RowBox[{"v", "[", 
                 RowBox[{"\[Lambda]", ",", "\[Phi]", ",", "0"}], "]"}], 
                "\[Equal]", "0"}], ",", 
               RowBox[{
                RowBox[{"h", "[", 
                 RowBox[{"\[Lambda]", ",", 
                  SubscriptBox["\[Phi]", "min"], ",", "t"}], "]"}], 
                "\[Equal]", 
                RowBox[{"h", "[", 
                 RowBox[{"\[Lambda]", ",", 
                  SubscriptBox["\[Phi]", "max"], ",", "t"}], "]"}]}], ",", 
               RowBox[{
                RowBox[{"h", "[", 
                 RowBox[{
                  SubscriptBox["\[Lambda]", "min"], ",", "\[Phi]", ",", "t"}],
                  "]"}], "\[Equal]", 
                RowBox[{"h", "[", 
                 RowBox[{
                  SubscriptBox["\[Lambda]", "max"], ",", "\[Phi]", ",", "t"}],
                  "]"}]}]}], "}"}], ",", "h", ",", 
             RowBox[{"{", 
              RowBox[{"\[Lambda]", ",", 
               SubscriptBox["\[Lambda]", "min"], ",", 
               SubscriptBox["\[Lambda]", "max"]}], "}"}], ",", 
             RowBox[{"{", 
              RowBox[{"\[Phi]", ",", 
               SubscriptBox["\[Phi]", "min"], ",", 
               SubscriptBox["\[Phi]", "max"]}], "}"}], ",", 
             RowBox[{"{", 
              RowBox[{"t", ",", "0", ",", "T"}], "}"}], ",", 
             RowBox[{"DependentVariables", "\[Rule]", 
              RowBox[{"{", 
               RowBox[{"h", ",", "u", ",", "v"}], "}"}]}], ",", 
             RowBox[{"Method", "\[Rule]", 
              RowBox[{"{", 
               RowBox[{"\"\<MethodOfLines\>\"", ",", 
                RowBox[{"\"\<SpatialDiscretization\>\"", "\[Rule]", 
                 RowBox[{"{", 
                  RowBox[{"\"\<TensorProductGrid\>\"", ",", 
                   RowBox[{"\"\<MinPoints\>\"", "\[Rule]", 
                    RowBox[{"{", 
                    RowBox[{"nxy", ",", "nxy"}], "}"}]}], ",", 
                   RowBox[{"\"\<MaxPoints\>\"", "\[Rule]", 
                    RowBox[{"{", 
                    RowBox[{"nxy", ",", "nxy"}], "}"}]}], ",", 
                   RowBox[{
                   "\"\<DifferenceOrder\>\"", "\[Rule]", 
                    "\"\<Pseudospectral\>\""}]}], "}"}]}]}], "}"}]}]}], 
            "]"}]}], "]"}]}]}], "]"}], ";"}], "\[IndentingNewLine]", 
     ")"}]}]}], "]"}]], "Input",
 CellChangeTimes->{
  3.35696210375764*^9, {3.3990340517417526`*^9, 3.399034131209485*^9}, {
   3.399034425065099*^9, 3.399034451346012*^9}, {3.399034512626478*^9, 
   3.3990345500791235`*^9}, {3.3990345809537287`*^9, 3.399034583719318*^9}, {
   3.399034628171874*^9, 3.3990346502497163`*^9}, {3.3990346837336626`*^9, 
   3.399034763951386*^9}, {3.399034829091177*^9, 3.3990348752780857`*^9}, 
   3.399035056197645*^9, {3.3990351614619226`*^9, 3.3990351636025205`*^9}, {
   3.3990352564763317`*^9, 3.3990352653980923`*^9}, {3.399035342787727*^9, 
   3.399035363303089*^9}, {3.399035482285941*^9, 3.3990354891452284`*^9}, {
   3.3990355909095507`*^9, 3.399035620721669*^9}, {3.3990356984394245`*^9, 
   3.3990357175016804`*^9}, {3.3990368077377253`*^9, 
   3.3990368832367587`*^9}, {3.399036932267381*^9, 3.399036945079717*^9}, {
   3.399037046265922*^9, 3.399037101671463*^9}, 3.399037141249081*^9, {
   3.3990371767798767`*^9, 3.3990372084200964`*^9}, {3.399037245263375*^9, 
   3.3990373563088284`*^9}, {3.39903741676118*^9, 3.3990374232610965`*^9}, {
   3.399037497135151*^9, 3.3990375555094037`*^9}, {3.39903761125869*^9, 
   3.3990378864582925`*^9}, {3.3990379302858562`*^9, 3.399037968738489*^9}, {
   3.399038000909952*^9, 3.3990380037224164`*^9}, {3.399039274674898*^9, 
   3.3990393247367573`*^9}, {3.399039543202711*^9, 3.399039698106978*^9}, {
   3.3990397413876743`*^9, 3.3990398463550806`*^9}, {3.3990400297121086`*^9, 
   3.399040205803604*^9}, {3.39904027255275*^9, 3.3990403030367346`*^9}, {
   3.399040337348796*^9, 3.399040389520003*^9}, {3.3990404604722195`*^9, 
   3.3990405138777857`*^9}, {3.399040819748871*^9, 3.399040832904952*^9}, {
   3.3990408709513407`*^9, 3.3990408819355745`*^9}, {3.3990409239037876`*^9, 
   3.39904093973171*^9}, {3.3990410552614813`*^9, 3.3990411152450886`*^9}, {
   3.399041234884182*^9, 3.3990413227268076`*^9}, {3.399041780595947*^9, 
   3.399041780752195*^9}, {3.399041811658049*^9, 3.3990418625636473`*^9}, {
   3.3990419399845314`*^9, 3.3990419526718693`*^9}, {3.3990421038418093`*^9, 
   3.399042117779131*^9}, {3.399042147825621*^9, 3.399042265964734*^9}, {
   3.399042486446287*^9, 3.3990425192114925`*^9}, {3.3990450474603806`*^9, 
   3.399045048257245*^9}, {3.399045254051486*^9, 3.399045303972722*^9}, {
   3.3990465719721165`*^9, 3.3990465896906395`*^9}, {3.3990466725802035`*^9, 
   3.3990467657977605`*^9}, {3.399046797875475*^9, 3.399046841062422*^9}, 
   3.399046885202482*^9, {3.399047002091611*^9, 3.3990470100133843`*^9}, {
   3.3990471658238897`*^9, 3.399047262478903*^9}, {3.399047393242854*^9, 
   3.399047451976477*^9}, {3.39904749355407*^9, 3.3990475099601097`*^9}, {
   3.399047615099389*^9, 3.3990476384272156`*^9}, {3.399047778097303*^9, 
   3.399047804565714*^9}, {3.399047926282906*^9, 3.399047933626562*^9}, {
   3.3990479828603067`*^9, 3.3990479955945187`*^9}, {3.3990481013431654`*^9, 
   3.3990481144679976`*^9}, {3.3990484255421405`*^9, 
   3.3990484422138023`*^9}, {3.399052541020712*^9, 3.39905266965969*^9}, {
   3.3990527089873114`*^9, 3.3990527317057705`*^9}, 3.3990531151696124`*^9, {
   3.399053356916518*^9, 3.3990533832911806`*^9}, {3.3990555501484227`*^9, 
   3.3990555622421727`*^9}, {3.3990556270702977`*^9, 3.3990556287734227`*^9}, 
   3.3990557160702977`*^9, {3.3990557902890477`*^9, 3.3990558008046727`*^9}, {
   3.3990559358202977`*^9, 3.3990559424609227`*^9}, {3.3990561089140477`*^9, 
   3.3990561091015477`*^9}, {3.3990564922890477`*^9, 
   3.3990565003671727`*^9}, {3.3990676690123434`*^9, 
   3.3990677014148664`*^9}, {3.399124018245832*^9, 3.399124054683736*^9}}]
}, Open  ]],

Cell[BoxData[
 TagBox[
  StyleBox[
   DynamicModuleBox[{$CellContext`io$$ = None, $CellContext`plottype$$ = 
    "3D", $CellContext`sb$$ = True, $CellContext`tt$$ = 0, Typeset`show$$ = 
    True, Typeset`bookmarkList$$ = {}, Typeset`bookmarkMode$$ = "Menu", 
    Typeset`animator$$, Typeset`animvar$$ = 1, Typeset`name$$ = 
    "\"untitled\"", Typeset`specs$$ = {{{
       Hold[$CellContext`tt$$], 0, "time"}, 0, 7200, 360}, {{
       Hold[$CellContext`plottype$$], "3D", "plot type"}, {
      "3D", "density"}}, {{
       Hold[$CellContext`io$$], None, "interpolation"}, {
      None -> "none", 2 -> "order 2"}}, {{
       Hold[$CellContext`sb$$], True, "show seabed"}, {True, False}}}, 
    Typeset`size$$ = {450., {160., 165.}}, Typeset`update$$ = 0, 
    Typeset`initDone$$, Typeset`skipInitDone$$ = 
    False, $CellContext`tt$10278$$ = 0, $CellContext`plottype$10279$$ = 
    False, $CellContext`io$10280$$ = False, $CellContext`sb$10281$$ = False}, 
    
    DynamicBox[Manipulate`ManipulateBoxes[
     1, StandardForm, 
      "Variables" :> {$CellContext`io$$ = None, $CellContext`plottype$$ = 
        "3D", $CellContext`sb$$ = True, $CellContext`tt$$ = 0}, 
      "ControllerVariables" :> {
        Hold[$CellContext`tt$$, $CellContext`tt$10278$$, 0], 
        Hold[$CellContext`plottype$$, $CellContext`plottype$10279$$, False], 
        Hold[$CellContext`io$$, $CellContext`io$10280$$, False], 
        Hold[$CellContext`sb$$, $CellContext`sb$10281$$, False]}, 
      "OtherVariables" :> {
       Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, 
        Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, 
        Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$,
         Typeset`skipInitDone$$}, "Body" :> 
      If[$CellContext`plottype$$ == "3D", 
        Show[
         ListPlot3D[
          Table[
           $CellContext`sol[$CellContext`\[Lambda], $CellContext`\[Phi], \
$CellContext`tt$$], {$CellContext`\[Lambda], 
            Subscript[$CellContext`\[Lambda], $CellContext`min], 
            Subscript[$CellContext`\[Lambda], $CellContext`max], (
             Subscript[$CellContext`\[Lambda], $CellContext`max] - 
             Subscript[$CellContext`\[Lambda], \
$CellContext`min])/$CellContext`nxy}, {$CellContext`\[Phi], 
            Subscript[$CellContext`\[Phi], $CellContext`min], 
            
            Subscript[$CellContext`\[Phi], $CellContext`max], (
             Subscript[$CellContext`\[Phi], $CellContext`max] - 
             Subscript[$CellContext`\[Phi], \
$CellContext`min])/$CellContext`nxy}], DataRange -> {{
             Subscript[$CellContext`\[Phi], $CellContext`min], 
             Subscript[$CellContext`\[Phi], $CellContext`max]}, {
             Subscript[$CellContext`\[Lambda], $CellContext`min], 
             Subscript[$CellContext`\[Lambda], $CellContext`max]}}, 
          PlotRange -> {-4, 1.2}, PlotStyle -> Directive[
            RGBColor[0.8, 0.8, 1], 
            Specularity[White, 20]], MaxPlotPoints -> Infinity, 
          InterpolationOrder -> $CellContext`io$$, Mesh -> None, 
          PerformanceGoal -> "Speed"], 
         If[$CellContext`sb$$, $CellContext`seabed, {}], Lighting -> 
         Automatic, 
         BoxRatios -> {
          Subscript[$CellContext`\[Phi], $CellContext`max] - 
           Subscript[$CellContext`\[Phi], $CellContext`min], 
           Subscript[$CellContext`\[Lambda], $CellContext`max] - 
           Subscript[$CellContext`\[Lambda], $CellContext`min], 1/4}, 
         ImageSize -> {450, 325}, 
         Ticks -> {
          None, None, {{-4, 4000}, {-3, 3000}, {-2, 2000}, {-1, 1000}, {0, 
           0}}}], 
        Show[
         ListDensityPlot[
          Table[
           $CellContext`sol[$CellContext`\[Lambda], $CellContext`\[Phi], \
$CellContext`tt$$], {$CellContext`\[Lambda], 
            Subscript[$CellContext`\[Lambda], $CellContext`min], 
            
            Subscript[$CellContext`\[Lambda], $CellContext`max], (
             Subscript[$CellContext`\[Lambda], $CellContext`max] - 
             Subscript[$CellContext`\[Lambda], \
$CellContext`min])/$CellContext`nxy}, {$CellContext`\[Phi], 
            Subscript[$CellContext`\[Phi], $CellContext`min], 
            
            Subscript[$CellContext`\[Phi], $CellContext`max], (
             Subscript[$CellContext`\[Phi], $CellContext`max] - 
             Subscript[$CellContext`\[Phi], \
$CellContext`min])/$CellContext`nxy}], DataRange -> {{
             Subscript[$CellContext`\[Phi], $CellContext`min], 
             Subscript[$CellContext`\[Phi], $CellContext`max]}, {
             Subscript[$CellContext`\[Lambda], $CellContext`min], 
             Subscript[$CellContext`\[Lambda], $CellContext`max]}}, 
          ColorFunction -> (ColorData["TemperatureMap"][0.8 (# + 0.5)]& ), 
          ColorFunctionScaling -> False, PlotRange -> {-1, 1.2}, 
          MaxPlotPoints -> Infinity, InterpolationOrder -> $CellContext`io$$, 
          Mesh -> None], 
         If[$CellContext`sb$$, $CellContext`seabedcontour, {}], AspectRatio -> 
         Automatic, ImageSize -> {450, 325}, FrameTicks -> None]], 
      "Specifications" :> {{{$CellContext`tt$$, 0, "time"}, 0, 7200, 
         360}, {{$CellContext`plottype$$, "3D", "plot type"}, {
         "3D", "density"}, ControlType -> 
         RadioButton}, {{$CellContext`io$$, None, "interpolation"}, {
         None -> "none", 2 -> "order 2"}, ControlType -> 
         RadioButton}, {{$CellContext`sb$$, True, "show seabed"}, {
         True, False}}}, 
      "Options" :> {
       AutorunSequencing -> {1, 2}, SynchronousInitialization -> False}, 
      "DefaultOptions" :> {ControllerLinking -> True}],
     ImageSizeCache->{494., {239., 244.}},
     SingleEvaluation->True],
    Deinitialization:>None,
    DynamicModuleValues:>{},
    Initialization:>(($CellContext`ldist[
         Pattern[$CellContext`p1, 
          Blank[]], 
         Pattern[$CellContext`p2, 
          Blank[]]][
         PatternTest[
          Pattern[$CellContext`p, 
           Blank[]], VectorQ[#, NumberQ]& ]] := 
       If[$CellContext`p1 == $CellContext`p2, 
         Norm[$CellContext`p - $CellContext`p1], 
         Module[{$CellContext`pp1, $CellContext`pp2, $CellContext`p12}, \
$CellContext`pp1 = $CellContext`p - $CellContext`p1; $CellContext`pp2 = \
$CellContext`p - $CellContext`p2; $CellContext`p12 = ($CellContext`p1 - \
$CellContext`p2)/Norm[$CellContext`p1 - $CellContext`p2]; If[Sign[
              Dot[$CellContext`p12, $CellContext`pp1]] != Sign[
              Dot[$CellContext`p12, $CellContext`pp2]], 
            
            Norm[$CellContext`pp1 - 
             Dot[$CellContext`pp1, $CellContext`p12] $CellContext`p12], 
            Min[
             Norm[$CellContext`pp1], 
             Norm[$CellContext`pp2]]]]]; $CellContext`seamount[
         Pattern[$CellContext`s, 
          Blank[]], 
         Pattern[$CellContext`w, 
          Blank[]], {
          Pattern[$CellContext`\[Lambda], 
           Blank[]], 
          Pattern[$CellContext`\[Phi], 
           Blank[]]}][
         Pattern[$CellContext`l, 
          Blank[]], 
         Pattern[$CellContext`p, 
          Blank[]]] := $CellContext`s 
        E^((-$CellContext`w) (($CellContext`l - $CellContext`\[Lambda])^2 + \
($CellContext`p - $CellContext`\[Phi])^2)); 
      Subscript[$CellContext`\[Lambda], $CellContext`min] = (-15) Degree; 
      Subscript[$CellContext`\[Lambda], $CellContext`max] = 15 Degree; 
      Subscript[$CellContext`\[Lambda], $CellContext`e] = 0; 
      Subscript[$CellContext`\[Lambda], $CellContext`i] = 2.5 Degree; 
      Subscript[$CellContext`\[Phi], $CellContext`min] = (-35) Degree; 
      Subscript[$CellContext`\[Phi], $CellContext`max] = 5 Degree; 
      Subscript[$CellContext`\[Phi], 1] = (-10) Degree; 
      Subscript[$CellContext`\[Phi], 2] = (-20) Degree; 
      Subscript[$CellContext`\[Phi], $CellContext`i] = (-25) 
        Degree; $CellContext`T = 2 3600; $CellContext`nxy = 
       50; $CellContext`b[
         Pattern[$CellContext`\[Lambda], 
          Blank[]], 
         Pattern[$CellContext`\[Phi], 
          Blank[]]] := -4000 + $CellContext`seamount[
         3500, 1000, {(-2.5) Degree, (-25) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {(-5) Degree, (-23) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {(-7.5) Degree, (-27) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {
          5 Degree, (-24) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {
          5 Degree, (-21) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {
          5 Degree, (-18) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {
          5 Degree, (-15) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3000, 1000, {
          5 Degree, (-12) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]] + \
$CellContext`seamount[
         3750, 1000, {(-2) Degree, (-18) 
           Degree}][$CellContext`\[Lambda], $CellContext`\[Phi]]; 
      SeedRandom[2004]; $CellContext`seabed = 
       Plot3D[0.001 $CellContext`b[$CellContext`u, $CellContext`v], \
{$CellContext`v, 
          Subscript[$CellContext`\[Phi], $CellContext`min], 
          Subscript[$CellContext`\[Phi], $CellContext`max]}, {$CellContext`u, 
          
          Subscript[$CellContext`\[Lambda], $CellContext`min], 
          Subscript[$CellContext`\[Lambda], $CellContext`max]}, PlotRange -> 
         All, PlotPoints -> $CellContext`nxy, Mesh -> None, MaxRecursion -> 0,
          ColorFunction -> (Blend[{Brown, 
            RGBColor[0, 0.25, 0], White}, #3 + 
           RandomReal[0.1]]& )]; $CellContext`seabedcontour = ContourPlot[
         $CellContext`b[$CellContext`u, $CellContext`v], {$CellContext`v, 
          Subscript[$CellContext`\[Phi], $CellContext`min], 
          Subscript[$CellContext`\[Phi], $CellContext`max]}, {$CellContext`u,