From 847270877abc3bd983a400a29a0b4bebae033b06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Moritz=20J=C3=B6rg?= Date: Tue, 18 Nov 2025 18:01:36 +0100 Subject: [PATCH] feat: Add Density profile plot and cancelable jobs Adds a Density Plot to the Pipette, it uses the temp and salinity at node together with surface pressure. Also fixes the matrix titles for oceanbox/Poseidon#30 and adds a cancel button as part of oceanbox/Poseidon#41. --- .releaserc.yaml | 4 +- src/Atlantis/src/Client/Lib/Types.fs | 9 ++ src/Atlantis/src/Client/Mapster/Inbox.fs | 62 ++++++++-- src/Atlantis/src/Client/Mapster/Mapster.fs | 17 +++ src/Atlantis/src/Client/Mapster/Model.fs | 3 +- src/Atlantis/src/Client/Mapster/Navigation.fs | 3 + src/Atlantis/src/Client/Mapster/Plotly.fs | 10 +- .../src/Client/Mapster/Plots/DepthPlots.fs | 9 +- src/Atlantis/src/Server/Api.fs | 17 +++ .../src/Server/Hipster/DriftersActor.fs | 2 +- src/Atlantis/src/Server/Hipster/JobActor.fs | 60 +++++++--- src/Atlantis/src/Server/Hipster/PlumeActor.fs | 2 +- src/Atlantis/src/Server/Hipster/Slurm.fs | 13 +++ src/Interfaces/Atlantis/Api.fs | 1 + src/Interfaces/Hipster/Actors.fs | 2 +- src/Interfaces/Sorcerer/Api.fs | 1 + src/Sorcerer/src/Server/Api.fs | 9 ++ src/Sorcerer/src/Server/Fvcom.fs | 110 ++++++++++++++++++ 18 files changed, 299 insertions(+), 35 deletions(-) diff --git a/.releaserc.yaml b/.releaserc.yaml index 78bb97d4..0f5f8616 100644 --- a/.releaserc.yaml +++ b/.releaserc.yaml @@ -15,7 +15,7 @@ plugins: - "src/Atlantis/src/**.fsproj" - "src/Sorcerer/src/**.fsproj" - "src/DataAgent/src/**.fsproj" - - "src/ServerPack/src/*.fsproj" + - "src/ServerPack/src/**.fsproj" - "src/Interfaces/**.fsproj" - - '@semantic-release/exec' - generateNotesCmd: "echo ${nextRelease.version} > VERSION" @@ -29,7 +29,7 @@ plugins: - "src/Atlantis/src/**.fsproj" - "src/Sorcerer/src/**.fsproj" - "src/DataAgent/src/**.fsproj" - - "src/ServerPack/src/*.fsproj" + - "src/ServerPack/src/**.fsproj" - "src/Interfaces/**.fsproj" analyzeCommits: diff --git a/src/Atlantis/src/Client/Lib/Types.fs b/src/Atlantis/src/Client/Lib/Types.fs index 9091e5fa..5ecef63e 100644 --- a/src/Atlantis/src/Client/Lib/Types.fs +++ b/src/Atlantis/src/Client/Lib/Types.fs @@ -277,6 +277,7 @@ type Prop = | Temp | Salt | Zeta + | Dens | Speed | Conc2D | Conc3D @@ -292,6 +293,7 @@ type Prop = | Temp -> "temp" | Salt -> "salt" | Zeta -> "zeta" + | Dens -> "dens" | Speed -> "speed" | Conc2D -> "concentration2D" | Conc3D -> "concentration3D" @@ -308,6 +310,7 @@ type Prop = | Temp -> "Temperature" | Salt -> "Salinity" | Zeta -> "Tide" + | Dens -> "Density (σt(T, S, 0)" | Speed -> "Current" | Conc2D -> "Concentration2D" | Conc3D -> "Concentration3D" @@ -324,6 +327,7 @@ type Prop = | Temp -> 0.0, 15.0 | Salt -> 27.5, 35.0 | Zeta -> -1.5, 1.5 + | Dens -> 20.0, 27.0 | Speed -> 0.0, 2.0 | Conc2D -> 0.0, 1.0 | Conc3D -> 0.0, 1.0 @@ -342,6 +346,7 @@ type Prop = | Temp -> -5.0, 45.0 | Salt -> 0.0, 50.0 | Zeta -> -5.0, 5.0 + | Dens -> 15.0, 28.0 | Speed -> 0.0, 5.0 | Conc2D -> 0.0, 100.0 | Conc3D -> 0.0, 100.0 @@ -360,6 +365,7 @@ type Prop = | Temp -> 1.0 | Salt -> 1.0 | Zeta -> 0.1 + | Dens -> 0.1 | Speed -> 0.1 | Conc2D -> 0.1 | Conc3D -> 1.0 @@ -377,6 +383,7 @@ type Prop = | Temp -> "°C" | Salt -> "psu" | Zeta -> "m" + | Dens -> "kg/m3-1000" | Speed -> "m/s" | Conc2D -> "1/km2" | Conc3D -> "1/km2" @@ -394,6 +401,7 @@ type Prop = | Speed -> elem | Temp | Salt + | Dens | Bathy | Temp | Salt @@ -414,6 +422,7 @@ type Prop = | "zeta" -> Prop.Zeta | "temp" -> Prop.Temp | "salt" -> Prop.Salt + | "dens" -> Prop.Dens | "speed" -> Prop.Speed | "concentration2D" -> Prop.Conc2D | "concentration3D" -> Prop.Conc3D diff --git a/src/Atlantis/src/Client/Mapster/Inbox.fs b/src/Atlantis/src/Client/Mapster/Inbox.fs index 551fa7f9..ffd9d87b 100644 --- a/src/Atlantis/src/Client/Mapster/Inbox.fs +++ b/src/Atlantis/src/Client/Mapster/Inbox.fs @@ -20,6 +20,7 @@ let inboxDialog markAsRead: Guid -> unit deleteMessage: Guid -> unit postMessage: InboxItem -> unit + cancelJob: int -> unit unread: int // can flip between +/- N to indicate the need for a reload currentDrifters: Map |}) = @@ -66,16 +67,32 @@ let inboxDialog let doDelete _ = let table = document.getElementById "inbox-table" - let items: InboxItem[] = table?items - items - |> Array.iter (fun item -> - if Set.contains item.id selected then - arg.deleteMessage item.id) - loadMessages () + let selectedSet : Guid JS.Set = table?selectedSet + let items: InboxItem array = table?items + async { + let toDelete = + items + |> Array.filter (fun item -> selectedSet.has(item.id)) + |> Array.map (fun item -> item.id) + + console.debug("Deleting", toDelete.Length, "messages") + + for id in toDelete do + arg.deleteMessage id + + // Clear selection immediately + selectedSet.clear() + setSelected Set.empty + + // Wait a bit for server to process, then reload + do! Async.Sleep 200 + let! mbox = Remoting.inboxApi().getMessages () + table?items <- mbox + } |> Async.StartImmediate let doRead selected _ = let table = document.getElementById "inbox-table" - let items: InboxItem[] = table?items + let items: InboxItem array = table?items items |> Array.iter (fun item -> console.log selected @@ -221,6 +238,30 @@ let inboxDialog """ + let cancelButton = + let jobId, canCancel = + match item.type' with + | MessageType.Progress -> + let progressMsg = decodeProgressMessage item.content + let canCancel = progressMsg.job <> -1 + progressMsg.job, canCancel + | MessageType.Drifters | MessageType.Job -> + let job = decodeJobMessage item.content + let canCancel = (job.status = JobStatus.Running || job.status = JobStatus.Waiting) && job.job <> -1 + job.job, canCancel + | _ -> + -1, false + + let doCancelJob _ = + if canCancel then arg.cancelJob jobId + + html $""" + e.stopPropagation(); doCancelJob())}> + + Cancel simulation + + """ + if item.content = "" then html $""" @@ -239,7 +280,10 @@ let inboxDialog {formatMsg item.unread inactive (item.created.ToString "dd/MM/yyyy")} - {downloadButton} + + {downloadButton} + {cancelButton} + """ Hook.useEffectOnce (fun () -> @@ -285,7 +329,7 @@ let inboxDialog Created - PDF + Actions diff --git a/src/Atlantis/src/Client/Mapster/Mapster.fs b/src/Atlantis/src/Client/Mapster/Mapster.fs index 6313bd9a..df6c4450 100644 --- a/src/Atlantis/src/Client/Mapster/Mapster.fs +++ b/src/Atlantis/src/Client/Mapster/Mapster.fs @@ -26,6 +26,7 @@ open Petimeter.Inbox open Remoting open Sorcerer.Types open Utils +open Atlantis.Shared let private hmr = HMR.createToken () @@ -1757,6 +1758,21 @@ let update cmd model = } model, Cmd.OfAsync.perform delete () id + | CancelJob jobId -> + let cancel () = + async { + let driftersApi = driftersJobApi () + match! driftersApi.cancelJob jobId with + | Ok msg -> + console.log $"[Mapster]: Job {jobId} cancelled : {msg}" + let note = Note.warn msg + return SetNotification note + | Error err -> + console.error $"[Mapster]: Failed to cancel job {jobId}: {err}" + let note = Note.error err + return SetNotification note + } + model, Cmd.OfAsync.perform cancel () id | SetIdentity identityOpt -> match identityOpt with | Some id -> @@ -2216,6 +2232,7 @@ let MapAppElement () = markAsRead = fun id -> Hub.Action.Inbox (Hub.InboxMsg.MarkRead id) |> (HubMsg >> dispatch) deleteMessage = fun id -> Hub.Action.Inbox (Hub.InboxMsg.Delete id) |> (HubMsg >> dispatch) postMessage = fun _ -> Hub.Action.Inbox (Hub.InboxMsg.Post (testMsg count)) |> (HubMsg >> dispatch) + cancelJob = CancelJob >> dispatch unread = model.inboxUnread currentDrifters = model.availableDrifters |} diff --git a/src/Atlantis/src/Client/Mapster/Model.fs b/src/Atlantis/src/Client/Mapster/Model.fs index f2947285..58c033b9 100644 --- a/src/Atlantis/src/Client/Mapster/Model.fs +++ b/src/Atlantis/src/Client/Mapster/Model.fs @@ -98,7 +98,7 @@ type ProbeView = static member props view : Prop array = match view with - | DepthProfile -> [| Prop.Temp; Prop.Salt; Prop.Speed |] + | DepthProfile -> [| Prop.Temp; Prop.Salt; Prop.Speed; Prop.Dens |] | TimeSeries -> [| Prop.Temp; Prop.Salt; Prop.Speed; Prop.Zeta |] | RosePlots -> [| Prop.Speed |] @@ -482,6 +482,7 @@ type Msg = | SetSimPolicies of DriftersPolicy[] | RenameDriftersArchive of System.Guid * string | DeleteArchive of System.Guid + | CancelJob of int | SetPlumeModel of PlumeModel option | ShowReleases of bool diff --git a/src/Atlantis/src/Client/Mapster/Navigation.fs b/src/Atlantis/src/Client/Mapster/Navigation.fs index ebb04a50..c8a30cfd 100644 --- a/src/Atlantis/src/Client/Mapster/Navigation.fs +++ b/src/Atlantis/src/Client/Mapster/Navigation.fs @@ -589,6 +589,9 @@ let private OceanPlotControls model dispatch = Speed + + Density + {GraphRangeSlider model dispatch} diff --git a/src/Atlantis/src/Client/Mapster/Plotly.fs b/src/Atlantis/src/Client/Mapster/Plotly.fs index f27a4560..314f0fe7 100644 --- a/src/Atlantis/src/Client/Mapster/Plotly.fs +++ b/src/Atlantis/src/Client/Mapster/Plotly.fs @@ -656,8 +656,9 @@ module ReactLib = let style = {| minHeight = "416px"; width = "100%" |} let config = {| responsive = true; editable = false |} let layout = {| - xaxis = {| side = "top" |} - yaxis = {| autorange = "reversed" |} + xaxis = {| side = "top"; title = {| text = "Receiver"; standoff = 120 |} |} + yaxis = {| autorange = "reversed"; title = {| text = "Sender"; standoff = 120 |} |} + margin = {| t = 100; b = 50; l = 100; r = 50 |} |} let traces = newHeatMap siteNames siteNames weights @@ -718,7 +719,9 @@ module ReactLib = editable = false |} let layout = {| - xaxis = {| side = "top" |} + xaxis = {| side = "top"; title = {| text = "Receiver"; standoff = 120 |} |} + yaxis = {| title = {| text = "Sender"; standoff = 120 |} |} + margin = {| t = 100; b = 50; l = 100; r = 50 |} |} let traces = newCageHeatMap groupNames' cageNames weights' @@ -731,6 +734,7 @@ module ReactLib = /> """ + // NOTE(simkir): !! These cannot be partially applied! Or, the exposing Component must be curried, so not take any // arguments. // diff --git a/src/Atlantis/src/Client/Mapster/Plots/DepthPlots.fs b/src/Atlantis/src/Client/Mapster/Plots/DepthPlots.fs index 68d0d1ca..b0fbb69b 100644 --- a/src/Atlantis/src/Client/Mapster/Plots/DepthPlots.fs +++ b/src/Atlantis/src/Client/Mapster/Plots/DepthPlots.fs @@ -18,9 +18,13 @@ let private fetchPropData (archiveId: System.Guid) (frame: FrameIdx) (gridIdx: G match prop with | Prop.Temp -> fvcom.Node.GetTemp archiveId frame | Prop.Salt -> fvcom.Node.GetSalinity archiveId frame + | Prop.Dens -> fvcom.Node.GetDensity archiveId frame | Prop.Speed -> fvcom.Element.GetSpeed archiveId frame | _ -> fun _ -> async.Return [||] + + console.debug("[DepthPlots] Fetching %s data for archive %s, frame %d, idx %d", string prop, string archiveId, frame, idx) let! res = fetch idx |> Async.StartAsPromise + console.debug("[DepthPlots] Received %s data: length=%d, data=%o", string prop, res.Length, res) return res } @@ -322,7 +326,10 @@ let View fun updatedStats -> console.debug ("[DepthPlots] Stats changed %o", updatedStats) if updatedStats.propType = Undefined then - console.warn "[DepthPlots] Stats prop type is Undefined!" + if probeProp = Atlantis.Types.Prop.Dens then + console.debug "[DepthPlots] Density selected - statistics not available, showing instant data only" + else + console.warn "[DepthPlots] Stats prop type is Undefined!" else console.debug ("[DepthPlots] Stats prop type is %s", string updatedStats.propType) do FetchMetrics updatedStats |> dispatch diff --git a/src/Atlantis/src/Server/Api.fs b/src/Atlantis/src/Server/Api.fs index 16c88514..3f4551c3 100644 --- a/src/Atlantis/src/Server/Api.fs +++ b/src/Atlantis/src/Server/Api.fs @@ -445,6 +445,22 @@ module Handlers = } |> Async.AwaitTask + let private cancelJob (ctx: HttpContext) jobId = + let user = getUserName ctx + Log.Information ("User {username} cancels job {}", user, jobId) + let actorId = ActorId user + + task { + try + let proxy = ActorProxy.Create(actorId, "DriftersActor") + return! proxy.Cancel jobId + with exn -> + Log.Error $"cancelJob: {exn.Message}" + Log.Verbose $"cancelJob: %A{exn}" + return Error exn.Message + } + |> Async.AwaitTask + let driftersApi (ctx: HttpContext) : Api.Drifters = { startDrifters = runDrifters ctx startPostdrift = runPostdrift ctx @@ -455,6 +471,7 @@ module Handlers = getDriftersInput = getDriftersInput ctx renameArchive = renameArchive ctx retireArchive = retireArchive ctx + cancelJob = cancelJob ctx } let inboxApi (ctx: HttpContext) : Api.Inbox = { diff --git a/src/Atlantis/src/Server/Hipster/DriftersActor.fs b/src/Atlantis/src/Server/Hipster/DriftersActor.fs index 6e403ebc..4a811cbc 100644 --- a/src/Atlantis/src/Server/Hipster/DriftersActor.fs +++ b/src/Atlantis/src/Server/Hipster/DriftersActor.fs @@ -246,7 +246,7 @@ type DriftersActor(host: ActorHost, slurm: SlurmClient, settings: Common.Setting // } interface IJobActor with - member this.Cancel() = this.cancel () + member this.Cancel(jobId) = this.cancel jobId member this.HandleJobEvent(job) = this.handleJobEvent job member this.Remove(jobid) = this.remove jobid member this.RemoveById(aid: Guid) = this.removeById aid diff --git a/src/Atlantis/src/Server/Hipster/JobActor.fs b/src/Atlantis/src/Server/Hipster/JobActor.fs index f652547e..df9b81a9 100644 --- a/src/Atlantis/src/Server/Hipster/JobActor.fs +++ b/src/Atlantis/src/Server/Hipster/JobActor.fs @@ -156,9 +156,32 @@ type JobActor(host: ActorHost, slurm: SlurmClient, settings: Common.Settings) = else Task.FromResult () - member this.cancel() = - Log.Debug $"cancel (not implemented yet): {this.myId}" - task { return true } + member this.cancel(jobId: int) = + Log.Debug $"[JobActor.Cancel]: Cancel job %i{jobId}: %s{this.myId}" + task { + try + if this.jobs.ContainsKey jobId then + let! cancelled = slurm.CancelJob jobId + if cancelled then + let updatedJob = { this.jobs[jobId] with status = JobStatus.Failed } + this.jobs[jobId] <- updatedJob + do! this.StateManager.SetStateAsync (this.jobsKey, this.jobs) + + // Publish cancellation to pubsub so clients are immediately notified + do! client.PublishEventAsync ("pubsub", "hipster", updatedJob) + + // Post status to inbox when job is cancelled successfully + do! this.postStatus MessageType.Job updatedJob + + return Ok "Simulation cancelled" + else + return Error "Failed to cancel job" + else + return Error "Job not found" + with exn -> + Log.Error $"[JobActor.cancel]: Cancel job {jobId} failed: {exn.Message}" + return Error exn.Message + } member this.handleJobEvent(job: SlurmJobStatusMsg) = let job' = @@ -182,26 +205,31 @@ type JobActor(host: ActorHost, slurm: SlurmClient, settings: Common.Settings) = task { match job' with + | None -> + Log.Debug $"[JobActor.handleJobEvent] No job found with id: %d{job.jobId}" + Log.Debug $"[JobActor.handleJobEvent] jobs: %A{this.jobs}" + return () | Some j -> match job.messageType with | "progress" -> do! this.postProgress job | _ -> let status = LanguagePrimitives.EnumOfValue (int job.content) - let j' = { j with status = status } - do! update j' - let jobType = job.jobType |> inboxMessageTypeFromString - - if status = JobStatus.Completed then - // Delay for Atlantis to update on job completion - System.Threading.Thread.Sleep 1000 - do! this.postStatus jobType j' + // Don't update if job is already cancelled (Failed) + if j.status = JobStatus.Failed then + Log.Debug $"[JobActor.handleJobEvent] Ignoring status update for cancelled job {job.jobId}: current={j.status}, new={status}" else - do! this.postStatus MessageType.Job j' - | None -> - Log.Debug $"[JobActor.handleJobEvent] No job found with id: %d{job.jobId}" - Log.Debug $"[JobActor.handleJobEvent] jobs: %A{this.jobs}" - return () + let j' = { j with status = status } + do! update j' + + let jobType = job.jobType |> inboxMessageTypeFromString + + if status = JobStatus.Completed then + // Delay for Atlantis to update on job completion + System.Threading.Thread.Sleep 1000 + do! this.postStatus jobType j' + else + do! this.postStatus MessageType.Job j' } member this.remove(jobid) = diff --git a/src/Atlantis/src/Server/Hipster/PlumeActor.fs b/src/Atlantis/src/Server/Hipster/PlumeActor.fs index 5e769adc..7fa730cb 100644 --- a/src/Atlantis/src/Server/Hipster/PlumeActor.fs +++ b/src/Atlantis/src/Server/Hipster/PlumeActor.fs @@ -71,7 +71,7 @@ type PlumeActor(host: ActorHost, slurm: SlurmClient, settings: Common.Settings, submitJob () interface IJobActor with - member this.Cancel() = this.cancel () + member this.Cancel(jobId) = this.cancel jobId member this.HandleJobEvent(job) = this.handleJobEvent job member this.Remove(jobid) = this.remove jobid member this.RemoveById(aid: Guid) = this.removeById aid diff --git a/src/Atlantis/src/Server/Hipster/Slurm.fs b/src/Atlantis/src/Server/Hipster/Slurm.fs index d4fc7656..4c5e786b 100644 --- a/src/Atlantis/src/Server/Hipster/Slurm.fs +++ b/src/Atlantis/src/Server/Hipster/Slurm.fs @@ -189,4 +189,17 @@ type SlurmClient(client: HttpClient, settings: ISlurmClientSettings) = match Decode.Auto.fromString rsp' with | Ok job -> return Array.tryHead job.jobs |> Option.map (fun q -> getJobStatus q.job_state) | Error _ -> return None + } + + member this.CancelJob(jobId: int) = + task { + try + // Cancel or signal job + // https://slurm.schedmd.com/rest_api.html#slurmV0044DeleteJob + let! rsp = client.DeleteAsync $"job/%i{jobId}" + // Returns 200 no succesful cancel + return rsp.IsSuccessStatusCode + with exn -> + Log.Error $"Cancel job %i{jobId} failed: %s{exn.Message}" + return false } \ No newline at end of file diff --git a/src/Interfaces/Atlantis/Api.fs b/src/Interfaces/Atlantis/Api.fs index d9151b83..62b324fb 100644 --- a/src/Interfaces/Atlantis/Api.fs +++ b/src/Interfaces/Atlantis/Api.fs @@ -57,6 +57,7 @@ module Api = getDriftersInput: Guid -> Async> renameArchive: Guid -> string -> Async> retireArchive: Guid -> Async> + cancelJob: int -> Async> } type Inbox = diff --git a/src/Interfaces/Hipster/Actors.fs b/src/Interfaces/Hipster/Actors.fs index 516f5c2a..144edd43 100644 --- a/src/Interfaces/Hipster/Actors.fs +++ b/src/Interfaces/Hipster/Actors.fs @@ -50,7 +50,6 @@ type PostdriftJob = { type IJobActor = inherit IActor - abstract Cancel: unit: unit -> Task abstract Remove: job: int -> Task abstract RemoveById: aid: Guid -> Task abstract Clear: unit: unit -> Task @@ -59,6 +58,7 @@ type IJobActor = abstract GetActiveJobs: aid: Guid -> Task abstract GetFenceRadius: unit: unit -> Task abstract CheckFence: aid: Guid * pos: (float * float) list -> Task + abstract Cancel: job: int -> Task> type IDriftersActor = inherit IJobActor diff --git a/src/Interfaces/Sorcerer/Api.fs b/src/Interfaces/Sorcerer/Api.fs index 7561692c..5f1386cb 100644 --- a/src/Interfaces/Sorcerer/Api.fs +++ b/src/Interfaces/Sorcerer/Api.fs @@ -39,6 +39,7 @@ module Api = GetBathymetry: Guid -> NodeIdx -> Async GetTemp: Guid -> FrameIdx -> NodeIdx -> Async GetSalinity: Guid -> FrameIdx -> NodeIdx -> Async + GetDensity: Guid -> FrameIdx -> NodeIdx -> Async } type Element = { diff --git a/src/Sorcerer/src/Server/Api.fs b/src/Sorcerer/src/Server/Api.fs index c0bfed61..cc931da4 100644 --- a/src/Sorcerer/src/Server/Api.fs +++ b/src/Sorcerer/src/Server/Api.fs @@ -446,6 +446,15 @@ module Fvcom = Fvcom.salinityAtNode aid t n |> Result.defaultValue Array.empty } + GetDensity = + fun aid t n -> + async { + let logData = {| aid = aid; n = n |} + use _ = observer.trace ("GetDensity", "{@log_data}", logData) + return + Fvcom.densityAtNode aid t n + |> Result.defaultValue Array.empty + } } let elementApi (ctx: HttpContext) : Fvcom.Element = diff --git a/src/Sorcerer/src/Server/Fvcom.fs b/src/Sorcerer/src/Server/Fvcom.fs index 08ebde5e..1f0cf23d 100644 --- a/src/Sorcerer/src/Server/Fvcom.fs +++ b/src/Sorcerer/src/Server/Fvcom.fs @@ -214,6 +214,96 @@ let private queryGridIndexCache (aid: Guid) (grid: ExtendedGrid) = } |> Async.Start +/// Compute density of seawater from salinity, temperature, and pressure +let private dens (temp: float) (salt: float) (pres: float) = + // From Bjørn Aadlandsvik https://github.com/bjornaa/seawater/blob/master/seawater/density.py + + /// Density of seawater at zero pressure + let dens0 (salt: float) (temp: float) = + // --- Define constants --- + let a0 = 999.842594 + let a1 = 6.793952e-2 + let a2 = -9.095290e-3 + let a3 = 1.001685e-4 + let a4 = -1.120083e-6 + let a5 = 6.536332e-9 + + let b0 = 8.24493e-1 + let b1 = -4.0899e-3 + let b2 = 7.6438e-5 + let b3 = -8.2467e-7 + let b4 = 5.3875e-9 + + let c0 = -5.72466e-3 + let c1 = 1.0227e-4 + let c2 = -1.6546e-6 + + let d0 = 4.8314e-4 + + // --- Computations --- + // Density of pure water + let SMOW = a0 + (a1 + (a2 + (a3 + (a4 + a5 * temp) * temp) * temp) * temp) * temp + + // More temperature polynomials + let RB = b0 + (b1 + (b2 + (b3 + b4 * temp) * temp) * temp) * temp + let RC = c0 + (c1 + c2 * temp) * temp + + SMOW + RB * salt + RC * (salt ** 1.5) + d0 * salt * salt + + /// Secant bulk modulus + let seck salt temp pres = + // --- Pure water terms --- + let h0 = 3.239908 + let h1 = 1.43713e-3 + let h2 = 1.16092e-4 + let h3 = -5.77905e-7 + let AW = h0 + (h1 + (h2 + h3 * temp) * temp) * temp + + let k0 = 8.50935e-5 + let k1 = -6.12293e-6 + let k2 = 5.2787e-8 + let BW = k0 + (k1 + k2 * temp) * temp + + let e0 = 19652.21 + let e1 = 148.4206 + let e2 = -2.327105 + let e3 = 1.360477e-2 + let e4 = -5.155288e-5 + let KW = e0 + (e1 + (e2 + (e3 + e4 * temp) * temp) * temp) * temp + + // --- Seawater, P = 0 --- + let SR = salt ** 0.5 + + let i0 = 2.2838e-3 + let i1 = -1.0981e-5 + let i2 = -1.6078e-6 + let j0 = 1.91075e-4 + let A = AW + (i0 + (i1 + i2 * temp) * temp + j0 * SR) * salt + + let f0 = 54.6746 + let f1 = -0.603459 + let f2 = 1.09987e-2 + let f3 = -6.1670e-5 + let g0 = 7.944e-2 + let g1 = 1.6483e-2 + let g2 = -5.3009e-4 + let K0 = + KW + + (f0 + (f1 + (f2 + f3 * temp) * temp) * temp + (g0 + (g1 + g2 * temp) * temp) * SR) + * salt + + // --- General expression --- + let m0 = -9.9348e-7 + let m1 = 2.0816e-8 + let m2 = 9.1697e-10 + let B = BW + (m0 + (m1 + m2 * temp) * temp) * salt + + K0 + (A + B * pres) * pres + + // Convert to bar + let pres = 0.1 * pres + (dens0 salt temp) / (1.0 - pres / seck salt temp pres) + let nLayers (aid: Guid) = let f ds _ = Fvcom.getNumSiglay ds dataAgent.eval (f, aid) @@ -472,6 +562,26 @@ let zetaAtNode aid t n = let f ds t = Fvcom.Singular.readZeta ds n t dataAgent.eval (f, aid, t) +let densityAtNode aid t n = + monad { + let! temp = tempAtNode aid t n + let! salt = salinityAtNode aid t n + let! h = bathymetryAtNode aid n + let! zeta = zetaAtNode aid t n + let! siglay = siglay aid n + + return + Array.map3 (fun t_val s_val sigma -> + let depth = abs (sigma * h + zeta) |> float + let t_val = float t_val + let s_val = float s_val + // NOTE: Pressure set to surface pressure which is + // approx 0 using σ_t(T, S, 0) + let pres = 0 + (dens t_val s_val pres - 1000.) |> single + ) temp salt siglay + } + let getDepthsAtNode aid node = monad { let! h = bathymetryAtNode aid node