Commit 83519b37 authored by agebhard's avatar agebhard
Browse files

noch mehr fehler?

parent 4f1c083a
...@@ -210,7 +210,7 @@ bk.grid <- function(point.obj, ...@@ -210,7 +210,7 @@ bk.grid <- function(point.obj,
typpr<-prior$info typpr<-prior$info
typpr[prior$type=="subjective"]<-typpr[prior$type=="subjective"]*(-1) typpr[prior$type=="subjective"]<-typpr[prior$type=="subjective"]*(-1)
browser() #browser()
if(FALSE) if(FALSE)
ans<-.C("bk_grid", ans<-.C("bk_grid",
# xsw = as.double(xsw), # xsw = as.double(xsw),
...@@ -338,7 +338,7 @@ if(TRUE) ans<-.C("bk_grid", ...@@ -338,7 +338,7 @@ if(TRUE) ans<-.C("bk_grid",
glsmth = as.integer(method), glsmth = as.integer(method),
# ,.Package= "baykrig" # ,.Package= "baykrig"
) )
browser() #browser()
retval<-list(x=ans$xg, retval<-list(x=ans$xg,
y=ans$yg, y=ans$yg,
z=matrix(ans$zg,nx,ny), z=matrix(ans$zg,nx,ny),
......
...@@ -29,4 +29,4 @@ library(baykrig) ...@@ -29,4 +29,4 @@ library(baykrig)
library(baykrig) library(baykrig)
leman.bk<- bk.grid(point = leman.88.pt , at = "cadpbm", prior=leman.prior,var.mod.obj = leman.88.vmsph, xsw=min(leman.bank$x),ysw=min(leman.bank$y), xne=max(leman.bank$x), yne=max(leman.bank$y), nx=100, ny=100, trend=1, rsearch = 10, extrap = F,border=leman.bank, duplicate="mean",method="ols") leman.bk<- bk.grid(point = leman.88.pt , at = "cadpbm", prior=leman.prior,var.mod.obj = leman.88.vmsph, xsw=min(leman.bank$x),ysw=min(leman.bank$y), xne=max(leman.bank$x), yne=max(leman.bank$y), nx=100, ny=100, trend=1, rsearch = 10, extrap = F,border=leman.bank, duplicate="mean",method="ols")
library(baykrig) library(baykrig)
leman.bk<- bk.grid(point = leman.88.pt , at = "cadpbm", prior=leman.prior,var.mod.obj = leman.88.vmsph, xsw=min(leman.bank$x),ysw=min(leman.bank$y), xne=max(leman.bank$x), yne=max(leman.bank$y), nx=100, ny=100, trend=1, rsearch = 10, extrap = F,border=leman.bank, duplicate="mean") leman.bk<- bk.grid(point = leman.88.pt , at = "cadpbm", prior=leman.prior,var.mod.obj = leman.88.vmsph, xsw=min(leman.bank$x),ysw=min(leman.bank$y), xne=max(leman.bank$x), yne=max(leman.bank$y), nx=5, ny=5, trend=1, rsearch = 10, extrap = F,border=leman.bank, duplicate="mean")
...@@ -201,11 +201,11 @@ ccc ...@@ -201,11 +201,11 @@ ccc
c goto 123 c goto 123
ccccccc FEHLER ccccccccc: ccccccc FEHLER ccccccccc:
CALL DGEMM('N','N',NTREND,NTREND,N,ONE, c CALL DGEMM('N','N',NTREND,NTREND,N,ONE,
. CWORK,LDCWRK,FMAT,LDF,ZERO,COVBTA,LDCVBT) c . CWORK,LDCWRK,FMAT,LDF,ZERO,COVBTA,LDCVBT)
ccc ccc
goto 123 c goto 123
DO 130 I=1,NTREND DO 130 I=1,NTREND
DO 120 J=1,NTREND DO 120 J=1,NTREND
IF( I.EQ.J) THEN IF( I.EQ.J) THEN
...@@ -218,9 +218,11 @@ ccc ...@@ -218,9 +218,11 @@ ccc
c destroys CHLUP with inverse of F'*C**-1*F: c destroys CHLUP with inverse of F'*C**-1*F:
CALL DSYSVX( 'N', 'U', NTREND, NTREND, COVBTA, LDCVBT, CWRK2, ccc naechster fehler:
$ LDCWK2, IPIV, CWORK, LDCWRK, CHLUP, LDCLUP, c goto 123
$ RCOND, FERR, BERR, WORK, LWORK, IWORK, IERR ) c CALL DSYSVX( 'N', 'U', NTREND, NTREND, COVBTA, LDCVBT, CWRK2,
c $ LDCWK2, IPIV, CWORK, LDCWRK, CHLUP, LDCLUP,
c $ RCOND, FERR, BERR, WORK, LWORK, IWORK, IERR )
IF ( IERR .NE. 0) THEN IF ( IERR .NE. 0) THEN
IF ( IERR .LT. 0 ) THEN IF ( IERR .LT. 0 ) THEN
CALL ERRMSG('GLSFIT DSYSVX: argument no IERR wrong',38, CALL ERRMSG('GLSFIT DSYSVX: argument no IERR wrong',38,
...@@ -242,6 +244,7 @@ c destroys CHLUP with inverse of F'*C**-1*F: ...@@ -242,6 +244,7 @@ c destroys CHLUP with inverse of F'*C**-1*F:
140 CONTINUE 140 CONTINUE
150 CONTINUE 150 CONTINUE
goto 123
GO TO 4 GO TO 4
c direct computation of BETA: c direct computation of BETA:
......
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