R/WindHazaRds.R

Defines functions TCpoints2lines predict_rmax rMax2_modelsR rMax175ms_solver TCHazaRdsWindProfile TCProfilePts inlandWindDecay beta_modelsR vMax_modelsR rMax_modelsR returnBearing TCHazaRdsWindFields TCHazaRdsWindField TCHazaRdsWindTimeSereies TCvectInterp update_Track land_geometry tunedParams

Documented in beta_modelsR inlandWindDecay land_geometry predict_rmax returnBearing rMax175ms_solver rMax2_modelsR rMax_modelsR TCHazaRdsWindField TCHazaRdsWindFields TCHazaRdsWindProfile TCHazaRdsWindTimeSereies TCpoints2lines TCProfilePts TCvectInterp tunedParams update_Track vMax_modelsR

#' Update Parameter List to Calibrated Values
#'
#' @param paramsTable Global parameters to compute TC Hazards.
#' @param infile File containing tuning parameters in a .csv. Default for QLD calibration.
#'
#' @return list of params with updated tuning wind parameters.
#' @export
#'
#' @examples
#' paramsTable <- read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#'
#' tunedParams(paramsTable)
tunedParams = function(paramsTable,infile = system.file("extdata/tuningParams/QLD_modelSummaryTable.csv",package = "TCHazaRds")){
  params <- array(paramsTable$value,dim = c(1,length(paramsTable$value)))
  colnames(params) <- paramsTable$param
  params <- data.frame(params)
  if(with(params,rMaxModel != vMaxModel | rMaxModel !=betaModel)) stop("Along track models (beta, rMax, vMax) must have the same value")
  tunedvalues <- utils::read.csv(infile)
  tunedvalues <- tunedvalues[tunedvalues$simulation == "DecayCorrect",]
  vmods = c("Kepert","Hubbert","McConochie")
  tunedvalues = tunedvalues[tunedvalues$Dataset == vmods[params$windVortexModel+1] & tunedvalues$param_mod == params$rMaxModel,]
  paramsTable[which(paramsTable[,1] == "Decay_a1"),]$value <- tunedvalues$a1
  paramsTable[which(paramsTable[,1] == "Decay_a2"),]$value <- tunedvalues$a2
  paramsTable[which(paramsTable[,1] == "Decay_a3"),]$value <- tunedvalues$a3
  return(paramsTable)
}

#' @title Calculate the Geometric Parameters for Terrestrial Wind
#' @description Returns geometric data to compute wind fields.
#' @param dem SpatRaster  object, digital elevation model
#' @param inland_proximity SpatRaster  object, distance from the coast inland
#' @param returnpoints Return SpatVector of points or SpatRaster
#' @return SpatVector with attributes or SpatRaster
#'
#' | Abbreviated attribute       | description  | units |
#' | ------------- | ------------- | ------------- |
#' | dem      | Digital Elevation Model | m |
#' | lat      | Latitude  | degs  |
#' | lon      | Longitude | degs    |
#' | slope      | slope of terrain | radians |
#' | aspect      | DEM aspect | radians |
#' | inlandD      | distance inland from coast | m |
#' | f        | Coriolis parameter | hz |
#' | dzdx        | land gradient in x direction | radians |
#' | dzdy        | land gradient in y direction | radians |
#'
#' @md
#' @export
#'
#' @examples
#' require(terra)
#' dem <- rast(system.file("extdata/DEMs/YASI_dem.tif", package="TCHazaRds"))
#' land <- dem; land[land > 0] = 0
#' inland_proximity = distance(land,target = 0)
#' GEO_land = land_geometry(dem,inland_proximity)
#' plot(GEO_land)
land_geometry = function(dem,inland_proximity,returnpoints=FALSE){
    dem[dem < 0] = NA #don't include underwater slopes
    land_slope = terra::terrain(dem,"slope",neighbors = 4, unit="radians")
    land_aspect = terra::terrain(dem,"aspect",neighbors = 4, unit="radians")
    m <- tan(land_slope)
    dzdx <- -m * sin(land_aspect)
    dzdy <- -m * cos(land_aspect)
    msk = dem
    msk=msk/msk

    rex = terra::ext(dem)
    rre = terra::res(dem)
    latlon = expand.grid(seq(rex[1]+rre[1]/2,rex[2]-rre[1]/2,rre[1]),rev(seq(rex[3]+rre[2]/2,rex[4]-rre[2]/2,rre[2])))

    lons = dem*0;terra::values(lons) <- latlon[,1]
    lats = dem*0;terra::values(lats) <- latlon[,2]
    wearth <- pi*(1.0 / 24.0) / 1800.0
    f = 2*wearth*sin(lats*pi / 180.0)

    if(returnpoints){
      GEO = terra::as.points(dem*msk, na.rm= FALSE)
      names(GEO) = "dem"
      g = terra::geom(GEO)
      GEO$lats = g[,4] #return latitude
      GEO$lons = g[,3] #return longitude
      GEO$slope = terra::extract(land_slope*msk,GEO)[,2]
      GEO$aspect = terra::extract(land_aspect*msk)[,2]
      GEO$dzdx = terra::extract(dzdx*msk,GEO)[,2]
      GEO$dzdy = terra::extract(dzdy*msk,GEO)[,2]
      GEO$inlandD = terra::extract(inland_proximity*msk,GEO)[,2]
    }
    if(!returnpoints){
      GEO = terra::rast(list(dem,lons,lats,land_slope*msk,land_aspect*msk,inland_proximity*msk,f,dzdx,dzdy))
      names(GEO) = c("dem","lons","lats","slope","aspect","inlandD","f","dzdx","dzdy")
    }
    return(GEO)
}



