Skip to content

GitLab

B
baykrig
Commit ec47cd70 authored by alge's avatar alge
Browse files
Options

auskommentierungen entfernt

parent 82767c40
Hide whitespace changes
Inline Side-by-side
Showing with 13 additions and 189 deletions
src/bk.f
View file @ ec47cd70
......@@ -304,7 +304,7 @@ c call matpr(name,beta,ntrend,1,ntrend,1)
c name="covbta\0"
c call matpr(name,covbta,ntrend,ntrend,ntrend,1)
END IF
goto 123
cccc goto 123
c merge priors with search neighbourhood:
c average all prior guesses with estimation in search neighbourhood
......@@ -517,8 +517,9 @@ c Z0 = LAMBDA' * Z + LAMBD0
END IF
c name="z0"
c call matpr(z0,n0,1,n0,name,dbglvl)
write(*,*)"z: ",z0(1)
IWORK(1)=NS
123 continue
cccc 123 continue
RETURN
END
......
src/bk_grid.c
View file @ ec47cd70
#include "bk_grid.h"
#include "bk_grid.h"
void bk_grid(double *xsw,
double *ysw,
......@@ -53,6 +53,7 @@ void bk_grid(double *xsw,
int *indsnb, *indsnw, *indsrt, *ipiv, *ipvt, *iwork;
/* #if 0 */
#ifndef TRANSIENT
covmat =Calloc((size_t)(*n)*(*n),double);
c0vec =Calloc((size_t)(*n),double);
......@@ -225,7 +226,7 @@ void bk_grid(double *xsw,
Free(indsnb);
Free(dist);
Free(f0work);
/*
Free(fwrk2); // crash bei trend=0
Free(fwork);
Free(zsrnb);
......@@ -237,7 +238,7 @@ void bk_grid(double *xsw,
Free(muwrk);
Free(c0vec);
Free(covmat);
*/
#else
/*
......@@ -274,6 +275,9 @@ void bk_grid(double *xsw,
free(covmat);
*/
#endif
/* #endif */
printf("huhu\n");
}
src/bk_grid.h
View file @ ec47cd70
......@@ -43,7 +43,7 @@ void bk_grid(double *xsw,
int *searchnb,
int *ierr,
int *glsmth);
void F77_NAME(bkgrid)(double *xsw,
double *ysw,
double *xne,
......@@ -129,3 +129,4 @@ void F77_NAME(bkgrid)(double *xsw,
int *ierr,
int *glsmth);
src/bkgrid.f
View file @ ec47cd70
SUBROUTINE BKGRWR(DATVEC,
. DBLVEC,
. INTVEC,
. ZG,
. LDZG,
. VARG,
. LDVARG,
. DOG,
. LDDOG,
. COVPAR,
. COVMAT,
. LDCOV,
. C0VEC,
. COV0,
. MUPR,
. LDMPR,
. PHIPR,
. LDPHPR,
. PHIWRK,
. LDPHWK,
. LONPR,
. LATPR,
. COVBTA,
. LDCVBT,
. CVSRNB,
. RSEARCH,
. FWORK,
. FWRK2,
. LDFWRK,
. F0WORK,
. KWORK,
. LDKWRK,
. RHSWORK,
. FPWORK,
. FPFWORK,
. FPF0WRK,
. CHLUP,
. LDCLUP,
. CMINV,
. LDCINV,
. MU,
. LAMBDA,
. LAMBD0,
. IERR)
IMPLICIT NONE
INTEGER LDCOV,LDFWRK,LDMPR,LDPHPR,LDPHWK,LDCVBT,LDCLUP,
. LDCINV,LDKWRK,LDZG,LDVARG,LDDOG,
. INTVEC(*),IERR,DOG(LDDOG,*)
DOUBLE PRECISION DATVEC(*),DBLVEC(*),
. ZG(LDZG,*),VARG(LDVARG,*),
. COVMAT(LDCOV,*),C0VEC(*),COV0,
. RSEARCH,FWORK(LDFWRK,*),F0WORK(*),
. KWORK(LDKWRK,*),RHSWORK(*),MU(*),
. LAMBDA(*),FWRK2(LDFWRK,*),
. COVPAR(*),
. FPWORK(LDFWRK,*),FPFWORK(LDFWRK,*),
. FPF0WRK(LDFWRK,*),MUPR(LDMPR,*),
. PHIPR(LDPHPR,*),PHIWRK(LDPHWK,*),LAMBD0,
. LONPR(*),LATPR(*),
. COVBTA(LDCVBT,*),
. CHLUP(LDCLUP,*),CMINV(LDCINV,*),
. CVSRNB(LDCOV,*)
c call wrapper for BKGRID to reduce no of parameters to be passed
c from R:
c
c all double data goes to DATVEC, remaining things to DBLVEC (double)
c and INTVEC (integer)
c
c DATVEC=XSW+YSW+XNE+YNE+ANGLE+DX+DY+LON+LAT+Z
c length= 1 1 1 1 1 1 1 N N N
c
c DBLVEC=XG+YG+ muwrk beta errbeta dev errdev zsrnb dist work ferr berr
c length=NX+NY+ ntrend+ntrend +1 +n +1 +n +n +lwork +n +n
c
c INTVEC=NX NY NZ EXTRAP N COVTYPE TREND NTREND NPR TYPPR NSEARCH NSMIN
c length= 1 1 1 1 1 1 1 1 1 npr 1 1
c NSMAX INDSNB INDSNW INDSRT LWORK IPVT IPIV IWORK MODE GLSMTH
c ... 1 n n n 1 ntrend n+ntrend 3*n 1 1
c ... BITS
c ... nz+nz*n+1 (pos nz+1=usesnbbit)
c total: 15 + npr + 7*n + 2*ntrend + nz+nz*n+1
c debug options
CHARACTER*16 NAME
INTEGER DBGLVL
COMMON /DEBUG/ DBGLVL
DBGLVL=0
c wrapped parameters orig. params(..orig ints)
CALL BKGRID(DATVEC(1), XSW
. DATVEC(2), YSW
. DATVEC(3), XNE
. DATVEC(4), YNE
. DATVEC(5), ANGLE
. INTVEC(1), NX
. INTVEC(2), NY
. INTVEC(3), NZ
. DATVEC(6), DX
. DATVEC(7), DY
. DBLVEC(1), XG
. DBLVEC(INTVEC(1)+1), YG(NX)
. ZG,
. LDZG,
. VARG,
. DOG,
. DATVEC(8), LON
. DATVEC(8+INTVEC(5)), LAT(N)
. DATVEC(8+2*INTVEC(5)), Z(..)
. INTVEC(4), EXTRAP
. INTVEC(5), N
. INTVEC(6), COVTYPE
. COVPAR,
. COVMAT,
. LDCOV,
. C0VEC,
. COV0,
. INTVEC(7), TREND
. INTVEC(8), NTREND
. MUPR,
. LDMPR,
. PHIPR,
. LDPHPR,
. DBLVEC(INTVEC(1)+INTVEC(2)+1), MUWRK(..NY)
. PHIWRK,
. LDPHWK,
. LONPR,
. LATPR,
. DBLVEC(INTVEC(1)+INTVEC(2)+INTVEC(8)+1), BETA(..NTREND)
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+1), ERRBTA
. COVBTA,
. LDCVBT,
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+2), DEV
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+INTVEC(5)+2), ERRDEV(..N)
. CVSRNB,
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+INTVEC(5)+3), ZSRNB
. INTVEC(9), NPR
. INTVEC(10), TYPPR
. RSEARCH,
. INTVEC(10+INTVEC(9)), NSEARCH(NPR)
. INTVEC(11+INTVEC(9)), NSMIN
. INTVEC(12+INTVEC(9)), NSMAX
. FWORK,
. FWRK2,
. LDFWRK,
. F0WORK,
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+2*INTVEC(5)+3),DIST
. INTVEC(13+INTVEC(9)), INDSNB
. INTVEC(13+INTVEC(9)+INTVEC(5)), INDSNW(..N)
. INTVEC(13+INTVEC(9)+2*INTVEC(5)), INDSRT
. KWORK,
. LDKWRK,
. RHSWORK,
. FPWORK,
. FPFWORK,
. FPF0WRK,
. CHLUP,
. LDCLUP,
. CMINV,
. LDCINV,
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+3*INTVEC(5)+3),WORK
. INTVEC(13+INTVEC(9)+3*INTVEC(5)), LWORK
. INTVEC(14+INTVEC(9)+3*INTVEC(5)), IPVT
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+3*INTVEC(5)+
. INTVEC(13+INTVEC(9)+3*INTVEC(5))+3), FERR(..LWORK)
. DBLVEC(INTVEC(1)+INTVEC(2)+2*INTVEC(8)+4*INTVEC(5)+
. INTVEC(13+INTVEC(9)+3*INTVEC(5))+3), BERR
. INTVEC(14+INTVEC(9)+3*INTVEC(5)+INTVEC(8)), IPIV(..NTREND)
. INTVEC(14+INTVEC(9)+4*INTVEC(5)+2*INTVEC(8)), IWORK(..N+NTREND
. INTVEC(14+INTVEC(9)+7*INTVEC(5)+2*INTVEC(8)), MODE(..3*N)?
. MU,
. LAMBDA,
. LAMBD0,
. INTVEC(16+INTVEC(9)+7*INTVEC(5)+2*INTVEC(8)), BITS(..NZ+N*NZ+1)
. IERR,
. INTVEC(15+INTVEC(9)+7*INTVEC(5)+2*INTVEC(8))) GLSMTH
RETURN
END
SUBROUTINE BKGRID(XSW,
. YSW,
. XNE,
......@@ -530,7 +348,7 @@ c call matpr(name,yg,ny,1,ny,dbglvl)
c extract results for this tile
IF (NA0.EQ.1) THEN
DOG(I,J)=0
DOG(I,J)=-1
ZG(I,J)=0
VARG(I,J)=0
write(*,*)"x"
......
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