Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Gebhardt, Albrecht
baykrig
Commits
ec47cd70
Commit
ec47cd70
authored
May 19, 2002
by
alge
Browse files
auskommentierungen entfernt
parent
82767c40
Changes
4
Hide whitespace changes
Inline
Side-by-side
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"
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment