calculator Subroutine

recursive subroutine calculator(inline,outlin,mssg,slast,ierr)
!
!     The goal is to create a procedure easily utilized from other
!     programs that takes a standard Fortran value statement and reduces
!     it down to a value, efficiently and using standard Fortran
!     standards where ever feasible.
!
!  Version 2.0: 03/13/87
!  Version 3.0: 07/11/2013
!  Version 5.0: 07/16/2013
!
!  o  adjacent powers are done left to right, not right to left
!  o  code does not prevent - and + beside an other operator.
!  o  no check on whether user input more characters than allowed.
!     no check on whether line expansion ever causes line length to
!     exceed allowable number of characters.
!     number of characters to prevent over-expansion would currently be
!     23 digits per number max*(input number of characters/2+1).
!  o  allowing for ixy_calc arguments in max and min seems too high. if reducing
!     array size helps significantly in costs, do so.
!  o  parentheses are required on a function call.
!  o  square brackets [] are equivalent to parenthesis ().
!===========================================================================--------------------------------------------------------
!  2. need a generic help function to list commands and functions
!  3. allow multiple expressions per line with a semi-colon between them
!     (like the parse functions).
!  4. make a function to fill x and y arrays, or to read values into them
!     from a file; and make some statistical functions that work on the
!     arrays.
!  6. allow user-written functions to be called from funcs_ routine.
!  7. allow for user-defined arrays and array operations.
!===========================================================================--------------------------------------------------------
!  12/07/87 --- put in an implicit real (a-h,o-z) statement in each
!              procedure so that it could quickly be changed to
!              implicit real*8 (a-h,o-z) for a vax. be careful of
!              type mismatch between external functions and the
!              real variables.
!              use following xedit commands where periods denote
!              spaces
!              c/implicit real../implicit real*8./ *
! 12/11/87  --- changed ifix calls to int calls as ifix on vax does
!              not allow real*8 in ifix calls
! 12/11/87  --- moving all prints out of column 1 so it is not picked
!              out by vax as carriage control.
! 12/28/87  --- put bn format specifier into a_to_d_ routine because
!              vax assumes zero fill
! 06/23/88  --- making a first cut at allowing string variables.
!               1. string variable names must start with a dollar-sign
!               2. strings can only be up to (iclen_calc) characters long
!               3. they will be returned in the message string to
!                  the calling program
!               4. input strings must be delimited with double quotes.
!                  to place a double quote into the string, put two
!                  double quotes adjacent to each other.
!               5. a flag value for ier to distinguish between string
!                  and numeric output?
!#----------------------------------------------------------------------------------------------------------------------------------
!subroutine calculator(inline,outlin,mssg,slast,ierr)

! ident_1="@(#) M_calculator calculator(3f) The procedure CALCULATOR(3f) acts like a calculator"

!-----------------------------------------------------------------------------------------------------------------------------------
character(len=*),intent(in)            :: inline
character(len=iclen_calc),intent(out)  :: outlin
character(len=iclen_calc),intent(out)  :: mssg
real(kind=dp),intent(out)              :: slast
integer,intent(out)                    :: ierr
!-----------------------------------------------------------------------------------------------------------------------------------
character(len=icbuf_calc)              :: line
character(len=iclen_calc)              :: varnam
character(len=iclen_calc)              :: junout
real(kind=dp),save                     :: rlast=0.0_dp
integer                                :: i10
integer                                :: i20
integer                                :: idum
integer                                :: imax
integer                                :: indx
integer                                :: iplace
integer                                :: istart
integer                                :: nchar2
integer                                :: nchard
!-----------------------------------------------------------------------------------------------------------------------------------
   line=inline                                      ! set working string to initial input line
   imax=len(inline)                                 ! determine the length of the input line
   mssg=' '                                         ! set returned message/error/string value string to a blank
   outlin=' '
   BIG: do                                          ! for $A=numeric and A=string
      ierr=1                                           ! set status flag to message mode
      mssge=' '                                        ! set message/error/string value in GLOBAL to a blank
      varnam=' '
      call squeeze_(line,imax,nchard,varnam,nchar2,ierr) ! preprocess the string: remove blanks and process special characters
                                                         ! also remove all quoted strings and replace them with a token
