00001 /* Ergo, version 3.7, a program for linear scaling electronic structure 00002 * calculations. 00003 * Copyright (C) 2018 Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, 00004 * and Anastasia Kruchinina. 00005 * 00006 * This program is free software: you can redistribute it and/or modify 00007 * it under the terms of the GNU General Public License as published by 00008 * the Free Software Foundation, either version 3 of the License, or 00009 * (at your option) any later version. 00010 * 00011 * This program is distributed in the hope that it will be useful, 00012 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00013 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00014 * GNU General Public License for more details. 00015 * 00016 * You should have received a copy of the GNU General Public License 00017 * along with this program. If not, see <http://www.gnu.org/licenses/>. 00018 * 00019 * Primary academic reference: 00020 * Ergo: An open-source program for linear-scaling electronic structure 00021 * calculations, 00022 * Elias Rudberg, Emanuel H. Rubensson, Pawel Salek, and Anastasia 00023 * Kruchinina, 00024 * SoftwareX 7, 107 (2018), 00025 * <http://dx.doi.org/10.1016/j.softx.2018.03.005> 00026 * 00027 * For further information about Ergo, see <http://www.ergoscf.org>. 00028 */ 00029 00030 /* This file belongs to the template_lapack part of the Ergo source 00031 * code. The source files in the template_lapack directory are modified 00032 * versions of files originally distributed as CLAPACK, see the 00033 * Copyright/license notice in the file template_lapack/COPYING. 00034 */ 00035 00036 00037 #ifndef TEMPLATE_LAPACK_LARNV_HEADER 00038 #define TEMPLATE_LAPACK_LARNV_HEADER 00039 00040 00041 template<class Treal> 00042 int template_lapack_larnv(const integer *idist, integer *iseed, const integer *n, 00043 Treal *x) 00044 { 00045 /* -- LAPACK auxiliary routine (version 3.0) -- 00046 Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 00047 Courant Institute, Argonne National Lab, and Rice University 00048 September 30, 1994 00049 00050 00051 Purpose 00052 ======= 00053 00054 DLARNV returns a vector of n random real numbers from a uniform or 00055 normal distribution. 00056 00057 Arguments 00058 ========= 00059 00060 IDIST (input) INTEGER 00061 Specifies the distribution of the random numbers: 00062 = 1: uniform (0,1) 00063 = 2: uniform (-1,1) 00064 = 3: normal (0,1) 00065 00066 ISEED (input/output) INTEGER array, dimension (4) 00067 On entry, the seed of the random number generator; the array 00068 elements must be between 0 and 4095, and ISEED(4) must be 00069 odd. 00070 On exit, the seed is updated. 00071 00072 N (input) INTEGER 00073 The number of random numbers to be generated. 00074 00075 X (output) DOUBLE PRECISION array, dimension (N) 00076 The generated random numbers. 00077 00078 Further Details 00079 =============== 00080 00081 This routine calls the auxiliary routine DLARUV to generate random 00082 real numbers from a uniform (0,1) distribution, in batches of up to 00083 128 using vectorisable code. The Box-Muller method is used to 00084 transform numbers from a uniform to a normal distribution. 00085 00086 ===================================================================== 00087 00088 00089 Parameter adjustments */ 00090 /* System generated locals */ 00091 integer i__1, i__2, i__3; 00092 /* Local variables */ 00093 integer i__; 00094 Treal u[128]; 00095 integer il, iv; 00096 integer il2; 00097 00098 --x; 00099 --iseed; 00100 00101 /* Function Body */ 00102 i__1 = *n; 00103 for (iv = 1; iv <= i__1; iv += 64) { 00104 /* Computing MIN */ 00105 i__2 = 64, i__3 = *n - iv + 1; 00106 il = minMACRO(i__2,i__3); 00107 if (*idist == 3) { 00108 il2 = il << 1; 00109 } else { 00110 il2 = il; 00111 } 00112 00113 /* Call DLARUV to generate IL2 numbers from a uniform (0,1) 00114 distribution (IL2 <= LV) */ 00115 00116 dlaruv_(&iseed[1], &il2, u); 00117 00118 if (*idist == 1) { 00119 00120 /* Copy generated numbers */ 00121 00122 i__2 = il; 00123 for (i__ = 1; i__ <= i__2; ++i__) { 00124 x[iv + i__ - 1] = u[i__ - 1]; 00125 /* L10: */ 00126 } 00127 } else if (*idist == 2) { 00128 00129 /* Convert generated numbers to uniform (-1,1) distribution */ 00130 00131 i__2 = il; 00132 for (i__ = 1; i__ <= i__2; ++i__) { 00133 x[iv + i__ - 1] = u[i__ - 1] * 2. - 1.; 00134 /* L20: */ 00135 } 00136 } else if (*idist == 3) { 00137 00138 /* Convert generated numbers to normal (0,1) distribution */ 00139 00140 i__2 = il; 00141 for (i__ = 1; i__ <= i__2; ++i__) { 00142 x[iv + i__ - 1] = template_blas_sqrt(template_blas_log(u[(i__ << 1) - 2]) * -2.) * template_blas_cos(u[( 00143 i__ << 1) - 1] * 6.2831853071795864769252867663); 00144 /* L30: */ 00145 } 00146 } 00147 /* L40: */ 00148 } 00149 return 0; 00150 00151 /* End of DLARNV */ 00152 00153 } /* dlarnv_ */ 00154 00155 #endif