#' Calculate Additional TC Parameters, and temporally Interpolate Along a Tropical Cyclone Track
#'
#' @param outdate POSIX times to be interpolated to
#' @param indate POSIX input times
#' @param TClons input central TC longitude
#' @param TClats input central TC latitude
#' @param vFms input forward velocity of TC
#' @param thetaFms input forward direction
#' @param cPs central pressure
#' @param rMaxModel empirical model for radius of maximum wind calculation (rMax in km)
#' @param vMaxModel empirical model for maximum wind velocity calculation (vMax in m/s)
#' @param betaModel empirical model for TC shape parameter beta (dimensionless Beta)
#' @param rMax2Model empirical model for radius of outer 17.5ms wind calculation (rMax2 in km)
#' @param eP background environmental pressure (hPa)
#' @param rho air density
#' @param RMAX If params rMaxModel value is NA, use input TC$RMAX
#' @param VMAX If params rMaxModel value is NA, use input TC$VMAX
#' @param B If params rMaxModel value is NA, use input TC$B
#' @param RMAX2 If params rMax2Model value is NA, use input TC$RMAX2
#'
#' @return list of track data inclining the rMax vMax and Beta.
#' @export
#'
#' @examples
#' paramsTable <- read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' params <- array(paramsTable$value,dim = c(1,length(paramsTable$value)))
#' colnames(params) <- paramsTable$param
#' params <- data.frame(params)
#' require(terra)
#' TCi <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TCi$PRES <- TCi$BOM_PRES
#' TCi$RMAX <- TCi$BOM_RMW*1.852 #convert from nautical miles to km
#' TCi$VMAX <- TCi$BOM_WIND*1.94 #convert from knots to m/s
#' TCi$B <- 1.4
#' TCi$RMAX2 <- 150 
#' t1 <- strptime("2011-02-01 09:00:00","%Y-%m-%d %H:%M:%S", tz = "UTC") #first date in POSIX format
#' t2 <- strptime(rev(TCi$ISO_TIME)[1],"%Y-%m-%d %H:%M:%S", tz = "UTC") #last date in POSIX format
#' outdate <- seq(t1,t2,"hour") #array sequence from t1 to t2 stepping by “hour”
#' # defult along track parameters are calculated
#' TCil = update_Track(outdate = outdate,
#'                    indate = strptime(TCi$ISO_TIME,"%Y-%m-%d %H:%M:%S", tz = "UTC"),
#'                    TClons = TCi$LON,
#'                    TClats = TCi$LAT,
#'                    vFms=TCi$STORM_SPD,
#'                    thetaFms=TCi$thetaFm,
#'                    cPs=TCi$PRES,
#'                    rMaxModel=params$rMaxModel,
#'                    vMaxModel=params$vMaxModel,
#'                    betaModel=params$betaModel,
#'                    rMax2Model = params$rMaxModel,
#'                    eP = params$eP,
#'                    rho = params$rhoa,
#'                    RMAX = TCi$RMAX,
#'                    VMAX = TCi$VMAX,
#'                    B = TCi$B,
#'                    RMAX2 = TCi$RMAX2
#'                    )
#' # 'observed' along tack parameters are calculated (#Model = NA)                   
#' TCil = update_Track(outdate = outdate,
#'                    indate = strptime(TCi$ISO_TIME,"%Y-%m-%d %H:%M:%S", tz = "UTC"),
#'                    TClons = TCi$LON,
#'                    TClats = TCi$LAT,
#'                    vFms=TCi$STORM_SPD,
#'                    thetaFms=TCi$thetaFm,
#'                    cPs=TCi$PRES,
#'                    rMaxModel=NA,
#'                    vMaxModel=NA,
#'                    betaModel=NA,
#'                    rMax2Model = NA,
#'                    eP = params$eP,
#'                    rho = params$rhoa,
#'                    RMAX = TCi$RMAX,
#'                    VMAX = TCi$VMAX,
#'                    B = TCi$B,
#'                    RMAX2 = TCi$RMAX2
#'                    )
update_Track <- function(outdate = NULL, indate, TClons, TClats, vFms, thetaFms, cPs,
                         rMaxModel, vMaxModel, betaModel,rMax2Model, eP, rho = NULL,RMAX,VMAX,B,RMAX2) {
  TRACK <- list()
  TRACK$eP <- eP
  TRACK$rho <- rho
  if(is.na(rMaxModel) & all(is.na(RMAX))) stop("If params rMaxModel value is NA, please provide non-NA TC$RMAX")
  if(is.na(vMaxModel) & all(is.na(VMAX))) stop("If params vMaxModel value is NA, please provide non-NA TC$VMAX")
  if(is.na(betaModel) & all(is.na(B))) stop("If params betaModel value is NA, please provide non-NA TC$B")
  if(is.na(rMax2Model) & all(is.na(RMAX2))) stop("If params rmax2Model value is NA, please provide non-NA TC$RMAX2")
  if(!is.na(rMaxModel)) if(rMaxModel == 5 & all(is.na(RMAX2))) stop("If params rmaxModel value is 5 (Chavas & Knaff 2022), please provide non-NA TC$RMAX2")

  odatei <- as.numeric(indate)
  indatei <- as.numeric(indate)
  if (!is.null(outdate[1])) { # interpolate track to out time steps with approx fun
    
    outdatei <- as.numeric(outdate)
    odatei <- stats::approx(indatei, indatei, outdatei)$y
    TClons <- stats::approx(indatei, TClons, outdatei)$y
    TClats <- stats::approx(indatei, TClats, outdatei)$y
    vFms <- stats::approx(indatei, vFms, outdatei)$y
    thetaFms <- stats::approx(indatei, thetaFms, outdatei)$y
    cPs <- stats::approx(indatei, cPs, outdatei)$y
  }

  s <- !is.na(cPs) # which values to keep
  if (length(s) < 1) {
    stop("A non-NA Central Pressure value is required")
  }

  TRACK$TClons <- TClons[s]
  TRACK$TClats <- TClats[s]
  TRACK$vFms <- vFms[s]
  TRACK$thetaFms <- thetaFms[s]
  TRACK$cPs <- cPs[s]
  TRACK$odatei <- odatei[s]

  TRACK$dPs <- (eP - TRACK$cPs) # pressure deficit assumed to be 1013 hPa

  TRACK$dt <- c(diff(TRACK$odatei), 0)
  TRACK$dPdt <- c(diff(TRACK$cPs), 0) / (TRACK$dt / 3600) # hPa per hour from Holland 2008
  if (length(s) == 1) {
    TRACK$dt <- 3600
    TRACK$dPdt <- 0.1
  }
  TRACK$dPdt[is.nan(TRACK$dPdt)] <- 0

  # Radius of maximum winds model selection
  if (length(rMaxModel) > 1) {
    TRACK$rMax <- rMaxModel # use the input values
  }
  if (length(rMaxModel) == 1) {
    if(!is.na(rMaxModel)){
      
      if(rMaxModel <= 4) TRACK$rMax <- rMax_modelsR(rMaxModel = rMaxModel, TClats = TRACK$TClats, cPs = TRACK$cPs, eP = eP,
                               dPdt = TRACK$dPdt, vFms = TRACK$vFms, rho = rho)
      # Chavas & Knaff (2022) is untested in this software
      if(rMaxModel == 5) { 
        TRACK$rMax2 = RMAX2
        TRACK$rMax <- rMax_modelsR(rMaxModel = rMaxModel, TClats = TRACK$TClats, cPs = TRACK$cPs, eP = eP,
                                                  dPdt = TRACK$dPdt, vFms = TRACK$vFms, rho = rho, R175ms = TRACK$rMax2,vMax = TRACK$vMax)
      }
    }
    if(is.na(rMaxModel)) {
      if (is.null(outdate[1])) TRACK$rMax <- RMAX[s]
      if (!is.null(outdate[1])) TRACK$rMax <- stats::approx(indatei, RMAX, outdatei)$y[s]
    }
  }

  
  # Compute the Coriolis parameter
  TClatrad <- TRACK$TClats * pi / 180.0
  wearth <- pi * (1.0 / 24.0) / 1800.0
  TRACK$f <- 2.0 * wearth * sin(TClatrad)

  # Maximum wind speed models selection
  if (length(vMaxModel) > 1) {
    TRACK$vMax <- vMaxModel
  }
  if (length(vMaxModel) == 1) {
    if(!is.na(vMaxModel)) if(vMaxModel <= 4) TRACK$vMax <- vMax_modelsR(vMaxModel = vMaxModel, cPs = TRACK$cPs, eP = eP, vFms = TRACK$vFms,
                               TClats = TRACK$TClats, dPdt = TRACK$dPdt, beta = 1.3, rho = rho) # Holland 80 beta = 1.3
    if(is.na(vMaxModel)) {
      if(is.null(outdate[1])) TRACK$vMax <- VMAX[s]
      if(!is.null(outdate[1])) TRACK$vMax <- stats::approx(indatei, VMAX, outdatei)$y[s]
    }
  }

  # Beta parameter model selection
  if (length(betaModel) > 1) {
    beta <- betaModel
  }
  if (length(betaModel) == 1) {
    if(!is.na(betaModel)) if(betaModel <= 4) TRACK$beta <- beta_modelsR(betaModel = betaModel, vMax = TRACK$vMax, rMax = TRACK$rMax, cPs = TRACK$cPs,
                             eP = TRACK$eP, vFms = TRACK$vFms, TClats = TRACK$TClats, dPdt = TRACK$dPdt)
    if(is.na(betaModel)) {
      if(is.null(outdate[1]))TRACK$beta <- B[s]
      if(!is.null(outdate[1])) TRACK$beta <- stats::approx(indatei, B, outdatei)$y[s]
    }
  }
  
  # Radius of outer 17.5m/s winds model selection
  if (length(rMax2Model) > 1) {
    TRACK$rMax2 <- rMax2Model # use the input values
  }
  if (length(rMax2Model) == 1) {
    if(!is.na(rMax2Model)) if(rMax2Model <= 2) TRACK$rMax2 <- rMax2_modelsR(rMax2Model = rMax2Model, vMax = TRACK$vMax, rMax = TRACK$rMax, TClats = TRACK$TClats)
    if(is.na(rMax2Model)) {
      if (is.null(outdate[1])) TRACK$rMax2 <- RMAX2[s]
      if (!is.null(outdate[1])) TRACK$rMax2 <- stats::approx(indatei, RMAX2, outdatei)$y[s]
    }
    
  }
  

  return(TRACK)
}



#' Temporally Interpolate Along a Tropical Cyclone Track And Compute Along-Track Parameters
#'
#' @param outdate POSIX times to be interpolated to. The output date in "YYYY-MM-DD" format. Default is NULL.
#' @param TC SpatVector of Tropical cyclone track parameters
#' @param paramsTable Global parameters to compute TC Hazards.
#'
#' @return SpatVector of Tropical cyclone track parameters
#' @export
#'
#' @examples
#' require(terra)
#' TCi <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TCi$PRES <- TCi$BOM_PRES
#' TCi$PRES[is.na(TCi$PRES)] = 1010
#' outdate = seq(strptime(TCi$ISO_TIME[1],"%Y-%m-%d %H:%M:%S",tz="UTC"),
#' strptime(rev(TCi$ISO_TIME)[1],"%Y-%m-%d %H:%M:%S",tz="UTC"),3600)
#' paramsTable = read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' TCii = TCvectInterp(outdate = outdate,TC=TCi,paramsTable = paramsTable)
#'
TCvectInterp = function(outdate = NULL, TC, paramsTable) {
  # Extract and organize the parameters from the paramsTable
  gt = terra::geomtype(TC)
  if(gt == "points") TC = TCpoints2lines(TC) #convert TC points to lines
  
  if(is.null(TC$LAT[1])){
    gg = terra::geom(TC)
    gg = gg[seq(1,2*length(TC),2),]
    TC$LON = gg[,3]
    TC$LAT = gg[,4]
  }
  if(is.null(TC$STORM_SPD[1])) {
    TC$STORM_SPD = terra::perim(TC)/(1*3600) #m/s
    warning("time step of track is assumed 1hr, please specify TC$STORM_SPD")
  }
  if(is.null(TC$thetaFm[1])) {
    TC$thetaFm = 90-returnBearing(TC)
  }
  
  params <- array(paramsTable$value, dim = c(1, length(paramsTable$value)))
  colnames(params) <- paramsTable$param
  params <- data.frame(params)

  # Convert the date in ISO_TIME to POSIX class
  indate <- strptime(TC$ISO_TIME, "%Y-%m-%d %H:%M:%S", tz = "UTC")

  # Interpolate and reformat the track data if outdate is provided
  TRACK <- update_Track(outdate = outdate, indate = indate, TClons = TC$LON, TClats = TC$LAT,
                        vFms = TC$STORM_SPD, thetaFms = TC$thetaFm, cPs = TC$PRES,
                        rMaxModel = params$rMaxModel, vMaxModel = params$vMaxModel,
                        betaModel = params$betaModel, rMax2Model = params$rMaxModel, eP = params$eP, rho = params$rhoa,
                        RMAX = TC$RMAX,VMAX = TC$VMAX,B = TC$B, RMAX2 = TC$RMAX2
                        )
   
  # Create a spatial vector from the interpolated track data
  v <- terra::vect(cbind(TRACK$TClons, TRACK$TClats))
  v$NAME <- TC$NAME
  v$date <- paste(TRACK$odatei + strptime("1970-01-01 00:00", "%Y-%m-%d %H:%M", tz = "UTC"))
  v$rMax <- TRACK$rMax
  v$vMax <- TRACK$vMax
  v$beta <- TRACK$beta
  v$rMax2 <- TRACK$rMax2
  v$dPdt <- TRACK$dPdt
  v$cP <- TRACK$cPs
  v$TClat <- TRACK$TClats
  v$vFm <- TRACK$vFm
  
  
  v$LON <- TRACK$TClons
  v$LAT <- TRACK$TClats
  v$PRES = TRACK$cPs
  v$TClats = TRACK$TClats
  v$STORM_SPD = v$vFm 
  v$ISO_TIME = v$date
  v$thetaFm <- TRACK$thetaFms
  
  v_l = TCpoints2lines(v) #return lines rather than points
  
  return(v_l)
}



