Commit a97072ac authored by agebhard's avatar agebhard

retrun of lambda etc now opional

parent e4510cc1
......@@ -77,16 +77,16 @@ bk.grid <- function(point.obj,
snbbit<-rep(0,1+n*nz)
snbbit[1]<-1
if(get.lm){
mu <- double(ntrend*nz)
lambda <- double(n*nz)
lambd0 <- double(nz)
snbbits <- integer(n*nz)
} else {
mu <- double(ntrend)
lambda <- double(n)
lambd0 <- double(1)
snbbits <- integer(1)
}
......@@ -134,8 +134,8 @@ bk.grid <- function(point.obj,
mu = as.double(mu),
lambda = as.double(lambda),
lambd0 = double(lambd0),
bits = as.integer(c(integer(nz),snbbit)),
ierr = integer(1),
bits = as.integer(snbbits),
get.lm = as.integer(get.lm),
glsmth = as.integer(method),
# ,.Package= "baykrig"
......@@ -146,13 +146,16 @@ bk.grid <- function(point.obj,
z=matrix(ans$zg,nx,ny),
var=matrix(ans$varg,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){
retval$snb <- matrix(ans$bits,nrow=n,ncol=nz,byrow=F)
retval$lambda <- matrix(ans$lambda,nrow=n,ncol=nz,byrow=FALSE)
retval$lambda0 <- matrix(ans$lambd0,nx,ny)
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$var[retval$done<=0] <- NA
retval$lambda0[retval$done<=0] <- NA
......
......@@ -253,13 +253,12 @@ c if (dst.eq.0.0D0) write(*,*)i,j,dst
c rotation:
c call drotg(nz,xgwork,1,ygwork,1,COS(ALPHA),SIN(ALPHA))
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
PCNT=0
usesbbt=1
else
PCNT=1
usesbbt=0
end if
DO 20 I=1,NX
DO 10 J=1,NY
......@@ -352,7 +351,7 @@ c . LAMBDA,
. L0,
c . LAMBD0(pcnt),
. VAR0,
. BITS(nz+2+(pcnt-1)*n),
. BITS(1+(pcnt-1)*n),
. USESBBT,
. IERR,
. 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