Commit a897e6ab authored by agebhard's avatar agebhard

covmat now external parameter

parent 760972cc
......@@ -56,7 +56,6 @@ bk.grid <- function(point.obj,
linear=4,
0)
cov0<-0
covmat<-matrix(0,n,n)
# determine optimum array sizes:
if(!is.null(method)){
......@@ -103,6 +102,9 @@ bk.grid <- function(point.obj,
n = as.integer(n),
covtype = as.integer(covtype),
covpar = as.double(var.mod.obj$parameters),
covmat = double(n*n),
ldcov = as.integer(n),
extcov = as.integer(0), # no external cov matrix
trend = as.integer(trend),
ntrend = as.integer(ntrend),
mupr = as.double(matlist.cbind(prior$mu)),
......
......@@ -21,6 +21,9 @@ void F77_NAME(bk_grid)(double *xsw,
int *n,
int *covtype,
double *covpar,
double *covmat,
int *ldcov,
int *extcov,
int *trend,
int *ntrend,
double *mupr,
......@@ -64,6 +67,9 @@ bk_grid(xsw,
n,
covtype,
covpar,
covmat,
ldcov,
extcov,
trend,
ntrend,
mupr,
......@@ -108,6 +114,9 @@ void bk_grid(double *xsw,
int *n,
int *covtype,
double *covpar,
double *covmat,
int *ldcov,
int *extcov,
int *trend,
int *ntrend,
double *mupr,
......@@ -130,11 +139,11 @@ void bk_grid(double *xsw,
int *ierr,
int *glsmth){
int nz=(*nx)*(*ny), ldcov=(*n), ldc0=(*n),ldphwk=(*ntrend),
int nz=(*nx)*(*ny), ldc0=(*n),ldphwk=(*ntrend),
ldfwrk=(*n), ldlmbd=(*n), ldkwrk=(*n),
ldcvbt=(*ntrend),
ldclup=(*n),ldcinv=(*n),ldzg=(*nx);
double *covmat, *c0vec, *muwrk, *phiwrk, *beta, errbta,
double *c0vec, *muwrk, *phiwrk, *beta, errbta,
*dev, errdev, *covbta, *cvsrnb, *zsrnb,
*fwork, *fwrk2, *f0work, *dist, *kwork,
*rhswork, *fpwork, *fpfwork, *fpf0wrk, *chlup,
......@@ -146,7 +155,6 @@ void bk_grid(double *xsw,
/* #if 0 */
#ifndef TRANSIENT
covmat =Calloc((size_t)(*n)*(*n),double);
c0vec =Calloc((size_t)(*n),double);
muwrk =Calloc((size_t)(*ntrend),double);
phiwrk =Calloc((size_t)((*ntrend)*(*ntrend)),double);
......@@ -177,7 +185,6 @@ void bk_grid(double *xsw,
iwork =Calloc((size_t)(3*(*n)),int);
mu =Calloc((size_t)(*ntrend),double);
#else
covmat =(double *) R_alloc((*n)*(*n),sizeof(double));
c0vec =(double *) R_alloc((*n),sizeof(double));
muwrk =(double *) R_alloc((*ntrend),sizeof(double));
phiwrk =(double *) R_alloc((*ntrend)*(*ntrend),sizeof(double));
......@@ -232,10 +239,11 @@ void bk_grid(double *xsw,
n,
covtype,
covpar,
covmat,
&ldcov,
c0vec,
&cov0,
covmat,
ldcov,
extcov,
trend,
ntrend,
mupr,
......@@ -326,7 +334,6 @@ void bk_grid(double *xsw,
Free(phiwrk);
Free(muwrk);
Free(c0vec);
Free(covmat);
#else
......@@ -360,12 +367,9 @@ void bk_grid(double *xsw,
free(phiwrk);
free(muwrk);
free(c0vec);
free(covmat);
*/
#endif
/* #endif */
printf("huhu\n");
}
......@@ -24,6 +24,9 @@ void bk_grid(double *xsw,
int *n,
int *covtype,
double *covpar,
double *covmat,
int *ldcov,
int *extcov,
int *trend,
int *ntrend,
double *mupr,
......@@ -67,6 +70,9 @@ void F77_NAME(bk_grid)(double *xsw,
int *n,
int *covtype,
double *covpar,
double *covmat,
int *ldcov,
int *extcov,
int *trend,
int *ntrend,
double *mupr,
......@@ -112,10 +118,11 @@ void F77_NAME(bkgrid)(double *xsw,
int *n,
int *covtype,
double *covpar,
double *covmat,
int *ldcov,
double *c0vec,
double *cov0,
double *covmat,
int *ldcov,
int *extcov,
int *trend,
int *ntrend,
double *mupr,
......
......@@ -21,10 +21,11 @@
. N,
. COVTYPE,
. COVPAR,
. COVMAT,
. LDCOV,
. C0VEC,
. COV0,
. COVMAT,
. LDCOV,
. EXTCOV,
. TREND,
. NTREND,
. MUPR,
......@@ -86,7 +87,7 @@
IMPLICIT NONE
INTEGER NX,NY,NZ,N,COVTYPE,TREND,NTREND,LDZG,
. NSEARCH,NSMIN,NSMAX,MODE,IERR,INDSNB(*),INDSNW(*),
. INDSRT(*),IPIV(*),IPT,EXTRAP,DOG(NX,*),LDKWRK,
. INDSRT(*),IPIV(*),IPT,EXTRAP,DOG(NX,*),LDKWRK,EXTCOV,
. LDCOV,LDFWRK,LDMPR,LDPHPR,LDPHWK,LDCVBT,LWORK,LDLMBD,
. LDCLUP,LDCINV,NPR,TYPPR(*),IPVT(*),IWORK(*),GLSMTH,BITS(*)
DOUBLE PRECISION XSW,YSW,XNE,YNE,ANGLE,DX,DY,
......@@ -231,6 +232,7 @@ c call matpr(name,yg,ny,1,ny,dbglvl)
c prepare the covariance matrix
IF (COVTYPE.NE.0) THEN
IF (EXTCOV.NE.1) THEN
DO 1000 I=1,N
DO 1001 J=I,N
DST=SQRT((LON(I)-LON(J))*(LON(I)-LON(J))+
......@@ -240,6 +242,7 @@ c if (dst.eq.0.0D0) write(*,*)i,j,dst
COVMAT(J,I)=COVMAT(I,J)
1001 CONTINUE
1000 CONTINUE
END IF
ELSE
IERR=1
CALL ERRMSG('BKGRID: no covariance type specified!',38,
......
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