#' Compute the Wind Hazards Associated Over the Period of a TCs Event at one Given Location
#'
#' @param outdate array of POSITx date times to linearly interpolate TC track,optional.
#' @param GEO_land dataframe hazard geometry generated with land_geometry
#' @param TC SpatVector of Tropical cyclone track parameters
#' @param paramsTable Global parameters to compute TC Hazards.
#' @param returnWaves Return ocean wave parameters (default = FALSE)
#'
#' @return list() containing a timeseries
#'
#'
#' |  abbreviated attribute       |  description           |  units  |
#' | ------------- | ------------- | ------------- |
#' | date      | POSIX data time object of TC or outdate if provided  |  as.POSIX  |
#' | P      | Atmospheric pressure |  hPa  |
#' | Uw      | Meridional  wind speed  |  m/s  |
#' | Vw      | Zonal wind speed  |  m/s  |
#' | Sw      | Wind speed  |  m/s  |
#' | R      | distance to TC centre  |  m  |
#' | rMax      | radius of maximum wind  |  km  |
#' | vMax      | TC maximum velocity  |  m/s  |
#' | b      | TC wind profile exponent  |  -  |
#' | CP      | TC central Pressure  |  hPa  |
#' | dPdt      | change in TC CP per hour  |  hPa/hr  |
#' | vFm      | velocity of TC forward motion  |  m/s  |
#' | Hs0    | Deep water significant wave height | m |
#' | Tp0    | Deep water Peak wave period | s |
#' | Dp0    | The peak direction in which wave are heading | deg clockwise from true north. |
#'
#' @details The function calculates wind speed and direction time series from a tropical cyclone track using various wind profile models.
#' @md
#'
#' @export
#'
#' @examples
#' GEO_land = data.frame(dem=0,lons = 147,lats=-18,f=-4e-4,inlandD = 0)
#'
#' require(terra)
#' TCi <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TCi$PRES <- TCi$BOM_PRES
#'
#' paramsTable = read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' HAZts = TCHazaRdsWindTimeSereies(GEO_land=GEO_land,TC=TCi,paramsTable = paramsTable)
#' main =  paste(TCi$NAME[1],TCi$SEASON[1],"at",GEO_land$lons,GEO_land$lats)
#' #with(HAZts,plot(date,Sw,format = "%b-%d %H",type="l",main = main,ylab = "Wind speed [m/s]"))
TCHazaRdsWindTimeSereies <- function(outdate = NULL, GEO_land = NULL, TC, paramsTable,returnWaves = FALSE) {
  # Extract parameters from the paramsTable and convert them into a data frame.
  params <- array(paramsTable$value, dim = c(1, length(paramsTable$value)))
  colnames(params) <- paramsTable$param
  params <- data.frame(params)

  # Convert ISO_TIME to POSIX format
  indate <- strptime(TC$ISO_TIME, "%Y-%m-%d %H:%M:%S", tz = "UTC")

  # Reformat and interpolate the track if outdate is provided
  TRACK <- update_Track(outdate = outdate, indate = indate, TClons = TC$LON, TClats = TC$LAT,
                        vFms = TC$STORM_SPD, thetaFms = TC$thetaFm, cPs = TC$PRES,
                        rMaxModel = params$rMaxModel, vMaxModel = params$vMaxModel,
                        betaModel = params$betaModel, rMax2Model = params$rMax2Model, eP = params$eP, rho = params$rhoa,
                        RMAX = TC$RMAX,VMAX = TC$VMAX,B = TC$B,RMAX2 = TC$RMAX2)

  # Extract geographical land information
  lon <- GEO_land$lons
  lat <- GEO_land$lats

  # Calculate distance from the center to each grid point
  Rlam <- with(TRACK, RdistPi(Gridlon = lon, Gridlat = lat, TClon = TClons, TClat = TClats))
  R <- Rlam[, 1]
  lam <- Rlam[,2]
  # Calculate pressure based on pressure profile model
  if (params$pressureProfileModel == 0)
    P <- with(TRACK, HollandPressureProfilePi(rMax = rMax, dP = dPs, cP = cPs, beta = beta, R = R))
  if (params$pressureProfileModel == 2)
    P <- with(TRACK, DoubleHollandPressureProfilePi(rMax = rMax,rMax2 = rMax2, dP = dPs, cP = cPs, beta = beta, R = R))

  # Calculate wind speed and direction based on wind profile model
  fs <- rep(GEO_land$f, length(R))
  if (params$windProfileModel == 0)
    VZ <- with(TRACK, HollandWindProfilePi(f = fs, vMax = vMax, rMax = rMax, dP = dPs, rho = rho, beta = beta, R = R))
  if (params$windProfileModel == 1)
    VZ <- with(TRACK, NewHollandWindProfilePi(f = fs, vMax = vMax, rMax = rMax, rMax2 = rMax2, dP = dPs, rho = rho, beta = beta, R = R))
  if (params$windProfileModel == 2)
    VZ <- with(TRACK, DoubleHollandWindProfilePi(f = fs, vMax = vMax, rMax = rMax, rMax2 = rMax2, dP = dPs, rho = rho, beta = beta, R = R, cP = cPs))
  if (params$windProfileModel == 4)
    VZ <- with(TRACK, JelesnianskiWindProfilePi(f = fs, vMax = vMax, rMax = rMax, R = R))

  V <- VZ[, 1]

  # Calculate wind vortex model
  if (params$windVortexModel == 0)
    UV <- with(TRACK, KepertWindFieldPi(rMax = rMax, vMax = vMax, vFm = vFms, thetaFm = thetaFms, f = fs, Rlam = Rlam, VZ = VZ, surface = params$surface))
  if (params$windVortexModel == 1)
    UV <- with(TRACK, HubbertWindFieldPi(rMax = rMax, vFm = vFms, thetaFm = thetaFms, f = fs, Rlam = Rlam, V = V, surface = params$surface))
  if (params$windVortexModel == 2)
    UV <- with(TRACK, McConochieWindFieldPi(rMax = rMax, vMax = vMax, vFm = vFms, thetaFm = thetaFms, Rlam = Rlam, V = V, f = fs[1], surface = params$surface))

  Uw <- UV[, 1]
  Vw <- UV[, 2]

  # Calculate wind direction from wind components
  Va <- atan2(Vw, Uw)
  Dw <- 90 - (Va - pi) * 180 / pi # Convert to clockwise from true north
  Dw[Dw < 0 & !is.na(Dw)] <- 360 + Dw[Dw < 0 & !is.na(Dw)]
  Dw[Dw > 360 & !is.na(Dw)] <- Dw[Dw > 360 & !is.na(Dw)] - 360

  # Calculate wind decay based on parameters
  decay <- 1
  a <- c(params$Decay_a1, params$Decay_a2, params$Decay_a3)
  if (a[1] != 0 & params$surface == 1) {
    decay <- inlandWindDecay(GEO_land$inlandD / 1000, a)
    decay[is.na(decay)] <- 1
  }

  # Bias-correct winds and correct for surface roughness
  Sw <- sqrt(Uw^2 + Vw^2) * decay

  Uw <- cos(Va) * Sw
  Vw <- sin(Va) * Sw
  if(returnWaves){  
    # significant wave heights OGrady 2024 JCR eq 1
    Sww = Sw
    Sww[R < TRACK$rMax & Sww < 10] = 10 #lift winds in the eye so there are always waves
    dP = params$eP-TRACK$PRES
    Hs0 = params$Wave_a*Sww^params$Wave_x + params$Wave_b*TRACK$dPs + params$Wave_c*TRACK$vFm
    Hs0[Hs0 < 0] = 0
    Hs0[GEO_land$dem > 0] = NA
    Hs0[R < TRACK$rMax & Hs0 < 2] = 2
    # wave period Young 2017 eq 4
    e0 = 96.04*(Hs0^2/16)/(Sww^4)
    nu0 = (e0/6.365e-6)^-0.303
    Tp0 = Sww/(nu0*9.8)
    
    #Wave directions
    fs = sign(TRACK$f[1])
    d = fs*c(0.0,   22.5,   67.5,  112.5,  157.5,180,-180, -157.5, -112.5,  -67.5,  -22.5,  -0.01)
    #Wave ang outward from the wind Tamizi & Young 2020 (Pers comms)
    TRACK$thetaFm[TRACK$thetaFm < -180] =  360+TRACK$thetaFm[TRACK$thetaFm < -180]
    TRACK$thetaFm[TRACK$thetaFm > 180] = -360+TRACK$thetaFm[TRACK$thetaFm >= 180]
    wwang = fs*c(54,52,36,27,16,56,56,92,104,79,56,54)
    ang = (90.0-lam) - (90-TRACK$thetaFm) #orientate clockwise to the forward motion thetaFm in degrees
    ang[ang < -180] =  360+ang[ang < -180]
    ang[ang >= 180] = -360+ang[ang >= 180]
    p2a = approx(d,wwang,ang)$y
    Dp0 = Dw-180+p2a
    Dp0[Dp0 < 0] = 360 + Dp0[Dp0 < 0]
    Dp0[GEO_land$dem > 0] = NA
  }
  # Create and populate the output list
  v <- list() # time series list
  v$date <- TRACK$odatei + strptime("1970-01-01 00:00", "%Y-%m-%d %H:%M", tz = "UTC")
  v$Uw <- cos(Va) * Sw
  v$Vw <- sin(Va) * Sw
  v$Sw <- Sw
  v$Dw <- Dw
  v$P <- P
  v$R <- R
  v$lam <- lam
  v$rMax <- TRACK$rMax
  v$vMax <- TRACK$vMax
  v$beta <- TRACK$beta
  v$rMax2 <- TRACK$rMax2
  v$dPdt <- TRACK$dPdt
  v$cP <- TRACK$cPs
  v$TClat <- TRACK$TClats
  v$vFm <- TRACK$vFm
  v$thetaFm <- TRACK$thetaFm
  if(returnWaves){
    v$Hs0 <- Hs0
    v$Tp0 <- Tp0
   v$Dp0 <- Dp0
  }
  return(v)
}

