76f58ce6b39bf4fcad71a418c9a4e4c832da67d5
[alexxy/gromacs.git] / src / gmxlib / gmx_lapack / slarnv.c
1 #include <math.h>
2 #include "gmx_lapack.h"
3
4 void
5 F77_FUNC(slarnv,SLARNV)(int *idist, 
6         int *iseed, 
7         int *n, 
8         float *x)
9 {
10     int i__1, i__2, i__3;
11
12     int i__;
13     float u[128];
14     int il, iv, il2;
15
16     --x;
17     --iseed;
18
19     i__1 = *n;
20     for (iv = 1; iv <= i__1; iv += 64) {
21         i__2 = 64, i__3 = *n - iv + 1;
22         il = (i__2<i__3) ? i__2 : i__3;
23         if (*idist == 3) {
24             il2 = il << 1;
25         } else {
26             il2 = il;
27         }
28
29         F77_FUNC(slaruv,SLARUV)(&iseed[1], &il2, u);
30
31         if (*idist == 1) {
32
33             i__2 = il;
34             for (i__ = 1; i__ <= i__2; ++i__) {
35                 x[iv + i__ - 1] = u[i__ - 1];
36             }
37         } else if (*idist == 2) {
38
39             i__2 = il;
40             for (i__ = 1; i__ <= i__2; ++i__) {
41                 x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.;
42             }
43         } else if (*idist == 3) {
44
45             i__2 = il;
46             for (i__ = 1; i__ <= i__2; ++i__) {
47                 x[iv + i__ - 1] = sqrt(log(u[(i__ << 1) - 2]) * -2.) * 
48                   cos(u[(i__ << 1) - 1] * 
49                       (float)6.2831853071795864769252867663);
50             }
51         }
52     }
53     return;
54
55 }