bk_grid.c 7.88 KB
Newer Older
alge's avatar
alge committed
1
#include "bk_grid.h" 
agebhard's avatar
agebhard committed
2

3
void bk_grid__(double *xsw,
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
	     double *ysw,
	     double *xne,
	     double *yne,
	     double *angle,
	     int *nx,
	     int *ny,
	     double *dx,
	     double *dy,
	     double *xg,
	     double *yg,
	     double *zg,
	     double *varg,
	     int *dog,
	     double *lon,
	     double *lat,
	     double *z,
	     int *extrap,
	     int *n,
	     int *covtype,
	     double *covpar,
agebhard's avatar
agebhard committed
24
25
26
	     double *covmat,
	     int *ldcov,
	     int *extcov,
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
	     int *trend,
	     int *ntrend,
	     double *mupr,
	     int *ldmpr,
	     double *phipr,
	     int *ldphpr,
	     double *lonpr,
	     double *latpr,
	     int *npr,
	     int *typpr,
	     double *rsearch,
	     int *nsearch,
	     int *nsmin,
	     int *nsmax,
	     int *lwork,
	     int *mode,
43
	       double *mu,
44
45
46
47
	     double *lambda,
	     double *lambd0,
	     int *searchnb,
	     int *ierr,
48
	       int *retlm,
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
	     int *glsmth){
/* simple Fortran wrapper */
bk_grid(xsw,
	     ysw,
	     xne,
	     yne,
	     angle,
	     nx,
	     ny,
	     dx,
	     dy,
	     xg,
	     yg,
	     zg,
	     varg,
	     dog,
	     lon,
	     lat,
	     z,
	     extrap,
	     n,
	     covtype,
	     covpar,
agebhard's avatar
agebhard committed
72
73
74
	     covmat,
	     ldcov,
	     extcov,
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
	     trend,
	     ntrend,
	     mupr,
	     ldmpr,
	     phipr,
	     ldphpr,
	     lonpr,
	     latpr,
	     npr,
	     typpr,
	     rsearch,
	     nsearch,
	     nsmin,
	     nsmax,
	     lwork,
	     mode,
91
	mu,
92
93
94
95
	     lambda,
	     lambd0,
	     searchnb,
	     ierr,
96
	retlm,
97
98
99
	     glsmth);
}