#' Compute the Wind and Pressure Spatial Hazards Field Associated with TCs Single Time Step.
#'
#' @param GEO_land SpatVector or dataframe hazard geometry generated with land_geometry
#' @param TC SpatVector or data.frame of Tropical cyclone track parameters for a single time step.
#' @param paramsTable Global parameters to compute TC Hazards.
#' @param return_vars character(). Variables to return. Default: core winds/pressure.
#'        Options: c("Pr","Uw","Vw","Sw","Dw","R","lam","Ww","Hs0","Tp0","Dp0")
#' @param returnWaves DEPRECATED. Use return_vars including 'Hs0','Tp0','Dp0' instead
#'
#' @return SpatRaster with the following attributes
#'
#'
#'
#' | abbreviated variable       | description     | units |
#' | ------------- | -------------|  -------------|
#' | P      | Atmospheric pressure | hPa  |
#' | Uw     | Meridional  wind speed | m/s |
#' | Vw     | Zonal wind speed | m/s |
#' | Ww     | Vertical wind speed | m/s |
#' | Sw     | Wind speed | m/s |
#' | Dw     | The direction from which wind originates | deg clockwise from true north   |
#' | Hs0    | Deep water significant wave height | m |
#' | Tp0    | Deep water Peak wave period | s |
#' | Dp0    | The peak direction in which wave are heading | deg clockwise from true north |
#' | R      | The radial distance to the TC centre | km |
#' | lam    | The radial direction to the TC centre | deg |    
#'
#' @md
#'
#' @export
#'
#' @examples
#' require(terra)
#' dem <- rast(system.file("extdata/DEMs/YASI_dem.tif", package="TCHazaRds"))
#' land <- dem; land[land > 0] = 0
#' inland_proximity = distance(land,target = 0)
#' GEO_land = land_geometry(dem,inland_proximity)
#'
#' TCi = vect(cbind(c(154,154),c(-26.1,-26)),"lines",crs="epsg:4283") #track line segment
#' TCi$PRES = 950
#' TCi$RMAX = 40
#' TCi$VMAX = 60
#' TCi$B = 1.4
#' TCi$ISO_TIME = "2022-10-04 20:00:00"
#' TCi$LON = geom(TCi)[1,3]
#' TCi$LAT = geom(TCi)[1,4]
#' TCi$STORM_SPD = perim(TCi)/(3*3600) #m/s
#' TCi$thetaFm = 90-returnBearing(TCi)
#' #OR
#' TC <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TC$PRES <- TC$BOM_PRES
#' TCi = TC[47]
#' plot(dem);lines(TCi,lwd = 4,col=2)
#'
#' paramsTable = read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' #calculate the wind hazard
#' HAZ = TCHazaRdsWindField(GEO_land,TCi,paramsTable)
#' plot(HAZ)
#'
#' #require(rasterVis) #pretty spatial vector plot
#' #ats = seq(0, 80, length=9)
#' #UV = as(c(HAZ["Uw"],HAZ["Vw"]),"Raster") #need to convert back to raster
#' #vectorplot(UV, isField='dXY', col.arrows='white', aspX=0.002,aspY=0.002,at=ats ,
#' #colorkey=list( at=ats), par.settings=viridisTheme)
#'
TCHazaRdsWindField <- function(GEO_land, TC, paramsTable,return_vars = c("Pr","Uw","Vw","Sw","Dw","R","lam"),returnWaves = NULL) {
  # Figure out which optional fields are needed
  if (!is.null(returnWaves)) {
    warning("Argument 'returnWaves' is deprecated and will be removed in a future release. ",
            "Please include 'Hs0', 'Tp0', and/or 'Dp0' in return_vars instead.")
    # For backward compatibility, honour returnWaves if TRUE
    if (isTRUE(returnWaves)) {
      return_vars <- unique(c(return_vars, "Hs0", "Tp0", "Dp0"))
    }
  }
  
  returnWaves        <- any(c("Hs0","Tp0","Dp0") %in% return_vars)
  returnVerticalWind <- any(c("Ww") %in% return_vars)
  
  # Extract parameters from paramsTable
  params <- array(paramsTable$value, dim = c(1, length(paramsTable$value)))
  colnames(params) <- paramsTable$param
  params <- data.frame(params)
  
  if ("Ww" %in% return_vars) warning("Variable 'Ww' (vertical wind) is experimental: under active development")
  if ("Ww" %in% return_vars && params$windVortexModel != 0) {
    stop("Vertical wind (Ww) can only be returned when using the Kepert vortex model (params$windVortexModel == 0).")
  }  

  # Convert TC dates to POSIX class if necessary
  if (methods::is(TC, "SpatVector")) {
    indate <- strptime(TC$ISO_TIME, "%Y-%m-%d %H:%M:%S", tz = "UTC")
    # Reformat track data
    TRACK <- update_Track(outdate = NULL, indate = indate, TClons = TC$LON, TClats = TC$LAT, vFms = TC$STORM_SPD, thetaFms = TC$thetaFm,
                          cPs = TC$PRES, rMaxModel = params$rMaxModel, vMaxModel = params$vMaxModel, betaModel = params$betaModel, rMax2Model = params$rMax2Model, 
                          eP = params$eP, rho = params$rhoa,RMAX = TC$RMAX,VMAX = TC$VMAX,B = TC$B, RMAX2 = TC$RMAX2)
  } else if (methods::is(TC, "data.frame")) {
    TRACK <- TC
    indate <- strptime("1970-01-01 00:00:00", "%Y-%m-%d %H:%M:%S", tz = "UTC") + TRACK$odatei
  }

  # Check if the central pressure value is provided
  if (is.na(TRACK$cPs)) {
    stop("Central pressure value must be provided")
  }

  lon <- as.numeric(terra::values(GEO_land$lons))
  lat <- as.numeric(terra::values(GEO_land$lats))
  Rlam <- with(TRACK, Rdist(Gridlon = lon, Gridlat = lat, TClon = TClons, TClat = TClats))
  R <- Rlam[, 1]

  # Calculate pressure profile based on the selected model
  if (params$pressureProfileModel == 0) {
    P <- with(TRACK, HollandPressureProfile(rMax = rMax, dP = dPs, cP = cPs, beta = beta, R = R))
  } else if (params$pressureProfileModel == 2) {
    P <- with(TRACK, DoubleHollandPressureProfile(rMax = rMax, rMax2 = rMax2, dP = dPs, cP = cPs, beta = beta, R = R))
  }

  # Calculate wind profile based on the selected model
  fs <- as.numeric(terra::values(GEO_land$f))
  if (params$windProfileModel == 0) {
    VZ <- with(TRACK, HollandWindProfile(f = f, vMax = vMax, rMax = rMax, dP = dPs, rho = rho, beta = beta, R = R))
  } else if (params$windProfileModel == 1) {
    VZ <- with(TRACK, NewHollandWindProfile(f = f, vMax = vMax, rMax = rMax, rMax2 = rMax2, dP = dPs, rho = rho, beta = beta, R = R))
  } else if (params$windProfileModel == 2) {
    VZ <- with(TRACK, DoubleHollandWindProfile(f = f, vMax = vMax, rMax = rMax, rMax2 = rMax2, dP = dPs, rho = rho, beta = beta, R = R, cP = cPs))
  } else if (params$windProfileModel == 4) {
    VZ <- with(TRACK, JelesnianskiWindProfile(f = f, vMax = vMax, rMax = rMax, R = R))
  }

  V <- VZ[, 1]

  # Calculate wind vortex field based on the selected model
  if (params$windVortexModel == 0) {
    
    if(!returnVerticalWind) {
      UVKs <- with(TRACK, KepertWindField(rMax = rMax, vMax = vMax, vFm = vFms, thetaFm = thetaFms, f = f, Rlam = Rlam, VZ = VZ, surface = params$surface))
      UV <- UVKs[,1:2]
    }

    if(returnVerticalWind){
      UVKsWs <- with(TRACK, KepertVerticalWindField(
        rMax = rMax, vMax = vMax, vFm = vFms, thetaFm = thetaFms, f = f,
        Rlam = Rlam, VZ = VZ, surface = params$surface,
        dr_m = 100.0  # optional; defaults to 10 m
      ))
      Ww <- GEO_land["lons"] / GEO_land["lons"]
      terra::values(Ww) <- (UVKsWs[,4])
      
      terra::time(Ww) <- indate
      terra::units(Ww) <- "m/s"
      terra::longnames(Ww) <- "vertical_wind"
      
      UV = UVKsWs[,1:2]
    }
    
  } else if (params$windVortexModel == 1) {
    UV <- with(TRACK, HubbertWindField(rMax = rMax, vFm = vFms, thetaFm = thetaFms, f = f, Rlam = Rlam, V = V, surface = params$surface))
  } else if (params$windVortexModel == 2) {
    UV <- with(TRACK, McConochieWindField(rMax = rMax, vMax = vMax, vFm = vFms, thetaFm = thetaFms, Rlam = Rlam, V = V, f = f, surface = params$surface))
  }

  # Extract wind components
  ept <- GEO_land["lons"] / GEO_land["lons"]
  Pr <- ept
  terra::values(Pr) <- P
  Uw <- ept
  terra::values(Uw) <- UV[, 1]
  Vw <- ept
  terra::values(Vw) <- UV[, 2]

  # Calculate wind speed and wind direction
  Sw <- sqrt(Uw^2 + Vw^2)
  Va <- terra::atan2(Vw, Uw)
  #add pi to get direction from, then remove direction from from 90 to get clockwise from north
  Dw <- 90 - (Va - pi ) * 180 / pi # Convert to clockwise from true north
  Dwv <- terra::values(Dw)

  # Adjust wind direction to be within the range [0, 360]
  s <- which(Dwv < 0 & !is.na(Dwv))
  if (length(s) > 0) {
    Dw[s] <- 360 + Dw[s]
  }
  s <- which(Dwv > 360 & !is.na(Dwv))
  if (length(s) > 0) {
    Dw[s] <- Dw[s] - 360
  }

  # Calculate wind decay based on surface roughness
  decay <- 1
  a <- c(params$Decay_a1, params$Decay_a2, params$Decay_a3)
  if (a[1] != 0 & params$surface == 1) {
    decay <- inlandWindDecay(GEO_land$inlandD / 1000, a)
    decay[is.na(decay)] <- 1
  }

  # Bias-correct winds and correct for surface roughness
  Sw <- Sw * decay
  Uw <- cos(Va) * Sw
  Vw <- sin(Va) * Sw

  R <- ept
  terra::values(R) <- Rlam[,1]

  lam <- ept
  terra::values(lam) <- Rlam[,2]

  if(returnWaves){  
    # significant wave heights OGrady 2024 JCR eq 1
    Sww = Sw
    Sww[R < TRACK$rMax & Sww < 10] = 10 #lift winds in the eye so there are always waves
    dP = params$eP-TRACK$PRES
    Hs0 = params$Wave_a*Sww^params$Wave_x + params$Wave_b*TRACK$dPs + params$Wave_c*TRACK$vFm
    Hs0[Hs0 <0] = 0
    Hs0[GEO_land$dem > 0] = NA
    Hs0[R < TRACK$rMax & Hs0 < 2] = 2
    # wave period Young 2017 eq 4
    e0 = 96.04*(Hs0^2/16)/(Sww^4)
    nu0 = (e0/6.365e-6)^-0.303
    Tp0 = Sww/(nu0*9.8)
    
    #Wave directions
    fs = sign(TRACK$f)
    d = fs*c(0.0,   22.5,   67.5,  112.5,  157.5,180,-180, -157.5, -112.5,  -67.5,  -22.5,  -0.01)
    #Wave ang outward from the wind Tamizi & Young 2020 (Pers comms)
    TRACK$thetaFm[TRACK$thetaFm < -180] =  360+TRACK$thetaFm[TRACK$thetaFm < -180]
    TRACK$thetaFm[TRACK$thetaFm > 180] = -360+TRACK$thetaFm[TRACK$thetaFm >= 180]
    wwang = fs*c(54,52,36,27,16,56,56,92,104,79,56,54)
    ang = (90.0-lam) - (90-TRACK$thetaFm) #orientate clockwise to the forward motion thetaFm in degrees
    ang[ang < -180] =  360+ang[ang < -180]
    ang[ang >= 180] = -360+ang[ang >= 180]
    p2av = approx(d,wwang,terra::values(ang))$y
    p2a <- ept
    terra::values(p2a) <- p2av
    Dp0 = Dw-180+p2a
    Dp0[Dp0 < 0] = 360 + Dp0[Dp0 < 0]
    Dp0[GEO_land$dem > 0] = NA
    
    terra::time(Hs0) <- indate
    terra::units(Hs0) <- "m"
    terra::longnames(Hs0) <- "Deep_water_significant_wave_height"
    
    terra::time(Tp0) <- indate
    terra::units(Tp0) <- "s"
    terra::longnames(Tp0) <- "peak_wave_period"
    
    terra::time(Dp0) <- indate
    terra::units(Dp0) <- "Deg"
    terra::longnames(Dp0) <- "peak_wave_direction"
    
    
  }
  
  # Create a raster stack with wind field components
  terra::time(Pr) <- indate
  terra::units(Pr) <- "hPa"
  terra::longnames(Pr) <- "air_pressure_at_sea_level"

  terra::time(Uw) <- indate
  terra::units(Uw) <- "m/s"
  terra::longnames(Uw) <- "eastward_wind"

  terra::time(Vw) <- indate
  terra::units(Vw) <- "m/s"
  terra::longnames(Vw) <- "northward_wind"

  terra::time(Sw) <- indate
  terra::units(Sw) <- "m/s"
  terra::longnames(Sw) <- "wind_speed"

  terra::time(Dw) <- indate
  terra::units(Dw) <- "Deg"
  terra::longnames(Dw) <- "wind_direction"
  
  terra::time(R) <- indate
  terra::units(R) <- "m"
  terra::longnames(R) <- "radial_distance_from_cyclone_centre"
  
  terra::time(lam) <- indate
  terra::units(lam) <- "deg"
  terra::longnames(lam) <- "radial_direction_from_cyclone_centre"
  
  all_outputs <- list(
    Pr  = Pr,
    Uw  = Uw,
    Vw  = Vw,
    Sw  = Sw,
    Dw  = Dw,
    Ww  = if(exists("Ww")) Ww else NULL,
    R   = R,
    lam = lam,
    Hs0 = if(exists("Hs0")) Hs0 else NULL,
    Tp0 = if(exists("Tp0")) Tp0 else NULL,
    Dp0 = if(exists("Dp0")) Dp0 else NULL
  )
  
  # Subset to requested variables only
  selected <- all_outputs[names(all_outputs) %in% return_vars]
  selected <- selected[!sapply(selected, is.null)]
  
  rout <- terra::rast(selected)
  names(rout) <- names(selected)
  
  return(rout)
}

