Commit 4f890057 authored by agebhard's avatar agebhard

kein crash mehr, leading dim von covbta war falsch!!

bayes krige varianzen sind aber deutlich hoeher als uk var.!?
parent f326ea16
R : Copyright 2002, The R Development Core Team
Version 1.5.0 (2002-04-29)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type `license()' or `licence()' for distribution details.
R is a collaborative project with many contributors.
Type `contributors()' for more information.
Type `demo()' for some demos, `help()' for on-line help, or
`help.start()' for a HTML browser interface to help.
Type `q()' to quit R.
[Previously saved workspace restored]
> options(STERM='iESS', editor='emacslient')
>
> library(baykrig)
Loading required package: rgeostat
Loading required package: sgeostat
Loading required package: mva
> plot(leman.bkgrid,var=T)
Warning message:
X11 used font size 8 when 7 was requested
> q()
Save workspace image? [y/n/c]: y
Process R segmentation fault at Thu May 23 11:45:47 2002
R : Copyright 2002, The R Development Core Team
Version 1.5.0 (2002-04-29)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type `license()' or `licence()' for distribution details.
R is a collaborative project with many contributors.
Type `contributors()' for more information.
Type `demo()' for some demos, `help()' for on-line help, or
`help.start()' for a HTML browser interface to help.
Type `q()' to quit R.
[Previously saved workspace restored]
> options(STERM='iESS', editor='emacslient')
> library(baykrig)
Loading required package: rgeostat
Loading required package: sgeostat
Loading required package: mva
> plot(leman.bkgrid,var=T)
Warning message:
X11 used font size 8 when 7 was requested
> q()
Save workspace image? [y/n/c]: y
Process R finished at Thu May 23 11:46:49 2002
R : Copyright 2002, The R Development Core Team
Version 1.5.0 (2002-04-29)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type `license()' or `licence()' for distribution details.
R is a collaborative project with many contributors.
Type `contributors()' for more information.
Type `demo()' for some demos, `help()' for on-line help, or
`help.start()' for a HTML browser interface to help.
Type `q()' to quit R.
[Previously saved workspace restored]
> options(STERM='iESS', editor='emacslient')
> library(baykrig)
Loading required package: rgeostat
Loading required package: sgeostat
Loading required package: mva
> plot(leman.bkgrid,var=T)
Warning message:
X11 used font size 8 when 7 was requested
> plot(leman.krg,var=T)
> plot(leman.bkgrid,var=T)
> leman.bkgrid.0<-bk.grid(point = leman.88.pt, at = "cadpbm", prior = leman.prior.0, 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 = 50, ny = 50, trend = 1, rsearch = 10, extrap = F, border = leman.bank, duplicate = "mean")
Error in bk.grid(point = leman.88.pt, at = "cadpbm", prior = leman.prior.0, :
model order of priors does not match!
> leman.bkgrid.0<-bk.grid(point = leman.88.pt, at = "cadpbm", prior = leman.prior.0, 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 = 50, ny = 50, trend = 0, rsearch = 10, extrap = F, border = leman.bank, duplicate = "mean")
huhu
> plot(leman.bkgrid.0,var=T)
> plot(leman.bkgrid.0)
> save.image()
> q()
Save workspace image? [y/n/c]: y
Process R finished at Thu May 23 12:14:15 2002
......@@ -310,7 +310,7 @@ c name="covbta\0"
c call matpr(name,covbta,ntrend,ntrend,ntrend,1)
END IF
goto 123
ccc goto 123
......@@ -525,7 +525,7 @@ c Z0 = LAMBDA' * Z + LAMBD0
END IF
c name="z0"
c call matpr(z0,n0,1,n0,name,dbglvl)
write(*,*)"z: ",z0(1)
c write(*,*)"z: ",z0(1)
IWORK(1)=NS
123 continue
RETURN
......
......@@ -42,7 +42,8 @@ void bk_grid(double *xsw,
int *glsmth){
int nz=(*nx)*(*ny), ldcov=(*n), ldc0=(*n),ldphwk=(*ntrend),
ldfwrk=(*n), ldlmbd=(*n), ldkwrk=(*n), ldcvbt=(*ntrend)*(*ntrend),
ldfwrk=(*n), ldlmbd=(*n), ldkwrk=(*n), // ldcvbt=(*ntrend)*(*ntrend),
ldcvbt=(*ntrend),
ldclup=(*n),ldcinv=(*n),ldzg=(*nx);
double *covmat, *c0vec, *muwrk, *phiwrk, *beta, errbta,
*dev, errdev, *covbta, *cvsrnb, *zsrnb,
......
......@@ -259,7 +259,7 @@ c loop over all points and pass them to KRIGE:
X0=XG(I)
Y0=YG(J)
DO0(1)=DOG(I,J)
write(*,*),i,j
c write(*,*),i,j
c the main work is now done by BK:
IF (DO0(1).EQ.1) THEN
INDDO(1)=1
......@@ -351,11 +351,11 @@ c extract results for this tile
DOG(I,J)=-1
ZG(I,J)=0
VARG(I,J)=0
write(*,*)"x"
c write(*,*)"x"
ELSE
ZG(I,J)=Z0
VARG(I,J)=VAR0
write(*,*)"o"
c write(*,*)"o"
c VARG(I,J)=IWORK(1)*1.0D0
c VARG(I,J)=lambd0
END IF
......
......@@ -201,8 +201,8 @@ ccc
c goto 123
ccccccc FEHLER ccccccccc:
c CALL DGEMM('N','N',NTREND,NTREND,N,ONE,
c . CWORK,LDCWRK,FMAT,LDF,ZERO,COVBTA,LDCVBT)
CALL DGEMM('N','N',NTREND,NTREND,N,ONE,
. CWORK,LDCWRK,FMAT,LDF,ZERO,COVBTA,LDCVBT)
ccc
c goto 123
......@@ -220,9 +220,9 @@ c goto 123
c destroys CHLUP with inverse of F'*C**-1*F:
ccc naechster fehler:
c goto 123
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 )
CALL DSYSVX( 'N', 'U', NTREND, NTREND, COVBTA, LDCVBT, CWRK2,
$ LDCWK2, IPIV, CWORK, LDCWRK, CHLUP, LDCLUP,
$ RCOND, FERR, BERR, WORK, LWORK, IWORK, IERR )
IF ( IERR .NE. 0) THEN
IF ( IERR .LT. 0 ) THEN
CALL ERRMSG('GLSFIT DSYSVX: argument no IERR wrong',38,
......@@ -238,13 +238,14 @@ c $ RCOND, FERR, BERR, WORK, LWORK, IWORK, IERR )
RETURN
END IF
C EINE WEITERE FEHLERSTELLE !!!
ccc goto 123
DO 150 I=1,NTREND
DO 140 J=1,NTREND
COVBTA(I,J)=CHLUP(I,J)
140 CONTINUE
150 CONTINUE
goto 123
GO TO 4
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