.packageName <- "climatol"
#depurdat.R.- Depuracin de series climatolgicas y relleno de lagunas.

#depudm.- Depuracin de datos mensuales, con opcin de visualizacin.
depudm <- function(varcli, anyi, anyf, nm=12, wa=100, dz.max=2, difumb=0.05,
  leer=TRUE, a=0, b=1, wz=0.001, sqrtrans=FALSE, ttip=3, refglob=FALSE, ndec=1,
  pval=0.05, graf=FALSE, auto=FALSE, verb=TRUE) {

  mes3 <- c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")
# Lectura (opcional) de los datos desde ficheros varcli_anyi-anyf.dat y
# varcli_anyi-anyf.est, a una matriz dat (datos) y una tabla est.c
# (coordenadas, indicativos y nombres de las estaciones). Las constantes
# a y b son para transformar los datos que se leen mediante y=a+bx :
  if(leer) leerdm(varcli,anyi,anyf,nm=nm,b=b,a=a)
# Obtencin de la matriz de pesos (est.w).  wa: 0(no ponderar) o >>5 para
# depuracin; <5 para relleno de lagunas (si los datos son de alta calidad).
  matpesos(wa=wa, wz=wz, verb=verb) #matriz de pesos (est.w)
  if(auto==TRUE || graf==FALSE) {
    sink("climatol.log",append=TRUE)
    cat("\n=========== HOMOGENIZATION OF ",varcli,", ",anyi,"-",anyf,". (",
      date(),")\n",sep="")
    cat("depudm: nm=",nm,", wa=",wa,", dz.max=",dz.max,", difumb=",difumb,
      ", leer=",leer,", a=",a,", b=",b,",\n",sep="")
    cat("  wz=",wz,", sqrtrans=",sqrtrans,", ttip=",ttip,", refglob=",refglob,
      ", ndec=",ndec,", pval=",pval,",\n",sep="")
    cat("  graf=",graf,", auto=",auto,", verb=",verb,"\n\n",sep="")
    sink()
  }
# Transformacin raz cuadrada? Aplicar a difumb si >1:
  if(sqrtrans && difumb>1) difumb <- sqrt(difumb)
# proceso de depuracin iterativo, por meses (u otras series, si nm!=12):
  me <- 1
  while(me <= nm) {
    if(graf && !refglob) { #posibilidad de saltar a otro mes
      cat("Month ",me," ? (1-",nm,"; RETURN=confirm; f=end)\n",sep="")
      zz <- scan(what=character(),n=1,quiet=TRUE)
      if(length(zz)==0) zz <- "0"
      if(zz=="f") break
      if(substr(zz,1,1)!="1") zz <- "0"
      me2 <- as.integer(zz)
      if(me2 > 0 && me2 <= nm) me <- me2
    }
    if(refglob) { #todos los meses a la vez
      dat.d <<- dat
      attr(dat.d,"dim") <<- c(na*nm,ne)
    }
    else {
      cat("\n================== MONTH",me,"\n")
      dat.d <<- dat[me,,] #datos de 1 mes (dat.d)
    }
    #transformacin raz cuadrada opcional (slo valores > 1):
    if(sqrtrans) dat.d[dat.d>1] <<- sqrt(dat.d[dat.d>1])
    dat.na <- is.na(dat.d) #ndice de datos ausentes
    tipif(ttip=ttip) #tipificacin (dat.m, [dat.s,] dat.z)
    dat.m0 <- dat.m #copia de las medias
    #proceso iterativo:  
    ite <- 0
    repeat { #iterar hasta estabilizar las medias:
      ite <- ite+1
      cat("Iteration",ite,"...  ")
      datest(verb=verb) #obtencin de series estimadas (dat.e)
      if(auto) { #eliminacin automtica de los datos anmalos:
        elim <- abs(dat.z-dat.e) > dz.max #datos a eliminar
        elim[is.na(elim)] <- FALSE #eliminar los molestos NA
        nelim <- length(elim[elim==TRUE]) #no. de datos a eliminar
        destipif(ttip=ttip) #destipificacin de dat.e
        if(nelim>0) {
          sink("climatol.log",append=TRUE)
          for(i in 1:ne) { #listado de los datos que se van a eliminar
            for(j in 1:na) {
              if(elim[j,i]) cat(as.character(est.c[i,4]),
                anyi+j-1,me,":",round(dat.d[j,i],ndec),
                "->",round(dat.e[j,i],ndec),"\n")
            }
          }
          sink()
          dat.na[elim] <- TRUE #actualizacin ndice de datos ausentes
          cat(nelim,"data rejected.   ")
        }
      }
      else destipif(ttip=ttip) #destipificacin de dat.e
      dat.d[dat.na] <<- dat.e[dat.na] #relleno de los datos ausentes
      tipif(ttip=ttip) #actualizar dat.m y dat.z (y dat.s, si ttip=3)
      maxdif <- max(abs(dat.m-dat.m0))
      cat("Max. average difference: ",maxdif,"\n")
      if(maxdif<=difumb) break
      dat.m0 <- dat.m #copia de las medias
    }
    #grabar los datos depurados de errores puntuales y con lagunas rellenadas:
    arch <- paste(varcli,"_",substr(as.character(anyi),3,4),"-",substr(as.character(anyf),3,4),".dep",sep="") # nombre del archivo
    #deshacer transformacin raz cuadrada?:
    if(sqrtrans) dat.d[dat.d>1] <<- dat.d[dat.d>1] * dat.d[dat.d>1]
    if(refglob) {
      dat <<- round(dat.d,ndec)
      attr(dat,"dim") <<- c(nm,na,ne)
      for(j in 1:nm) write(dat[j,,],arch,ncolumns=10,append=(j!=1))
    }
    else write(round(dat.d,ndec),arch,ncolumns=10,append=(me!=1))
    #no usar datos rellenados para grficas ni pruebas de homogeneidad:
    dat.d[dat.na] <<- NA #no representar los datos rellenados!
    dat.z[dat.na] <<- NA # "      "       "    "       "
    #grficas interactivas de anomalas y datos (incopatible con refglob!):
    if(graf && !refglob) {
      #etiqueta del mes (si nm!=12, poner slo el nmero):
      if(nm==12) labm <- mes3[me] else labm <- me
      grafanom(me=me,labm=labm,ttip=ttip,ndec=ndec,sqrtrans=sqrtrans,pval=pval)
    }
    else if(pval>0) { #aplicar los tests de homogeneidad de grafanom()
      sink("climatol.log",append=TRUE)
      i <- 1
      while(i>0 && i<=ne) { #para cada estacin
        switch(ttip,   #tipificar los datos estimados
          y <- dat.e[,i] - dat.m[i],
          if(dat.m[i]>1) y <- dat.e[,i] / dat.m[i]
            else y <- dat.e[,i],
          y <- (dat.e[,i]-dat.m[i]) / dat.s[i],
          y <- dat.e[,i]
        )
        y <- dat.z[,i] - y #ahora como anomala (tipificada)
        indme <- paste(est.c[i,4],sprintf("%02d",as.integer(me))) #indicativo y mes
        #prueba mvil de la t (ventana de 10 trminos):
        movttest(y,indme,pval=pval,verb=verb)
        #prueba mvil de la t (ventana de 10 trminos):
        movttest(y,indme,nterm=20,pval=pval,verb=verb)
        tpv <- cor.test(y,anyi:anyf)$p.value
        if(tpv<=pval) cat(indme,"Trend p-value:",round(tpv,3),"\n")
        i <- i+1
      }
      sink()
    }
    me <- me+1
  }
}