#' Compute the Wind and Pressure Spatial Hazards Field Associated with TC track.
#'
#' @param outdate array of POSITx date times to linearly interpolate TC track
#' @param GEO_land SpatVector or dataframe hazard geometry generated with land_geometry
#' @param TC SpatVector of Tropical cyclone track parameters for a single time step
#' @param paramsTable Global parameters to compute TC Hazards
#' @param outfile character. Output netcdf filename
#' @param overwrite TRUE/FALSE, option to overwrite outfile
#' @param returnWaves DEPRECATED. Use return_vars including 'Hs0','Tp0','Dp0' instead
#' @param return_vars character(). Variables to return. Default: core winds/pressure.
#'        Options: c("Pr","Uw","Vw","Sw","Dw","R","lam","Ww","Hs0","Tp0","Dp0")
#' 
#' @return SpatRasterDataset with the following attributes.
#'
#'
#'
#' | abbreviated variable       | description     | units |
#' | ------------- | -------------|  -------------|
#' | P      | Atmospheric pressure | hPa  |
#' | Uw     | Meridional  wind speed | m/s |
#' | Vw     | Zonal wind speed | m/s |
#' | Ww     | Vertical wind speed | m/s |
#' | Sw     | Wind speed | m/s |
#' | Dw     | The direction from which wind originates | deg clockwise from true north   |
#' | Hs0    | Deep water significant wave height | m |
#' | Tp0    | Deep water Peak wave period | s |
#' | Dp0    | The peak direction in which wave are heading | deg clockwise from true north |
#' | R      | The radial distance to the TC centre | km |
#' | lam    | The radial direction to the TC centre | deg |    
#'
#' @md
#'
#' @export
#'
#' @examples
#' require(terra)
#' dem <- rast(system.file("extdata/DEMs/YASI_dem.tif", package="TCHazaRds"))
#' land <- dem; land[land > 0] = 0
#' inland_proximity = distance(land,target = 0)
#' GEO_land = land_geometry(dem,inland_proximity)
#'
#' TCi = vect(cbind(c(154,154),c(-26.1,-26)),"lines",crs="epsg:4283") #track line segment
#' TCi$PRES = 950
#' TCi$RMAX = 40
#' TCi$VMAX = 60
#' TCi$B = 1.4
#' TCi$ISO_TIME = "2022-10-04 20:00:00"
#' TCi$LON = geom(TCi)[1,3]
#' TCi$LAT = geom(TCi)[1,4]
#' TCi$STORM_SPD = perim(TCi)/(3*3600) #m/s
#' TCi$thetaFm = 90-returnBearing(TCi)
#' #OR
#' TC <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TC$PRES <- TC$BOM_PRES
#' plot(dem);lines(TC,lwd = 4,col=2)
#'
#' paramsTable = read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' #calculate the wind hazard
#'
#' outdate = seq(strptime(TC$ISO_TIME[44],"%Y-%m-%d %H:%M:%S",tz="UTC"),
#'               strptime(TC$ISO_TIME[46],"%Y-%m-%d %H:%M:%S",tz="UTC"),
#'               3600*3)
#' HAZi = TCHazaRdsWindFields(outdate=outdate,GEO_land=GEO_land,TC=TC,paramsTable=paramsTable)
#' plot(min(HAZi$Pr))
#'
TCHazaRdsWindFields <- function(outdate = NULL, GEO_land, TC, paramsTable,
                                outfile = NULL, overwrite = FALSE,
                                returnWaves = NULL,
                                return_vars = c("Pr","Uw","Vw","Sw","Dw")) {
  
  ## ---- Parameters table to named data.frame ----
  params <- data.frame(t(paramsTable$value))
  colnames(params) <- paramsTable$param
  
  ## ---- Deprecation shim for returnWaves ----
  if (!is.null(returnWaves)) {
    warning("Argument 'returnWaves' is deprecated and will be removed in a future release. ",
            "Please include 'Hs0', 'Tp0', and/or 'Dp0' in return_vars instead.")
    if (isTRUE(returnWaves)) {
      return_vars <- unique(c(return_vars, "Hs0","Tp0","Dp0"))
    }
  }
  
  ## ---- Validate vertical wind request against vortex model ----
  # Ww is only defined for Kepert vortex (params$windVortexModel == 0)
  if ("Ww" %in% return_vars) warning("Variable 'Ww' (vertical wind) is experimental: under active development")
  if ("Ww" %in% return_vars && !is.null(params$windVortexModel) && params$windVortexModel != 0) {
    stop("Vertical wind (Ww) can only be returned for Kepert vortex model (params$windVortexModel == 0).")
  }
  
  ## ---- Time handling and track reformat ----
  indate <- as.POSIXct(TC$ISO_TIME, format="%Y-%m-%d %H:%M:%S", tz="UTC")
  
  TRACK <- as.data.frame(update_Track(
    outdate = outdate,
    indate  = indate,
    TClons  = TC$LON,
    TClats  = TC$LAT,
    vFms    = TC$STORM_SPD,
    thetaFms= TC$thetaFm,
    cPs     = TC$PRES,
    rMaxModel = params$rMaxModel,
    vMaxModel = params$vMaxModel,
    rMax2Model= params$rMax2Model,
    betaModel = params$betaModel,
    eP       = params$eP,
    rho      = params$rhoa,
    RMAX = TC$RMAX, VMAX = TC$VMAX, B = TC$B, RMAX2 = TC$RMAX2
  ))
  
  # normalise names used by inner calls
  TRACK$PRES      <- TRACK$cPs
  TRACK$STORM_SPD <- TRACK$vFms
  TRACK$LON       <- TRACK$TClons
  TRACK$LAT       <- TRACK$TClats
  TRACK$thetaFm   <- TRACK$thetaFms
  
  ## ---- Compute selected fields at each (valid) time step ----
  valid_idx <- which(!is.na(TRACK$cPs))
  if (length(valid_idx) == 0L) stop("No valid cPs values in TRACK; cannot compute hazards.")
  
  HAZ_l <- lapply(valid_idx, function(i)
    TCHazaRdsWindField(
      GEO_land    = GEO_land,
      TC          = TRACK[i, ],
      paramsTable = paramsTable,
      return_vars = return_vars   # <- inner function auto-computes waves/Ww as needed
    )
  )
  
  ## ---- Determine available variables from first element ----
  vars_present <- names(HAZ_l[[1L]])
  # Keep order as requested by user, but drop those not present for robustness
  vars_to_stack <- intersect(return_vars, vars_present)
  if (length(vars_to_stack) == 0L) stop("No requested variables were produced. Check return_vars and inputs.")
  
  ## ---- Stack each requested variable across time ----
  sds_list <- lapply(vars_to_stack, function(v)
    terra::rast(lapply(HAZ_l, function(x) x[[v]]))
  )
  names(sds_list) <- vars_to_stack
  
  ## ---- Build SpatRasterDataset with metadata ----
  HAZs <- terra::sds(sds_list)
  
  # Metadata lookups
  longname_map <- c(
    Pr  = "air_pressure_at_sea_level",
    Uw  = "eastward_wind",
    Vw  = "northward_wind",
    Sw  = "wind_speed",
    Dw  = "wind_direction",
    Ww  = "vertical_wind",
    R   = "radial_distance_from_cyclone_centre",
    lam = "radial_direction_from_cyclone_centre",
    Hs0 = "Deep_water_significant_wave_height",
    Tp0 = "peak_wave_period",
    Dp0 = "peak_wave_direction"
  )
  unit_map <- c(
    Pr="hPa", Uw="m/s", Vw="m/s", Sw="m/s", Dw="deg",
    Ww="m/s", R="m", lam="deg", Hs0="m", Tp0="s", Dp0="deg"
  )
  
  terra::varnames(HAZs)   <- vars_to_stack
  terra::longnames(HAZs)  <- unname(longname_map[vars_to_stack])
  terra::units(HAZs)      <- unname(unit_map[vars_to_stack])
  
  ## ---- Optional write to NetCDF ----
  if (!is.null(outfile)) {
    terra::writeCDF(HAZs, filename = outfile, overwrite = overwrite)
  }
  
  return(HAZs)
}

