getcon.for

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

      SUBROUTINE GETCON(STRING,I1,I2,KLCH,STYP)
*-----------------------------------------------------------------------
*
*--- returns a numeric constant, and its type. Constant must start on I1
*--- input
*    STRING(I1:I2)  string
*--- output
*    KLCH           last pos. of const., or 0 if none
*    STYP           type of constant:
*                  'I' = integer
*                  'R' = real
*                  'D' = double prec.
*                  'K' = complex
*                  '$' = not specified
*
*-----------------------------------------------------------------------
      CHARACTER *(*)  STRING
      CHARACTER*1 STYP,STEMP,SLAST,SLOG*7
      character*7 touppr
      external touppr
      include 'convex.h'
c
      STYP='$'
      KLCH=0
      STEMP=STRING(I1:I1)
      IF(STEMP.EQ.'{')  THEN
*--- string, hollerith, etc., all treated as CHARACTER
         KPOS=INDEX(STRING(I1:I2),'}')
         IF(KPOS.NE.0) THEN
            KLCH=I1+KPOS-1
            STYP='C'
         ENDIF
      ELSEIF(STEMP.EQ.'.')  THEN
*--- logical constant ?
         CALL GETNBL(STRING(I1:I2),SLOG,NN)
         slog = touppr(slog)
         IF(NN.GE.5) THEN
            IF(SLOG(:5).EQ.'.NOT.'.OR.SLOG(:6).EQ.'.TRUE.'
     +      .OR.SLOG.EQ.'.FALSE.') THEN
               CALL POSCH('.',STRING,I1+1,I2,.FALSE.,0,KLCH,ILEV)
               IF(KLCH.NE.0) THEN
                  STYP='L'
                  GOTO 999
               ENDIF
            ENDIF
         ENDIF
      ENDIF
      IF(NUMCH(STEMP).OR.STEMP.EQ.'.')  THEN
*--- integer, real, or double precision
         KLCH=I1
         IF(STEMP.EQ.'.')  THEN
            STYP='R'
         ELSE
            STYP='I'
         ENDIF
         SLAST=STEMP
         DO 10 I=I1+1,I2
            STEMP=STRING(I:I)
            IF(STEMP.EQ.' ') GOTO 10
            IF(.NOT.NUMCH(STEMP)) THEN
               IF(STEMP.EQ.'.'.OR.STEMP.EQ.'E') THEN
                  STYP='R'
               ELSEIF(STEMP.EQ.'D') THEN
                  STYP='D'
               ELSEIF((STEMP.EQ.'+'.OR.STEMP.EQ.'-').AND. (SLAST.EQ.'E'
     +         .OR.SLAST.EQ.'D')) THEN
                  CONTINUE
               ELSE
                  GOTO 20
               ENDIF
            ENDIF
            KLCH=I
            SLAST=STEMP
   10    CONTINUE
   20    CONTINUE
      ELSEIF(STEMP.EQ.'(')  THEN
*--- complex
         CALL SKIPLV(STRING,I1+1,I2,.FALSE.,KLCH,ILEV)
         IF(KLCH.GT.0) THEN
            CALL POSCH(',',STRING,I1+1,KLCH-1,.FALSE.,0,KPOS,ILEV)
            IF(KPOS.NE.0) STYP='K'
         ENDIF
      ENDIF
  999 END