# Lectura de los datos mensuales, y transformacin a+bx:
leerdm <- function(varcli,anyi,anyf,nm=12,b=1,a=0) {
  varcli <<- varcli
  anyi <<- anyi
  anyf <<- anyf
  na <<- anyf-anyi+1 #no. de aos
  arch <- paste(varcli,"_",substr(as.character(anyi),3,4),"-",substr(as.character(anyf),3,4),".",sep="") #raz de los nombres de archivo 
  arche <- paste(arch,"est",sep="") #nombre del archivo de estaciones
  est.c <<- read.table(arche) #leer coordenadas y nombres de las estaciones
  ne <<- nrow(est.c) #no. de estaciones
  nd <<- na*nm #no. de datos por estacin
  archd <- paste(arch,"dat",sep="") #nombre del archivo de datos
  dat <<- scan(archd) #lectura de los datos
  dat <<- a+dat*b #transformacin lineal (ej.: si estaban grabados en dcimas)
 #attr(dat,"dim") <<- c(nd,ne) #conversin de vector a matriz
  attr(dat,"dim") <<- c(nm,na,ne) #conversin de vector a matriz
}

#clculo de la matriz de pesos:
matpesos <- function(wa=5,wz=.001,verb=TRUE) {
#wa: parmetro de suavizacin de la funcin de peso (> 0). Asignarle
# un valor cero (o negativo) para que no aplicar ponderaciones (todos los
# pesos valdrn la unidad).
#wz: factor de escala de z. El valor por defecto es apropiado si z se da en m
# y x,y en km. Tambin sirve para sobreponderar z, o para hallar las distancias
# nicamente en el plano horizontal (wz=0).
  ne <- nrow(est.c) #no. de estaciones
  est.w <<- mat.or.vec(ne,ne)
  if(verb) cat("Computing inter-station weight matrix:\n")
  for(i in 1:(ne-1)) {
    if(verb) cat(" ",i)
    for(j in (i+1):ne) {
      if(wa<=0) est.w[i,j] <- 1
      else {
        dx <- est.c[i,1]-est.c[j,1]
        dy <- est.c[i,2]-est.c[j,2]
        dz <- (est.c[i,3]-est.c[j,3])*wz
        d2 <- dx*dx+dy*dy+dz*dz #distancia cuadrtica
        est.w[i,j] <<- wa/(wa+d2)
      }
      est.w[j,i] <<- est.w[i,j]
    }
  }
  if(verb) cat("\n")
}

