
      SUBROUTINE LotusFileSave (datary, rowlabel,
     +      collabel, numrow, numcol, filename)
      INCLUDE 'STDHDR.FOR'
      REAL datary(0:maxr, 0:maxc)
      CHARACTER * 15 rowlabel(0:maxC), collabel(0:maxC)
      CHARACTER * 80 tempstr
      CHARACTER * 20 filename
      CHARACTER * 18 exstr(-1:maxc), fstr, nstr
      INTEGER i, j, tlen

      OPEN (3, FILE = filename, STATUS = 'UNKNOWN')

      DO i = -1, numcol
        exstr(i) = '                 '
      END DO
      tempstr = '               '
      DO i = 1, 18
        fstr(i:i) = ' '
        nstr(i:i) = ' '
      END DO

      CALL LotusString(REAL(numcol+1), 0,nstr)
      fstr = '(1X'
      CALL LotusCat(fstr,nstr)
      nstr = 'A18 )'
      CALL LotusCat(fstr,nstr)

      exstr(-1) = '"  ", '
      DO j = 0, numcol - 1
        tempstr = '"'
        CALL LotusCat(tempstr, collabel(j))
        tlen = LEN_TRIM(tempstr) + 1
        tempStr(tlen:tlen) = '"'
        IF (j .LT. numcol - 1)  THEN
          tlen = tlen + 1
          tempStr(tlen:tlen) = ','
        END IF
        exstr(j) = tempstr
      END DO
      WRITE (3,fstr) (exstr(j), j = -1, numcol-1)


      DO i = 0, numrow - 1
        tempstr = '"'
        CALL LotusCat(tempstr,rowlabel(i))
        CALL LotusCat(tempstr, '",')
        exstr(-1) = tempstr
        DO j = 0, numcol - 1
          CALL LotusString(datary(i,j), 4, tempstr)
          IF (j .LT. numcol - 1)  THEN
           tlen = LEN_TRIM(tempstr) + 1
           tempStr(tlen:tlen) = ','
          END IF
          exstr(j) = tempstr
        END DO
       WRITE (3,fstr) (exstr(j), j = -1, numcol-1)
      END DO
      WRITE(3,*) CHAR(26)
      CLOSE (3)
      END


      SUBROUTINE LotusString (r, digits, TheString)
      REAL r, tempr
      CHARACTER *80 TheString
      INTEGER  exponent, digits,  behind, before
      INTEGER  i, y, strLen, location
      LOGICAL sign

      DO i= 1, 80
        TheString(i:i) = ' '
      END DO
      location = 1
      tempr = r
      strLen = ABS(REAL(digits)) + 2    !!!  min. 2 characters sign, digit
      IF (digits .NE. 0) THEN strLen = strLen + 1
      IF (digits .LT. 0) THEN strLen = strLen + 4
      IF (tempr .LT. 0)   sign = .TRUE.
      tempr = ABS(tempr)

      IF (digits .GE. 0)
     +   tempr = tempr + 0.5 * LotusExp(-digits) + 1.0E-14

      !!!  normalize downward, less than 10
      exponent = 0
      DO WHILE (tempr .GE. 10.0)
        tempr = tempr / 10.0
        exponent = exponent + 1
      END DO
      IF (digits .GE. 0) THEN
        before = exponent
      ELSE
        before = 0
      END IF
      behind = ABS(digits)

      !!!  Write digits before the decimal-point
      y = AINT(tempr)
      TheString(location:location) = CHAR(y+48)
      location = location + 1
      tempr = tempr - REAL(y)
      DO WHILE (before .GT. 0)
        tempr = tempr * 10.0
        y = AINT(tempr)
        TheString(location:location) =  CHAR(y+48)
        strindex = strindex + 1
        location = location + 1
        tempr = tempr - y
        before = before - 1
      END DO
      IF (behind .NE. 0) THEN
        TheString(location:location) = '.'
        strindex = strindex + 1
        location = location + 1
      END IF

      !!!  write digits after the decimal-point
      DO WHILE (behind .GT. 0)
        tempr = tempr * 10.0
        y = AINT(tempr)
        TheString(location:location) = CHAR(y + 48)
        strindex = strindex + 1
        location = location + 1
        tempr = tempr - REAL(y)
        behind = behind - 1
      END DO

      END !SUBROUTINE



      FUNCTION Lotusexp (e)
      INTEGER  e, i
      REAL x

      x = 1.0
      IF (e .GT. 0) THEN
        DO i = 1, e
          x = x * 10.0
        END DO
      ELSE
        DO i = 1, -e, -1
          x = x / 10.0
        END DO
        Lotusexp = x
      END IF
      END !FUNCTION


      SUBROUTINE Lotuscat( outstr, s)
      CHARACTER * (*) outstr, s
      INTEGER LenO, LenS, i
      LenO = LEN_TRIM(outstr) + 1
      LenS = LEN_TRIM(s)
      DO i = 1, Lens
        outstr(LenO:LenO) = s(i:i)
        LenO = LenO + 1
      END DO
      END !SUBROUTINE