#' Return the Bearing for Line Segments
#'
#' @param x spatial vector with line segments (two connected points)
#'
#' @return array of bearings see geosphere::bearing, i.e the Forward direction of the storm geographic bearing, positive clockwise from true north
#' @export
#' @import geosphere, terra
#'
#' @examples
#' ### IBTRACS HAS the WRONG BEARING!!
#' require(terra)
#' northwardTC <- vect(cbind(c(154,154),c(-26.1,-26)),"lines",crs="epsg:4283") #track line segment
#' easthwardTC <- vect(cbind(c(154,154.1),c(-26,-26)),"lines",crs="epsg:4283") #track line segment
#' southhwardTC <- vect(cbind(c(154,154),c(-26,-26.1)),"lines",crs="epsg:4283") #track line segment
#' westwardTC <- vect(cbind(c(154.1,154),c(-26,-26)),"lines",crs="epsg:4283") #track line segment
#' returnBearing(northwardTC)
#' returnBearing(easthwardTC)
#' returnBearing(southhwardTC)
#' returnBearing(westwardTC)
returnBearing <- function(x){
  xy = terra::geom(x)
  np = max(xy[,1])
  bear = sapply(1:np, function(i) {sxy = xy[xy[,1] == i,]; geosphere::bearing(sxy[1,3:4],sxy[2,3:4])})
  bear[bear < 0] = bear[bear < 0]+360
  return(bear)
}


#' Compute the  Tropical Cyclone Radius of Maximum Winds
#'
#' @param rMaxModel 0=Powell et.al.(2005),1=McInnes et.al.(2014),2=Willoughby & Rahn (2004),  3=Vickery & Wadhera (2008), 4=Takagi & Wu (2016), 5 = Chavas & Knaff (2022).
#' @param TClats Tropical cyclone central latitude (nautical degrees)
#' @param cPs Tropical cyclone central pressure (hPa)
#' @param eP Background environmental pressure (hPa)
#' @param R175ms radius of 17.5m/s wind speeds (km)
#' @param dPdt rate of change in central pressure over time, hPa per hour from Holland 2008
#' @param vFms Forward speed of the storm m/s
#' @param rho  density of air
#' @param vMax maximum wind speed m/s. see \code{vMax_modelsR}
#'
#' @return radius of maximum winds (km)
#' @export
#'
#' @examples rMax_modelsR(0,-14,950,1013,200,0,0,1.15)
rMax_modelsR <- function(rMaxModel, TClats, cPs, eP, R175ms = 150, dPdt = NULL, vFms = NULL, rho = 1.15,vMax = NULL) {
  #not in TCRM
  #0: Powell Soukup et al (2005) updated to Arthur 2021
  #1: McInnes et al 2014 (Kossin, pers. comm. October, 2010).
  #2: Willoughby & Rahn(2004), eq 7
  #3: Vickery & Wadhera (2008) eq 11
  #4: Takagi & Wu (2016)
  #5: Chavas & Knaff (2022) Has not been extensively tested!
  if(is.na(rMaxModel)) stop("rMaxModel must be a value from 0 to 5, see params file") 
  dP <- (eP - cPs)
  dP[dP < 1] <- 1
  if (rMaxModel == 0) {
    # Powell Soukup et al (2005) updated to Arthur 2021
    rMaxs <- exp(3.543 - 0.00378 * dP + 0.813 * exp(-0.0022 * (dP)^2) + 0.00157 * (TClats^2))
  } else if (rMaxModel == 1) {
    # McInnes et al 2014 (Kossin, pers. comm. October, 2010)
    rMaxs <- exp(-3.5115 + 0.0068 * cPs + 0.0264 * abs(TClats))
  } else if (rMaxModel == 2) {
    # Willoughby & Rahn(2004), eq 7
    a <- 0.0173 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0313 * (-0.0223 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0281 * abs(TClats))
    b <- 1.0036 - 0.0313 * log(51.6) + 0.0087 * abs(TClats)
    beta <- (1/2) * (a^2 + sqrt(a^4 + 4 * a^2 * b) + 2 * b)
    beta[beta < 0.8] <- 0.8
    beta[beta > 1.9] <- 1.9
    if(is.null(vMax)) vMax <- sqrt(beta * dP * 100 / (exp(1) * rho))
    rMaxs <- 51.6 * exp(-0.0223 * vMax + 0.0281 * abs(TClats))
  } else if (rMaxModel == 3) {
    # Vickery Wadhera 2008 eq 11
    rMaxs <- exp(3.015 - 6.291e-5 * dP^2 + 0.0337 * abs(TClats))
  } else if (rMaxModel == 4) {
    # Takagi Wu 2016 Figure 3
    rMaxs <- 0.676 * cPs - 578
  } else if (rMaxModel == 5) {
    message("Chavas & Knaff (2022) is untested in this software")
    if(is.null(vMax)) vMax <- sqrt(1.3 * dP * 100 / (exp(1) * rho))
    rMaxs <- predict_rmax(R175ms, vMax, TClats)
  }

  return(rMaxs)
}





#' Compute the Tropical Cyclone Maximum Wind Speeds
#'
#' @param vMaxModel 0=Arthur (1980),1=Holland (2008),2=Willoughby & Rahn (2004).3=Vickery & Wadhera (2008),4=Atkinson and Holliday (1977)
#' @param cPs Tropical cyclone central pressure (hPa)
#' @param eP Background environmental pressure (hPa)
#' @param vFms Forward speed of the storm m/s
#' @param TClats Tropical cyclone central latitude
#' @param dPdt rate of change in central pressure over time, hPa per hour from Holland 2008
#' @param beta exponential term for Holland vortex
#' @param rho density of air
#'
#' @return maximum wind speed m/s.
#' @export
#'
#' @examples
#' vMax_modelsR(vMaxModel=1,cPs=950,eP=1010,vFms = 1,TClats = -14,dPdt = .1)
vMax_modelsR <- function(vMaxModel, cPs, eP, vFms = NULL, TClats = NULL, dPdt = NULL, beta = 1.3, rho = 1.15) {
  # Calculate max wind speed in the model. The beta parameter is only used in Holland 08, where it equals 1.3.
  # vMaxModel is the type of model used:
  # 0: Arthur 2021 Willoughby & Rahn (2004) default.
  # 1: Holland (2008)
  # 2: Willoughby & Rahn (2004) via the beta parameter
  # 3: Vickery & Wadhera (2008)
  # 4: Atkinson and Holliday (1977)

  dP = eP - cPs
  dP[dP < 1] = 1 # Needs to be at least lower than the background
  if(is.na(vMaxModel)) stop("vMaxModel must be a value from 0 to 4, see params file") 

  if (vMaxModel == 0) {
    # see https://github.com/GeoscienceAustralia/tcha/blob/6e6de8df2b3fd5c9287d060f1f7f1d4ff63e87a7/wind-radii/rmax_fit.py#L205
    vMax = 0.6252 * sqrt(dP * 100)
  }
  
  if (vMaxModel == 1) {
    x = 0.6 * (1 - dP / 215)
    bs = -4.4e-5 * dP^2 + 0.01 * dP + 0.03 * dPdt - 0.014 * abs(TClats) + 0.15 * vFms^x + 1
    vMax = sqrt(abs(100 * bs / (rho * exp(1)) * dP))  # Holland 2008 model "A Revised Hurricane Pressure – Wind Model" Equation 11.
  }

  if (vMaxModel == 2) {
    # The WR04 Vmax and Rmax equations needed to be refactored to solve for beta
    a <- 0.0173 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0313 * (-0.0223 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0281 * abs(TClats))
    b <- 1.0036 - 0.0313 * log(51.6) + 0.0087 * abs(TClats)
    # x - a * sqrt(x) = b
    # https://www.wolframalpha.com/input?i=x-+a*sqrt%28x%29%3Db
    beta <- (1 / 2) * (a^2 + sqrt(a^4 + 4 * a^2 * b) + 2 * b)
    beta[beta < 0.8] = 0.8
    beta[beta > 1.9] = 1.9
    vMax <- sqrt(beta * dP * 100 / (exp(1) * rho))
  }

  if (vMaxModel == 3) { # Vickery and Wadhera (2008)
    rMaxs <- exp(3.015 - 6.291e-5 * dP^2 + 0.0337 * abs(TClats)) # Equation 11
    TClatrad <- TClats * pi / 180.0
    wearth <- pi * (1.0 / 24.0) / 1800.0
    f <- 2.0 * wearth * sin(TClatrad)
    beta = 1.833 - 0.326 * sqrt(abs(f) * rMaxs * 1000) # Equation 23 rMax is in units [m] not km
    vMax = sqrt(beta * dP * 100 / (exp(1) * rho)) # Equation 4  dP in Pa, not hPa, so * 100
  }

  if (vMaxModel == 4) {
    vMax = (3.04 * ((1010.0 - cPs) / 100.0)^0.644) # Atkinson and Holliday (1977), *Tropical Cyclone Minimum SeaLevel Pressure Maximum Sustained Wind Relationship for Maximum 10m, 1 - minute wind speed. Uses ``pEnv`` as 1010 hPa.
  }

  return(vMax)
}

#' Compute the Exponential TC beta Profile-Curvature Parameter
#'
#' @param betaModel 0=Powell (2005), 1=Holland (2008),2=Willoughby & Rahn (2004),3=Vickery & Wadhera (2008),4=Hubbert (1991)
#' @param vMax maximum wind speed m/s. see \code{vMax_modelsR}
#' @param rMax radius of maximum winds (km). see \code{rMax_modelsR}
#' @param cPs Tropical cyclone central pressure (hPa)
#' @param eP Background environmental pressure (hPa)
#' @param vFms Forward speed of the storm m/s
#' @param TClats Tropical cyclone central latitude
#' @param dPdt rate of change in central pressure over time, hPa per hour from Holland 2008
#' @param rho density of air
#'
#' @return exponential beta parameter
#' @export
#'
#' @examples beta_modelsR(0,10,10,960,1013,3,-15,1)
beta_modelsR <- function(betaModel, vMax, rMax, cPs, eP, vFms, TClats, dPdt, rho = 1.15) {
  # 0: Powell et al (2005) see Arthur 2021
  # 1: Holland (2008)
  # 2: Willoughby & Rahn(2004) default? https://github.com/GeoscienceAustralia/tcrm/blob/1916233f7dfdecf6a1b5f5b0d89f3eb1d164bd3e/wind/vmax.py#L96
  # 3: Vickery & Wadhera (2008)
  # 4: Hubbert (1991)

  dP <- (eP - cPs)
  dP[dP < 1] <- 1
  if(is.na(betaModel)) stop("betaModel must be a value from 0 to 4, see params file") 
  
  if (betaModel == 0) {
    beta <- 1.881093 - 0.010917 * abs(TClats) - 0.005567 * rMax # Powell (2005)
    beta[beta < 0.8] <- 0.8
    beta[beta > 1.9] <- 1.9
  } else if (betaModel == 1) {
    x <- 0.6 * (1 - dP / 215)
    bs <- -4.4e-5 * dP^2 + 0.01 * dP + 0.03 * dPdt - 0.014 * abs(TClats) + 0.15 * vFms^x + 1
    beta <- bs # Holland (2008) # cyclone08v2.for beta = 1.6bs
  } else if (betaModel == 2) {
    a <- 0.0173 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0313 * (-0.0223 * sqrt(dP * 100 / (exp(1) * rho)) + 0.0281 * abs(TClats))
    b <- 1.0036 - 0.0313 * log(51.6) + 0.0087 * abs(TClats)
    beta <- (1/2) * (a^2 + sqrt(a^4 + 4 * a^2 * b) + 2 * b)
    beta[beta < 0.8] <- 0.8
    beta[beta > 1.9] <- 1.9
  } else if (betaModel == 3) {
    TClatrad <- TClats * pi / 180.0
    wearth <- pi * (1.0 / 24.0) / 1800.0
    f <- 2.0 * wearth * sin(TClatrad)
    beta <- 1.833 - 0.326 * sqrt(abs(f) * rMax * 1000) # Vickery and Wadhera (2008) equ 23 rMax is in units [m] not km
  } else if (betaModel == 4) {
    beta <- 1.5 + (980 - cPs) / 120 # Hubbert (1991)
  }

  return(pmin(pmax(beta, 0.8), 1.9)) # Clip beta values to be between 0.8 and 1.9
}



