R/mgswrite.rep_aermetsfc.R

Defines functions mgswrite.rep_aermetsfc

Documented in mgswrite.rep_aermetsfc

#' read AERMET .SFC file and find representative conditions (by L) for Stable, Slightly Stable, Neutral, Slightly Convective, and Convective
#' NOTE: "REPMET_" will be append to front of original filename for file containing representative conditions.
#'
#' @param infile name of original .SFC file
#' 
#' @import mgsread.aermetsfc
#'
#' @export mgswrite.rep_aermetsfc
#########################################################################

mgswrite.rep_aermetsfc <- function(infile){

  #get header of original file
  f=file(infile,open="r")
  header <- readLines(f, n=1)  #header
  close(f)
  
  #get original sfc as dataframe
  sfc <- mgsread.aermetsfc(infile)
  col_name <- c("year","month","day","jday","hour","sens_h_flux","ustar","wstar",
                "VPTG","conv_mix_h","mech_mix_h","MO_l","z0","Bowen_r","albedo",
                "wind_s","wind_d","wind_h","temp","temp_h","precip_code","precip_amt",
                "rel_hum","press","cloud_cov","WSADJ","subs")
  
  # Set up dataframe to store representative Met conditions
  repMet <- data.frame(matrix(ncol = length(col_name), nrow = 5))
  colnames(repMet) <- col_name
  
  # Subset by Stable, Convective -- MGS
  sfc_stab <-subset(sfc, sfc$MO_l > 0 & sfc$ustar > 0.0)
  sfc_conv <-subset(sfc, sfc$MO_l < 0 & sfc$ustar > 0.0)
  sfc_all <-subset(sfc, sfc$ustar > 0.0)
  
  #Set-up vector to hold origninal file indices of rep. hours
  ind <- c(0,0,0,0,0) #length of 5
  
  # Find index in sfc in which the quantile L value occurs -- MGS
  # STABLE: Find quantile L for +/-L -- MGS
  L_Squant <- quantile(sfc_stab$MO_l, c(.05, .50), na.rm=TRUE) #[1] Stable, [2] SStab
  ind[1]<- which(abs(sfc$MO_l-L_Squant[1]) == min(abs(sfc$MO_l-L_Squant[1])))[1]#Stable
  ind[2]<- which(abs(sfc$MO_l-L_Squant[2]) == min(abs(sfc$MO_l-L_Squant[2])))[1] #SlightlyStable
  
  # NEUTRAL: Find quantile L for +/-L -- MGS
  L_Nquant <- quantile(abs(sfc_all$MO_l), c(.99), na.rm=TRUE) #[1] Neutral
  ind[3]<- which(abs(sfc$MO_l-L_Nquant[1]) == min(abs(sfc$MO_l-L_Nquant[1])))[1] #Neutral
  
  # CONVECTIVE: Find quantile L for +/-L -- MGS
  L_Cquant <- quantile(sfc_conv$MO_l, c(.50, .95), na.rm=TRUE) #[1] SConv, [2] Conv
  ind[4]<- which(abs(sfc$MO_l-L_Cquant[1]) == min(abs(sfc$MO_l-L_Cquant[1])))[1] #SlightlyConv
  ind[5]<- which(abs(sfc$MO_l-L_Cquant[2]) == min(abs(sfc$MO_l-L_Cquant[2])))[1] #Conv
  
  # Get line for each SS/S/N/SC/C met conditions
  for(i in 1:5){
    repMet[i,] <- read.table(infile,skip=ind[i],nrows=1)
  }
  
  #make wind direction 270
  repMet[,"wind_d"] <- 270
  
  ## WRITE OUTPUT
  outfile <- paste("REPMET",infile,sep="_")
  write(header, file = outfile,append = FALSE)
  write.table(repMet,file = outfile,sep="\t",row.names=FALSE,col.names=FALSE,append=TRUE)
  
}
michellegrace/mgs.dispersion documentation built on May 22, 2019, 9:55 p.m.