1"hydrogenicR_1" <- function(Z, r, give=FALSE, strict=TRUE){
2  jj <- process.args(Z,r)
3  Z.vec <- jj$arg1
4  r.vec <- jj$arg2
5  attr <- jj$attr
6  jj <- .C("hydrogenicR_1",
7           as.double(Z.vec),
8           as.double(r.vec),
9           as.integer(length(Z.vec)),
10           val=as.double(Z.vec),
11           err=as.double(Z.vec),
12           status=as.integer(0*Z.vec),
13           PACKAGE="gsl"
14           )
15  val <- jj$val
16  err <- jj$err
17  status <- jj$status
18  attributes(val) <- attr
19  attributes(err) <- attr
20  attributes(status) <- attr
21
22  if(strict){
23    val <- strictify(val,status)
24  }
25
26  if(give){
27      return(list(val=val,err=err,status=status))
28  } else {
29    return(val)
30  }
31}
32
33"hydrogenicR" <- function(n, l, Z, r, give=FALSE, strict=TRUE){
34  jj <- process.args(n,l,Z,r)
35  n.vec <- jj$arg1
36  l.vec <- jj$arg2
37  Z.vec <- jj$arg3
38  r.vec <- jj$arg4
39  attr <- jj$attr
40  jj <- .C("hydrogenicR",
41           as.integer(n.vec),
42           as.integer(l.vec),
43           as.double(Z.vec),
44           as.double(r.vec),
45           as.integer(length(r.vec)),
46           val=as.double(r.vec),
47           err=as.double(r.vec),
48           status=as.integer(0*r.vec),
49           PACKAGE="gsl"
50           )
51  val <- jj$val
52  err <- jj$err
53  status <- jj$status
54  attributes(val) <- attr
55  attributes(err) <- attr
56  attributes(status) <- attr
57
58  if(strict){
59    val <- strictify(val,status)
60  }
61
62  if(give){
63      return(list(val=val,err=err,status=status))
64  } else {
65    return(val)
66  }
67}
68
69"coulomb_wave_FG" <- function(eta, x, L_F, k, give=FALSE, strict=TRUE){
70  jj <- process.args(eta, x, L_F, k)
71  eta.vec <- jj$arg1
72  x.vec <- jj$arg2
73  L_F.vec <- jj$arg3
74  k.vec <- jj$arg4
75  attr <- jj$attr
76  jj <- .C("coulomb_wave_FG",
77           as.double(eta.vec),
78           as.double(x.vec),
79           as.double(L_F.vec),
80           as.integer(k.vec),
81           as.integer(length(eta.vec)),
82           val_F=as.double(0*eta.vec),
83           err_F=as.double(0*eta.vec),
84           val_Fp=as.double(0*eta.vec),
85           err_Fp=as.double(0*eta.vec),
86           val_G=as.double(0*eta.vec),
87           err_G=as.double(0*eta.vec),
88           val_Gp=as.double(0*eta.vec),
89           err_Gp=as.double(0*eta.vec),
90           exp_F=as.double(0*eta.vec),
91           exp_G=as.double(0*eta.vec),
92           status=as.integer(0*eta.vec),
93           PACKAGE="gsl"
94           )
95  val_F <- jj$val_F
96  val_Fp <- jj$val_Fp
97  val_G <- jj$val_G
98  val_Gp <- jj$val_Gp
99
100  err_F <- jj$err_F
101  err_Fp <- jj$err_Fp
102  err_G <- jj$err_Gp
103  err_Gp <- jj$err_Gp
104
105  status <- jj$status
106
107  exp_F <- jj$exp_F
108  exp_G <- jj$exp_G
109
110  attributes(val_F) <- attr
111  attributes(val_Fp) <- attr
112  attributes(val_G) <- attr
113  attributes(val_Gp) <- attr
114
115  attributes(err_F) <- attr
116  attributes(err_Fp) <- attr
117  attributes(err_G) <- attr
118  attributes(err_Gp) <- attr
119
120  attributes(exp_F) <- attr
121  attributes(exp_G) <- attr
122
123  attributes(status) <- attr
124
125  if(strict){
126    val_F <- strictify(val_F,status)
127    val_Fp <- strictify(val_Fp,status)
128    val_G <- strictify(val_G,status)
129    val_Gp <- strictify(val_Gp,status)
130
131    err_F <- strictify(err_F,status)
132    err_Fp <- strictify(err_Fp,status)
133    err_G <- strictify(err_G,status)
134    err_Gp <- strictify(err_Gp,status)
135
136    exp_F <- strictify(exp_F,status)
137    exp_G <- strictify(exp_G,status)
138  }
139
140  if(give){
141      return(list(val_F=val_F,
142                  val_Fp=val_Fp,
143                  val_G=val_G,
144                  val_Gp=val_Gp,
145                  err_F=err_F,
146                  err_Fp=err_Fp,
147                  err_G=err_G,
148                  err_Gp=err_Gp,
149                  exp_F=exp_F,
150                  exp_G=exp_G,
151                  status=status
152                  )
153             )
154
155  } else {
156      return(list(val_F=val_F,
157                  val_Fp=val_Fp,
158                  val_G=val_G,
159                  val_Gp=val_Gp,
160                  exp_F=exp_F,
161                  exp_G=exp_G
162                  )
163             )
164  }
165}
166
167"coulomb_wave_F_array" <- function(L_min, kmax, eta, x, give=FALSE,strict=TRUE){
168  if(length(L_min)>1){stop("L_min should be of length 1")}
169  if(length(kmax)>1){stop("kmax should be of length 1")}
170  jj <- process.args(eta,x)
171  eta.vec <- jj$arg1
172  x.vec <- jj$arg2
173  attr <- jj$attr
174
175  x.out <- rep(x.vec,(kmax+1))
176  jj <- .C("coulomb_wave_F_array",
177           as.double(L_min),
178           as.integer(kmax),
179           as.double(eta.vec),
180           as.double(x.vec),
181           as.integer(length(x.vec)),
182           val=as.double(x.out),
183           F_exp=as.double(x.vec),
184           status=as.integer(0*x.vec),
185           PACKAGE="gsl"
186           )
187
188  val <- jj$val
189  dim(val) <- c(kmax+1, length(x.vec))
190  rownames(val) <- L_min:(L_min+kmax)
191  colnames(val) <- names(x)
192  status <- jj$status
193  attributes(status) <- attr
194
195  if(strict){
196    val <- strictify(val,status)
197  }
198
199  if(give){
200    return(list(val=val, F_exp=jj$F_exp, status=status))
201  } else {
202    return(val)
203  }
204}
205
206"coulomb_wave_FG_array" <- function(L_min, kmax, eta, x, give=FALSE,strict=TRUE){
207  if(length(L_min)>1){stop("L_min should be of length 1")}
208  if(length(kmax)>1){stop("kmax should be of length 1")}
209  jj <- process.args(eta,x)
210  eta.vec <- jj$arg1
211  x.vec <- jj$arg2
212  attr <- jj$attr
213
214  x.out <- rep(x.vec,(kmax+1))
215  jj <- .C("coulomb_wave_FG_array",
216           as.double(L_min),
217           as.integer(kmax),
218           as.double(eta.vec),
219           as.double(x.vec),
220           as.integer(length(x.vec)),
221           val_F=as.double(x.out),
222           val_G=as.double(x.out),
223           F_exp=as.double(x.vec),
224           G_exp=as.double(x.vec),
225           status=as.integer(0*x.vec),
226           PACKAGE="gsl"
227           )
228
229  val_F <- jj$val_F
230  val_G <- jj$val_G
231  F_exp <- jj$F_exp
232  G_exp <- jj$G_exp
233  dim(val_F) <- c(kmax+1, length(x.vec))
234  dim(val_G) <- c(kmax+1, length(x.vec))
235
236  status <- jj$status
237  attributes(status) <- attr
238
239  if(strict){
240    val_F <- strictify(val_F,status)
241    val_G <- strictify(val_G,status)
242  }
243
244  if(give){
245    return(list(val_F=val_F, val_G=val_G, F_exp=F_exp, status=status))
246  } else {
247    return(list(val_F=val_F, val_G=val_G))
248  }
249}
250
251"coulomb_wave_FGp_array" <- function(L_min, kmax, eta, x, give=FALSE,strict=TRUE){
252  if(length(L_min)>1){stop("L_min should be of length 1")}
253  if(length(kmax)>1){stop("kmax should be of length 1")}
254  jj <- process.args(eta,x)
255  eta.vec <- jj$arg1
256  x.vec <- jj$arg2
257  attr <- jj$attr
258
259  x.out <- rep(x.vec,(kmax+1))
260  jj <- .C("coulomb_wave_FGp_array",
261           as.double(L_min),
262           as.integer(kmax),
263           as.double(eta.vec),
264           as.double(x.vec),
265           as.integer(length(x.vec)),
266           val_F=as.double(x.out),
267           val_Fp=as.double(x.out),
268           val_G=as.double(x.out),
269           val_Gp=as.double(x.out),
270           F_exp=as.double(x.vec),
271           G_exp=as.double(x.vec),
272           status=as.integer(0*x.vec),
273           PACKAGE="gsl"
274           )
275
276  val_F <- jj$val_F
277  val_Fp <- jj$val_Fp
278  val_G <- jj$val_G
279  val_Gp <- jj$val_Gp
280  F_exp <- jj$F_exp
281  G_exp <- jj$G_exp
282  dim(val_F) <- c(kmax+1, length(x.vec))
283  dim(val_Fp) <- c(kmax+1, length(x.vec))
284  dim(val_G) <- c(kmax+1, length(x.vec))
285  dim(val_Gp) <- c(kmax+1, length(x.vec))
286
287  status <- jj$status
288  attributes(status) <- attr
289
290  if(strict){
291    val_F <- strictify(val_F,status)
292    val_Fp <- strictify(val_Fp,status)
293    val_G <- strictify(val_G,status)
294    val_Gp <- strictify(val_Gp,status)
295  }
296
297  if(give){
298    return(list(val_F=val_F, val_Fp=val_Fp, val_G=val_G, val_Gp=val_Gp, F_exp=F_exp, status=status))
299  } else {
300    return(list(val_F=val_F, val_Fp=val_Fp, val_G=val_G, val_Gp=val_Gp))
301  }
302}
303
304"coulomb_wave_sphF_array" <- function(L_min, kmax, eta, x, give=FALSE,strict=TRUE){
305  if(length(L_min)>1){stop("L_min should be of length 1")}
306  if(length(kmax)>1){stop("kmax should be of length 1")}
307  jj <- process.args(eta,x)
308  eta.vec <- jj$arg1
309  x.vec <- jj$arg2
310  attr <- jj$attr
311
312  x.out <- rep(x.vec,(kmax+1))
313  jj <- .C("coulomb_wave_sphF_array",
314           as.double(L_min),
315           as.integer(kmax),
316           as.double(eta.vec),
317           as.double(x.vec),
318           as.integer(length(x.vec)),
319           val=as.double(x.out),
320           F_exp=as.double(x.vec),
321           status=as.integer(0*x.vec),
322           PACKAGE="gsl"
323           )
324
325  val <- jj$val
326  dim(val) <- c(kmax+1, length(x.vec))
327  rownames(val) <- L_min:(L_min+kmax)
328  colnames(val) <- names(x)
329  status <- jj$status
330  attributes(status) <- attr
331
332  if(strict){
333    val <- strictify(val,status)
334  }
335
336  if(give){
337    return(list(val=val, F_exp=jj$F_exp, status=status))
338  } else {
339    return(val)
340  }
341}
342
343"coulomb_CL" <- function(L, eta, give=FALSE, strict=TRUE){
344  jj <- process.args(L,eta)
345  L.vec <- jj$arg1
346  eta.vec <- jj$arg2
347  attr <- jj$attr
348  jj <- .C("coulomb_CL",
349           as.double(L.vec),
350           as.double(eta.vec),
351           as.integer(length(L.vec)),
352           val=as.double(L.vec),
353           err=as.double(L.vec),
354           status=as.integer(0*L.vec),
355           PACKAGE="gsl"
356           )
357  val <- jj$val
358  err <- jj$err
359  status <- jj$status
360  attributes(val) <- attr
361  attributes(err) <- attr
362  attributes(status) <- attr
363
364  if(strict){
365    val <- strictify(val,status)
366  }
367
368  if(give){
369      return(list(val=val,err=err,status=status))
370  } else {
371    return(val)
372  }
373}
374
375"coulomb_CL_array" <- function(L_min, kmax, eta, give=FALSE,strict=TRUE){
376  if(length(L_min)>1){stop("L_min should be of length 1")}
377  if(length(kmax)>1){stop("kmax should be of length 1")}
378  jj <- process.args(eta)
379  eta.vec <- jj$arg1
380  attr <- jj$attr
381
382  eta.out <- rep(eta.vec,(kmax+1))
383  jj <- .C("coulomb_CL_array",
384           as.double(L_min),
385           as.integer(kmax),
386           as.double(eta.vec),
387           as.integer(length(eta.vec)),
388           val=as.double(eta.out),
389           status=as.integer(0*eta.vec),
390           PACKAGE="gsl"
391           )
392
393  val <- jj$val
394  dim(val) <- c(kmax+1, length(eta.vec))
395  rownames(val) <- L_min:(L_min+kmax)
396  status <- jj$status
397  attributes(status) <- attr
398
399  if(strict){
400    val <- strictify(val,status)
401  }
402
403  if(give){
404    return(list(val=val, status=status))
405  } else {
406    return(val)
407  }
408}
409