#' Reduce Winds Overland
#'
#' @param d inland distance in km
#' @param a three parameter of decay model a1,a2,a3
#'
#' @return a reduction factor Km
#' @export
#'
#' @examples
#' inlandWindDecay(10)
inlandWindDecay = function(d,a = c(0.66,1,0.4)){
  d[d < 0] = 0
  f = a[1]+a[2]*(1-a[1]/a[2])*exp(-d/a[3])
  return(f)
}



#' Transect points from a origin through a point or with a bearing and to the opposite side.
#'
#' @param TC_line origin of the transect
#' @param Through_point a point to pass through
#' @param bear the bearing
#' @param length the length of the transect in Km
#' @param step the spacing of the transect in Km
#'
#' @return spatial vector of transect profile points with distances in Km (negative for left hand side)
#' @export
#'
#' @examples
#' require(terra)
#' TCi <- vect(cbind(c(154.1,154),c(-26.1,-26)),"lines",crs="epsg:4283") #track line segment
#' TCi$PRES <- 950
#' TCi$RMAX <- 40
#' TCi$B <- 1.4
#' TCi$RMAX2 <- 90
#' TCi$ISO_TIME <- "2022-10-04 20:00:00"
#' TCi$LON <- geom(TCi)[1,3]
#' TCi$LAT <- geom(TCi)[1,4]
#' TCi$STORM_SPD <- perim(TCi)/(3*3600) #m/s
#' TCi$thetaFm <- 90-returnBearing(TCi)
#' #Through_point <- isd[isd$OID==isdsi]
#' pp <- TCProfilePts(TC_line = TCi,Through_point=NULL,bear=TCi$thetaFm+90,length =100,step=10)
#' plot(pp,"radialdist",type="continuous")
#' lines(TCi,col=2)
TCProfilePts = function(TC_line,Through_point=NULL,bear=NULL,length =200,step=2){
  xy0 = terra::geom(TC_line)[1,3:4]
  #XY0 = terra::vect(rbind(xy0),"points")

  if(is.null(Through_point) & is.null(bear)) stop("need a through point or bearing")
  if(!is.null(Through_point)) {
    xy1 = terra::geom(Through_point)[1,3:4]
    #XY1 = terra::vect(rbind(xy1),"points")
  }
  if(is.null(bear)) bear = geosphere::bearing(xy0,xy1)
  dist = seq(0,length,step)*1000
  bear = 90-bear+180
  bear[bear < 0] = bear[bear < 0]+360
  ptsR = geosphere::destPoint(p=xy0,b=bear,d= dist)
  ptsL = geosphere::destPoint(p=xy0,b=bear+180,d= dist)
  np = dim(ptsL)[1]
  out = terra::vect(rbind(ptsL[np:1,],ptsR[-1,]),"points")
  out$radialdist = c(rev(-dist),dist[-1])/1000
  return(out)
}


#' Compute the Wind and Pressure Spatial Hazards Profile Associated with TCs Single Time Step.
#'
#' @param GEO_land SpatVector or dataframe hazard geometry generated with land_geometry
#' @param TC SpatVector or data.frame of Tropical cyclone track parameters for a single time step.
#' @param paramsTable Global parameters to compute TC Hazards.
#'
#' @return SpatRaster with the following attributes
#'
#'
#'
#' | abbreviated attribute       | description     | units |
#' | ------------- | -------------|  -------------|
#' | P      | Atmospheric pressure | hPa  |
#' | Uw      | Meridional  wind speed | m/s |
#' | Vw      | Zonal wind speed | m/s  |
#' | Sw     | Wind speed | m/s  |
#' | Dw     | Wind direction | deg clockwise from true north  |
#'
#' @md
#'
#' @export
#'
#' @examples
#' require(terra)
#' dem <- rast(system.file("extdata/DEMs/YASI_dem.tif", package="TCHazaRds"))
#' land <- dem; land[land > 0] = 0
#' inland_proximity = distance(land,target = 0)
#' GEO_land = land_geometry(dem,inland_proximity)
#'
#' TCi = vect(cbind(c(154,154),c(-26.1,-26)),"lines",crs="epsg:4283") #track line segment
#' TCi$PRES = 950
#' TCi$RMAX = 40
#' TCi$VMAX = 60
#' TCi$B = 1.4
#' TCi$ISO_TIME = "2022-10-04 20:00:00"
#' TCi$LON = geom(TCi)[1,3]
#' TCi$LAT = geom(TCi)[1,4]
#' TCi$STORM_SPD = perim(TCi)/(3*3600) #m/s
#' TCi$thetaFm = 90-returnBearing(TCi)
#' #OR
#' TC <- vect(system.file("extdata/YASI/YASI.shp", package="TCHazaRds"))
#' TC$PRES <- TC$BOM_PRES
#' TCi = TC[47]
#' TCi$thetaFm = 90-returnBearing(TCi)
#'
#' #extract a profile/transect at right angles (90 degrees) from the TC heading/bearing direction
#' pp <- TCProfilePts(TC_line = TCi,bear=TCi$thetaFm+90,length =100,step=1)
#' #plot(dem);lines(TCi,lwd = 4,col=2)
#' #points(pp)
#' GEO_land_v = extract(GEO_land,pp,bind=TRUE,method = "bilinear")
#'
#' paramsTable = read.csv(system.file("extdata/tuningParams/defult_params.csv",package = "TCHazaRds"))
#' #calculate the wind hazard
#' HAZ = TCHazaRdsWindProfile(GEO_land_v,TCi,paramsTable)
#' #plot(HAZ$radialdist,HAZ$Sw,type="l",xlab = "Radial distance [km]",ylab = "Wind speed [m/s]");grid()
#' #plot(HAZ,"Sw",type="continuous")
#'
TCHazaRdsWindProfile = function(GEO_land,TC,paramsTable){
  params <- array(paramsTable$value,dim = c(1,length(paramsTable$value)))
  colnames(params) <- paramsTable$param
  params <- data.frame(params)
  #SpatVector can't "hold" POSIX class.
  if(methods::is(TC,"SpatVector")) {
    indate=strptime(TC$ISO_TIME,"%Y-%m-%d %H:%M:%S",tz = "UTC")
    #reformat
    TRACK = update_Track(outdate=NULL,indate=indate,TClons=TC$LON,TClats=TC$LAT,vFms=TC$STORM_SPD,thetaFms=TC$thetaFm,cPs=TC$PRES,
                         rMaxModel=params$rMaxModel,vMaxModel=params$vMaxModel,betaModel=params$betaModel,rMax2Model=params$rMax2Model,eP = params$eP,rho = params$rhoa,
                         RMAX = TC$RMAX,VMAX = TC$VMAX,B = TC$B, RMAX2 = TC$RMAX2)
  }
  if(methods::is(TC,"data.frame")){
    TRACK = TC
    indate = strptime("1970-01-01 00:00:00","%Y-%m-%d %H:%M:%S",tz = "UTC")+TRACK$odatei
  }

  lon = as.numeric(GEO_land$lons)
  lat = as.numeric(GEO_land$lats)
  Rlam <- with(TRACK,Rdist(Gridlon =lon,Gridlat=lat,TClon=TClons,TClat=TClats))
  R <- Rlam[,1]

  #Rcpp::sourceCpp("src/TCHazaRds.cpp")

  #0: Holland (1980)
  #2: McConochie et al. (2004) "Double-Holland"
  if(params$pressureProfileModel == 0) P <- with(TRACK,HollandPressureProfile(rMax=rMax,dP = dPs, cP=cPs,beta=beta,R=R))
  if(params$pressureProfileModel == 2) P <- with(TRACK,DoubleHollandPressureProfile(rMax=rMax, rMax2 = rMax2,dP=dPs,cP=cPs,beta=beta,R=R))

  #windProfileModel #https://geoscienceaustralia.github.io/tcrm/docs/setup.html?highlight=jelesnianski#windProfileinterface
  #0: Holland (1980)
  #2: McConochie et al. (2004) "Double-Holland"
  #4: Jelesnianski (1966)
  fs=GEO_land$f
  if(params$windProfileModel == 0) VZ <- with(TRACK,HollandWindProfile(      f=f, vMax=vMax, rMax=rMax,                dP=dPs, rho=rho, beta=beta, R=R))
  if(params$windProfileModel == 1) VZ <- with(TRACK,NewHollandWindProfile(   f=f, vMax=vMax, rMax=rMax, rMax2 = rMax2, dP=dPs, rho=rho, beta=beta, R=R))
  if(params$windProfileModel == 2) VZ <- with(TRACK,DoubleHollandWindProfile(f=f, vMax=vMax, rMax=rMax, rMax2 = rMax2, dP=dPs, rho=rho, beta=beta, R=R, cP=cPs))
  if(params$windProfileModel == 4) VZ <- with(TRACK,JelesnianskiWindProfile( f=f, vMax=vMax, rMax=rMax,                                            R=R))

  V=VZ[,1]
  #0 Kepert & Wang (2001)
  #1 Hubbert et al (1991)
  #2 McConochie et al (2004) "Double-Holland"
  if(params$windVortexModel == 0) UV <- with(TRACK,KepertWindField(    rMax=rMax, vMax=vMax, vFm=vFms, thetaFm=thetaFms, f=f , Rlam=Rlam, VZ=VZ,  surface=params$surface))
  if(params$windVortexModel == 1) UV <- with(TRACK,HubbertWindField(   rMax=rMax,            vFm=vFms, thetaFm=thetaFms, f=f , Rlam=Rlam, V=V,    surface=params$surface))
  if(params$windVortexModel == 2) UV <- with(TRACK,McConochieWindField(rMax=rMax, vMax=vMax, vFm=vFms, thetaFm=thetaFms,       Rlam=Rlam, V=V,f=f,surface=params$surface))

  GEO_land$Pr  <- P
  GEO_land$Uw  <- UV[,1]
  GEO_land$Vw  <- UV[,2]
  GEO_land$Va  <- atan2(GEO_land$Vw,GEO_land$Uw)
  GEO_land$Dw  <- 90-(GEO_land$Va-pi/2)*180/pi
  GEO_land$Dwv <- GEO_land$Dw
  s <- which(GEO_land$Dwv < 0 & !is.na(GEO_land$Dwv))
  if( length(s > 0) ) GEO_land$Dw[s] <- 360+GEO_land$Dw[s]
  s = which(GEO_land$Dwv > 360 & !is.na(GEO_land$Dwv))
  if( length(s > 0) ) GEO_land$Dw[s] <- GEO_land$Dw[s]-360

  GEO_land$decay <- 1
  a = c(params$Decay_a1,params$Decay_a2,params$Decay_a3)
  if(a[1] != 0 & params$surface == 1){
    GEO_land$decay = inlandWindDecay(GEO_land$inlandD/1000,a)
    GEO_land$decay[is.na(GEO_land$decay)] <- 1
  }

  #bias correct winds and correct for surface roughness
  GEO_land$Sw = sqrt(GEO_land$Uw^2+GEO_land$Vw^2)*GEO_land$decay

  GEO_land$Uw = cos(GEO_land$Va) * GEO_land$Sw
  GEO_land$Vw = sin(GEO_land$Va) * GEO_land$Sw

  return(GEO_land)
}

