Theis Calculator / Confined Aquifer Drawdown Computation

Brief Description of the R code: 
This code compute the drawdown over time of a confined aquifer being pumped. The drawdown is computed at a given distance from the pumping well. The user provides: 1. Distance from the well 2. The aquifer transmissivity 3. The aquifer storativity 4. The total pumping time (time elapsed since beginning of pumpage) 5. Time steps for the drawdown time series The code also displays a spatial distribution of the drawdown with contours in the vicinity of the well. PS: The user is responsible for making sure the units are consistent.
R code: 
# Loading required libraries
library(tcltk)
 
###### Functions
 
# Confined aquifer Well function approximation
# From Srivastava and Guzman (1998) paper in Ground Water
 
wellf<-function(u) {
  if ((u<=1) & (u>0)) {
    C1<-exp(-0.5772)  
    wu<-log(C1/u)+0.9713*u-0.1742*u*u
    return(wu)
 
  } else {
  wu<-1/(u*exp(u))*(u+0.3637)/(u+1.282)
  return(wu)
 
}
 stop
}
 
 
# Generates a multi-entry input box in tcltk
inputBox<-function()
{
    tt<-tktoplevel()
    # Defining input variable
    radius<-tclVar("10")
    trans<-tclVar("300")
    stor<-tclVar("1e-4")
    time<-tclVar("1")
    prate<-tclVar("12000")
    tstep<-tclVar("0.001")
 
    # Defining input widget
    entry.radius<-tkentry(tt,width="20",textvariable=radius)
    entry.trans<-tkentry(tt,width="20",textvariable=trans)
    entry.stor<-tkentry(tt,width="20",textvariable=stor)
    entry.time<-tkentry(tt,width="20",textvariable=time)
    entry.prate<-tkentry(tt,width="20",textvariable=prate)
    entry.tstep<-tkentry(tt,width="20",textvariable=tstep)
 
    # Variable input label
    lbl.radius<-tklabel(tt,text="Distance from pumping well:")
    lbl.trans<-tklabel(tt,text="Aquifer transmissivity:")
    lbl.stor<-tklabel(tt,text="Aquifer storage coefficient/ Storativity:")
    lbl.time<-tklabel(tt,text="Pumping duration")
    lbl.prate<-tklabel(tt,text="Pumping rate")
    lbl.tstep<-tklabel(tt,text="Time step size (for timeseries output):")
    fontTextLabel <- tkfont.create(family="times",size=12)
    lbl.title<-tklabel(tt,text="Input Pumping test parameters here",font=fontTextLabel)
 
 
    # Displaying widget
    tkgrid(lbl.title)
    tkgrid(lbl.radius,entry.radius)
    #tkgrid(entry.radius)
    tkgrid(lbl.trans,entry.trans)
    #tkgrid(entry.trans)
    tkgrid(lbl.stor,entry.stor)
    #tkgrid(entry.stor)
    tkgrid(lbl.time,entry.time)
    #tkgrid(entry.time)
    tkgrid(lbl.prate,entry.prate)
    #tkgrid(entry.prate)
    tkgrid(lbl.tstep,entry.tstep)
    #tkgrid(entry.tstep)
 
 
    OnOK <- function()
    {
        # NameVal <- c(tclvalue(Zmin),tclvalue(Zmax),tclvalue(dZ))
        tkdestroy(tt)
    }
    OK.but <-tkbutton(tt,text="   OK   ",command=OnOK)
    # tkbind(entry.Name, "<Return>",OnOK)
    tkgrid(OK.but,columnspan=3)
    tkfocus(tt)
    tkwait.window(tt)
    res<-as.numeric(c(tclvalue(radius),tclvalue(trans),tclvalue(stor),tclvalue(time),
                      tclvalue(prate),tclvalue(tstep)))
    return(res)
}
 
 
#############################################
#    Main Program
#############################################
## Input parameters    
   param<-inputBox()
   names(param)<-c("radius","trans","stor","time","prate","tstep")
 # Timeseries creation
   tseries<-seq(0,param["time"],by=param["tstep"])+1e-12
   title<-"Drawdown over time"
par(mfrow=c(2,1)) 
# Drawdown timeseries
   fct.u<-param["radius"]^2*param["stor"]/(4*param["trans"]*tseries)
   well.fct<-sapply(fct.u,FUN=wellf)
   ddn<- param["prate"]/(4*pi*param["trans"])*well.fct  
   plot(tseries,ddn,ty="l",xlab="Time",ylab="Drawdown",col="blue",lwd=2,main=title)
 
# 3D drawdown computation
x<-seq(-4*param["radius"],4*param["radius"],length=100)
coords<-expand.grid(x,x)
d.vect<-sqrt(coords[,1]^2+coords[,2]^2)
d.mat<-matrix(d.vect,ncol=100)
fct.u_mat<-d.mat^2*param["stor"]/(4*param["trans"]*param["time"])
well.fct<-sapply(fct.u_mat,FUN=wellf)
ddn_mat<-param["prate"]/(4*pi*param["trans"])*well.fct   
ddn_mat<-matrix(ddn_mat,ncol=100)
 
#Plotting contour
 contour(x,x, ddn_mat,asp=1,main="2D contours of drawdown")
 

Created by Pretty R at inside-R.org