h28454
s 00000/00000/00094
d D 1.2 83/01/28 14:30:43 tes 2 1
c these three routines were not in initial release, gr2chr ptreal gtreal
e
s 00094/00000/00000
d D 1.1 83/01/28 14:27:04 tes 1 0
c date and time created 83/01/28 14:27:04 by tes
e
u
tes
mjb
mmm
mrk
U
t
T
I 1
integer function gr2chr (value, chrstr, size, deciml, ierror)
########################################################################
#                                                                      #
#          THIS MATERIAL IS CONFIDENTIAL AND IS FURNISHED UNDER        #
#          A WRITTEN LICENSE AGREEMENT.  IT MAY NOT BE USED,           #
#          COPIED OR DISCLOSED TO OTHERS EXCEPT IN ACCORDANCE          #
#          WITH THE TERMS OF THAT AGREEMENT.                           #
#                                                                      #
#          COPYRIGHT (C) 1982 GRAPHIC SOFTWARE SYSTEMS INC.            #
#          ALL RIGHTS RESERVED.                                        #
#                                                                      #
#     Function: convert a real binary to a character string            #
#                                                                      #
#     Input Parameters:                                                #
#            value  - real binary number to be converted               #
#            size   - maximum number of output characters              #
#            deciml - number of decimal places to be output            #
#                                                                      #
#     Output Parameters:                                               #
#            chrstr - integer array for ade string of characters       #
#            ierror - error flag; 0= no error, 1=string too large      #
#                                                                      #
#     Routines Called:                                                 #
#            none                                                      #
#                                                                      #
########################################################################
integer chrstr(1), size, deciml, ierror
real value
 
integer i, lngth1
real valtmp, powten, val, small

   ierror = NO
   gr2chr = 0
   for (i=1; i<=size; i=i+1) chrstr(i) = BLANK

   # Convert the part to the left of the decimal point
   valtmp = abs(value) + ZEPS

   # If the value is less than 0, put out the leading minus
   lngth1 = 1
   if (value < 0.0)  {
      chrstr(1) = MINUS
      lngth1 = 2
      }

   powten = 1.
   small = 1.0 - ZEPS
   if (valtmp > small)  {  # If it has some real digits
      for (powten=1; powten<=valtmp; powten=powten*10)  {          }
      powten = powten / 10.

      while (powten > small)  {
	 val = valtmp / powten
	 valtmp = valtmp - ifix(val)*powten
	 powten = powten / 10.
	 if (size - lngth1 < 1)  {   # Buffer overflow
	    ierror = YES
	    return
	    }
	 chrstr(lngth1) = ifix(val) + DIG0
	 lngth1 = lngth1 + 1
	 }
      lngth1 = lngth1 - 1
      }
   else  {  # Value has leading 0
      chrstr(lngth1) = DIG0
      }

   gr2chr = lngth1
   if ((size-lngth1) >= 1) {
      lngth1 = lngth1 + 1
      chrstr(lngth1) = PERIOD
      gr2chr = lngth1
      if ((size-lngth1) >= 1 & deciml > 0) {
	 powten = 10.**(deciml-1)
	 valtmp = valtmp*powten*10.
         for (i=1; i<=deciml; i=i+1) {
            lngth1 = lngth1 + 1
	    if (size - lngth1 < 1)  {   # Buffer overflow
	       gr2chr = lngth1 - 1
	       return
	       }
	    val = valtmp / powten
	    valtmp = valtmp - ifix(val)*powten
	    powten = powten / 10.
	    chrstr(lngth1) = ifix(val) + DIG0
            }
         gr2chr = lngth1 
         }
      }
 
   return
end
E 1
