* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand

	gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
	* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
	GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
	* trans-intrinsic.c:  Use symbols.
	* intrinsic.c (add_sym_2s): New function.
	* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
	* intrinsic.h: Function prototypes.
	* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
	gfc_resolve_srand):  New functions.
libgfortran
	* Makefile.am: Add rand.c and etime.c
	* Makefile.in: Regenerated.
	* aclocal.in: Regenerated.
	* cpu_time.c (second_sub, second): New functions.
	* rand.c (irand, rand, srand): New file.
	* etime.c (etime_sub, etime): New file.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@83034 138bc75d-0d04-0410-961f-82ee72b054a4

7 files changed, 500 insertions, 2 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8cf4131eae1..2865a4342b2 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2004-06-12  Steven G. Kargl  <kargls@comcast.net>
+
+	* Makefile.am: Add rand.c and etime.c
+	* Makefile.in: Regenerated.
+	* aclocal.in: Regenerated.
+	* cpu_time.c (second_sub, second): New functions.
+	* rand.c (irand, rand, srand): New file.
+	* etime.c (etime_sub, etime): New file.
+
 2004-06-12  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 	    Steven Bosscher  <stevenb@suse.de>
 
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 63bf6b5afe6..a395cdddf7b 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -42,11 +42,13 @@ intrinsics/cshift0.c \
 intrinsics/date_and_time.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
+intrinsics/etime.c \
 intrinsics/ishftc.c \
 intrinsics/pack_generic.c \
 intrinsics/size.c \
 intrinsics/spread_generic.c \
 intrinsics/string_intrinsics.c \
+intrinsics/rand.c \
 intrinsics/random.c \
 intrinsics/reshape_generic.c \
 intrinsics/reshape_packed.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index f30ae3077c6..01399c917b7 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -119,9 +119,9 @@ am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
 	list_read.lo lock.lo open.lo read.lo rewind.lo transfer.lo \
 	unit.lo unix.lo write.lo
 am__objects_33 = associated.lo abort.lo args.lo cpu_time.lo cshift0.lo \
-	date_and_time.lo eoshift0.lo eoshift2.lo ishftc.lo \
+	date_and_time.lo eoshift0.lo eoshift2.lo etime.lo ishftc.lo \
 	pack_generic.lo size.lo spread_generic.lo string_intrinsics.lo \
-	random.lo reshape_generic.lo reshape_packed.lo \
+	rand.lo random.lo reshape_generic.lo reshape_packed.lo \
 	selected_kind.lo system_clock.lo transpose_generic.lo \
 	unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo
 am__objects_34 =
@@ -314,11 +314,13 @@ intrinsics/cshift0.c \
 intrinsics/date_and_time.c \
 intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
+intrinsics/etime.c \
 intrinsics/ishftc.c \
 intrinsics/pack_generic.c \
 intrinsics/size.c \
 intrinsics/spread_generic.c \
 intrinsics/string_intrinsics.c \
+intrinsics/rand.c \
 intrinsics/random.c \
 intrinsics/reshape_generic.c \
 intrinsics/reshape_packed.c \
@@ -2029,6 +2031,15 @@ eoshift2.obj: intrinsics/eoshift2.c
 eoshift2.lo: intrinsics/eoshift2.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o eoshift2.lo `test -f 'intrinsics/eoshift2.c' || echo '$(srcdir)/'`intrinsics/eoshift2.c
 
