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