home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / libs / matlab.lzh / MATLAB / MATLAB.LZH / Source / Plot / VALGET.FOR < prev    next >
Encoding:
Text File  |  1991-04-13  |  2.9 KB  |  113 lines
  1.       SUBROUTINE VALGET (X, INTEG, IVAL)
  2.       IMPLICIT NONE
  3. C
  4. C ***      READ A NUMERIC VALUE IN FREE FORMAT
  5. C            X     IS RETURNED FLOATING POINT VERSION
  6. C            INTEG IS RETURNED INTEGER VERSION
  7. C            IVAL  IS A CONTROL CODE: 'F' = FLOATING POINT VALUE IS EXPECTED
  8. C
  9.       REAL X
  10.       INTEGER INTEG
  11.       CHARACTER*1 IVAL
  12. C
  13.       INCLUDE MATLAB$KOM:IOP.KOM
  14. C
  15.       CHARACTER*1 A(80), NULL
  16.       INTEGER INTX(80), I, J, ICOUNT, ISTART, IFCOUN
  17.       REAL FRAC, EX, BAS, FSIGN
  18. C
  19.       DATA NULL / Z'00' /
  20. C
  21. C
  22.       DO 40 I = 1, 80
  23.         A(I) = Z'20'
  24. 40    CONTINUE
  25. C
  26. C ***      CHECK IF THE CURRENT PLOT IS DONE
  27. C           THIS IS MERELY THE MOST CONVENIENT PLACE TO DO IT
  28.       CALL CHKEND
  29. C
  30. C ***      GET THE TERMINAL INPUT STRING
  31.       CALL GETLAB (A)
  32. C
  33. C ***      TEST FOR A BLANK INPUT LINE
  34. C           IF SO,  RETURN (DON'T CHANGE THE INPUT VALUE)
  35.       DO 1 I = 1, 80
  36.         IF (A(I).NE.' ') GOTO 2
  37. 1     CONTINUE
  38.       GO TO 9999
  39. C
  40. C
  41. 2     CONTINUE
  42.       INTEG = 0
  43.       X = 0
  44. C
  45. C ***      TEST FOR LEADING BLANKS AND LOOK FOR A NEGATIVE SIGN
  46. C      WRITE (WTE, 342) (A(I), I = 1, 80)
  47. C342   FORMAT (1X, 80Z2)
  48.       ICOUNT = 1
  49.       ISIGN = 1
  50. 3     CONTINUE
  51.       IF (A(ICOUNT).EQ.' ' .AND. ICOUNT.LE.80) THEN
  52.         ICOUNT = ICOUNT + 1
  53. C        WRITE (WTE, 657)
  54. C657     FORMAT (' FOUND A LEADING BLANK')
  55.         GOTO 3
  56.       ENDIF
  57.       IF (A(ICOUNT).EQ.'-') THEN
  58.         ISIGN = -1
  59.         ICOUNT = ICOUNT + 1
  60. C        WRITE (WTE, 546) ICOUNT
  61. C546     FORMAT (' FOUND A NEGATIVE SIGN', I2)
  62.       ENDIF
  63.       ISTART = ICOUNT
  64. C
  65. C ***      NOW RESOLVE THE INTEGER PORTION OF THE NUMBER.
  66. C           STOP AT END OF STRING OR AT A DECIMAL POINT.
  67. 4     CONTINUE
  68.       IF (A(ICOUNT).NE.'.' .AND. A(ICOUNT).NE.NULL .AND.
  69.      .    ICOUNT.LE.80) THEN
  70.         INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
  71.         ICOUNT = ICOUNT+1
  72.         GOTO 4
  73.       ENDIF
  74.       ICOUNT = ICOUNT-1
  75. C      WRITE (WTE, 7) ICOUNT
  76. C7     FORMAT (' ICOUNT = ', I2)
  77.       DO 5 J = ISTART, ICOUNT
  78.         INTEG = INTEG+INTX(J) * 10**(ICOUNT-J)
  79. 5     CONTINUE
  80.       INTEG = INTEG*ISIGN
  81. C      WRITE (WTE, 10) INTEG
  82. C10    FORMAT (1X, I6)
  83. C
  84. C ***      SEE IF THIS IS NUMBER HAS A FRACTIONAL PORTION.  IF SO, RESOLVE
  85. C           ITS VALUE AND RETURN IT AS PART OF THE FLOATING POINT NUMBER.
  86.       ICOUNT = ICOUNT+1
  87.       FRAC = 0.0
  88.       IF (IVAL.EQ.'F' .AND. A(ICOUNT).EQ.'.') THEN
  89.         ICOUNT = ICOUNT+1
  90.         IFCOUN = ICOUNT
  91. 20      CONTINUE
  92.         IF (A(ICOUNT).NE.NULL .AND. ICOUNT.LE.80) THEN
  93.           INTX(ICOUNT) = ICHAR(A(ICOUNT))-48
  94.           ICOUNT = ICOUNT+1
  95.           GOTO 20
  96.         ENDIF
  97.         ICOUNT = ICOUNT - 1
  98.         DO 25 J = IFCOUN, ICOUNT
  99.           EX = FLOAT(IFCOUN-J-1)
  100.           BAS = FLOAT(INTX(J))
  101.           FRAC = FRAC+ BAS * 10.** EX
  102. 25      CONTINUE
  103.       ENDIF
  104.       FSIGN = ISIGN
  105.       FRAC = FRAC*FSIGN
  106.       X = FLOAT(INTEG)+FRAC
  107. C      WRITE (WTE, 30) X, FRAC
  108. C30    FORMAT (' X = ', 2F10.4)
  109. C
  110. 9999  CONTINUE
  111.       RETURN
  112.       END
  113.