+etime.o: intrinsics/etime.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o etime.o `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c
+
+etime.obj: intrinsics/etime.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o etime.obj `if test -f 'intrinsics/etime.c'; then $(CYGPATH_W) 'intrinsics/etime.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/etime.c'; fi`
+
+etime.lo: intrinsics/etime.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o etime.lo `test -f 'intrinsics/etime.c' || echo '$(srcdir)/'`intrinsics/etime.c
+
 ishftc.o: intrinsics/ishftc.c
 	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ishftc.o `test -f 'intrinsics/ishftc.c' || echo '$(srcdir)/'`intrinsics/ishftc.c
 
@@ -2074,6 +2085,15 @@ string_intrinsics.obj: intrinsics/string_intrinsics.c
 string_intrinsics.lo: intrinsics/string_intrinsics.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o string_intrinsics.lo `test -f 'intrinsics/string_intrinsics.c' || echo '$(srcdir)/'`intrinsics/string_intrinsics.c
 
+rand.o: intrinsics/rand.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rand.o `test -f 'intrinsics/rand.c' || echo '$(srcdir)/'`intrinsics/rand.c
+
+rand.obj: intrinsics/rand.c
+	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rand.obj `if test -f 'intrinsics/rand.c'; then $(CYGPATH_W) 'intrinsics/rand.c'; else $(CYGPATH_W) '$(srcdir)/intrinsics/rand.c'; fi`
+
+rand.lo: intrinsics/rand.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rand.lo `test -f 'intrinsics/rand.c' || echo '$(srcdir)/'`intrinsics/rand.c
+
 random.o: intrinsics/random.c
 	$(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o random.o `test -f 'intrinsics/random.c' || echo '$(srcdir)/'`intrinsics/random.c
 
diff --git a/libgfortran/intrinsics/cpu_time.c b/libgfortran/intrinsics/cpu_time.c
index 9fd954b9a71..887debc3e53 100644
--- a/libgfortran/intrinsics/cpu_time.c
+++ b/libgfortran/intrinsics/cpu_time.c
@@ -114,3 +114,16 @@ void prefix(cpu_time_##KIND) (GFC_REAL_##KIND *__time)		\
 CPU_TIME(4)
 CPU_TIME(8)
 
+void
+prefix(second_sub) (GFC_REAL_4 *s)
+{
+  prefix(cpu_time_4)(s);
+}
+
+GFC_REAL_4
+prefix(second) (void)
+{
+  GFC_REAL_4 s;
+  prefix(cpu_time_4)(&s);
+  return s;
+}
diff --git a/libgfortran/intrinsics/date_and_time.c b/libgfortran/intrinsics/date_and_time.c
new file mode 100644
index 00000000000..6a09b2aeba2
--- /dev/null
+++ b/libgfortran/intrinsics/date_and_time.c
@@ -0,0 +1,280 @@
+/* Implementation of the DATE_AND_TIME intrinsic.
+   Copyright (C) 2003, 2004 Free Software Foundation, Inc.
+   Contributed by Steven Bosscher.
+
+This file is part of the GNU Fortran 95 runtime library (libgfor).
+
+Libgfor is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+Libgfor is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with libgfor; see the file COPYING.LIB.  If not,
+write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include <sys/types.h>
+#include <string.h>
+#include <assert.h>
+#include "libgfortran.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#undef HAVE_NO_DATE_TIME
+#if TIME_WITH_SYS_TIME
+#  include <sys/time.h>
+#  include <time.h>
+#else
+#  if HAVE_SYS_TIME_H
+#    include <sys/time.h>
+#  else
+#    ifdef HAVE_TIME_H
+#      include <time.h>
+#    else
+#      define HAVE_NO_DATE_TIME
+#    endif  /* HAVE_TIME_H  */
+#  endif  /* HAVE_SYS_TIME_H  */
+#endif  /* TIME_WITH_SYS_TIME  */
+
+#ifndef abs
+#define abs(x) ((x)>=0 ? (x) : -(x))
+#endif
+
+/* DATE_AND_TIME ([DATE, TIME, ZONE, VALUES])
+
+   Description: Returns data on the real-time clock and date in a form
+   compatible with the representations defined in ISO 8601:1988.
+
+   Class: Non-elemental subroutine.
+
+   Arguments:
+
+   DATE (optional) shall be scalar and of type default character, and
+   shall be of length at least 8 in order to contain the complete
+   value. It is an INTENT (OUT) argument. Its leftmost 8 characters
+   are assigned a value of the form CCYYMMDD, where CC is the century,
+   YY the year within the century, MM the month within the year, and
+   DD the day within the month. If there is no date available, they
+   are assigned blanks.
+
+   TIME (optional) shall be scalar and of type default character, and
+   shall be of length at least 10 in order to contain the complete
+   value. It is an INTENT (OUT) argument. Its leftmost 10 characters
+   are assigned a value of the form hhmmss.sss, where hh is the hour
+   of the day, mm is the minutes of the hour, and ss.sss is the
+   seconds and milliseconds of the minute. If there is no clock
+   available, they are assigned blanks.
+
+   ZONE (optional) shall be scalar and of type default character, and
+   shall be of length at least 5 in order to contain the complete
+   value. It is an INTENT (OUT) argument. Its leftmost 5 characters
+   are assigned a value of the form ±hhmm, where hh and mm are the
+   time difference with respect to Coordinated Universal Time (UTC) in
+   hours and parts of an hour expressed in minutes, respectively. If
+   there is no clock available, they are assigned blanks.
+
+   VALUES (optional) shall be of type default integer and of rank
+   one. It is an INTENT (OUT) argument. Its size shall be at least
+   8. The values returned in VALUES are as follows:
+
+      VALUES (1) the year (for example, 2003), or HUGE (0) if there is
+      no date available;
+
+      VALUES (2) the month of the year, or HUGE (0) if there
+      is no date available;
+
+      VALUES (3) the day of the month, or HUGE (0) if there is no date
+      available;
+
+      VALUES (4) the time difference with respect to Coordinated
+      Universal Time (UTC) in minutes, or HUGE (0) if this information
+      is not available;
+
+      VALUES (5) the hour of the day, in the range of 0 to 23, or HUGE
+      (0) if there is no clock;
+
+      VALUES (6) the minutes of the hour, in the range 0 to 59, or
+      HUGE (0) if there is no clock;
+
+      VALUES (7) the seconds of the minute, in the range 0 to 60, or
+      HUGE (0) if there is no clock;
+
+      VALUES (8) the milliseconds of the second, in the range 0 to
+      999, or HUGE (0) if there is no clock.
+
+   NULL pointer represent missing OPTIONAL arguments.  All arguments
+   have INTENT(OUT).  Because of the -i8 option, we must implement
+   VALUES for INTEGER(kind=4) and INTEGER(kind=8).
+
+   Based on libU77's date_time_.c.
+
+   TODO :
+   - Check year boundaries.
+   - There is no STDC/POSIX way to get VALUES(8).  A GNUish way may
+     be to use ftime.
+*/
+
+void
+date_and_time (char *__date,
+	       char *__time,
+	       char *__zone,
+	       gfc_array_i4 *__values,
+	       GFC_INTEGER_4 __date_len,
+	       GFC_INTEGER_4 __time_len,
+	       GFC_INTEGER_4 __zone_len)
+{
+#define DATE_LEN 8
+#define TIME_LEN 10   
+#define ZONE_LEN 5
+#define VALUES_SIZE 8
+  char date[DATE_LEN + 1];
+  char timec[TIME_LEN + 1];
+  char zone[ZONE_LEN + 1];
+  GFC_INTEGER_4 values[VALUES_SIZE];
+
+#ifndef HAVE_NO_DATE_TIME
+  time_t lt = time (NULL);
+  struct tm local_time = *localtime (&lt);
+  struct tm UTC_time = *gmtime (&lt);
+
+  /* All arguments can be derived from VALUES.  */
+  values[0] = 1900 + local_time.tm_year;
+  values[1] = 1 + local_time.tm_mon;
+  values[2] = local_time.tm_mday;
+  values[3] = (local_time.tm_min - UTC_time.tm_min +
+	       60 * (local_time.tm_hour - UTC_time.tm_hour +
+		     24 * (local_time.tm_yday - UTC_time.tm_yday)));
+  values[4] = local_time.tm_hour;
+  values[5] = local_time.tm_min;
+  values[6] = local_time.tm_sec;
+#if HAVE_GETTIMEOFDAY
+    {
+      struct timeval tp;
+#  if GETTIMEOFDAY_ONE_ARGUMENT
+      if (!gettimeofday (&tp))
+#  else
+#    if HAVE_STRUCT_TIMEZONE
+      struct timezone tzp;
+
+      /* Some systems such as HP-UX, do have struct timezone, but
+	 gettimeofday takes void* as the 2nd arg.  However, the
+	 effect of passing anything other than a null pointer is
+	 unspecified on HPUX.  Configure checks if gettimeofday
+	 actually fails with a non-NULL arg and pretends that
+	 struct timezone is missing if it does fail.  */
+      if (!gettimeofday (&tp, &tzp))
+#    else
+      if (!gettimeofday (&tp, (void *) 0))
+#    endif /* HAVE_STRUCT_TIMEZONE  */
+#  endif /* GETTIMEOFDAY_ONE_ARGUMENT  */
+	values[7] = tp.tv_usec / 1000;
+    }
+#else
+   values[7] = GFC_INTEGER_4_HUGE;
+#endif /* HAVE_GETTIMEOFDAY */
+
+  if (__date)
+    {
+      snprintf (date, DATE_LEN + 1, "%04d%02d%02d",
+		values[0], values[1], values[2]);
+    }
+
+  if (__time)
+    {
+      snprintf (timec, TIME_LEN + 1, "%02d%02d%02d.%03d",
+		values[4], values[5], values[6], values[7]);
+    }
+
+  if (__zone)
+    {
+      snprintf (zone, ZONE_LEN + 1, "%+03d%02d",
+		values[3] / 60, abs (values[3] % 60));
+    }
+#else /* if defined HAVE_NO_DATE_TIME  */
+  /* We really have *nothing* to return, so return blanks and HUGE(0).  */
+    {
+      int i;
+
+      memset (date, ' ', DATE_LEN);
+      date[DATE_LEN] = '\0';
+
+      memset (timec, ' ', TIME_LEN);
+      time[TIME_LEN] = '\0';
+
+      memset (zone, ' ', ZONE_LEN);
+      zone[ZONE_LEN] = '\0';
+
+      for (i = 0; i < VALUES_SIZE; i++)
+        values[i] = GFC_INTEGER_4_HUGE;
+    }
+#endif  /* HAVE_NO_DATE_TIME  */
+
+  /* Copy the values into the arguments.  */
+  if (__values)
+    {
+      int i;
+      size_t len, delta, elt_size;
+
+      elt_size = GFC_DESCRIPTOR_SIZE (__values);
+      len = __values->dim[0].ubound + 1 - __values->dim[0].lbound;
+      delta = __values->dim[0].stride;
+      if (delta == 0)
+	delta = 1;
+
+      assert (len >= VALUES_SIZE);
+      /* Cope with different type kinds.  */
+      if (elt_size == 4)
+        {
+	  GFC_INTEGER_4 *vptr4 = __values->data;
+
+	  for (i = 0; i < VALUES_SIZE; i++, vptr4 += delta)
+	    {
+	      *vptr4 = values[i];
+	    }
+	}
+      else if (elt_size == 8)
+        {
+	  GFC_INTEGER_8 *vptr8 = (GFC_INTEGER_8 *)__values->data;
+
+	  for (i = 0; i < VALUES_SIZE; i++, vptr8 += delta)
+	    {
+	      if (values[i] == GFC_INTEGER_4_HUGE)
+		*vptr8 = GFC_INTEGER_8_HUGE;
+	      else
+		*vptr8 = values[i];
+	    }
+	}
+      else 
+	abort ();
+    }
+
+  if (__zone)
+    {
+      assert (__zone_len >= ZONE_LEN);
+      fstrcpy (__zone, ZONE_LEN, zone, ZONE_LEN);
+    }
+
+  if (__time)
+    {
+      assert (__time_len >= TIME_LEN);
+      fstrcpy (__time, TIME_LEN, timec, TIME_LEN);
+    }
+
+  if (__date)
+    {
+      assert (__date_len >= DATE_LEN);
+      fstrcpy (__date, DATE_LEN, date, DATE_LEN);
+    }
+#undef DATE_LEN
+#undef TIME_LEN   
+#undef ZONE_LEN
+#undef VALUES_SIZE
+}
diff --git a/libgfortran/intrinsics/etime.c b/libgfortran/intrinsics/etime.c
new file mode 100644
index 00000000000..89ee539f064
--- /dev/null
+++ b/libgfortran/intrinsics/etime.c
@@ -0,0 +1,81 @@
+/* Implementation of the ETIME intrinsic.
+   Copyright (C) 2004 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargls@comcast.net>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with libgfor; see the file COPYING.LIB.  If not,
+write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+#include "config.h"
+#include <sys/types.h>
+#include "libgfortran.h"
+
+#include <stdio.h>
+
+#if defined (HAVE_SYS_TIME_H) && defined (HAVE_SYS_RESOURCE_H)
+#include <sys/time.h>
+#include <sys/resource.h>
+#endif
+
+void
+prefix(etime_sub) (gfc_array_r4 *t, GFC_REAL_4 *result)
+{
+  GFC_REAL_4 tu, ts, tt, *tp;
+  index_type dim;
+
+#if defined(HAVE_SYS_TIME_H) && defined(HAVE_SYS_RESOURCE_H)
+  struct rusage rt;
+
+  if (getrusage(RUSAGE_SELF, &rt) == 0)
+    {
+      tu = (GFC_REAL_4)(rt.ru_utime.tv_sec + 1.e-6 * rt.ru_utime.tv_usec);
+      ts = (GFC_REAL_4)(rt.ru_stime.tv_sec + 1.e-6 * rt.ru_stime.tv_usec);
+      tt = tu + ts;
+    }
+  else
+    {
+      tu = -1.;
+      ts = -1.;
+      tt = -1.;
+    }
+#else
+  tu = -1.;
+  ts = -1.;
+  tt = -1.;
+#endif
+
+  dim = GFC_DESCRIPTOR_RANK (t);
+  if (dim != 1)
+    runtime_error ("Array rank of TARRAY is not 1.");
+
+  if (t->dim[0].stride == 0)
+    t->dim[0].stride = 1;
+
+  tp = t->data;
+
+  *tp = tu;
+  tp += t->dim[0].stride;
+  *tp = ts;
+  *result = tt;
+}
+
+GFC_REAL_4
+prefix(etime) (gfc_array_r4 *t)
+{
+  GFC_REAL_4 val;
+  prefix(etime_sub) (t, &val);
+  return val;
+}
diff --git a/libgfortran/intrinsics/rand.c b/libgfortran/intrinsics/rand.c
new file mode 100644
index 00000000000..c4782fcdf61
--- /dev/null
+++ b/libgfortran/intrinsics/rand.c
@@ -0,0 +1,93 @@
+/* Implementation of the IRAND, RAND, and SRAND intrinsics.
+   Copyright (C) 2004 Free Software Foundation, Inc.
+   Contributed by Steven G. Kargl <kargls@comcast.net>.
+
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with libgfor; see the file COPYING.LIB.  If not,
+write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Simple multiplicative congruent algorithm.
+   The period of this generator is approximately 2^31-1, which means that
+   it should not be used for anything serious.  The implementation here
+   is based of an algorithm from  S.K. Park and K.W. Miller, Comm. ACM,
+   31, 1192-1201 (1988).  It is also provided solely for compatibility 
+   with G77.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#define GFC_RAND_A	16807
+#define GFC_RAND_M	2147483647
+#define GFC_RAND_M1	(GFC_RAND_M - 1)
+
+static GFC_UINTEGER_8 rand_seed = 1;
+
+
+/* Set the seed of the irand generator.  Note 0 is a bad seed.  */
+
+void
+prefix(srand) (GFC_INTEGER_4 *i)
+{
+  rand_seed = (GFC_UINTEGER_8) (*i != 0) ? *i : 123459876;
+}
+
+
+/* Return an INTEGER in the range [1,GFC_RAND_M-1].  */
+
+GFC_INTEGER_4
+prefix(irand) (GFC_INTEGER_4 *i)
+{
+  
+  GFC_INTEGER_4 j = *i;
+
+  switch (j)
+  {
+    /* Return the next RN. */
+    case 0:
+      break;
+
+    /* Reset the RN sequence to system-dependent sequence and return the
+       first value.  */
+    case 1:
+      j = 0;
+      prefix(srand) (&j);
+      break;
+    
+    /* Seed the RN sequence with j and return the first value.  */
+    default:
+      prefix(srand) (&j);
+   }
+
+   rand_seed = GFC_RAND_A * rand_seed % GFC_RAND_M;
+
+   return (GFC_INTEGER_4) rand_seed;
+}
+
+
+/*  Return a REAL in the range [0,1).  Cast to double to use the full
+    range of pseudo-random numbers returned by irand().  */
+
+GFC_REAL_4
+prefix(rand) (GFC_INTEGER_4 *i)
+{
+  GFC_REAL_4 val;
+
+  do 
+    val = (GFC_REAL_4)((double)(prefix(irand) (i) - 1) / (double) GFC_RAND_M1);
+  while (val == 1.0);
+
+  return val;
+}