       subroutine ctor ( cstr, nch, rval, ierr )
c
c    dac:zeus3d.ctor <-------------- translates character string to real
c                                                          january, 1992
c
c      Written by: David Clarke
c      Modified 1:
c
c  PURPOSE:  This subroutine translates a character string to a real
c  constant.
c
c  INPUT VARIABLES:
c    cstr      character representation of real number
c    nch       number of characters in "cstr"
c
c  OUTPUT VARIABLES
c    rval      floating representation of real number
c    ierr      0 => floating conversion successful
c              1 => non-translatable character found in "cstr"
c
c  EXTERNALS: [NONE]
c
c-----------------------------------------------------------------------
c
c
c-----------------------------------------------------------------------
c------------------------ IMPLICIT STATEMENTS --------------------------
c-----------------------------------------------------------------------
c
       implicit      none
c
       character*1   char1
       character*(*) cstr
       integer       nch     , ierr    , i       , esign   , ipnt
     1             , npnt    , more    , iman    , iexp    , j
       real*8        rval    , msign   , term    , fact
c
       character*1   ch      (  10)
       integer       exponent(   4), mantissa(  16)
c
c      Data statements
c
       data          ch       /'0','1','2','3','4','5','6','7','8','9'/
c
c-----------------------------------------------------------------------
c
c      Initialise parameters.
c
       do 10 i=1,4
         exponent(i) = 0
10     continue
       do 20 i=1,16
         mantissa(i) = 0
20     continue
       rval  = 0.0
       msign = 1.0
       esign = 1
       ipnt  = 0
       npnt  = 0
       more  = 1
       iman  = 0
       iexp  = 0
       ierr  = 0
c
c      Scan "cstr".
c
       do 40 i=1,nch
         char1 = cstr(i:i)
         if (char1 .eq. ' ') go to 40
         if (char1 .eq. '-') then
           if (more .eq. 1) msign = -1.0
           if (more .eq. 2) esign = -1
           go to 40
         endif
         if (char1 .eq. '+') go to 40
         if (char1 .eq. '.') then
           npnt = 1
           ipnt = i - 2
           if (msign .eq. -1.0) ipnt = ipnt - 1
           go to 40
         endif
         if ( (char1 .eq. 'e') .or. (char1 .eq. 'd') ) then
           more = 2
           if (npnt .eq. 0) then
             npnt = 1
             ipnt = i - 2
             if (msign .eq. -1.0) ipnt = ipnt - 1
             if (ipnt .lt. 0) ipnt = 0
           endif
           go to 40
         endif
         do 30 j=1,10
           if (char1 .eq. ch(j)) then
             if (more .eq. 1) then
               iman = iman + 1
               mantissa(iman) = j - 1
             endif
             if (more .eq. 2) then
               iexp = iexp + 1
               exponent(iexp) = j - 1
             endif
             go to 40
           endif
30       continue
c
c      Illegal character found.  Set "ierr" to 1 and return.
c
         ierr = 1
         return
40     continue
       if (npnt .eq. 0) ipnt = iman - 1
c
c      Evaluate the mantissa.
c
       if (iman .gt. 0) then
         do 50 i=1,iman
           term =  real(mantissa(i)) * 10.0**ipnt
           rval = rval + term
           ipnt = ipnt - 1
50       continue
       else
         rval = 1.0
       endif
       rval = rval * msign
c
c      Evaluate the exponential factor.
c
       fact = 1.0
       if (iexp .gt. 0) then
         do 60 i=1,iexp
           ipnt = iexp - i
           fact = fact * 10.0 ** (exponent(i) * 10.0**ipnt)
60       continue
       endif
       if (esign .eq. -1) fact = 1.0 / fact
c
c      Return real representation of character string.
c
       rval = rval * fact
c
       return
       end
