1       SUBROUTINE INDINT (STRING, START, END)
2C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
3C Purpose:      Find the position of the first valid integer in STRING
4C
5C Arguments:    STRING   character string (input only)
6C               START    index of beginning of integer (output only)
7C               END      index of last digit of integer (output only)
8C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
9C $Header: /tmp/mss/nwchem/src/util/indint.F,v 1.1 1997-03-24 02:00:36 gg502 Exp $
10C
11C $Log: not supported by cvs2svn $
12C Revision 1.1  1996/08/27 21:56:14  d3e129
13C removed requirments of LLE, LGE, LLT, LGT for SGITFP.
14C rak
15C
16C Revision 1.3  1995/12/16 21:06:34  gg502
17C The great implicit none-ification :-)
18C
19c Revision 1.2  1995/02/02  23:21:10  d3g681
20c RJH: A CVS ID for every file and automated generation of a version output
21c
22c Revision 1.1  1994/06/14  21:54:18  gg502
23c First cut at RIMP2.
24c
25c Revision 1.1  91/08/26  23:09:37  bernhold
26c Initial revision
27c
28c Revision 1.1  90/05/14  17:13:09  bernhold
29c Initial revision
30c
31C
32C System:       Standard FORTRAN 77
33C
34C Copyright 1988 David E. Bernholdt
35C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
36C$Id$
37       IMPLICIT NONE
38       CHARACTER*(*) STRING
39       CHARACTER*1 C
40       INTEGER START, END
41       INTEGER I
42       LOGICAL INONE, SIGN
43#if defined(SGITFP)
44       logical l_llt, l_lgt, l_lge, l_lle
45       integer ic_c, ic_0, ic_9
46#endif
47C
48       START = 0
49       END = 0
50       INONE = .FALSE.
51       SIGN = .FALSE.
52#if defined(SGITFP)
53c
54       ic_0  = ichar('0')
55       ic_9  = ichar('9')
56#endif
57C
58       DO 100 I = 1, LEN(STRING)
59          C = STRING(I:I)
60#if defined(SGITFP)
61          ic_c  = ichar(c)
62          l_llt = ic_c.lt.ic_0
63          l_lgt = ic_c.gt.ic_9
64          l_lge = ic_c.ge.ic_0
65          l_lle = ic_c.le.ic_9
66          IF (INONE .AND. (l_llt .OR. l_lgt)) THEN
67#else
68          IF (INONE .AND. (LLT(C,'0') .OR. LGT(C,'9'))) THEN
69#endif
70C               End of an integer...
71             INONE = .FALSE.
72C               Check to make sure it wasn't just a + or a -
73             IF (SIGN .AND. (START .EQ. I-1)) THEN
74                SIGN = .FALSE.
75                START = 0
76             ELSE
77                END = I - 1
78                RETURN
79             ENDIF
80          ELSEIF (.NOT.INONE .AND.
81     1           (C.EQ.'-' .OR. C.EQ.'+')) THEN
82C               This is a sign character, which may begin an integer
83             SIGN = .TRUE.
84             INONE = .TRUE.
85             START = I
86#if defined(SGITFP)
87          ELSEIF (.NOT.INONE .AND.
88     1           (l_lge .AND. l_lle)) THEN
89#else
90          ELSEIF (.NOT.INONE .AND.
91     1           (LGE(C,'0') .AND. LLE(C,'9'))) THEN
92#endif
93C               This is a digit, which does begin an integer
94             INONE = .TRUE.
95             START = I
96          ENDIF
97 100   CONTINUE
98C
99C      If we as still INONE here, the integer is at the end of STRING
100C
101       IF (INONE) END = LEN(STRING)
102       RETURN
103       END
104