view libcruft/ranlib/getcgn.f @ 10103:0e71ead7359d

Use CALL XSTOPX instead of STOP in Fortran ranlib routines New call allows Octave's error handler to intercept otherwise fatal errors in Fortran code
author Rik <rdrider0-list@yahoo.com>
date Wed, 13 Jan 2010 22:22:46 -0800
parents df7c57a6639d
children
line wrap: on
line source

      SUBROUTINE getcgn(g)
      INTEGER g
C**********************************************************************
C
C      SUBROUTINE GETCGN(G)
C                         Get GeNerator
C
C     Returns in G the number of the current random number generator
C
C
C                              Arguments
C
C
C     G <-- Number of the current random number generator (1..32)
C                    INTEGER G
C
C**********************************************************************
C
      INTEGER curntg,numg
      SAVE curntg
      PARAMETER (numg=32)
      DATA curntg/1/
C
      g = curntg
      RETURN

      ENTRY setcgn(g)
C**********************************************************************
C
C     SUBROUTINE SETCGN( G )
C                      Set GeNerator
C
C     Sets  the  current  generator to G.    All references to a generat
C     are to the current generator.
C
C
C                              Arguments
C
C
C     G --> Number of the current random number generator (1..32)
C                    INTEGER G
C
C**********************************************************************
C
C     Abort if generator number out of range
C
      IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10
      WRITE (*,*) ' Generator number out of range in SETCGN:',
     +  ' Legal range is 1 to ',numg,' -- ABORT!'
      CALL XSTOPX (' Generator number out of range in SETCGN')

   10 curntg = g
      RETURN

      END