!-----------------------------------------------------------------------------------------------------------------------------------
      if(ierr.eq.-1)then                ! if an error occurred during preprocessing of the string, set returned message and quit
         slast=rlast                    ! set returned real value to last good calculated value
         mssg=mssge                     ! place internal message from GLOBAL into message returned to user
         return
      elseif(nchard.eq.0)then  ! if a blank input string was entered report it as an error and quit
         ierr=-1
         mssg='*calculator* input line was empty'
      elseif(line(1:nchard).eq.'dump')then ! process dump command
         write(*,g)line(1:nchard)
         write(*,g)' current value= ',last
         write(*,g)' variable name       variable value     '
         if(allocated(keyr_q))then
            do i10=1,size(keyr_q)
               if(keyr_q(i10).ne.' ')then
                  write(junout,'('' '',2a,g23.16e3)')keyr_q(i10),' ',values_d(i10)
                  write(*,g)trim(junout)
               endif
            enddo
         endif
         if(allocated(keys_q))then
            do i20=1,size(keys_q)
               if(keys_q(i20).ne.' ')then
                  write(junout,'('' '',3a)')keys_q(i20),' ',values(i20)(:values_len(i20))
                  write(*,g)trim(junout)
               endif
            enddo
         endif
         mssg='variable listing complete'
      elseif(line(1:nchard).eq.'funcs') then     ! process funcs command
         call help_funcs_()
         mssg='function listing complete'
!-----------------------------------------------------------------------------------------------------------------------------------
      else                                                ! this is an input line to process
         call parens_(line,nchard,ierr)                   ! process the command
         if(ierr.eq.0)then                 ! if no errors occurred set output string, store the value as last, store any variable
                                           ! numeric value with no errors, assume nchard is 23 or less
            outlin=line(1:nchard)                         ! set string output value
            last=line(1:nchard)                           ! store last value (for use with question-mark token)
            call a_to_d_(last(1:nchard),rlast,idum)       ! set real number output value
            if(nchar2.ne.0.and.varnam(1:1).ne.'$')then    ! if the statement defines a variable make sure variable name is stored
               call locate(keyr_q,varnam(:nchar2),indx,ierr) ! determine placement of the variable and whether it is new
               if(ierr.eq.-1)then
                  slast=rlast                             ! set returned real value to last good calculated value
                  mssg=mssge                              ! place internal message from GLOBAL into message returned to user
                  return
               endif
               if(indx.le.0)then                          ! if the variable needs added, add it
                  istart=iabs(indx)
                  call insert(keyr_q,varnam(:nchar2),istart)
                  call insert(values_d,0.0d0,istart)
               endif
               call a_to_d_(last(1:nchard),values_d(iabs(indx)),ierr)  ! store a defined variable's value
            elseif(nchar2.ne.0)then                       ! numeric value to string
               line(:)=' '
               line=varnam(:nchar2)//'="'//last(1:nchard)//'"'
               imax=len_trim(line)                        ! determine the length of the input line
               cycle BIG
            endif
         elseif(ierr.eq.2)then ! returned output is not numeric, but alphanumeric (it is a string)
!!!!!!!  could return string values directly instead of thru message field
!!!!!!!  make sure normal output values are not left indeterminate
            mssg=mssge                                    ! set returned string value to returned string value
            if(nchar2.ne.0.and.varnam(1:1).eq.'$')then    ! if the statement defines a variable make sure variable name is stored
               call locate(keys_q,varnam(:nchar2),indx,ierr) ! determine placement of the variable and whether it is new
               if(ierr.eq.-1)then
                  slast=rlast                             ! set returned real value to last good calculated value
                  mssg=mssge                              ! place internal message from GLOBAL into message returned to user
                  return
               endif
               iplace=iabs(indx)
               if(indx.le.0)then                             ! if the variable needs added, add it
                  call insert(keys_q,varnam(:nchar2),iplace) ! adding the new variable name to the variable name array
                  call insert(values,' '            ,iplace)
                  call insert(values_len,0              ,iplace)
               endif
               call replace(values,mssg,iplace)
               call replace(values_len,len_trim(mssg),iplace)
               rlast=dble(values_len(iplace))             ! returned value is length of string when string is returned
            elseif(nchar2.ne.0)then                       ! string but being stored to numeric variable
                line=varnam(:nchar2)//'='//mssg
                imax=len_trim(line)                       ! determine the length of the input line
                cycle BIG
            else                                          ! a string function with an assignment to it (for example "Hello"
               rlast=len_trim(mssg)                       ! probably should pass message length up from someplace
            endif
         endif
         mssg=mssge
      endif
      exit BIG
   enddo BIG
   slast=rlast                                            ! set returned value to last successfully calculated real value
end subroutine calculator