#tipificacin de los valores (genera dat.m, dat.s y dat.z):
tipif <- function(ttip=3) {
  dat.m <<- apply(dat.d,2,mean,na.rm=TRUE) #medias
  if(ttip==3) dat.s <<- apply(dat.d,2,sd,na.rm=TRUE) #desviaciones tpicas
  nd <- attr(dat.d,"dim")[1] #no. de datos
  ne <- attr(dat.d,"dim")[2] #no. de estaciones
  dat.z <<- mat.or.vec(nd,ne)
#tipos de tipificacin: ttip=1(diferencias), 2(proporciones), 3(estandari-
#  zacin); 0(ninguna).
  switch(ttip,
    for(i in 1:ne) dat.z[,i] <<- dat.d[,i] - dat.m[i],
    #en proporciones, no dividir por menos de 1:
    for(i in 1:ne) { if(dat.m[i]>1) dat.z[,i] <<- dat.d[,i] / dat.m[i]
      else dat.z[,i] <<- dat.d[,i] },
    for(i in 1:ne) dat.z[,i] <<- (dat.d[,i]-dat.m[i]) / dat.s[i],
    dat.z <<- dat.d
  )
}

#destipificacin de los valores estimados (destipifica dat.e):
destipif <- function(ttip=3) {
  if(!ttip) return()
  ne <- attr(dat.d,"dim")[2] #no. de estaciones
#tipos de tipificacin: ttip=1(diferencias), 2(proporciones), 3(estandari-
#  zacin); 0(ninguna).
  switch(ttip,
    for(i in 1:ne) dat.e[,i] <<- dat.e[,i] + dat.m[i],
    for(i in 1:ne) if(dat.m[i]>1) dat.e[,i] <<- dat.e[,i] * dat.m[i],
    for(i in 1:ne) dat.e[,i] <<- dat.e[,i] * dat.s[i] + dat.m[i],
    return()
  )
}

#obtencin de series estimadas en funcin de las vecinas:
datest <- function(verb=FALSE) {
# dat.m <- apply(dat.d,2,mean,na.rm=TRUE) #medias
# dat.s <- apply(dat.d,2,sd,na.rm=TRUE) #medias
  nd <- attr(dat.d,"dim")[1] #no. de datos
  ne <- attr(dat.d,"dim")[2] #no. de estaciones
  dat.e <<- mat.or.vec(nd,ne) #datos estimados <<matrix(nd,ne)?
  if(verb) cat("Computing estimated series for each station:\n")
  for(i in 1:ne) { #para cada estacin
    if(verb) cat(" ",i)
    for(j in 1:nd) { #para cada dato
      se <- 0
      sw <- 0
      for(ir in 1:ne) { #para cada estacin de referencia
        if(ir==i) next #es la misma estacin
        if(is.na(dat.z[j,ir])) next #sin dato de referencia
        se <- se + dat.z[j,ir]*est.w[i,ir]
        sw <- sw + est.w[i,ir]
      }
      dat.e[j,i] <<- se / sw #dato estimado (tipificado)
    }
  }
  if(verb) cat("\n")
  #si hay NaN, convertirlos en NA. (Esto sucede si faltan datos de referencia):
  dat.e[is.nan(dat.e)] <<- NA
}

