Commit a97072ac authored by agebhard's avatar agebhard
Browse files

retrun of lambda etc now opional

parent e4510cc1
...@@ -77,16 +77,16 @@ bk.grid <- function(point.obj, ...@@ -77,16 +77,16 @@ bk.grid <- function(point.obj,
snbbit<-rep(0,1+n*nz)
snbbit[1]<-1
if(get.lm){ if(get.lm){
mu <- double(ntrend*nz) mu <- double(ntrend*nz)
lambda <- double(n*nz) lambda <- double(n*nz)
lambd0 <- double(nz) lambd0 <- double(nz)
snbbits <- integer(n*nz)
} else { } else {
mu <- double(ntrend) mu <- double(ntrend)
lambda <- double(n) lambda <- double(n)
lambd0 <- double(1) lambd0 <- double(1)
snbbits <- integer(1)
} }
...@@ -134,8 +134,8 @@ bk.grid <- function(point.obj, ...@@ -134,8 +134,8 @@ bk.grid <- function(point.obj,
mu = as.double(mu), mu = as.double(mu),
lambda = as.double(lambda), lambda = as.double(lambda),
lambd0 = double(lambd0), lambd0 = double(lambd0),
bits = as.integer(c(integer(nz),snbbit)),
ierr = integer(1), ierr = integer(1),
bits = as.integer(snbbits),
get.lm = as.integer(get.lm), get.lm = as.integer(get.lm),
glsmth = as.integer(method), glsmth = as.integer(method),
# ,.Package= "baykrig" # ,.Package= "baykrig"
...@@ -146,13 +146,16 @@ bk.grid <- function(point.obj, ...@@ -146,13 +146,16 @@ bk.grid <- function(point.obj,
z=matrix(ans$zg,nx,ny), z=matrix(ans$zg,nx,ny),
var=matrix(ans$varg,nx,ny), var=matrix(ans$varg,nx,ny),
done=matrix(ans$dog, nx, ny), done=matrix(ans$dog, nx, ny),
snb=matrix(ans$bits[(nz+2):(nz+n*nz+1)],nrow=n,ncol=nz,byrow=F)
) )
if(get.lm){ if(get.lm){
retval$snb <- matrix(ans$bits,nrow=n,ncol=nz,byrow=F)
retval$lambda <- matrix(ans$lambda,nrow=n,ncol=nz,byrow=FALSE) retval$lambda <- matrix(ans$lambda,nrow=n,ncol=nz,byrow=FALSE)
retval$lambda0 <- matrix(ans$lambd0,nx,ny) retval$lambda0 <- matrix(ans$lambd0,nx,ny)
retval$mu <- matrix(ans$mu,nrow=n,ncol=ntrend,byrow=FALSE) retval$mu <- matrix(ans$mu,nrow=n,ncol=ntrend,byrow=FALSE)
} else {
retval$snb <- retval$lambda <- retval$lambda0 <- retval$mu <- NULL
} }
retval$z[retval$done<=0] <- NA retval$z[retval$done<=0] <- NA
retval$var[retval$done<=0] <- NA retval$var[retval$done<=0] <- NA
retval$lambda0[retval$done<=0] <- NA retval$lambda0[retval$done<=0] <- NA
......
...@@ -253,13 +253,12 @@ c if (dst.eq.0.0D0) write(*,*)i,j,dst ...@@ -253,13 +253,12 @@ c if (dst.eq.0.0D0) write(*,*)i,j,dst
c rotation: c rotation:
c call drotg(nz,xgwork,1,ygwork,1,COS(ALPHA),SIN(ALPHA)) c call drotg(nz,xgwork,1,ygwork,1,COS(ALPHA),SIN(ALPHA))
c loop over all points and pass them to KRIGE: c loop over all points and pass them to KRIGE:
if (bits(1+nz).ne.0) then
usesbbt=1
end if
if (retlm.eq.1) then if (retlm.eq.1) then
PCNT=0 PCNT=0
usesbbt=1
else else
PCNT=1 PCNT=1
usesbbt=0
end if end if
DO 20 I=1,NX DO 20 I=1,NX
DO 10 J=1,NY DO 10 J=1,NY
...@@ -352,7 +351,7 @@ c . LAMBDA, ...@@ -352,7 +351,7 @@ c . LAMBDA,
. L0, . L0,
c . LAMBD0(pcnt), c . LAMBD0(pcnt),
. VAR0, . VAR0,
. BITS(nz+2+(pcnt-1)*n), . BITS(1+(pcnt-1)*n),
. USESBBT, . USESBBT,
. IERR, . IERR,
. GLSMTH) . GLSMTH)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment