← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/schkw.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/schkw.f
 
1
*DECK SCHKW
 
2
      SUBROUTINE SCHKW (NAME, LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR)
 
3
C***BEGIN PROLOGUE  SCHKW
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  SLAP WORK/IWORK Array Bounds Checker.
 
6
C            This routine checks the work array lengths and interfaces
 
7
C            to the SLATEC error handler if a problem is found.
 
8
C***LIBRARY   SLATEC (SLAP)
 
9
C***CATEGORY  R2
 
10
C***TYPE      SINGLE PRECISION (SCHKW-S, DCHKW-D)
 
11
C***KEYWORDS  ERROR CHECKING, SLAP, WORKSPACE CHECKING
 
12
C***AUTHOR  Seager, Mark K., (LLNL)
 
13
C             Lawrence Livermore National Laboratory
 
14
C             PO BOX 808, L-60
 
15
C             Livermore, CA 94550 (510) 423-3141
 
16
C             seager@llnl.gov
 
17
C***DESCRIPTION
 
18
C
 
19
C *Usage:
 
20
C     CHARACTER*(*) NAME
 
21
C     INTEGER LOCIW, LENIW, LOCW, LENW, IERR, ITER
 
22
C     REAL    ERR
 
23
C
 
24
C     CALL SCHKW( NAME, LOCIW, LENIW, LOCW, LENW, IERR, ITER, ERR )
 
25
C
 
26
C *Arguments:
 
27
C NAME   :IN       Character*(*).
 
28
C         Name of the calling routine.  This is used in the output
 
29
C         message, if an error is detected.
 
30
C LOCIW  :IN       Integer.
 
31
C         Location of the first free element in the integer workspace
 
32
C         array.
 
33
C LENIW  :IN       Integer.
 
34
C         Length of the integer workspace array.
 
35
C LOCW   :IN       Integer.
 
36
C         Location of the first free element in the real workspace
 
37
C         array.
 
38
C LENRW  :IN       Integer.
 
39
C         Length of the real workspace array.
 
40
C IERR   :OUT      Integer.
 
41
C         Return error flag.
 
42
C               IERR = 0 => All went well.
 
43
C               IERR = 1 => Insufficient storage allocated for
 
44
C                           WORK or IWORK.
 
45
C ITER   :OUT      Integer.
 
46
C         Set to zero on return.
 
47
C ERR    :OUT      Real.
 
48
C         Set to the smallest positive magnitude if all went well.
 
49
C         Set to a very large number if an error is detected.
 
50
C
 
51
C***REFERENCES  (NONE)
 
52
C***ROUTINES CALLED  R1MACH, XERMSG
 
53
C***REVISION HISTORY  (YYMMDD)
 
54
C   880225  DATE WRITTEN
 
55
C   881213  Previous REVISION DATE
 
56
C   890915  Made changes requested at July 1989 CML Meeting.  (MKS)
 
57
C   890922  Numerous changes to prologue to make closer to SLATEC
 
58
C           standard.  (FNF)
 
59
C   890929  Numerous changes to reduce SP/DP differences.  (FNF)
 
60
C   900805  Changed XERRWV calls to calls to XERMSG.  (RWC)
 
61
C   910411  Prologue converted to Version 4.0 format.  (BAB)
 
62
C   910502  Corrected XERMSG calls to satisfy Section 6.2.2 of ANSI
 
63
C           X3.9-1978.  (FNF)
 
64
C   910506  Made subsidiary.  (FNF)
 
65
C   920511  Added complete declaration section.  (WRB)
 
66
C   921015  Added code to initialize ITER and ERR when IERR=0.  (FNF)
 
67
C***END PROLOGUE  SCHKW
 
68
C     .. Scalar Arguments ..
 
69
      REAL ERR
 
70
      INTEGER IERR, ITER, LENIW, LENW, LOCIW, LOCW
 
71
      CHARACTER NAME*(*)
 
72
C     .. Local Scalars ..
 
73
      CHARACTER XERN1*8, XERN2*8, XERNAM*8
 
74
C     .. External Functions ..
 
75
      REAL R1MACH
 
76
      EXTERNAL R1MACH
 
77
C     .. External Subroutines ..
 
78
      EXTERNAL XERMSG
 
79
C***FIRST EXECUTABLE STATEMENT  SCHKW
 
80
C
 
81
C         Check the Integer workspace situation.
 
82
C
 
83
      IERR = 0
 
84
      ITER = 0
 
85
      ERR = R1MACH(1)
 
86
      IF( LOCIW.GT.LENIW ) THEN
 
87
         IERR = 1
 
88
         ERR = R1MACH(2)
 
89
         XERNAM = NAME
 
90
         WRITE (XERN1, '(I8)') LOCIW
 
91
         WRITE (XERN2, '(I8)') LENIW
 
92
         CALL XERMSG ('SLATEC', 'SCHKW',
 
93
     $      'In ' // XERNAM // ', INTEGER work array too short.  ' //
 
94
     $      'IWORK needs ' // XERN1 // '; have allocated ' // XERN2,
 
95
     $      1, 1)
 
96
      ENDIF
 
97
C
 
98
C         Check the Real workspace situation.
 
99
      IF( LOCW.GT.LENW ) THEN
 
100
         IERR = 1
 
101
         ERR = R1MACH(2)
 
102
         XERNAM = NAME
 
103
         WRITE (XERN1, '(I8)') LOCW
 
104
         WRITE (XERN2, '(I8)') LENW
 
105
         CALL XERMSG ('SLATEC', 'SCHKW',
 
106
     $      'In ' // XERNAM // ', REAL work array too short.  ' //
 
107
     $      'RWORK needs ' // XERN1 // '; have allocated ' // XERN2,
 
108
     $      1, 1)
 
109
      ENDIF
 
110
      RETURN
 
111
C------------- LAST LINE OF SCHKW FOLLOWS ----------------------------
 
112
      END