#Grficas de anomalas y datos originales y estimados (series mensuales)
grafanom <- function(me=me, labm="", ttip=3, ndec=1, sqrtrans=FALSE, pval=.05){
  old.par <- par(no.readonly = TRUE)
  on.exit(par(old.par))
# ne <- attr(dat.d,"dim")[2] #no. de estaciones
  par(pty="s",las=1,tck=1,fg=grey(.7)) #etiquetas, grid de color gris
  i <- 1
  while(i>0 && i<=ne) {
    switch(ttip,   #tipificar los datos estimados antes de representarlos
      y <- dat.e[,i] - dat.m[i],
      if(dat.m[i]>1) y <- dat.e[,i] / dat.m[i]
        else y <- dat.e[,i],
      y <- (dat.e[,i]-dat.m[i]) / dat.s[i],
      y <- dat.e[,i]
    )
    y <- dat.z[,i] - y #ahora como anomala (tipificada)
    ym <- mean(y, na.rm=TRUE)
    y <- y-ym #centramos las anomalas respecto a su propia media
    tit <- paste(i,": ",est.c[i,4],"-",est.c[i,5],sep="")
    if(ttip==3) tit <- paste(tit,"  (s=",round(dat.s[i],ndec+1),")",sep="")
    tit <- paste(tit,"       ",varcli," (",labm,")",sep="")
    plot(anyi:anyf,y,type="h",lty=1,lwd=3,main=tit,ylim=c(-5,5),xlab="Years",ylab="Centered normalized anomalies (original - estimated)",col=hsv(.7,1,.9))
    grid()
    abline(1,0,col=hsv(.3,1,.8),lty=2); abline(-1,0,col=hsv(.3,1,.8),lty=2)
    abline(2,0,col="red"); abline(-2,0,col="red")
    #pruebas de homogeneidad (saltos en la media y tendencias):
    if(pval>0) {
      indme <- paste(est.c[i,4],sprintf("%02d",as.integer(me))) #indicativo y mes
      #prueba mvil de la t (ventana de 10 trminos):
      movttest(y,indme,pval=pval)
      lines(anyi:anyf+.5,pv*2/pval,col="red") #p-valores de la prueba anterior
      #prueba mvil de la t (ventana de 10 trminos):
      movttest(y,indme,nterm=20,pval=pval)
      lines(anyi:anyf+.5,pv*2/pval,col=hsv(.3,1,.8)) #p-valores prueba anterior
      mtext("p-val",4,las=1,line=1,adj=0,at=5,col="red")
      mtext(pval,4,las=1,line=1,adj=0,at=2,col="red")
      mtext(0,4,las=1,line=1,adj=0,at=0,col="red")
      tpv <- cor.test(y,anyi:anyf)$p.value
      cat(indme,"Trend p-value:",round(tpv,3),"\n")
      if(tpv<pval) {
        areg <- lm(y~c(anyi:anyf))
        abline(areg,col="blue")
      }
    }
    cat("Station (1-",ne,"; RETURN=next, v=view data, g=graphic save, f=end)\n",sep="")
    zz <- scan(what=character(),n=1,quiet=TRUE)
    if(length(zz)==0) zz <- "0"
    if(zz=="f") break
    if(zz=="g") grabeps()  #grabar grfico en EPS
    else if(zz=="v") {
      yrotu <- paste(varcli,"data")
      y <- dat.e[,i]; yd <- dat.d[,i]
      if(sqrtrans) y[y>1] <- y[y>1] * y[y>1]
      yx <- max(max(y,na.rm=TRUE),max(yd,na.rm=TRUE))
      yn <- min(min(y,na.rm=TRUE),min(yd,na.rm=TRUE))
      yx <- yx + 0.1*(yx-yn)
      plot(anyi:anyf,y,ylim=c(yn,yx),type="l",lty=1,main=tit,xlab="Years",ylab=yrotu,col=hsv(.6))
      points(anyi:anyf,yd,type="b",col="red")
#     points(anyi:anyf,dat.d[,i],col="red")
#     segments(anyi:anyf,dat.d[,i],anyi:anyf,dat.e[,i],col="red")
      par(fg="black")
      legend(anyi,yx,legend=c("Originals","Estimated"),lty=c(1,1),col=c("red",hsv(.6)),bg="white",horiz=TRUE)
      par(fg=grey(.7))
      cat("RETURN=next station; g=graph save; f=end)\n",sep="")
      zz <- scan(what=character(),n=1,quiet=TRUE)
      if(length(zz)>0) {
        if(zz=="f") break
        if(zz=="g") grabeps()  #grabar grfico en EPS
        z0 <- substr(zz,1,1)
        if(z0>="0" && z0<="9") {
          qi <- as.numeric(zz)
          if(qi>0 && qi<=ne) i <- qi-1
        }
      }
    }
    else {
      z0 <- substr(zz,1,1)
      if(z0>="0" && z0<="9") {
        qi <- as.numeric(zz)
        if(qi>0 && qi<=ne) i <- qi-1
      }
    }
    i <- i+1
  }
  invisible()   #reset old.par (restablecemos parmetros grficos anteriores)
}

#depstat.- Clculo de promedios depurados del periodo deseado (-> *.med)
depstat <- function(varcli, anyi,anyf, anyip=anyi,anyfp=anyf, nm=12, ndec=1,
  vala=2) {
  if(anyip<anyi) {
    cat("First year former than initial year of data!\n")
    return()
  }
  if(anyfp>anyf) {
    cat("Last year later than final year of data!\n")
    return()
  }
  na <- anyf-anyi+1 #no. de aos
  arch <- paste(varcli,"_",substr(as.character(anyi),3,4),"-",substr(as.character(anyf),3,4),".",sep="") #raz de los nombres de archivo 
  arche <- paste(arch,"est",sep="") #nombre del archivo de estaciones
  est.c <<- read.table(arche) #leer coordenadas y nombres de las estaciones
  ne <<- nrow(est.c) #no. de estaciones
 #nd <<- na*nm #no. de datos por estacin
  archd <- paste(arch,"dep",sep="") #nombre del archivo de datos depurados
  dep <<- scan(archd) #lectura de los datos depurados
  attr(dep,"dim") <<- c(na,ne,nm) #conversin a matriz tridimensional
  ars <- paste(varcli,"_",substr(as.character(anyip),3,4),"-",substr(as.character(anyfp),3,4),".med",sep="") #nombre del archivo de salida
  sink(ars) #abrir archivo de salida
  cat("Average values of ",varcli," (",anyip,"-",anyfp,")\n\n",sep="")
  cat("Station    Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct    Nov    Dec Annual\n")
  cat("--------------------------------------------------------------------------------------------------\n")
  for(i in 1:ne) {
    #datos mensuales:
    dmens <- round(apply(dep[(anyip-anyi+1):(anyfp-anyi+1),i,],2,mean),ndec)
    #valor anual:
    switch(vala,
      vanu <- sum(dmens),
      vanu <- round(mean(dmens),ndec),
      vanu <- max(dmens),
      vanu <- min(dmens),
      vanu <- round(mean(dmens),ndec)
    )
    #imprimir los datos:
    cat(sprintf("%-8s",as.character(est.c[i,4]))) #indic. de la estacin
    cat(formatC(dmens,ndec,6,"f"),formatC(vanu,ndec,6,"f"),"\n")
  }
  sink()  #cerrar archivo de salida
}

