latlong2mesh.R

# http://www.fttsus.jp/worldgrids/ja/our_library/
# calculate 3rd mesh code
cal_meshcode <- function(latitude, longitude){
  return(cal_meshcode3(latitude,longitude))
}

# calculate 1st mesh code
cal_meshcode1 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  u <- floor(longitude-100*z)
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,sep="")
      }
      else{
        mesh <- paste(o,p,u,sep="")
      }
    }
  }
  return(mesh)
}

# calculate 2nd mesh code
cal_meshcode2 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  a <- (latitude*60/40-p)*40
  q <- floor(a/5)
  u <- floor(longitude-100*z)
  f <- longitude-100*z-u
  v <- floor(f*60/7.5)
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,q,v,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,q,v,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,q,v,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,q,v,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,q,v,sep="")
      }
      else{
        mesh <- paste(o,p,u,q,v,sep="")
      }
    }
  }
  return(mesh)
}

# calculate 3rd mesh code
cal_meshcode3 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  a <- (latitude*60/40-p)*40
  q <- floor(a/5)
  b <- (a/5-q)*5
  r <- floor(b*60/30)
  c <- (b*60/30-r)*30
  u <- floor(longitude-100*z)
  f <- longitude-100*z-u
  v <- floor(f*60/7.5)
  g <- (f*60/7.5-v)*7.5
  w <- floor(g*60/45)
  h <- (g*60/45-w)*45
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,q,v,r,w,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,q,v,r,w,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,q,v,r,w,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,q,v,r,w,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,q,v,r,w,sep="")
      }
      else{
        mesh <- paste(o,p,u,q,v,r,w,sep="")
      }
    }
  }
  return(mesh)
}

# calculate 4th mesh code
cal_meshcode4 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  a <- (latitude*60/40-p)*40
  q <- floor(a/5)
  b <- (a/5-q)*5
  r <- floor(b*60/30)
  c <- (b*60/30-r)*30
  s2u <- floor(c/15)
  u <- floor(longitude-100*z)
  f <- longitude-100*z-u
  v <- floor(f*60/7.5)
  g <- (f*60/7.5-v)*7.5
  w <- floor(g*60/45)
  h <- (g*60/45-w)*45
  s2l <- floor(h/22.5)
  s2 <- s2u*2+s2l+1
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,q,v,r,w,s2,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,q,v,r,w,s2,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,q,v,r,w,s2,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,q,v,r,w,s2,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,q,v,r,w,s2,sep="")
      }
      else{
        mesh <- paste(o,p,u,q,v,r,w,s2,sep="")
      }
    }
  }
  return(mesh)
}

# calculate 5rd mesh code
cal_meshcode5 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  a <- (latitude*60/40-p)*40
  q <- floor(a/5)
  b <- (a/5-q)*5
  r <- floor(b*60/30)
  c <- (b*60/30-r)*30
  s2u <- floor(c/15)
  d <- (c/15-s2u)*15
  s4u <- floor(d/7.5)
  u <- floor(longitude-100*z)
  f <- longitude-100*z-u
  v <- floor(f*60/7.5)
  g <- (f*60/7.5-v)*7.5
  w <- floor(g*60/45)
  h <- (g*60/45-w)*45
  s2l <- floor(h/22.5)
  i <- (h/22.5-s2l)*22.5
  s4l <- floor(i/11.25)
  s2 <- s2u*2+s2l+1
  s4 <- s4u*2+s4l+1
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,q,v,r,w,s2,s4,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,q,v,r,w,s2,s4,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,q,v,r,w,s2,s4,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,q,v,r,w,s2,s4,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,q,v,r,w,s2,s4,sep="")
      }
      else{
        mesh <- paste(o,p,u,q,v,r,w,s2,s4,sep="")
      }
    }
  }
  return(mesh)
}

# calculate 6rd mesh code
cal_meshcode6 <- function(latitude, longitude){
  if(latitude < 0){
    o <- 4
  }
  else{
    o <- 0
  }
  if(longitude < 0){
    o <- o + 2
  }
  if(abs(longitude) >= 100) o <- o + 1
  z <- o %% 2
  y <- ((o - z)/2) %% 2
  x <- (o - 2*y - z)/4
#
  o <- o + 1
#
  latitude <- (1-2*x)*latitude
  longitude <- (1-2*y)*longitude
  #
  p <- floor(latitude*60/40)
  a <- (latitude*60/40-p)*40
  q <- floor(a/5)
  b <- (a/5-q)*5
  r <- floor(b*60/30)
  c <- (b*60/30-r)*30
  s2u <- floor(c/15)
  d <- (c/15-s2u)*15
  s4u <- floor(d/7.5)
  e <- (d/7.5-s4u)*7.5
  s8u <- floor(e/3.75)
  u <- floor(longitude-100*z)
  f <- longitude-100*z-u
  v <- floor(f*60/7.5)
  g <- (f*60/7.5-v)*7.5
  w <- floor(g*60/45)
  h <- (g*60/45-w)*45
  s2l <- floor(h/22.5)
  i <- (h/22.5-s2l)*22.5
  s4l <- floor(i/11.25)
  j <- (i/11.25-s4l)*11.25
  s8l <- floor(j/5.625)
  s2 <- s2u*2+s2l+1
  s4 <- s4u*2+s4l+1
  s8 <- s8u*2+s8l+1
  #
  if(u < 10){
    if(p < 10){
      mesh <- paste(o,"00",p,"0",u,q,v,r,w,s2,s4,s8,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,"0",u,q,v,r,w,s2,s4,s8,sep="")
      }
      else{
        mesh <- paste(o,p,"0",u,q,v,r,w,s2,s4,s8,sep="")
      }
    }
  }
  else{
    if(p < 10){
      mesh <- paste(o,"00",p,u,q,v,r,w,s2,s4,s8,sep="")
    }else{
      if(p < 100){
        mesh <- paste(o,"0",p,u,q,v,r,w,s2,s4,s8,sep="")
      }
      else{
        mesh <- paste(o,p,u,q,v,r,w,s2,s4,s8,sep="")
      }
    }
  }
  return(mesh)
}