#' rMax175ms_solver
#'
#' A helper function for numerically solving the radius of 17.5 m/s winds using the
#' Chavas and Knaff (2022) model. This function is called by `uniroot` to compute
#' the difference between the guessed and actual rmax values.
#'
#' @param rMax175ms_m Numeric. Guessed radius of 17.5 m/s winds in meters.
#' @param vMax Numeric. Maximum wind speed (m/s).
#' @param rmax_predict_m Numeric. Target radius of maximum winds in meters.
#' @param TClats Numeric. Latitude of the tropical cyclone in degrees.
#'
#' @return The difference between the guessed rmax and the target rmax.
#' @examples
#' rMax175ms_solver(100000, 50, 36000, 20)
#' @export
rMax175ms_solver <- function(rMax175ms_m, vMax, rmax_predict_m, TClats) {
  TClats = abs(TClats)
  ms_kt <- 0.5144444  # 1 kt = 0.514444 m/s
  Vuser <- 34 * ms_kt  # [m/s]; used to fit E04 model to estimate r0'
  omeg <- 7.292e-5  # [s^-1]
  
  # Calculate fcor
  fcor <- 2 * omeg * sin(abs(TClats) * pi / 180)
  
  # Coefficient estimates from CK22 (Eq 7 / Table 2 of CK22)
  coefs <- list(b = 0.699, c = -0.00618, f = -0.00210)
  
  # Calculate Muser (Eq 2 of CK22)
  Muser <- rMax175ms_m * Vuser + 0.5 * abs(fcor) * rMax175ms_m^2
  
  # Estimate Mmax/Muser (Eq 6 of CK22)
  halffcorrMax175ms_m <- 0.5 * fcor * rMax175ms_m
  MmaxMuser_predict <- coefs$b * exp(
    coefs$c * (vMax - Vuser) + coefs$f * (vMax - Vuser) * halffcorrMax175ms_m
  )
  
  # Solve for Mmax (Eq 3 of CK22)
  Mmax_predict <- MmaxMuser_predict * Muser
  
  # Calculate the predicted rmax based on the guessed rMax175ms
  rmax_guess <- (vMax / fcor) * (sqrt(1 + (2 * fcor * Mmax_predict / (vMax^2))) - 1)
  
  # Return the difference between the guessed rmax and the target rmax
  return(rmax_guess - rmax_predict_m)
}


#' rMax2_modelsR
#'
#' Numerically solves for the radius of 17.5 m/s winds (rMax175ms) using the 
#' Chavas and Knaff (2022) model and `uniroot`.
#'
#' @param rMax2Model TC outer radius of 17.5m/s winds model 1='150km', 2=Chavas and Knaff(2022)
#' @param rMax Numeric. A vector of radius of maximum winds (km).
#' @param vMax Numeric. A vector of maximum wind speeds (m/s).
#' @param TClats Numeric. A vector of latitudes of tropical cyclone centre in degrees.
#'
#' @return A vector of predicted rMax175ms values (in km).
#' @examples
#' rMax <- c(30, 36, 40)
#' vMax <- c(50, 55, 60)
#' TClats <- c(20, 25, 30)
#' rMax2_modelsR(2,rMax, vMax, TClats)
#' @export
rMax2_modelsR <- function(rMax2Model, rMax, vMax, TClats) {
  # 1: O'Grady et al 2024 constant 150km
  # 2: Chavas and Knaff (2022)
  TClats = abs(TClats)
  rMax175ms_list = NA
  if(rMax2Model == 1) rMax175ms_list = rep(150,length(TClats))
  if(rMax2Model == 2){
    
    if(length(vMax) == 1) vMax = rep(vMax,length(rMax))
    if(length(TClats) == 1) vMax = rep(TClats,length(rMax))
    rMax175ms_list <- numeric(length(rMax))
    
    for (i in seq_along(rMax)) {
      # Convert rmax_km to meters
      rmax_m <- rMax[i] * 1000
      
      # Adjust the interval based on expected outer radius range (e.g., 50 km to 400 km)
      rMax175ms_solution <- tryCatch({
        uniroot(rMax175ms_solver, interval = c(5000, 400000), vMax = vMax[i], rmax_predict_m = rmax_m, TClats = TClats[i])$root
      }, error = function(e) {
        message(paste0("Failed to find solution for rmax = ", round(rMax[i],2), "km for vMax = ",round(vMax[i],2)," m/s, try another vMax"))
        NA  # Return NA if no solution found
      })
      
      # Convert rMax175ms back to km and store the result
      rMax175ms_list[i] <- rMax175ms_solution / 1000
    }
  }
  return(rMax175ms_list)
}


#' predict_rmax
#'
#' Predicts the radius of maximum winds (rmax) based on the radius of 17.5 m/s winds
#' (rMax175ms) using the Chavas and Knaff (2022) model.
#'
#' @param rMax175ms Numeric. A vector of radius of 17.5 m/s winds (in km).
#' @param vMax Numeric. A vector of maximum wind speeds (m/s).
#' @param TClats Numeric. A vector of latitudes of tropical cyclones (in degrees).
#'
#' @return A vector of predicted rmax values (in km).
#' @examples
#' rMax175ms <- c(100, 120, 140)
#' vMax <- c(50, 55, 60)
#' TClats <- c(20, 25, 30)
#' predict_rmax(rMax175ms, vMax, TClats)
#' @export
predict_rmax <- function(rMax175ms, vMax, TClats) {
  TClats = abs(TClats)
  # Constants
  ms_kt <- 0.5144444  # 1 kt = 0.514444 m/s
  Vuser <- 34 * ms_kt  # [m/s]; used to fit E04 model to estimate r0'
  omeg <- 7.292e-5  # [s^-1]
  
  # Convert rMax175ms to meters
  rMax175ms_m <- rMax175ms * 1000
  
  # Calculate fcor
  fcor <- 2 * omeg * sin(abs(TClats) * pi / 180)
  
  # Calculate Muser (Eq 2 of CK22)
  Muser <- rMax175ms_m * Vuser + 0.5 * abs(fcor) * rMax175ms_m^2
  
  # Define f*rMax175ms
  halffcorrMax175ms_m <- 0.5 * fcor * rMax175ms_m
  
  # Coefficient estimates from CK22 (Eq 7 / Table 2 of CK22)
  coefs <- list(b = 0.699, c = -0.00618, f = -0.00210)
  
  # Estimate Mmax/Muser (Eq 6 of CK22)
  MmaxMuser_predict <- coefs$b * exp(coefs$c * (vMax - Vuser) +
                                       coefs$f * (vMax - Vuser) * halffcorrMax175ms_m)
  
  # Solve for predicted rmax (Eq 3 of CK22)
  Mmax_predict <- MmaxMuser_predict * Muser
  
  # (Eq 4 of CK22)
  rmax_predict <- (vMax / fcor) * (sqrt(1 + (2 * fcor * Mmax_predict / (vMax^2))) - 1)
  
  # Convert rmax to km
  rMax <- rmax_predict / 1000
  
  return(rMax)
}

#' Convert Points to Line Segments
#'
#' This function converts a set of point geometries into line segments.
#' The input vector must be a set of points, and the function will draw line segments between consecutive points.
#' An additional point is extrapolated from the last two points to ensure the final segment is complete.
#'
#' @param pts_v A `SpatVector` of points (from the `terra` package).
#'
#' @return A `SpatVector` containing line geometries created from the input points.
#'
#' @import terra
#' @examples
#' library(terra)
#' # Create example points
#' pts <- vect(matrix(c(1, 1, 2, 2, 3, 3), ncol=2), type="points")
#' # Convert points to line segments
#' TClines <- TCpoints2lines(pts)
#' 
#' @export
TCpoints2lines <- function(pts_v) {
  out_v <- terra::vect()
  
  # Check if the geometry type is points
  gt <- terra::geomtype(pts_v)
  if (!(gt == "points")) stop(paste0("geomtype = ", gt))
  
  if (gt == "points") {
    # Extract coordinates
    coords <- terra::geom(pts_v)[, 3:4]
    n <- dim(coords)[1]
    
    # Add an extra point to extend the last segment
    coords <- rbind(coords, 2 * coords[n, ] - coords[n - 1, ])
    
    # Loop through the points to create line segments
    for (i in 1:(nrow(coords) - 1)) {
      segment_coords <- coords[i:(i + 1), ]
      segment <- terra::vect(segment_coords, type = "lines")
      out_v <- rbind(out_v, segment)
    }
  }
  terra::values(out_v) = terra::values(pts_v)
  terra::crs(out_v) = terra::crs(pts_v)
  return(out_v)  # Return the created line segments
}

Try the TCHazaRds package in your browser

Any scripts or data that you put into this service are public.

TCHazaRds documentation built on Aug. 25, 2025, 9:50 a.m.