#Prueba de la t para una ventana mvil
movttest <- function(x,indme,nterm=10,pval=.05,verb=TRUE) {
  n2 <- nterm/2; n1 <- n2-1; n3 <- 2*n2-1
  pmin <- 1; imin <- 0
  pv <<- rep(NA,na) #vector para guardar los p-valores
#if(verb) cat("Prueba de la t para una ventana mvil de",nterm,"trminos:\n")
  for(i in 1:(na-n3)) {
    n=0
    for(j in 0:n1) if(!is.na(x[i+j])) n <- n+1
    if(n<5) next #faltan datos
    n=0
    for(j in n2:n3) if(!is.na(x[i+j])) n <- n+1
    if(n<5) next #faltan datos
    pv[i+n1] <<- t.test(x[i:(i+n1)],x[(i+n2):(i+n3)])$p.value
#if(verb && pv[i+n1]<pval) cat(anyi+i+n1-1,"-",anyi+i+n1,": ",round(pv[i+n1],3),"\n",sep="")
    if(pmin>pv[i+n1]) { pmin=pv[i+n1]; imin=i }
  }
  if(verb && pmin<=pval) {
    cat(indme," Minimum p-value (",nterm," t.): ",sep="")
    if(pmin==1) cat("Not enough correlative data\n")
    else cat(round(pmin,3)," (",anyi+imin+n1-1,"-",anyi+imin+n1,")\n",sep="")
  }
}

#Grabar el grfico en eps
grabeps <- function() {
  if(dev.next()==dev.cur()) {
    ar <- system("date +R%y%m%d%H%M-%%02d.eps",TRUE)
    postscript(ar,onefile=FALSE,horizontal=FALSE,height=8,width=8,pointsize=12)
    dev.set(dev.prev())
  }
  dev.copy(which=dev.next())
  dev.set(dev.prev())
}