agebhard's avatar
agebhard committed
100
101
102
103
104
105
106
107
108
109
110
111
112
void bk_grid(double *xsw,
	     double *ysw,
	     double *xne,
	     double *yne,
	     double *angle,
	     int *nx,
	     int *ny,
	     double *dx,
	     double *dy,
	     double *xg,
	     double *yg,
	     double *zg,
	     double *varg,
113
	     int *dog,
agebhard's avatar
agebhard committed
114
115
116
117
118
119
120
	     double *lon,
	     double *lat,
	     double *z,
	     int *extrap,
	     int *n,
	     int *covtype,
	     double *covpar,
agebhard's avatar
agebhard committed
121
122
123
	     double *covmat,
	     int *ldcov,
	     int *extcov,
agebhard's avatar
agebhard committed
124
125
126
127
128
129
130
131
	     int *trend,
	     int *ntrend,
	     double *mupr,
	     int *ldmpr,
	     double *phipr,
	     int *ldphpr,
	     double *lonpr,
	     double *latpr,
agebhard's avatar
agebhard committed
132
	     int *npr,
agebhard's avatar
agebhard committed
133
134
135
136
137
	     int *typpr,
	     double *rsearch,
	     int *nsearch,
	     int *nsmin,
	     int *nsmax,
138
	     int *lwork,
agebhard's avatar
agebhard committed
139
	     int *mode,
140
	     double *mu,
141
142
	     double *lambda,
	     double *lambd0,
143
	     int *searchnb,
agebhard's avatar
agebhard committed
144
	     int *ierr,
145
	     int *retlm,
agebhard's avatar
agebhard committed
146
147
	     int *glsmth){
    
agebhard's avatar
agebhard committed
148
    int nz=(*nx)*(*ny), ldc0=(*n),ldphwk=(*ntrend),
agebhard's avatar
agebhard committed
149
	ldfwrk=(*n), ldlmbd=(*n), ldkwrk=(*n), 
150
	ldcvbt=(*ntrend), 
151
	ldclup=(*n),ldcinv=(*n),ldzg=(*nx);
agebhard's avatar
agebhard committed
152
    double *c0vec, *muwrk, *phiwrk, *beta, errbta,
agebhard's avatar
agebhard committed
153
	*dev, errdev, *covbta, *cvsrnb, *zsrnb,
alge's avatar
alge committed
154
	*fwork, *fwrk2, *f0work, *dist, *kwork,
155
156
	*rhswork, *fpwork, *fpfwork, *fpf0wrk, *chlup, 
	*cminv, *work, *ferr, *berr,
agebhard's avatar
agebhard committed
157
	cov0;
agebhard's avatar
agebhard committed
158
159
    int *indsnb, *indsnw, *indsrt, *ipiv, *ipvt, *iwork;

agebhard's avatar
agebhard committed
160

alge's avatar
alge committed
161
    /* #if 0 */
alge's avatar
alge committed
162
#ifndef TRANSIENT
agebhard's avatar
agebhard committed
163
    c0vec  =Calloc((size_t)(*n),double);  
agebhard's avatar
agebhard committed
164
    muwrk  =Calloc((size_t)(*ntrend),double); 
agebhard's avatar
agebhard committed
165
166
167
168
169
170
171
    phiwrk =Calloc((size_t)((*ntrend)*(*ntrend)),double); 
    covbta =Calloc((size_t)((*ntrend)*(*ntrend)),double); 
    beta   =Calloc((size_t)(*ntrend),double); 
    dev    =Calloc((size_t)(*n),double); 
    cvsrnb =Calloc((size_t)(*n)*(*n),double);
    zsrnb  =Calloc((size_t)(*n),double);
    fwork  =Calloc((size_t)(*n)*(*ntrend),double);    
alge's avatar
alge committed
172
    fwrk2 =Calloc((size_t)(*n)*(*ntrend),double);    
agebhard's avatar
agebhard committed
173
174
175
176
177
178
    f0work =Calloc((size_t)(*ntrend),double);    
    dist   =Calloc((size_t)(*n),double);    
    indsnb =Calloc((size_t)(*n),int);    
    indsnw =Calloc((size_t)(*n),int);    
    indsrt =Calloc((size_t)(*n),int); 
    kwork  =Calloc((size_t)(*n)*(*n),double); 
agebhard's avatar
agebhard committed
179
    rhswork=Calloc((size_t)(*n),double);
agebhard's avatar
agebhard committed
180
    fpwork =Calloc((size_t)(*n)*(*ntrend),double);    
agebhard's avatar
agebhard committed
181
182
    fpfwork=Calloc((size_t)(*n)*(*n),double);    
    fpf0wrk=Calloc((size_t)(*n),double);    
agebhard's avatar
agebhard committed
183
184
185
186
187
188
189
190
    chlup  =Calloc((size_t)(*n)*(*n),double);    
    cminv  =Calloc((size_t)(*n)*(*n),double);    
    work   =Calloc((size_t)(*lwork),double);    
    ipvt   =Calloc((size_t)(*n),int);
    ipiv   =Calloc((size_t)(*n+*ntrend),int);
    ferr   =Calloc((size_t)(*n),double);
    berr   =Calloc((size_t)(*n),double);
    iwork  =Calloc((size_t)(3*(*n)),int);
agebhard's avatar
agebhard committed
191
#else
agebhard's avatar
agebhard committed
192
    c0vec  =(double *) R_alloc((*n),sizeof(double));
agebhard's avatar
agebhard committed
193
    muwrk  =(double *) R_alloc((*ntrend),sizeof(double));
agebhard's avatar
agebhard committed
194
195
196
197
198
199
200
    phiwrk =(double *) R_alloc((*ntrend)*(*ntrend),sizeof(double)); 
    covbta =(double *) R_alloc((*ntrend)*(*ntrend),sizeof(double)); 
    beta   =(double *) R_alloc((*ntrend),sizeof(double));
    dev    =(double *) R_alloc((*n),sizeof(double));
    cvsrnb =(double *) R_alloc((*n)*(*n),sizeof(double));
    zsrnb  =(double *) R_alloc((*n),sizeof(double));
    fwork  =(double *) R_alloc((*n)*(*ntrend),sizeof(double)); 
alge's avatar
alge committed
201
    fwrk2 =(double *) R_alloc((*n)*(*ntrend),sizeof(double)); 
agebhard's avatar
agebhard committed
202
203
204
205
206
207
    f0work =(double *) R_alloc((*ntrend),sizeof(double));    
    dist   =(double *) R_alloc((*n),sizeof(double));
    indsnb =(int *) R_alloc((*n),sizeof(int));
    indsnw =(int *) R_alloc((*n),sizeof(int));
    indsrt =(int *) R_alloc((*n),sizeof(int));
    kwork  =(double *) R_alloc((*n+*ntrend)*(*n+*ntrend),sizeof(double)); 
agebhard's avatar
agebhard committed
208
    rhswork=(double *) R_alloc((*n+*ntrend),sizeof(double)); 
agebhard's avatar
agebhard committed
209
    fpwork =(double *) R_alloc((*n)*(*ntrend),sizeof(double)); 
agebhard's avatar
agebhard committed
210
211
    fpfwork=(double *) R_alloc((*n)*(*n),sizeof(double)); 
    fpf0wrk=(double *) R_alloc((*n),sizeof(double)); 
agebhard's avatar
agebhard committed
212
213
214
215
216
217
218
219
    chlup  =(double *) R_alloc((*n)*(*n),sizeof(double)); 
    cminv  =(double *) R_alloc((*n)*(*n),sizeof(double)); 
    work   =(double *) R_alloc((*lwork),sizeof(double)); 
    ipvt   =(int *) R_alloc((*n),sizeof(int)); 
    ipiv   =(int *) R_alloc((*n+*ntrend),sizeof(int)); 
    ferr   =(double *) R_alloc((*n),sizeof(double)); 
    berr   =(double *) R_alloc((*n),sizeof(double)); 
    iwork  =(int *) R_alloc(3*(*n),sizeof(int)); 
agebhard's avatar
agebhard committed
220
221
#endif

agebhard's avatar
agebhard committed
222
223
224
225
226
227
228
229
230
231
232
233
234
    F77_CALL(bkgrid)(xsw,
		     ysw,
		     xne,
		     yne,
		     angle,
		     nx,
		     ny,
		     &nz,
		     dx,
		     dy,
		     xg,
		     yg,
		     zg,
235
		     &ldzg,
agebhard's avatar
agebhard committed
236
237
238
239
240
241
242
243
244
245
246
		     varg,
		     dog,
		     lon,
		     lat,
		     z,
		     extrap,
		     n,
		     covtype,
		     covpar,
		     c0vec,
		     &cov0,
agebhard's avatar
agebhard committed
247
248
249
		     covmat,
		     ldcov,
		     extcov,
agebhard's avatar
agebhard committed
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
		     trend,
		     ntrend,
		     mupr,
		     ldmpr,
		     phipr,
		     ldphpr,
		     muwrk,
		     phiwrk,
		     &ldphwk,
		     lonpr,
		     latpr,
		     beta,
		     &errbta,
		     covbta,
		     &ldcvbt,
		     dev,
		     &errdev,
		     cvsrnb,
		     zsrnb,
		     npr,
		     typpr,
		     rsearch,
		     nsearch,
		     nsmin,
		     nsmax,
		     fwork,
alge's avatar
alge committed
276
		     fwrk2,
agebhard's avatar
agebhard committed
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
		     &ldfwrk,
		     f0work,
		     dist,
		     indsnb,
		     indsnw,
		     indsrt,
		     kwork,
		     &ldkwrk,
		     rhswork,
		     fpwork,
		     fpfwork,
		     fpf0wrk,
		     chlup,
		     &ldclup,
		     cminv,
		     &ldcinv,
		     work,
		     lwork,
		     ipvt,
		     ferr,
		     berr,
		     ipiv,
		     iwork,
		     mode,
		     mu,
		     lambda,
303
304
		     &ldlmbd,
		     lambd0,
305
		     searchnb,
agebhard's avatar
agebhard committed
306
		     ierr,
307
		     retlm,
agebhard's avatar
agebhard committed
308
309
		     glsmth);

alge's avatar
alge committed
310
#ifndef TRANSIENT
agebhard's avatar
agebhard committed
311
312
313
    Free(iwork);
    Free(berr);
    Free(ferr);
agebhard's avatar
agebhard committed
314
    Free(ipiv);
agebhard's avatar
agebhard committed
315
316
317
318
319
320
321
    Free(ipvt);
    Free(work);
    Free(cminv);
    Free(chlup);
    Free(fpf0wrk);
    Free(fpfwork);
    Free(fpwork);
agebhard's avatar
agebhard committed
322
323
324
    Free(rhswork);
    Free(kwork);
    Free(indsrt);
agebhard's avatar
agebhard committed
325
    Free(indsnw);
agebhard's avatar
agebhard committed
326
327
328
    Free(indsnb);
    Free(dist);
    Free(f0work);
alge's avatar
alge committed
329

agebhard's avatar
agebhard committed
330
    Free(fwrk2);  
agebhard's avatar
agebhard committed
331
    Free(fwork);
agebhard's avatar
agebhard committed
332
333
    Free(zsrnb);
    Free(cvsrnb);
agebhard's avatar
agebhard committed
334
335
    Free(dev);
    Free(beta);
agebhard's avatar
agebhard committed
336
    Free(covbta); 
agebhard's avatar
agebhard committed
337
338
339
    Free(phiwrk);
    Free(muwrk);
    Free(c0vec);
alge's avatar
alge committed
340

alge's avatar
alge committed
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372

#else
    /*
    free(iwork);
    free(berr);
    free(ferr);
    free(ipiv);
    free(ipvt);
    free(work);
    free(cminv);
    free(chlup);
    free(fpf0wrk);
    free(fpfwork);
    free(fpwork);
    free(rhswork);
    free(kwork);
    free(indsrt);
    free(indsnw);
    free(indsnb);
    free(dist);
    free(f0work);
    free(fwrk2);
    free(fwork);
    free(zsrnb);
    free(cvsrnb);
    free(dev);
    free(beta);
    free(covbta);
    free(phiwrk);
    free(muwrk);
    free(c0vec);
    */
agebhard's avatar
agebhard committed
373
#endif
alge's avatar
alge committed
374
375
    /* #endif */

agebhard's avatar
agebhard committed
376
377
}