00001 /* 00002 * Copyright 2004, 2005, 2006 PathScale, Inc. All Rights Reserved. 00003 */ 00004 00005 /* Copyright (C) 1995 Free Software Foundation, Inc. 00006 This file is part of GNU Fortran libU77 library. 00007 00008 This library is free software; you can redistribute it and/or modify it 00009 under the terms of the GNU Library General Public License as published 00010 by the Free Software Foundation; either version 2 of the License, or 00011 (at your option) any later version. 00012 00013 GNU Fortran is distributed in the hope that it will be useful, 00014 but WITHOUT ANY WARRANTY; without even the implied warranty of 00015 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 00016 Library General Public License for more details. 00017 00018 You should have received a copy of the GNU Library General Public 00019 License along with GNU Fortran; see the file COPYING.LIB. If 00020 not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 00021 Boston, MA 02111-1307, USA. */ 00022 00023 #include "config.h" 00024 #if HAVE_STDLIB_H 00025 # include <stdlib.h> 00026 #endif 00027 #include "f2c.h" 00028 #ifndef RAND_MAX 00029 # define RAND_MAX 2147483647 /* from SunOS */ 00030 #endif 00031 00032 /* We could presumably do much better than the traditional libc 00033 version, though at least the glibc one is reasonable, it seems. 00034 For the sake of the innocent, I'm not sure we should really do 00035 this... */ 00036 00037 /* Note this is per SunOS -- other s may have no arg. */ 00038 00039 #ifdef KEY /* Bug 1683, 5019 */ 00040 #include "cray/mtlock.h" 00041 plock_t pathf90_rand_mutex = MEM_LOCK_INIT; 00042 #endif /* KEY Bug 1683 */ 00043 00044 double 00045 G77_rand_0 (integer * flag) 00046 { 00047 #ifdef KEY /* Bug 1683 */ 00048 /* g77 provides a zero from outside library if user omits optional arg */ 00049 integer zero = 0; 00050 flag = (0 == flag) ? (&zero) : flag; 00051 MEM_LOCK(&pathf90_rand_mutex); 00052 switch (*flag) 00053 { 00054 case 0: 00055 break; 00056 case 1: 00057 srand (0); /* Arbitrary choice of initialiser. */ 00058 break; 00059 default: 00060 srand (*flag); 00061 } 00062 double result = (double) rand () / RAND_MAX; 00063 MEM_UNLOCK(&pathf90_rand_mutex); 00064 return result; 00065 #else 00066 switch (*flag) 00067 { 00068 case 0: 00069 break; 00070 case 1: 00071 srand (0); /* Arbitrary choice of initialiser. */ 00072 break; 00073 default: 00074 srand (*flag); 00075 } 00076 return (float) rand () / RAND_MAX; 00077 #endif /* KEY Bug 1683 */ 00078 }
1.5.6