#Diagrama de Walter y Lieth
diagwl <- function( dat, est="", alt=NA, per="", margen=c(4,4,5,4),
    mlab="", pcol="#005ac8", tcol="#e81800", pfcol="cyan",
    sfcol="#0eb6d7", shem=FALSE, ...) {
  plot.new()
  old.par <- par(no.readonly = TRUE)
  on.exit(par(old.par))
  par(mar=margen, pty="s", las=1, new=FALSE)
  nr <- nrow(dat) #no. de filas de datos mensuales
  if(nrow(dat) < 4) { cat("4 rows of monthly data must be provided\n"); break; }
  #etiquetas de los meses
  if(mlab=="es") mlab=c("E","F","M","A","M","J","J","A","S","O","N","D")
  else if(mlab=="en") mlab=c("J","F","M","A","M","J","J","A","S","O","N","D")
  else mlab=c(1:12) #etiquetas numricas
  dat <- as.matrix(dat)
  if(shem) { #Hemisferio sur: desplazar los datos medio ao
    m1 <- dat[,1:6]
    m2 <- dat[,7:12]
    dat <- cbind(m2,m1)
    mlab <- c(mlab[7:12],mlab[1:6])
  }
  p <- dat[1,] #precipitaciones medias mensuales
  if(nr==2) tm <- dat[2,]
  else tm <- apply(dat[2:3,],2,mean)  #temperaturas medias mensuales
  pmax <- max(p) #precipitacin mxima
  ymax <- 60  #mxima ordenada por defecto
cat("ymax=",ymax,"\n");
  if(pmax > 300) ymax <- 50 + 10*floor((pmax+100)/200)
cat("pmax=",pmax,"ymax=",ymax,"\n");
  ymin <- min(-1.5,min(tm)) #mnima ordenada sin redondear
  #ejes:
  if(ymin < -1.5) {
    ymin=floor(ymin/10)*10 #mnima ordenada redondeada
cat("ymin=",ymin,"\n")
    labT <- paste(ymin)
    labP <- ""
    if(ymin < -10) {
      for(i in (ymin/10+1):-1) {
        labT <- c(labT,i*10)
        labP <- c(labP,"")
cat(i,i*10,"\n",labT,"\n",labP,"\n")
      }
    }
    labT <- c(labT,"0","10","20","30","40","50","")
    labP <- c(labP,"0","20","40","60","80","100","300")
  }
  else {
    labT <- c("0","10","20","30","40","50","")
    labP <- c("0","20","40","60","80","100","300")
  }
  if(ymax > 60) {
    for(i in 6:(ymax/10-1)) {
      labT <- c(labT,"")
      labP <- c(labP,100*(2*i-7))
    }
  }
  plot(0:13-0.5,c(tm[12],tm[1:12],tm[1]),xlim=c(0,12),ylim=c(ymin,ymax),type="l",col=tcol,xaxs="i",yaxs="i",xaxp=c(0,12,12),xlab="",ylab="",xaxt="n",yaxt="n",bty="n",...)
  lmin <- ymin #mnima ordenada a rotular
  if(lmin==-1.5) lmin=0
  axis(2,((lmin/10):(ymax/10))*10,labels=labT,col.axis=tcol)
  axis(4,((lmin/10):(ymax/10))*10,labels=labP,col.axis=pcol)
  mtext("C",2,col=tcol,las=1,line=3,adj=0,at=55)
  mtext("mm",4,col=pcol,las=1,line=3,adj=1,at=55)
  abline(0,0)
  abline(50,0)
  #rtulos:
  if(is.na(alt)) mtext(est,line=2,adj=0)
  else mtext(paste(est," (",alt," m)",sep=""),line=2,adj=0)
  mtext(per,line=1,adj=0)
  mtext(paste(round(mean(tm*10))/10,"C        ",round(sum(p))," mm",sep=""),line=1,adj=1)
  x <- 0:13-0.5
  p2 <- c(p[12],p[1:12],p[1])
  if(pmax<=100) {
    xl <- x
    yl <- c(p[12],p[1:12],p[1])/2
    n2 <- 14
  }
  else { #cambio de escala en prec. > 100
    xp <- numeric(30)
    yp <- numeric(30)
    xl <- numeric(25)
    yl <- numeric(25)
    n <- 0
    n2 <- 0
    gr <- FALSE
    if(p2[1]>100) { #primer punto
      n <- n+1
      xp[n] <- x[1]
      yp[n] <- 50
      n <- n+1
      xp[n] <- x[1]
      yp[n] <- 50 + (p2[1]-100)/20
      n2 <- n2+1
      xl[n2] <- x[1]
      yl[n2] <- 50
      gr <- TRUE
    }
    else {
      n2 <- n2+1
      xl[n2] <- x[1]
      yl[n2] <- p2[1]/2
    }
    for(i in 2:14) {  #dems puntos
      if(gr) {  #si p anterior > 100
        n <- n+1
        if(p2[i]>100) {
          xp[n] <- x[i]
          yp[n] <- 50 + (p2[i]-100)/20
        }
        else {
          xp[n] <- x[i-1] + (100-p2[i-1])/(p2[i]-p2[i-1])
          yp[n] <- 50
          n2 <- n2+1
          xl[n2] <- xp[n]
          yl[n2] <- 50
          n <- n+1
          xp[n] <- NA
          yp[n] <- NA
          n2 <- n2+1
          xl[n2] <- x[i]
          yl[n2] <- p2[i]/2
          gr <- FALSE
        }
      }
      else {  # p anterior <=100
        if(p2[i]>100) { #si p > 100
          n <- n+1
          xp[n] <- x[i-1] + (100-p2[i-1])/(p2[i]-p2[i-1])
          yp[n] <- 50
          if(xl[n2]!=x[i-1]) {  #no repetir puntos!
            n2 <- n2+1
            xl[n2] <- x[i-1]
            yl[n2] <- p2[i-1]/2
          }
          n2 <- n2+1
          xl[n2] <- xp[n]
          yl[n2] <- 50
          n <- n+1
          xp[n] <- x[i]
          yp[n] <- 50 + (p2[i]-100)/20
          gr <- TRUE
        }
        else { # p <=100
          n2 <- n2+1
          xl[n2] <- x[i]
          yl[n2] <- p2[i]/2
        }
      }
    }
    if(!is.na(yp[n])) {  #cerrar ltimo polgono
      n <- n+1
      xp[n] <- xp[n-1]
      yp[n] <- 50
      n2 <- n2+1
      xl[n2] <- 12.5
      yl[n2] <- 50
    }
    polygon(xp[1:n],yp[1:n],col=pcol,border=pcol)
  }
  #tramas:
  pi <- approx(xl[1:n2],yl[1:n2],n=66)$y
  ti <- approx(x,c(tm[12],tm[1:12],tm[1]),n=66)$y
  d <- pi - ti
  xi <- (1:66)/5-0.7
  xw <- subset(xi,d>0) #periodo hmedo
  y1 <- subset(pi,d>0)
  y2 <- subset(ti,d>0)
  if(length(xw)>0) segments(xw,y1,xw,y2,col=pcol,lty=1,lwd=1)
  xw <- subset(xi,d<0) #periodo seco
  y1 <- subset(pi,d<0)
  y2 <- subset(ti,d<0)
  if(length(xw)>0) segments(xw,y1,xw,y2,col=tcol,lty=3,lwd=2)
  #curvas de P y T:
  lines(xl[1:n2],yl[1:n2],col=pcol,lwd=2)
  lines(x,c(tm[12],tm[1:12],tm[1]),col=tcol,lwd=2)
  #media de las mximas del mes ms clido
  mtext(formatC(max(as.matrix(dat[2,])),digits=1,format="f"),2,las=1,
    line=2,at=35)
  #media de las mnimas del mes ms fro
  mtext(formatC(min(as.matrix(dat[3,])),digits=1,format="f"),2,las=1,
    line=2,at=15)
  #marcar lmites de los meses:
  for(i in 0:13) segments(i,0,i,-1.5)
  #heladas seguras
  for(i in 1:12) if(dat[3,i]<=0) rect(i-1,-1.5,i,0,col=sfcol)
  #heladas probables
  for(i in 1:12) if(dat[4,i]<=0 && dat[3,i]>0) rect(i-1,-1.5,i,0,col=pfcol)
  #rtulos meses:
  mtext(mlab,1,las=1,line=0.5,adj=0.5,at=x[2:13])
  #reset old.par (restablecemos parmetros grficos anteriores):
  invisible()
}
#Rosa de los vientos, con nmero de direcciones variable
rosavent <- function(frec, fnum=4, fint=5, flab=2, ang=3*pi/16,
    col=rainbow(10,.5,.92,start=.33,end=.2), margen=c(0, 0, 4, 0),
    key=TRUE, uni="m/s", ...) {
  plot.new()
  old.par <- par(no.readonly = TRUE)
  on.exit(par(old.par))
  if(is.vector(frec)) nr <- 1  #no. de clases de velocidad
  else nr <- nrow(frec)
  ndir <- length(frec) #nmero de direcciones
  fmax <- fnum*fint  #frecuencia mxima a sealar con un crculo
  #convertimos las frecuencias a porcentajes:
  tot <- sum(frec)
  fr <- 100 * frec / tot
  key <- (nr>1) && key  #leyenda slo si hay varias clases
  #hacer sitio para la leyenda a la izda. del grfico:
  if(key) mlf <- 3 else mlf <- 1  #factor para el margen izquierdo
  par(mar=margen, new=FALSE)    #margen para la rosa de los vientos
  #componentes para cada direccin y preparacin del dibujo:
  fx <- cos(pi/2-(2*pi/ndir*0:(ndir-1)))
  fy <- sin(pi/2-(2*pi/ndir*0:(ndir-1)))
  plot(fx,fy,xlim=c(-fmax-mlf*fint,fmax+fint),ylim=c(-fmax-fint,fmax+fint),
    xaxt="n",yaxt="n",xlab="",ylab="",bty="n",asp=1,type="n", ...)
  if(nr==1) {  #una sola fila de direcciones
    cx <- fx*fr
    cy <- fy*fr
  }
  else {  #varias filas (= clases de velocidad)
    f <- apply(fr,2,sum)
    cx <- fx*f
    cy <- fy*f
    for(i in nr:2) {
      f <- f-fr[i,]
      cx <- c(cx,NA,fx*f)
      cy <- c(cy,NA,fy*f)
    }
  }
  polygon(cx,cy,col=col[nr:1])
  symbols(c(0*1:fnum),c(0*1:fnum),circles=c(fint*1:fnum),inches=FALSE,add=TRUE)
  segments(0*1:ndir,0*1:ndir,fmax*fx,fmax*fy)
  fmaxi <- fmax+fint/4
  text(0,fmaxi,"N")
  text(0,-fmaxi,"S")
  text(fmaxi,0,"E")
  text(-fmaxi,0,"W")
  if(flab==2)
    for(i in 1:fnum) text(i*fint*cos(ang),i*fint*sin(ang),paste(i*fint,"%"))
  else if(flab==1)
    text(fmax*cos(ang),fmax*sin(ang),paste(fmax,"%"))
  if(key) { #leyenda
    legend(-fmaxi-2*fint,fmaxi,fill=col,legend=attr(frec,"row.names"))
    text(-fmaxi-1.4*fint,fmaxi+.3*fint,uni)
  }
  invisible()   #reset old.par (restablecemos parmetros grficos anteriores)
}
