module evals

use global
use funcs
use stackops
use assert, only: wp, isclose
use help, only: print_help

implicit none (type, external)
private
public :: eval

complex(wp), parameter, private :: C0 = (0._wp, 0._wp)

contains

!***********************************************************************************************************************************
!  EVAL
!
!  Evaluate a operation.
!***********************************************************************************************************************************

recursive SUBROUTINE EVAL (STR)

CHARACTER(*), INTENT(IN) :: STR

real(wp), PARAMETER :: PI = 4._wp * atan(1._wp)
real(wp), PARAMETER :: EULER = 0.5772156649_wp
real(wp), PARAMETER :: GOLDEN = 1.618033988745_wp
COMPLEX(wp),  PARAMETER :: II = (0._wp,1._wp)
real(wp), PARAMETER :: KG_PER_LB = 0.45359237D0
real(wp), PARAMETER :: CM_PER_IN = 2.54_wp
real(wp), PARAMETER :: L_PER_GAL = 3.785411784D0
real(wp), PARAMETER :: A0 = 0.5291772108D-10                          ! m
real(wp), PARAMETER :: AMU = 1.660539040e-27_wp                       ! kg
real(wp), PARAMETER :: AU = 1.49597870D11                             ! m
real(wp), PARAMETER :: C = 299792458.0D0                              ! m/s
real(wp), PARAMETER :: ECHG = 1.6021766e-19_wp                        ! C
real(wp), PARAMETER :: EPS0 = 8.8541878176203898505D-12               ! F/m
real(wp), PARAMETER :: G = 9.80665D0                                  ! m/s^2
real(wp), PARAMETER :: GRAV = 6.6742D-11                              ! m^3/kg s^2
real(wp), PARAMETER :: H = 6.6260693D-34                              ! J s
real(wp), PARAMETER :: HBAR = 1.05457168D-34                          ! J s
real(wp), PARAMETER :: KB = 1.3806505D-23                             ! J/K
real(wp), PARAMETER :: ME = 9.1093826D-31                             ! kg
real(wp), PARAMETER :: MN = 1.67492728D-27                            ! kg
real(wp), PARAMETER :: MP = 1.67262171D-27                            ! kg
real(wp), PARAMETER :: MU0 = 12.5663706143591729539D-7                ! N/A^2
real(wp), PARAMETER :: MUB = 927.400949D-26                           ! A m^2
real(wp), PARAMETER :: MUN = 5.05078343D-27                           ! A m^2
real(wp), PARAMETER :: NA = 6.0221415D23                              ! mol^-1
real(wp), PARAMETER :: REARTH = 6378140.0D0                           ! m
real(wp), PARAMETER :: RGAS = 8.314472D0                              ! J/mol K
real(wp), PARAMETER :: STEFAN = 5.670400D-8                           ! W/m^2 K^4

INTEGER :: I, ITMP, ITMP2, NUM, DEN, NUM2, DEN2, NUM3, DEN3, NUM4, DEN4, &
   NUMM, DENM, NUMB, DENB
real(wp) :: TMP, TMP2, TMP3, TMPM, TMPB, TMPR
COMPLEX(wp) :: CTMP, CTMPM, CTMPB, CTMPR
CHARACTER(LEN=2) :: REGNAME
INTEGER :: DT(8)
INTEGER :: YEAR, MONTH, DAY, HOUR, MINUTE, SECOND, NB, NCALC
CHARACTER(LEN=100) :: NUMSTR
CHARACTER(LEN=10) :: TIME, DATE, ZONE

real(wp), ALLOCATABLE, DIMENSION(:) :: BES_B

IF (LEN_TRIM(STR) == 0) return

parse_cmd: select case(str)

case('HELP')
  call eval('VER')
  call eval('MODES')
  call eval('PS')
  call eval('PR')
  call print_help()
case('+')                                                  ! +
  call add(domain_mode)
case('-')                                                  ! -
  call subtract(domain_mode)
case('*')                                                  ! *
  call multiply(domain_mode)
case('/')                                                  ! /
  call divide(domain_mode)
case('^')                                                  ! ^
  call power(domain_mode)
case('RECIP')
  SELECT CASE (DOMAIN_MODE)
    CASE (1)
      IF (isclose(stack(1), 0._wp)) THEN
        write(stderr, *) '  Divide Error'
      ELSE
        LASTX = STACK(1)
        STACK(1) = 1._wp / STACK(1)
      END IF
    CASE (2)
      IF (isclose(CSTACK(1), C0)) THEN
        write(stderr, *) '  Divide Error'
      ELSE
        CLASTX = CSTACK(1)
        CSTACK(1) = (1.0,0.0) / CSTACK(1)
      END IF
    CASE (3)
      CALL RDIV (1,1,RNSTACK(1),RDSTACK(1),NUM,DEN)
      RNLASTX = RNSTACK(1)
      RDLASTX = RDSTACK(1)
      RNSTACK(1) = NUM
      RDSTACK(1) = DEN
   END SELECT
case('%')                                                  ! %
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(2) * 0.01_wp*STACK(1)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(2) * 0.01_wp*CSTACK(1)
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         NUM2 = RNSTACK(2)
         DEN2 = RDSTACK(2)
         CALL RMUL(NUM2,DEN2,NUM,DEN,ITMP,ITMP2)
         CALL RMUL(ITMP,ITMP2,1,100,NUM,DEN)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM
         RDSTACK(1) = DEN
   END SELECT
case('%CHG')                                               ! %CHG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(STACK(2), 0._wp)) THEN
            write(stderr, *) '  Divide Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = 100._wp*(STACK(1)-STACK(2))/STACK(2)
         END IF
      CASE (2)
         IF (isclose(CSTACK(2), c0)) THEN
            write(stderr, *) '  Divide Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = 100._wp*(CSTACK(1)-CSTACK(2))/CSTACK(2)
         END IF
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         NUM2 = RNSTACK(2)
         DEN2 = RDSTACK(2)
         CALL RSUB(NUM,DEN,NUM2,DEN2,ITMP,ITMP2)
         CALL RDIV(ITMP,ITMP2,NUM2,DEN2,NUM,DEN)
         CALL RMUL(NUM,DEN,100,1,NUM2,DEN2)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM2
         RDSTACK(1) = DEN2
   END SELECT

case('!')                                                  ! !
  SELECT CASE (DOMAIN_MODE)
    CASE (1)
      IF (ISINT(STACK(1)).AND.(STACK(1) < 0._wp)) THEN
        write(stderr, *) '  Factorial Error'
        return
      endif

      LASTX = STACK(1)
      STACK(1) = gamma(STACK(1)+1._wp)

    CASE (2)
      IF (isclose(CSTACK(1), (-1._wp, 0._wp))) THEN
        write(stderr, *) '  Factorial Error'
        return
      endif

      CLASTX = CSTACK(1)
      CSTACK(1) = CGAMMA(CSTACK(1)+(1._wp, 0._wp))

    CASE (3)
      IF ((RDSTACK(1)==1).AND.(RNSTACK(1)<0)) THEN
        write(stderr, *) '  Factorial Error'
        return
      endif

      IF (RDSTACK(1)==1) THEN
         ITMP = RNSTACK(1)
         IF (ITMP<0) THEN
            write(stderr, *) '  Factorial Error'
            return
         endif

         ITMP2 = 1
         DO I = 2, ITMP
           ITMP2 = ITMP2 * I
         END DO
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = ITMP2
         RDSTACK(1) = 1
      ELSE
         CALL SWITCH_RAT_TO_REAL
         IF (ISINT(STACK(1)).AND.(STACK(1)<0.0D0)) THEN
           write(stderr, *) '  Factorial Error'
           return
         endif
         LASTX = STACK(1)
         STACK(1) = gamma(STACK(1)+1._wp)
      END IF
   END SELECT

case('!!')                                                 ! !!
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) < 0._wp) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (ISFRAC(STACK(1))) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (NINT(STACK(1)) == 0) THEN
            LASTX = STACK(1)
            STACK(1) = 1._wp
         ELSE
            LASTX = STACK(1)
            ITMP = NINT(STACK(1))
            STACK(1) = 1._wp
            DO
               STACK(1) = STACK(1) * ITMP
               ITMP = ITMP - 2
               IF (ITMP <= 1) EXIT
            END DO
         END IF
      CASE (2)
         IF (real(CSTACK(1), wp) < 0._wp) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (ISFRAC(real(CSTACK(1), wp))) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (NINT(real(CSTACK(1), wp)) == 0) THEN
            CLASTX = CSTACK(1)
            CSTACK(1) = (1._wp, 0._wp)
         ELSE
            CLASTX = CSTACK(1)
            ITMP = NINT(real(CSTACK(1), wp))
            TMP = 1._wp
            DO
               TMP = TMP * ITMP
               ITMP = ITMP - 2
               IF (ITMP <= 1) EXIT
            END DO
            CSTACK(1) = CMPLX(TMP, kind=wp)
         END IF
      CASE (3)
         IF (RNSTACK(1) < 0) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (RDSTACK(1) /= 1) THEN
            write(stderr, *) '  !! Error'
         ELSE IF (RNSTACK(1) == 0) THEN
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = 1
            RDSTACK(1) = 1
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            ITMP = RNSTACK(1)
            RNSTACK(1) = 1
            RDSTACK(1) = 1
            DO
               RNSTACK(1) = RNSTACK(1) * ITMP
               ITMP = ITMP - 2
               IF (ITMP <= 1) EXIT
            END DO
         END IF
   END SELECT

case('10X')                                                ! 10X
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = 10._wp**(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = 10._wp**(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = 10._wp**(STACK(1))
   END SELECT

case('2PI')                                                ! 2PI
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK(2*pi)
      CASE (2)
         CALL PUSH_STACK(CMPLX(2*pi, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK(2*pi)
   END SELECT

case('2PII')                                               ! 2PII
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         write(stderr, *) ' 2PIi not available in REAL mode'
      CASE (2)
         CALL PUSH_STACK(CMPLX(0._wp,2*pi, wp))
      CASE (3)
         write(stderr, *) ' 2PIi not available in RATIONAL mode'
   END SELECT

case('2X')                                                 ! 2X
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = 2.0D0**(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = 2.0D0**(STACK(1))
   END SELECT

case('A0')                                                 ! A0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
      CASE (2)
         CALL push_stack(CMPLX(A0, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (A0)
   END SELECT

case('ABS')                                                ! ABS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ABS(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(ABS(CSTACK(1)), kind=wp)
      CASE (3)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = ABS(RNSTACK(1))
         RDSTACK(1) = ABS(RDSTACK(1))
   END SELECT

case('ACOS')                                               ! ACOS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)) > 1._wp) THEN
            write(stderr, *) '  ACOS Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACOS(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = acos(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) > ABS(RDSTACK(1))) THEN
            write(stderr, *) '  ACOS Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACOS(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ACOSH')                                             ! ACOSH
  call hacos(domain_mode)

case('ACOT')                                               ! ACOT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ACOT(STACK(1))/ANGLE_FACTOR
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ACOT(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = ACOT(STACK(1))/ANGLE_FACTOR
   END SELECT

case('ACOT2')                                             ! ACOT2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ACOT2(STACK(2),STACK(1))/ANGLE_FACTOR
         CALL DROP_STACK(2)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ACOT(CSTACK(2)/CSTACK(1))/ANGLE_FACTOR
         CALL CDROP_STACK(2)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = ACOT2(STACK(2),STACK(1))/ANGLE_FACTOR
         CALL DROP_STACK(2)
   END SELECT

case('ACOTH')                                             ! ACOTH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(stack(1), 0._wp)) THEN
            write(stderr, *) '  ACOTH Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACOTH(STACK(1))
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = acoth(CSTACK(1))
      CASE (3)
         IF (RNSTACK(1) == 0) THEN
            write(stderr, *) '  ACOTH Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACOTH(STACK(1))
         END IF
   END SELECT

case('ACOVERS')                                            ! ACOVERS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(1._wp-STACK(1)) > 1._wp) THEN
            write(stderr, *) '  ACOVERS Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACOVERS(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CACOVERS(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) < 0) THEN
            write(stderr, *) '  ACOVERS Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACOVERS(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ACRD')                                               ! ACRD
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)) > 2.0D0) THEN
            write(stderr, *) '  ACRD Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACRD(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CACRD(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) > 2*ABS(RDSTACK(1))) THEN
            write(stderr, *) '  ACRD Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACRD(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ACSC')                                               ! ACSC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)) < 1._wp) THEN
            write(stderr, *) '  ACSC Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACSC(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ACSC(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) < ABS(RDSTACK(1))) THEN
            write(stderr, *) '  ACSC Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACSC(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ACSCH')                                             ! ACSCH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(stack(1), 0._wp)) THEN
            write(stderr, *) '  ACSCH Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ACSCH(STACK(1))
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ACSCH(CSTACK(1))
      CASE (3)
         IF (RNSTACK(1) == 0) THEN
            write(stderr, *) '  ACSCH Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ACSCH(STACK(1))
         END IF
   END SELECT

case('AEXSEC')                                             ! AEXSEC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)+1._wp) < 1._wp) THEN
            write(stderr, *) '  AEXSEC Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = AEXSEC(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CAEXSEC(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) < 0) THEN
            write(stderr, *) '  AEXSEC Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = AEXSEC(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('AHAV')                                               ! AHAV
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((STACK(1)<0.0D0).OR.(STACK(1)>1._wp)) THEN
            write(stderr, *) '  AHAV Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = AHAV(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = AHAV(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF ((RNSTACK(1)<0).OR.(RNSTACK(1)>RDSTACK(1))) THEN
            write(stderr, *) '  AHAV Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = AHAV(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ALL')                                                 ! ALL
   DISP_MODE = 4

case('AMU')                                                ! AMU
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (AMU)
      CASE (2)
         CALL push_stack(CMPLX(AMU, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (AMU)
   END SELECT

case('AND')                                                ! AND
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = IAND (INT(STACK(2)), INT(STACK(1)))
         CALL DROP_STACK(2)
      CASE (2)
         TMP = IAND (INT(real(CSTACK(2), wp)), INT(real(CSTACK(1), wp)))
         TMP2 = IAND (INT(AIMAG(CSTACK(2))), INT(AIMAG(CSTACK(1))))
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
         CALL CDROP_STACK(2)
      CASE (3)
         ITMP = RNSTACK(1)/RDSTACK(1)
         ITMP2 = RNSTACK(2)/RDSTACK(2)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = IAND (ITMP2, ITMP)
         RDSTACK(1) = 1
         CALL RDROP_STACK(2)
   END SELECT

case('ARG')                                                ! ARG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = 0._wp
      CASE (2)
         TMP = ATAN2(AIMAG(CSTACK(1)),real(CSTACK(1), wp))/ANGLE_FACTOR
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP, kind=wp)
      CASE (3)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = 0
         RDSTACK(1) = 1
   END SELECT

case('ASEC')                                               ! ASEC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)) < 1._wp) THEN
            write(stderr, *) '  ASEC Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ASEC(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ASEC(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) < ABS(RDSTACK(1))) THEN
            write(stderr, *) '  ASEC Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            STACK(1) = ASEC(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ASECH')                                             ! ASECH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((STACK(1)<=0.0D0).OR.(STACK(1)>1._wp)) THEN
            write(stderr, *) '  ASECH Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ASECH(STACK(1))
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ASECH(CSTACK(1))
      CASE (3)
         IF ((RNSTACK(1)<=0).OR.(RNSTACK(1)>RDSTACK(1))) THEN
            write(stderr, *) '  ASECH Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ASECH(STACK(1))
         END IF
   END SELECT

case('ASIN')                                               ! ASIN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(STACK(1)) > 1._wp) THEN
            write(stderr, *) '  ASIN Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = ASIN(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ASIN(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) > ABS(RDSTACK(1))) THEN
            write(stderr, *) '  ASIN Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = ASIN(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('ASINH')                                             ! ASINH
  call hasin(domain_mode)
case('ATAN')                                               ! ATAN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ATAN(STACK(1))/ANGLE_FACTOR
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ATAN(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = ATAN(STACK(1))/ANGLE_FACTOR
   END SELECT

case('ATAN2')                                             ! ATAN2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ATAN2(STACK(2),STACK(1))/ANGLE_FACTOR
         CALL DROP_STACK(2)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = ATAN(CSTACK(2)/CSTACK(1))/ANGLE_FACTOR
         CALL CDROP_STACK(2)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = ATAN2(STACK(2),STACK(1))/ANGLE_FACTOR
         CALL DROP_STACK(2)
   END SELECT

case('ATANH')                                             ! ATANH
   call hatan(domain_mode)
case('AU')                                                 ! AU
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (AU)
      CASE (2)
         CALL push_stack(CMPLX(AU, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (AU)
   END SELECT

case('AVERS')                                             ! AVERS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ABS(1._wp-STACK(1)) > 1._wp) THEN
            write(stderr, *) '  AVERS Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = AVERS(STACK(1))/ANGLE_FACTOR
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CAVERS(CSTACK(1))/ANGLE_FACTOR
      CASE (3)
         IF (ABS(RNSTACK(1)) < 0) THEN
            write(stderr, *) '  AVERS Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = AVERS(STACK(1))/ANGLE_FACTOR
         END IF
   END SELECT

case('BESSELJ0')                                           ! BESSELJ0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = bessel_J0(STACK(1))
      CASE (2)
         write(stderr, *) '  Error:  BESSELJ0 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = bessel_j0(STACK(1))
   END SELECT

case('BESSELJ1')
  associate(x=>stack(1))
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = x
         x = bessel_j1(x)
      CASE (2)
         write(stderr, *) '  Error:  BESSELJ1 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = x
         x = bessel_j1(x)
   END SELECT
  end associate

case('BESSELJ1P')
  associate(x=>stack(1))
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = x
         x = bessel_j0(x) - 1 / x * bessel_j1(x)
      CASE (2)
         write(stderr, *) " Error:  BESSELJ0' not available in COMPLEX mode."
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = x
         x = bessel_j0(x) - 1 / x * bessel_j1(x)
   END SELECT
  end associate

case('BESSELJ')
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         call bsj()
      CASE (2)
         write(stderr, *) '  Error:  BESSELJ not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         call bsj()
   END SELECT

case('BESSELY0')                                           ! BESSELY0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         call bsy0()
      CASE (2)
         write(stderr, *) '  Error:  BESSELY0 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         call bsy0()
   END SELECT

case('BESSELY1')                                           ! BESSELY1
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELY1 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = bessel_y1(STACK(1))
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELY1 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELY1 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = bessel_y1(STACK(1))
         END IF
   END SELECT

case('BESSELY')                                            ! BESSELY
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELY Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RYBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, BY=BES_B, NCALC=NCALC)
            IF (NCALC < 0) THEN
               write(stderr, *) '  BESSELY Error 2'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELY Error 3'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELY not available '// &
            'in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELY Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RYBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, BY=BES_B, NCALC=NCALC)
            IF (NCALC < 0) THEN
               write(stderr, *) '  BESSELY Error 2'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELY Error 3'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
   END SELECT

case('BESSELI0')                                           ! BESSELI0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = BESI0(STACK(1))
      CASE (2)
         write(stderr, *) '  Error:  BESSELI0 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = BESI0(STACK(1))
   END SELECT

case('BESSELI1')                                           ! BESSELI1
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = BESI1(STACK(1))
      CASE (2)
         write(stderr, *) '  Error:  BESSELI1 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = BESI1(STACK(1))
   END SELECT

case('BESSELI')                                            ! BESSELI
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELI Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RIBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, IZE=1, B=BES_B, NCALC=NCALC)
            IF (NCALC < 0) THEN
               write(stderr, *) '  BESSELI Error 2'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELI Error 3'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELI not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELI Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RIBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, IZE=1, B=BES_B, NCALC=NCALC)
            IF (NCALC < 0) THEN
               write(stderr, *) '  BESSELI Error 2'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELI Error 3'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
   END SELECT

case('BESSELK0')                                           ! BESSELK0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELK0 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = BESK0(STACK(1))
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELK0 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELK0 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = BESK0(STACK(1))
         END IF
   END SELECT

case('BESSELK1')                                           ! BESSELK1
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELK1 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = BESK1(STACK(1))
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELK1 not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  BESSELK1 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = BESK1(STACK(1))
         END IF
   END SELECT

case('BESSELK')                                            ! BESSELK
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELK Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RKBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, IZE=1, BK=BES_B, NCALC=NCALC)
            IF (NCALC < -1) THEN
               write(stderr, *) '  BESSELK Error 2'
            ELSE IF (NCALC == -1) THEN
               write(stderr, *) '  BESSELK Error 3'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELK Error 4'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
      CASE (2)
         write(stderr, *) '  Error:  BESSELK not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  BESSELK Error 1'
         ELSE
            NB = INT(STACK(2)) + 1
            ALLOCATE (BES_B(NB))
            CALL RKBESL(X=STACK(1), ALPHA=FRAC(STACK(2)), NB=NB, IZE=1, BK=BES_B, NCALC=NCALC)
            IF (NCALC < -1) THEN
               write(stderr, *) '  BESSELK Error 2'
            ELSE IF (NCALC == -1) THEN
               write(stderr, *) '  BESSELK Error 3'
            ELSE IF (NCALC /= NB) THEN
               write(stderr, *) '  BESSELK Error 4'
            ELSE
               LASTX = STACK(1)
               STACK(1) = BES_B(NB)
               CALL DROP_STACK(2)
            END IF
            DEALLOCATE (BES_B)
         END IF
   END SELECT

case('BETA')                                               ! BETA
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((ISINT(STACK(1)).AND.(STACK(1)<=0.0D0)) .OR.  &
             (ISINT(STACK(2)).AND.(STACK(2)<=0.0D0))) THEN
            write(stderr, *) '  BETA Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = BETA(STACK(1),STACK(2))
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CBETA(CSTACK(1),CSTACK(2))
         CALL CDROP_STACK(2)
      CASE (3)
         IF (((RDSTACK(1)==1).AND.(RNSTACK(1)<=0)) .OR. &
             ((RDSTACK(2)==1).AND.(RNSTACK(2)<=0))) THEN
            write(stderr, *) '  BETA Error'
         ELSE
            IF ((RDSTACK(1)==1) .AND. (RDSTACK(2)==1)) THEN
               ITMP = RNSTACK(1)
               IF (ITMP<=0) THEN
                  write(stderr, *) '  BETA Error'
               ELSE
                  CALL RBETA(RNSTACK(1),RNSTACK(2),ITMP,ITMP2)
                  RNLASTX = RNSTACK(1)
                  RDLASTX = RDSTACK(1)
                  RNSTACK(1) = ITMP
                  RDSTACK(1) = ITMP2
                  CALL RDROP_STACK(2)
               END IF
            ELSE
               CALL SWITCH_RAT_TO_REAL
               IF ((ISINT(STACK(1)).AND.(STACK(1)<=0.0D0)) .OR.  &
                   (ISINT(STACK(2)).AND.(STACK(2)<=0.0D0))) THEN
                  write(stderr, *) '  BETA Error'
               ELSE
                  LASTX = STACK(1)
                  STACK(1) = BETA(STACK(1),STACK(2))
                  CALL DROP_STACK(2)
               END IF
            END IF
         END IF
   END SELECT

case('BIN')                                                ! BIN
   BASE_MODE = 2

case('C')                                                  ! C
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (C)
      CASE (2)
         CALL push_stack(CMPLX(C, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (C)
   END SELECT

case('C>F')                                                ! C>F
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = (9.0D0/5.0D0)*STACK(1)+32.0D0
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = (9.0D0/5.0D0)*CSTACK(1)+32.0D0
      CASE (3)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         CALL RMUL (9,5,RNSTACK(1),RDSTACK(1),NUM,DEN)
         CALL RADD (NUM,DEN,32,1,NUM2,DEN2)
         RNSTACK(1) = NUM2
         RDSTACK(1) = DEN2
   END SELECT

case('CBRT')                                               ! CBRT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = CUBEROOT(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CUBEROOT(CSTACK(1))
      CASE (3)
         TMP = CUBEROOT(real(RNSTACK(1), wp))
         TMP2 = CUBEROOT(real(RDSTACK(1), wp))
         IF (ISFRAC(TMP).OR.ISFRAC(TMP2)) THEN
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = CUBEROOT(STACK(1))
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = NINT(CUBEROOT(real(RNSTACK(1), wp)))
            RDSTACK(1) = NINT(CUBEROOT(real(RDSTACK(1), wp)))
         END IF
   END SELECT

case('CHS')                                                ! CHS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         STACK(1) = -STACK(1)
      CASE (2)
         CSTACK(1) = -CSTACK(1)
      CASE (3)
         RNSTACK(1) = -RNSTACK(1)
   END SELECT

case('CLALL')                                             ! CLALL
   SELECT CASE (DOMAIN_MODE)
      CASE(1)
         STACK = 0._wp
         REG = 0._wp
         NN = 0._wp
         SUMX = 0._wp
         SUMX2 = 0._wp
         SUMY = 0._wp
         SUMY2 = 0._wp
         SUMXY = 0._wp
      CASE (2)
         CSTACK = (0._wp, 0._wp)
         CREG = (0._wp, 0._wp)
         CNN = (0._wp, 0._wp)
         CSUMX = (0._wp, 0._wp)
         CSUMX2 = (0._wp, 0._wp)
         CSUMY = (0._wp, 0._wp)
         CSUMY2 = (0._wp, 0._wp)
         CSUMXY = (0._wp, 0._wp)
      CASE (3)
         RNSTACK = 0; RDSTACK = 1
         RNREG = 0; RDREG = 1
         RNNN = 0; RDNN = 1
         RNSUMX = 0; RDSUMX = 1
         RNSUMX2 = 0; RDSUMX2 = 1
         RNSUMY = 0; RDSUMY = 1
         RNSUMY2 = 0; RDSUMY2 = 1
         RNSUMXY = 0; RDSUMXY = 1
   END SELECT

case('CLREG')                                             ! CLREG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         REG = 0._wp
      CASE (2)
         CREG = (0._wp, 0._wp)
      CASE (3)
         RNREG = 0; RDREG = 1
   END SELECT

case('CLS')                                                ! CLS
   SELECT CASE (DOMAIN_MODE)
      CASE(1)
         NN = 0._wp
         SUMX = 0._wp
         SUMX2 = 0._wp
         SUMY = 0._wp
         SUMY2 = 0._wp
         SUMXY = 0._wp
      CASE (2)
         CNN = (0._wp, 0._wp)
         CSUMX = (0._wp, 0._wp)
         CSUMX2 = (0._wp, 0._wp)
         CSUMY = (0._wp, 0._wp)
         CSUMY2 = (0._wp, 0._wp)
         CSUMXY = (0._wp, 0._wp)
      CASE (3)
         RNNN = 0; RDNN = 1
         RNSUMX = 0; RDSUMX = 1
         RNSUMX2 = 0; RDSUMX2 = 1
         RNSUMY = 0; RDSUMY = 1
         RNSUMY2 = 0; RDSUMY2 = 1
         RNSUMXY = 0; RDSUMXY = 1
   END SELECT

case('CLSTK')                                             ! CLSTK
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         STACK = 0._wp
      CASE (2)
         CSTACK = (0._wp, 0._wp)
      CASE (3)
         RNSTACK = 0; RDSTACK = 1
   END SELECT

case('CLX')                                                ! CLX
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         STACK(1) = 0._wp
      CASE (2)
         CSTACK(1) = (0._wp, 0._wp)
      CASE (3)
         RNSTACK(1) = 0; RDSTACK(1) = 1
   END SELECT

case('CM>IN')                                             ! CM>IN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         STACK(1) = STACK(1) / CM_PER_IN
      CASE (2)
         CSTACK(1) = CSTACK(1) / CM_PER_IN
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         STACK(1) = STACK(1) / CM_PER_IN
   END SELECT

case('CNR')                                                ! CNR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ISFRAC(STACK(1)) .OR. ISFRAC(STACK(2))) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (STACK(2) < STACK(1)) THEN
            write(stderr, *) '  CNR Error'
         ELSE
            ITMP  = NINT(STACK(1))
            ITMP2 = NINT(STACK(2))
            LASTX = STACK(1)
            STACK(1) = CNR (ITMP2, ITMP)
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (ISFRAC(real(CSTACK(1), wp)) .OR. ISFRAC(real(CSTACK(2), wp))) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (real(CSTACK(1), wp)<0.0D0) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (real(CSTACK(2), wp)<0.0D0) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (.not.isclose(AIMAG(CSTACK(2)), 0._wp)) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (real(CSTACK(2), wp) < real(CSTACK(1), wp)) THEN
            write(stderr, *) '  CNR Error'
         ELSE
            ITMP  = NINT(real(CSTACK(1), wp))
            ITMP2 = NINT(real(CSTACK(2), wp))
            TMP = CNR (ITMP2, ITMP)
            CLASTX = CSTACK(1)
            CSTACK(1) = CMPLX(TMP, kind=wp)
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF ((RDSTACK(1)/=1).OR.(RDSTACK(2)/=1)) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF ((RNSTACK(1)<0) .OR. (RNSTACK(2)<0)) THEN
            write(stderr, *) '  CNR Error'
         ELSE IF (RNSTACK(2) < RNSTACK(1)) THEN
            write(stderr, *) '  CNR Error'
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = int(CNR(RNSTACK(2), RNSTACK(1)))
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('COMPLEX')
   DOMAIN_MODE = 2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)

         CSTACK = CMPLX(STACK, kind=wp)
         CREG = CMPLX(REG, kind=wp)

         CLASTX = CMPLX(LASTX, kind=wp)
         CNN = CMPLX(NN, kind=wp)
         CSUMX = CMPLX(SUMX, kind=wp)
         CSUMX2 = CMPLX(SUMX2, kind=wp)
         CSUMY = CMPLX(SUMY, kind=wp)
         CSUMY2 = CMPLX(SUMY2, kind=wp)
         CSUMXY = CMPLX(SUMXY, kind=wp)
      CASE (3)

         CSTACK = CMPLX(real(RNSTACK, wp) / real(RDSTACK, wp), kind=wp)
         CREG = CMPLX(real(RNREG, wp)/ real(RDREG, wp), kind=wp)

         CLASTX = CMPLX(real(RNLASTX, wp)/real(RDLASTX, wp), kind=wp)
         CNN = CMPLX(real(RNNN, wp)/real(RDNN, wp), kind=wp)
         CSUMX = CMPLX(real(RNSUMX, wp)/real(RDSUMX, wp), kind=wp)
         CSUMX2 = CMPLX(real(RNSUMX2, wp)/real(RDSUMX2, wp), kind=wp)
         CSUMY = CMPLX(real(RNSUMY, wp)/real(RDSUMY, wp), kind=wp)
         CSUMY2 = CMPLX(real(RNSUMY2, wp)/real(RDSUMY2, wp), kind=wp)
         CSUMXY = CMPLX(real(RNSUMXY, wp)/real(RDSUMXY, wp), kind=wp)
   END SELECT

case('CONJ')                                               ! CONJ
   SELECT CASE (DOMAIN_MODE)
      CASE (2)
         CSTACK(1) = CONJG(CSTACK(1))
   END SELECT

case('COS')                                                ! COS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = COS(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = COS(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = COS(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('COSH')                                               ! COSH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = COSH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = COSH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = COSH(STACK(1))
   END SELECT

case('COT')                                                ! COT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = COT(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = COT(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = COT(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('COTH')                                               ! COTH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = COTH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = COTH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = COTH(STACK(1))
   END SELECT

case('COVERS')                                             ! COVERS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = COVERS(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CCOVERS(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = COVERS(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('CRD')                                                ! CRD
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = CRD(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CRD(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = CRD(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('CSC')                                                ! CSC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = CSC(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSC(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = CSC(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('CSCH')                                               ! CSCH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = CSCH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSCH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = CSCH(STACK(1))
   END SELECT

case('CUBE')                                               ! CUBE
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1)**3
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1)**3
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         CALL RMUL (NUM,DEN,NUM,DEN,NUM2,DEN2)
         CALL RMUL (NUM, DEN, NUM2, DEN2, NUM, DEN)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM
         RDSTACK(1) = DEN
   END SELECT

case('D>F')                                                ! D>F
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         CALL DEC_TO_FRAC (STACK(1), NUM, DEN, FRACTOL)
         CALL DROP_STACK(1)
         CALL PUSH_STACK(real(NUM, wp))
         CALL PUSH_STACK(real(DEN, wp))
      CASE (2)
         CLASTX = CSTACK(1)
         CALL DEC_TO_FRAC (real(CSTACK(1), wp), NUM, DEN, FRACTOL)
         CALL DEC_TO_FRAC (AIMAG(CSTACK(1)), NUM2, DEN2, FRACTOL)
         CALL CDROP_STACK(1)
         CALL push_stack(CMPLX(real(NUM, wp),real(NUM2, wp), wp))
         CALL push_stack(CMPLX(real(DEN, wp),real(DEN2, wp), wp))
   END SELECT

case('D>R')                                                ! D>R
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1)*PI/180.0D0
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1)*PI/180.0D0
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1)*PI/180.0D0
   END SELECT

case('DEC')                                                ! DEC
   BASE_MODE = 10

case('DEFAULT')                                            ! DEFAULT
   ANGLE_MODE = INITIAL_ANGLE_MODE

   SELECT CASE (ANGLE_MODE)
      CASE (1)
         ANGLE_FACTOR = PI/180.0D0
      CASE (2)
         ANGLE_FACTOR = 1._wp
      CASE (3)
         ANGLE_FACTOR = PI/200.0D0
      CASE (4)
         ANGLE_FACTOR = 2*pi
   END SELECT

   DISP_MODE = INITIAL_DISP_MODE
   DISP_DIGITS = INITIAL_DISP_DIGITS
   DOMAIN_MODE = INITIAL_DOMAIN_MODE
   BASE_MODE = INITIAL_BASE_MODE
   FRACTION_MODE = INITIAL_FRACTION_MODE

case('DEG')                                                ! DEG
   ANGLE_MODE = 1
   ANGLE_FACTOR = PI/180.0D0

case('DIGAMMA')                                            ! DIGAMMA
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = PSI(STACK(1))
      CASE (2)
         write(stderr, *) ' DIGAMMA function not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = PSI(STACK(1))
   END SELECT

case('DUP')                                                ! DUP
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK(STACK(1))
      CASE (2)
         CALL push_stack(CSTACK(1))
      CASE (3)
         CALL push_stack(RNSTACK(1),RDSTACK(1))
   END SELECT

case('ECHG')                                               ! ECHG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (ECHG)
      CASE (2)
         CALL push_stack(CMPLX(ECHG, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (ECHG)
   END SELECT

case('EPS0')                                               ! EPS0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (EPS0)
      CASE (2)
         CALL push_stack(CMPLX(EPS0, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (EPS0)
   END SELECT

case('ERF')                                                ! ERF
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = erf(STACK(1))
      CASE (2)
         write(stderr, *) ' ERF function not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = erf(STACK(1))
   END SELECT

case('ERFC')                                               ! ERFC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = erfc(STACK(1))
      CASE (2)
         write(stderr, *) ' ERFC function not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = erfc(STACK(1))
   END SELECT

case('EULER')                                             ! EULER
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (EULER)
      CASE (2)
         CALL push_stack(CMPLX(EULER, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (EULER)
   END SELECT

case('EXP')                                                ! EXP
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = EXP(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = EXP(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = EXP(STACK(1))
   END SELECT

case('EXSEC')                                             ! EXSEC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = EXSEC(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CEXSEC(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = EXSEC(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('F>C')                                                ! F>C
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = (5.0D0/9.0D0)*(STACK(1)-32.0D0)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = (5.0D0/9.0D0)*(CSTACK(1)-32.0D0)
      CASE (3)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         CALL RSUB (RNSTACK(1),RDSTACK(1),32,1,NUM,DEN)
         CALL RMUL (5,9,NUM,DEN,NUM2,DEN2)
         RNSTACK(1) = NUM2
         RDSTACK(1) = DEN2
   END SELECT

case('FRAC')                                               ! FRAC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = FRAC(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = FRAC(CSTACK(1))
      CASE (3)
         CALL RFRAC(RNSTACK(1),RDSTACK(1),NUM,DEN)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM
         RDSTACK(1) = DEN
   END SELECT

case('FRACTOL')                                            ! FRACTOL
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         FRACTOL = STACK(1)
         CALL DROP_STACK(1)
      CASE (2)
         FRACTOL = real(CSTACK(1), wp)
         CALL CDROP_STACK(1)
      CASE (3)
         FRACTOL = real(RNSTACK(1), wp)/real(RDSTACK(1), wp)
         CALL RDROP_STACK(1)
   END SELECT

case('G')                                                  ! G
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (G)
      CASE (2)
         CALL push_stack(CMPLX(G, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (G)
   END SELECT

case('GAL>L')                                             ! GAL>L
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1) * L_PER_GAL
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1) * L_PER_GAL
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1) * L_PER_GAL
   END SELECT

case('GAMMA')                                             ! GAMMA
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ISINT(STACK(1)).AND.(STACK(1) <= 0._wp)) THEN
            write(stderr, *) '  GAMMA Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = gamma(STACK(1))
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  GAMMA Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = CGAMMA(CSTACK(1))
         END IF
      CASE (3)
         IF ((RDSTACK(1)==1).AND.(RNSTACK(1)<=0)) THEN
            write(stderr, *) '  GAMMA Error'
         ELSE
            IF (RDSTACK(1)==1) THEN
               ITMP = RNSTACK(1)
               IF (ITMP<=0) THEN
                  write(stderr, *) '  GAMMA Error'
               ELSE
                  ITMP2 = 1
                  DO I = 2, ITMP-1
                     ITMP2 = ITMP2 * I
                  END DO
                  RNLASTX = RNSTACK(1)
                  RDLASTX = RDSTACK(1)
                  RNSTACK(1) = ITMP2
                  RDSTACK(1) = 1
               END IF
            ELSE
               CALL SWITCH_RAT_TO_REAL
               IF (ISINT(STACK(1)).AND.(STACK(1) <= 0._wp)) THEN
                  write(stderr, *) '  GAMMA Error'
               ELSE
                  LASTX = STACK(1)
                  STACK(1) = gamma(STACK(1))
               END IF
            END IF
         END IF
   END SELECT

case('GCD')                                                ! GCD
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ISFRAC(STACK(1)).OR.ISFRAC(STACK(2))) THEN
            write(stderr, *) '  GCD Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = GCD(NINT(STACK(2)),NINT(STACK(1)))
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (ISFRAC(real(CSTACK(1), wp)).OR.ISFRAC(real(CSTACK(2), wp)).OR. &
            .not.isclose(AIMAG(CSTACK(1)), 0._wp).OR..not.isclose(AIMAG(CSTACK(2)), 0._wp)) THEN
            write(stderr, *) '  GCD Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = GCD(NINT(real(CSTACK(2), wp)),NINT(real(CSTACK(1), wp)))
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF ((RDSTACK(1)/=1).OR.(RDSTACK(2)/=1)) THEN
            write(stderr, *) '  GCD Error'
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(2)
            RNSTACK(1) = GCD(RNSTACK(2),RNSTACK(1))
            RDSTACK(1) = 1
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('GOLDEN')                                             ! GOLDEN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (GOLDEN)
      CASE (2)
         CALL push_stack(CMPLX(GOLDEN, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (GOLDEN)
   END SELECT

case('GRAD')                                               ! GRAD
   ANGLE_MODE = 3
   ANGLE_FACTOR = PI/200.0D0

case('GRAV')                                               ! GRAV
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (GRAV)
      CASE (2)
         CALL push_stack(CMPLX(GRAV, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (GRAV)
   END SELECT

case('H')                                                  ! H
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (H)
      CASE (2)
         CALL push_stack(CMPLX(H, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (H)
   END SELECT

case('H>HMS')                                             ! H>HMS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL H2HMSD (STACK(1), ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
      CASE (2)
         IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  H>HMS Error'
         ELSE
            CALL H2HMSD (real(CSTACK(1), wp), ITMP, ITMP2, TMP)
            CLASTX = CSTACK(1)
            CSTACK(1) = CMPLX(real(itmp, wp)+1.0D-2*ITMP2+1.0D-4*TMP, 0._wp, 8)
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL H2HMSD (STACK(1), ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
   END SELECT

case('HBAR')                                               ! HBAR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (HBAR)
      CASE (2)
         CALL push_stack(CMPLX(HBAR, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (HBAR)
   END SELECT

case('HEX')                                                ! HEX
   BASE_MODE = 16

case('HMS>H')                                             ! HMS>H
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         LASTX = STACK(1)
         STACK(1) = TMP2
      CASE (2)
         IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  HMS>H Error'
         ELSE
            ITMP = INT(real(CSTACK(1), wp))
            ITMP2 = INT(FRAC(real(CSTACK(1), wp))*1.0D2)
            TMP = (real(CSTACK(1), wp) - ITMP - ITMP2*1.0D-2)*1.0D4
            CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
            CLASTX = CSTACK(1)
            CSTACK(1) = CMPLX(TMP2, kind=wp)
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         LASTX = STACK(1)
         STACK(1) = TMP2
   END SELECT

case('HMS+')                                               ! HMS+
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         ITMP = INT(STACK(2))
         ITMP2 = INT(FRAC(STACK(2))*1.0D2)
         TMP = (STACK(2) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
         CALL H2HMSD (TMP2+TMP3, ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
         CALL DROP_STACK(2)
      CASE (2)
         IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  HMS+ Error'
         ELSE
            ITMP = INT(CSTACK(1))
            ITMP2 = INT(FRAC(CSTACK(1))*1.0e2_wp)
            TMP = (real(CSTACK(1), wp) - ITMP - ITMP2*1.0D-2)*1.0D4
            CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
            ITMP = INT(CSTACK(2))
            ITMP2 = INT(FRAC(CSTACK(2))*1.0e2_wp)
            TMP = (real(CSTACK(2), wp) - ITMP - ITMP2*1.0D-2)*1.0D4
            CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
            CALL H2HMSD (TMP2+TMP3, ITMP, ITMP2, TMP)
            CLASTX = CSTACK(1)
            CSTACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         ITMP = INT(STACK(2))
         ITMP2 = INT(FRAC(STACK(2))*1.0D2)
         TMP = (STACK(2) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
         CALL H2HMSD (TMP2+TMP3, ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
         CALL DROP_STACK(2)
   END SELECT

case('HMS-')                                               ! HMS-
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         ITMP = INT(STACK(2))
         ITMP2 = INT(FRAC(STACK(2))*1.0D2)
         TMP = (STACK(2) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
         CALL H2HMSD (TMP3-TMP2, ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
         CALL DROP_STACK(2)
      CASE (2)
         IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  HMS- Error'
         ELSE
            ITMP = INT(CSTACK(1))
            ITMP2 = INT(FRAC(CSTACK(1))*1.0D2)
            TMP = (real(CSTACK(1), wp) - ITMP - ITMP2*1.0D-2)*1.0D4
            CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
            ITMP = INT(CSTACK(2))
            ITMP2 = INT(FRAC(CSTACK(2))*1.0D2)
            TMP = (real(CSTACK(2), wp) - ITMP - ITMP2*1.0D-2)*1.0D4
            CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
            CALL H2HMSD (TMP3-TMP2, ITMP, ITMP2, TMP)
            CLASTX = CSTACK(1)
            CSTACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         ITMP = INT(STACK(1))
         ITMP2 = INT(FRAC(STACK(1))*1.0D2)
         TMP = (STACK(1) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP2)
         ITMP = INT(STACK(2))
         ITMP2 = INT(FRAC(STACK(2))*1.0D2)
         TMP = (STACK(2) - ITMP - ITMP2*1.0D-2)*1.0D4
         CALL HMS2H (ITMP, ITMP2, TMP, TMP3)
         CALL H2HMSD (TMP3-TMP2, ITMP, ITMP2, TMP)
         LASTX = STACK(1)
         STACK(1) = real(itmp, wp) + 1.0D-2*ITMP2 + 1.0D-4*TMP
         CALL DROP_STACK(2)
   END SELECT

case('HAV')
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = HAV(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = HAV(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = HAV(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('HYPOT')
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = hypot(STACK(1), STACK(2))
         CALL DROP_STACK(2)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SQRT(CSTACK(1)**2+CSTACK(2)**2)
         CALL CDROP_STACK(2)
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         NUM2 = RNSTACK(2)
         DEN2 = RDSTACK(2)
         CALL RMUL (NUM,DEN,NUM,DEN,NUM3,DEN3)
         CALL RMUL (NUM2,DEN2,NUM2,DEN2,NUM4,DEN4)
         CALL RADD (NUM3,DEN3,NUM4,DEN4,NUM,DEN)
         TMP = SQRT(real(NUM, wp))
         TMP2 = SQRT(real(DEN, wp))
         IF (ISFRAC(TMP).OR.ISFRAC(TMP2)) THEN
            CALL SWITCH_RAT_TO_REAL
            LASTX = STACK(1)
            STACK(1) = SQRT(STACK(1)**2+STACK(2)**2)
            CALL DROP_STACK(2)
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = NINT(SQRT(real(NUM, wp)))
            RDSTACK(1) = NINT(SQRT(real(DEN, wp)))
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('HYPOT3')                                             ! HYPOT3
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SQRT(STACK(1)**2+STACK(2)**2+STACK(3)**2)
         CALL DROP_STACK(3)
         CALL DROP_STACK(2)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SQRT(CSTACK(1)**2+CSTACK(2)**2+CSTACK(3)**2)
         CALL CDROP_STACK(3)
         CALL CDROP_STACK(2)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SQRT(STACK(1)**2+STACK(2)**2+STACK(3)**2)
         CALL DROP_STACK(3)
         CALL DROP_STACK(2)
   END SELECT

case('I')                                                  ! I
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         write(stderr, *) ' i not available in REAL mode'
      CASE (2)
         CALL push_stack(II)
      CASE (3)
         write(stderr, *) ' i not available in RATIONAL mode'
   END SELECT

case('IM')                                                 ! IM
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = 0._wp
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(AIMAG(CSTACK(1)), kind=wp)
      CASE (3)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = 0
         RDSTACK(1) = 1
   END SELECT

case('IMPROPER')                                           ! IMPROPER
   FRACTION_MODE = 1

case('IN>CM')                                             ! IN>CM
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1) * CM_PER_IN
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1) * CM_PER_IN
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1) * CM_PER_IN
   END SELECT

case('INT')                                                ! INT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = AINT(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CINT(CSTACK(1))
      CASE (3)
         NUM = RINT(RNSTACK(1),RDSTACK(1))
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM
         RDSTACK(1) = 1
   END SELECT

case('INT/')                                               ! INT/
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(stack(1), 0._wp)) THEN
            write(stderr, *) '  INT/ Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = AINT(STACK(2) / STACK(1))
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  INT/ Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = CINT(CSTACK(2) / CSTACK(1))
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF (RNSTACK(1) == 0) THEN
            write(stderr, *) '  INT/ Error'
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = RNSTACK(1) / RDSTACK(1)
            RDSTACK(1) = 1
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('KB')                                                 ! KB
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (KB)
      CASE (2)
         CALL push_stack(CMPLX(KB, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (KB)
   END SELECT

case('KEPLER')                                             ! KEPLER
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = KEPLER(STACK(2)*ANGLE_FACTOR,STACK(1))/ANGLE_FACTOR
      CASE (2)
         TMP = KEPLER(real(CSTACK(2), wp)*ANGLE_FACTOR,real(CSTACK(1), wp)) / &
            ANGLE_FACTOR
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP, kind=wp)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = KEPLER(STACK(2)*ANGLE_FACTOR,STACK(1))/ANGLE_FACTOR
   END SELECT

case('KG>LB')                                             ! KG>LB
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1) / KG_PER_LB
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1) / KG_PER_LB
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1) / KG_PER_LB
   END SELECT

case('JINC')
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = jinc(STACK(1))
      CASE (2)
         write(stderr, *) '  Error:  JINC not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = jinc(STACK(1))
   END SELECT

case('L>GAL')                                             ! L>GAL
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1) / L_PER_GAL
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1) / L_PER_GAL
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1) / L_PER_GAL
   END SELECT

case('LASTX')                                             ! LASTX
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (LASTX)
      CASE (2)
         CALL push_stack(CLASTX)
      CASE (3)
         CALL push_stack(RNLASTX, RDLASTX)
   END SELECT

case('LB>KG')                                             ! LB>KG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1) * KG_PER_LB
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1) * KG_PER_LB
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1) * KG_PER_LB
   END SELECT

case('LCM')                                                ! LCM
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (ISFRAC(STACK(1)).OR.ISFRAC(STACK(2))) THEN
            write(stderr, *) '  LCM Error'
         ELSE IF (isclose(STACK(1), 0._wp).AND.isclose(STACK(2), 0._wp)) THEN
            write(stderr, *) '  LCM Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LCM(NINT(STACK(2)),NINT(STACK(1)))
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (ISFRAC(real(CSTACK(1), wp)).OR.ISFRAC(real(CSTACK(2), wp)).OR. &
            .not.isclose(AIMAG(CSTACK(1)), 0._wp).OR..not.isclose(AIMAG(CSTACK(2)), 0._wp)) THEN
            write(stderr, *) '  LCM Error'
         ELSEIF (isclose(cstack(1), C0) .AND. isclose(cstack(2), C0)) THEN
            write(stderr, *) '  LCM Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = LCM(NINT(real(CSTACK(2), wp)),NINT(real(CSTACK(1), wp)))
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF ((RDSTACK(1)/=1).OR.(RDSTACK(2)/=1)) THEN
            write(stderr, *) '  LCM Error'
         ELSE IF ((RNSTACK(1)==0).AND.(RNSTACK(2)==0)) THEN
            write(stderr, *) '  LCM Error'
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(2)
            RNSTACK(1) = LCM(RNSTACK(2),RNSTACK(1))
            RDSTACK(1) = 1
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('LN')                                                 ! LN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LN Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG(STACK(1))
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  LN Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = LOG(CSTACK(1))
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LN Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG(STACK(1))
         END IF
   END SELECT

case('LOG')                                                ! LOG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LOG Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG10(STACK(1))
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  LOG Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = CLOG10(CSTACK(1))
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LOG Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG10(STACK(1))
         END IF
   END SELECT

case('LOG2')                                               ! LOG2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LOG2 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG(STACK(1)) / log(2._wp)
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  LOG2 Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = LOG(CSTACK(1)) / log(2._wp)
         END IF
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         IF (STACK(1) <= 0._wp) THEN
            write(stderr, *) '  LOG2 Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = LOG(STACK(1)) / log(2._wp)
         END IF
   END SELECT

case('LR')                                                 ! LR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  LR Error'
         ELSE
            CALL LINREG (TMPM,TMPB,TMPR)
            CALL PUSH_STACK (TMPM)
            CALL PUSH_STACK (TMPB)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  LR Error'
         ELSE
            CALL CLINREG (CTMPM,CTMPB,CTMPR)
            CALL push_stack(CTMPM)
            CALL push_stack(CTMPB)
         END IF
      CASE (3)
         IF (RNNN <= 1) THEN
            write(stderr, *) '  LR Error'
         ELSE
            CALL RLINREG (NUMM,DENM,NUMB,DENB,TMPR)
            CALL push_stack(NUMM,DENM)
            CALL push_stack(NUMB,DENB)
         END IF
   END SELECT

case('ME')                                                 ! ME
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (ME)
      CASE (2)
         CALL push_stack(CMPLX(ME, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (ME)
   END SELECT

case('MIXED')                                             ! MIXED
   FRACTION_MODE = 2

case('MN')                                                 ! MN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (MN)
      CASE (2)
         CALL push_stack(CMPLX(MN, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (MN)
   END SELECT

case('MOD')                                                ! MOD
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(stack(1), 0._wp)) THEN
            write(stderr, *) '  MOD Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = MOD (STACK(2),STACK(1))
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (isclose(cstack(1), C0)) THEN
            write(stderr, *) '  MOD Error'
         ELSE
            CLASTX = CSTACK(1)
            CSTACK(1) = CMOD (CSTACK(2),CSTACK(1))
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF (RNSTACK(1) == 0) THEN
            write(stderr, *) '  MOD Error'
         ELSE
            NUM = RNSTACK(1)
            DEN = RDSTACK(1)
            NUM2 = RNSTACK(2)
            DEN2 = RDSTACK(2)
            CALL RMOD (NUM2, DEN2, NUM, DEN, ITMP, ITMP2)
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = ITMP
            RDSTACK(1) = ITMP2
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('MODES')                                             ! MODES
   WRITE (UNIT=*, FMT='()')
   SELECT CASE (ANGLE_MODE)
      CASE (1)
         print *, '  Angles:     DEG'
      CASE (2)
         print *, '  Angles:     RAD'
      CASE (3)
         print *, '  Angles:     GRAD'
      CASE (4)
         print *, '  Angles:     REV'
   END SELECT
   SELECT CASE (DISP_MODE)
      CASE (1)
        print '(A,I0)', '  Display:    FIX ', DISP_DIGITS
      CASE (2)
        print '(A,I0)', '  Display:    SCI ', DISP_DIGITS
      CASE (3)
        print '(A,I0)', '  Display:    ENG ', DISP_DIGITS
      CASE (4)
         print *, '  Display:    ALL '
   END SELECT
   SELECT CASE (BASE_MODE)
      CASE (2)
         print *, '  Base:       BIN'
      CASE (8)
         print *, '  Base:       OCT'
      CASE (10)
         print *, '  Base:       DEC'
      CASE (16)
         print *, '  Base:       HEX'
   END SELECT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         print *, '  Domain:     REAL'
      CASE (2)
         print *, '  Domain:     COMPLEX'
      CASE (3)
         print *, '  Domain:     RATIONAL'
   END SELECT
   SELECT CASE (FRACTION_MODE)
      CASE (1)
         print *, '  Fractions:  IMPROPER'
      CASE (2)
         print *, '  Fractions:  MIXED'
   END SELECT
   print *, ' '

case('MP')                                                 ! MP
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (MP)
      CASE (2)
         CALL push_stack(CMPLX(MP, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (MP)
   END SELECT

case('MU0')                                                ! MU0
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (MU0)
      CASE (2)
         CALL push_stack(CMPLX(MU0, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (MU0)
   END SELECT

case('MUB')                                                ! MUB
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (MUB)
      CASE (2)
         CALL push_stack(CMPLX(MUB, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (MUB)
   END SELECT

case('MUN')                                                ! MUN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (MUN)
      CASE (2)
         CALL push_stack(CMPLX(MUN, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (MUN)
   END SELECT

case('N')                                                  ! N
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (NN)
      CASE (2)
         CALL push_stack(CNN)
      CASE (3)
         CALL push_stack(RNNN, RDNN)
   END SELECT

case('NA')                                                 ! NA
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (NA)
      CASE (2)
         CALL push_stack(CMPLX(NA, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (NA)
   END SELECT

case('NOT')                                                ! NOT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = NOT (INT(STACK(1)))
      CASE (2)
         TMP = NOT (INT(real(CSTACK(1), wp)))
         TMP2 = NOT (INT(AIMAG(CSTACK(1))))
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
      CASE (3)
         ITMP = RNSTACK(1)/RDSTACK(1)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NOT (ITMP)
         RDSTACK(1) = 1
   END SELECT

case('OCT')                                                ! OCT
   BASE_MODE = 8

case('OR')                                                 ! OR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = IOR (INT(STACK(2)), INT(STACK(1)))
         CALL DROP_STACK(2)
      CASE (2)
         TMP = IOR (INT(real(CSTACK(2), wp)), INT(real(CSTACK(1), wp)))
         TMP2 = IOR (INT(AIMAG(CSTACK(2))), INT(AIMAG(CSTACK(1))))
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
         CALL CDROP_STACK(2)
      CASE (3)
         ITMP = RNSTACK(1)/RDSTACK(1)
         ITMP2 = RNSTACK(2)/RDSTACK(2)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = IOR (ITMP2, ITMP)
         RDSTACK(1) = 1
         CALL RDROP_STACK(2)
   END SELECT

case('P>R')                                                ! P>R
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         TMP  = STACK(1)*COS(STACK(2)*ANGLE_FACTOR)
         TMP2 = STACK(1)*SIN(STACK(2)*ANGLE_FACTOR)
         LASTX = STACK(1)
         STACK(1) = TMP
         STACK(2) = TMP2
      CASE (2)
         TMP  = real(CSTACK(1), wp)*COS(AIMAG(CSTACK(1))*ANGLE_FACTOR)
         TMP2 = real(CSTACK(1), wp)*SIN(AIMAG(CSTACK(1))*ANGLE_FACTOR)
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         TMP  = STACK(1)*COS(STACK(2)*ANGLE_FACTOR)
         TMP2 = STACK(1)*SIN(STACK(2)*ANGLE_FACTOR)
         LASTX = STACK(1)
         STACK(1) = TMP
         STACK(2) = TMP2
   END SELECT

case('PI')                                                 ! PI
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (PI)
      CASE (2)
         CALL push_stack(CMPLX(PI, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (PI)
   END SELECT

case('PNR')                                                ! PNR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF ((RDSTACK(1)/=1).OR.(RDSTACK(2)/=1)) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF ((RNSTACK(1)<0) .OR. (RNSTACK(2)<0)) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (RNSTACK(2) < RNSTACK(1)) THEN
            write(stderr, *) '  PNR Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = PNR (ITMP2, ITMP)
            CALL DROP_STACK(2)
         END IF
      CASE (2)
         IF (ISFRAC(real(CSTACK(1), wp)) .OR. ISFRAC(real(CSTACK(2), wp))) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (real(CSTACK(1), wp)<0.0D0) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (real(CSTACK(2), wp)<0.0D0) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (.not.isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (.not.isclose(AIMAG(CSTACK(2)), 0._wp)) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (real(CSTACK(2), wp) < real(CSTACK(1), wp)) THEN
            write(stderr, *) '  PNR Error'
         ELSE
            ITMP  = NINT(real(CSTACK(1), wp))
            ITMP2 = NINT(real(CSTACK(2), wp))
            TMP = PNR (ITMP2, ITMP)
            CLASTX = CSTACK(1)
            CSTACK(1) = CMPLX(TMP, kind=wp)
            CALL CDROP_STACK(2)
         END IF
      CASE (3)
         IF (ISFRAC(STACK(1)) .OR. ISFRAC(STACK(2))) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF ((STACK(1)<0.0D0) .OR. (STACK(2)<0.0D0)) THEN
            write(stderr, *) '  PNR Error'
         ELSE IF (STACK(2) < STACK(1)) THEN
            write(stderr, *) '  PNR Error'
         ELSE
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            RNSTACK(1) = int(PNR(RNSTACK(2), RNSTACK(1)))
            CALL RDROP_STACK(2)
         END IF
   END SELECT

case('PR')                                                 ! PR
   WRITE (UNIT=*, FMT='()')
   DO I = 0, REG_SIZE-1
      SELECT CASE (DOMAIN_MODE)
         CASE (1)
            CALL PRINTX(REG(I), NUMSTR)
         CASE (2)
            CALL printx(CREG(I), NUMSTR)
         CASE (3)
            CALL printx(RNREG(I), RDREG(I), NUMSTR)
      END SELECT
      WRITE (UNIT=*, FMT='(1X,I3,A)') I, ':  '//TRIM(NUMSTR)
   END DO
   print *, ' '

case('PS')                                                 ! PS
   WRITE (UNIT=*, FMT='()')
   DO I = STACK_SIZE, 1, -1
      SELECT CASE (I)
         CASE (1)
            REGNAME = ' X'
         CASE (2)
            REGNAME = ' Y'
         CASE (3)
            REGNAME = ' Z'
         CASE (4)
            REGNAME = ' T'
         CASE DEFAULT
            WRITE (UNIT=REGNAME, FMT='(I2)') I
      END SELECT
      SELECT CASE (DOMAIN_MODE)
         CASE (1)
            CALL PRINTX(STACK(I), NUMSTR)
         CASE (2)
            CALL printx(CSTACK(I), NUMSTR)
         CASE (3)
            CALL printx(RNSTACK(I), RDSTACK(I), NUMSTR)
      END SELECT
      WRITE (UNIT=*, FMT='(2X,A)') REGNAME//':  '//TRIM(NUMSTR)
   END DO
   print *, ' '

case('PSUMS')                                             ! PSUMS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         WRITE (UNIT=*, FMT='()')
         CALL PRINTX(NN, NUMSTR)
         print *, '  N:   '//TRIM(NUMSTR)
         CALL PRINTX(SUMX, NUMSTR)
         print *, '  X:   '//TRIM(NUMSTR)
         CALL PRINTX(SUMX2, NUMSTR)
         print *, '  X2:  '//TRIM(NUMSTR)
         CALL PRINTX(SUMY, NUMSTR)
         print *, '  Y:   '//TRIM(NUMSTR)
         CALL PRINTX(SUMY2, NUMSTR)
         print *, '  Y2:  '//TRIM(NUMSTR)
         CALL PRINTX(SUMXY, NUMSTR)
         print *, '  XY:  '//TRIM(NUMSTR)
         print *, ' '
      CASE (2)
         WRITE (UNIT=*, FMT='()')
         CALL printx(CNN, NUMSTR)
         print *, '  N:   '//TRIM(NUMSTR)
         CALL printx(CSUMX, NUMSTR)
         print *, '  X:   '//TRIM(NUMSTR)
         CALL printx(CSUMX2, NUMSTR)
         print *, '  X2:  '//TRIM(NUMSTR)
         CALL printx(CSUMY, NUMSTR)
         print *, '  Y:   '//TRIM(NUMSTR)
         CALL printx(CSUMY2, NUMSTR)
         print *, '  Y2:  '//TRIM(NUMSTR)
         CALL printx(CSUMXY, NUMSTR)
         print *, '  XY:  '//TRIM(NUMSTR)
         print *, ' '
      CASE (3)
         WRITE (UNIT=*, FMT='()')
         CALL printx(RNNN, RDNN, NUMSTR)
         print *, '  N:   '//TRIM(NUMSTR)
         CALL printx(RNSUMX, RDSUMX, NUMSTR)
         print *, '  X:   '//TRIM(NUMSTR)
         CALL printx(RNSUMX2, RDSUMX2, NUMSTR)
         print *, '  X2:  '//TRIM(NUMSTR)
         CALL printx(RNSUMY, RDSUMY, NUMSTR)
         print *, '  Y:   '//TRIM(NUMSTR)
         CALL printx(RNSUMY2, RDSUMY2, NUMSTR)
         print *, '  Y2:  '//TRIM(NUMSTR)
         CALL printx(RNSUMXY, RDSUMXY, NUMSTR)
         print *, '  XY:  '//TRIM(NUMSTR)
         print *, ' '
   END SELECT

case('R')                                                  ! R
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         stack = cshift(stack, 1)
      CASE (2)
         cstack = cshift(cstack, 1)
      CASE (3)
         rnstack = cshift(rnstack, 1)
         rdstack = cshift(rdstack, 1)
   END SELECT

case('D')                                                  ! D
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         call drop_stack(1)
      CASE (2)
         call cdrop_stack(1)
      CASE (3)
         call rdrop_stack(1)
   END SELECT

case('R>D')                                                ! R>D
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1)*180.0D0/PI
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1)*180.0D0/PI
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(1)*180.0D0/PI
   END SELECT

case('R>P')                                                ! R>P
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         TMP  = SQRT((STACK(1))**2+(STACK(2))**2)
         TMP2 = ATAN2(STACK(2),STACK(1))/ANGLE_FACTOR
         LASTX = STACK(1)
         STACK(1) = TMP
         STACK(2) = TMP2
      CASE (2)
         TMP = ABS(CSTACK(1))
         TMP2 = ATAN2(AIMAG(CSTACK(1)),real(CSTACK(1), wp))/ANGLE_FACTOR
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         TMP  = SQRT((STACK(1))**2+(STACK(2))**2)
         TMP2 = ATAN2(STACK(2),STACK(1))/ANGLE_FACTOR
         LASTX = STACK(1)
         STACK(1) = TMP
         STACK(2) = TMP2
   END SELECT

case('RAD')                                                ! RAD
   ANGLE_MODE = 2
   ANGLE_FACTOR = 1._wp

case('RAND')                                               ! RAND
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL RANDOM_NUMBER (TMP)
         CALL PUSH_STACK(TMP)
      CASE (2)
         CALL RANDOM_NUMBER (TMP)
         CALL RANDOM_NUMBER (TMP2)
         CALL push_stack(CMPLX(TMP,TMP2, wp))
      CASE (3)
         CALL RANDOM_NUMBER (TMP)
         CALL DEC_TO_FRAC (TMP, NUM, DEN, FRACTOL)
         CALL push_stack(NUM, DEN)
   END SELECT

case('RATIONAL')                                           ! RATIONAL
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         DOMAIN_MODE = 3
         DO I = 1, STACK_SIZE
            CALL DEC_TO_FRAC (STACK(I),ITMP,ITMP2,FRACTOL)
            RNSTACK(I) = ITMP
            RDSTACK(I) = ITMP2
         END DO
         DO I = 0, REG_SIZE-1
            CALL DEC_TO_FRAC (REG(I),ITMP,ITMP2,FRACTOL)
            RNREG(I) = ITMP
            RDREG(I) = ITMP2
         END DO
         CALL DEC_TO_FRAC (LASTX,ITMP,ITMP2,FRACTOL)
         RNLASTX = ITMP
         RDLASTX = ITMP2
         CALL DEC_TO_FRAC (NN,ITMP,ITMP2,FRACTOL)
         RNNN = ITMP
         RDNN = ITMP2
         CALL DEC_TO_FRAC (SUMX,ITMP,ITMP2,FRACTOL)
         RNSUMX = ITMP
         RDSUMX = ITMP2
         CALL DEC_TO_FRAC (SUMX2,ITMP,ITMP2,FRACTOL)
         RNSUMX2 = ITMP
         RDSUMX2 = ITMP2
         CALL DEC_TO_FRAC (SUMY,ITMP,ITMP2,FRACTOL)
         RNSUMY = ITMP
         RDSUMY = ITMP2
         CALL DEC_TO_FRAC (SUMY2,ITMP,ITMP2,FRACTOL)
         RNSUMY2 = ITMP
         RDSUMY2 = ITMP2
         CALL DEC_TO_FRAC (SUMXY,ITMP,ITMP2,FRACTOL)
         RNSUMXY = ITMP
         RDSUMXY = ITMP2
      CASE (2)
         DOMAIN_MODE = 3
         DO I = 1, STACK_SIZE
            CALL DEC_TO_FRAC (real(CSTACK(I), wp),ITMP,ITMP2,FRACTOL)
            RNSTACK(I) = ITMP
            RDSTACK(I) = ITMP2
         END DO
         DO I = 0, REG_SIZE-1
            CALL DEC_TO_FRAC (real(CREG(I), wp),ITMP,ITMP2,FRACTOL)
            RNREG(I) = ITMP
            RDREG(I) = ITMP2
         END DO
         CALL DEC_TO_FRAC (real(CLASTX, wp),ITMP,ITMP2,FRACTOL)
         RNLASTX = ITMP
         RDLASTX = ITMP2
         CALL DEC_TO_FRAC (real(CNN, wp),ITMP,ITMP2,FRACTOL)
         RNNN = ITMP
         RDNN = ITMP2
         CALL DEC_TO_FRAC (real(CSUMX, wp),ITMP,ITMP2,FRACTOL)
         RNSUMX = ITMP
         RDSUMX = ITMP2
         CALL DEC_TO_FRAC (real(CSUMX2, wp),ITMP,ITMP2,FRACTOL)
         RNSUMX2 = ITMP
         RDSUMX2 = ITMP2
         CALL DEC_TO_FRAC (real(CSUMY, wp),ITMP,ITMP2,FRACTOL)
         RNSUMY = ITMP
         RDSUMY = ITMP2
         CALL DEC_TO_FRAC (real(CSUMY2, wp),ITMP,ITMP2,FRACTOL)
         RNSUMY2 = ITMP
         RDSUMY2 = ITMP2
         CALL DEC_TO_FRAC (real(CSUMXY, wp),ITMP,ITMP2,FRACTOL)
         RNSUMXY = ITMP
         RDSUMXY = ITMP2
   END SELECT

case('RCORR')                                             ! RCORR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  RCORR Error'
         ELSE
            CALL LINREG (TMPM,TMPB,TMPR)
            CALL PUSH_STACK (TMPR)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  RCORR Error'
         ELSE
            CALL CLINREG (CTMPM,CTMPB,CTMPR)
            CALL push_stack(CTMPR)
         END IF
      CASE (3)
         IF (RNNN <= 1) THEN
            write(stderr, *) '  RCORR Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            CALL LINREG (TMPM,TMPB,TMPR)
            CALL PUSH_STACK (TMPR)
         END IF
   END SELECT

case('RE')                                                 ! RE
   SELECT CASE (DOMAIN_MODE)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(real(CSTACK(1), wp), kind=wp)
   END SELECT

case('REAL')                                               ! REAL
   SELECT CASE (DOMAIN_MODE)
      CASE (2)
         DOMAIN_MODE = 1

         STACK = real(CSTACK, wp)

         REG = real(CREG, wp)

         LASTX = real(CLASTX, wp)
         NN = real(CNN, wp)
         SUMX = real(CSUMX, wp)
         SUMX2 = real(CSUMX2, wp)
         SUMY = real(CSUMY, wp)
         SUMY2 = real(CSUMY2, wp)
         SUMXY = real(CSUMXY, wp)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
   END SELECT

case('REARTH')                                             ! REARTH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (REARTH)
      CASE (2)
         CALL push_stack(CMPLX(REARTH, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (REARTH)
   END SELECT

case('REDUCE')                                             ! REDUCE
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         TMP = STACK(1)
         CALL DROP_STACK(1)
         LASTX = STACK(1)
         STACK(1) = REDUCE(STACK(1)*ANGLE_FACTOR,TMP*ANGLE_FACTOR) / ANGLE_FACTOR
      CASE (2)
         TMP = real(CSTACK(1), wp)
         CALL CDROP_STACK(1)
         CLASTX = CSTACK(1)
         TMP2 = REDUCE(real(CSTACK(1), wp)*ANGLE_FACTOR,TMP*ANGLE_FACTOR) / ANGLE_FACTOR
         CSTACK(1) = CMPLX(TMP2, kind=wp)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         TMP = STACK(1)
         CALL DROP_STACK(1)
         LASTX = STACK(1)
         STACK(1) = REDUCE(STACK(1)*ANGLE_FACTOR,TMP*ANGLE_FACTOR) / ANGLE_FACTOR
   END SELECT

case('RESET')                                             ! RESET
   STACK = 0._wp
   REG = 0._wp
   LASTX = 0._wp

   NN = 0._wp
   SUMX = 0._wp
   SUMX2 = 0._wp
   SUMY = 0._wp
   SUMY2 = 0._wp
   SUMXY = 0._wp

   CSTACK = (0._wp, 0._wp)
   CREG = (0._wp, 0._wp)
   CLASTX = (0._wp, 0._wp)

   CNN = (0._wp, 0._wp)
   CSUMX = (0._wp, 0._wp)
   CSUMX2 = (0._wp, 0._wp)
   CSUMY = (0._wp, 0._wp)
   CSUMY2 = (0._wp, 0._wp)
   CSUMXY = (0._wp, 0._wp)

   RNSTACK = 0; RDSTACK = 1
   RNREG = 0; RDREG = 1
   RNLASTX = 0; RDLASTX = 1

   RNNN = 0; RDNN = 1
   RNSUMX = 0; RDSUMX = 1
   RNSUMX2 = 0; RDSUMX2 = 1
   RNSUMY = 0; RDSUMY = 1
   RNSUMY2 = 0; RDSUMY2 = 1
   RNSUMXY = 0; RDSUMXY = 1

   ANGLE_MODE = INITIAL_ANGLE_MODE

   SELECT CASE (ANGLE_MODE)
      CASE (1)
         ANGLE_FACTOR = PI/180.0D0
      CASE (2)
         ANGLE_FACTOR = 1._wp
      CASE (3)
         ANGLE_FACTOR = PI/200.0D0
      CASE (4)
         ANGLE_FACTOR = 2*pi
   END SELECT

   DISP_MODE = INITIAL_DISP_MODE
   DISP_DIGITS = INITIAL_DISP_DIGITS
   DOMAIN_MODE = INITIAL_DOMAIN_MODE
   BASE_MODE = INITIAL_BASE_MODE
   FRACTION_MODE = INITIAL_FRACTION_MODE

   FRACTOL = INITIAL_FRACTOL

case('REV')                                                ! REV
   ANGLE_MODE = 4
   ANGLE_FACTOR = 2*pi

case('RGAS')                                               ! RGAS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (RGAS)
      CASE (2)
         CALL push_stack(CMPLX(RGAS, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (RGAS)
   END SELECT

case('RI')                                                 ! RI
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         STACK(1) = 0._wp
      CASE (2)
         TMP = real(CSTACK(1), wp)
         TMP2 = AIMAG(CSTACK(1))
         CSTACK(1) = CMPLX(TMP2,TMP, wp)
      CASE (3)
         RNSTACK(1) = 0
         RDSTACK(1) = 1
   END SELECT

case('ROUND')                                             ! ROUND
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = ANINT(STACK(1))
      CASE (2)
         TMP = ANINT(real(CSTACK(1), wp))
         TMP2 = ANINT(AIMAG(CSTACK(1)))
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         CALL RNINT (NUM, DEN)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM
         RDSTACK(1) = DEN
   END SELECT

case('U')                                                ! roll stack up
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         stack = cshift(stack, -1)
      CASE (2)
         cstack = cshift(cstack, -1)
      CASE (3)
         rnstack = cshift(rnstack, -1)
         rdstack = cshift(rdstack, -1)
   END SELECT

case('RZETA')                                             ! RZETA
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = RIEMANNZETA(STACK(1), 1.e-10_wp) + 1._wp
      CASE (2)
         write(stderr, *) ' RZETA function not available in COMPLEX mode.'
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = RIEMANNZETA(STACK(1), 1.e-10_wp) + 1._wp
   END SELECT

case('S')                                                  ! S
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         NN = NN + 1._wp
         SUMX = SUMX + STACK(1)
         SUMX2 = SUMX2 + STACK(1)**2
         SUMY = SUMY + STACK(2)
         SUMY2 = SUMY2 + STACK(2)**2
         SUMXY = SUMXY + STACK(1)*STACK(2)
         LASTX = STACK(1)
         STACK(1) = NN
      CASE (2)
         CNN = CNN + 1._wp
         CSUMX = CSUMX + CSTACK(1)
         CSUMX2 = CSUMX2 + CSTACK(1)**2
         CSUMY = CSUMY + CSTACK(2)
         CSUMY2 = CSUMY2 + CSTACK(2)**2
         CSUMXY = CSUMXY + CSTACK(1)*CSTACK(2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CNN
      CASE (3)
         CALL RADD(RNNN,RDNN,1,1,RNNN,RDNN)
         CALL RADD(RNSUMX,RDSUMX,RNSTACK(1),RDSTACK(1),RNSUMX,RDSUMX)
         CALL RMUL(RNSTACK(1),RDSTACK(1),RNSTACK(1),RDSTACK(1),NUM,DEN)
         CALL RADD(RNSUMX2,RDSUMX2,NUM,DEN,RNSUMX2,RDSUMX2)
         CALL RADD(RNSUMY,RDSUMY,RNSTACK(2),RDSTACK(2),RNSUMY,RDSUMY)
         CALL RMUL(RNSTACK(2),RDSTACK(2),RNSTACK(2),RDSTACK(2),NUM,DEN)
         CALL RADD(RNSUMY2,RDSUMY2,NUM,DEN,RNSUMY2,RDSUMY2)
         CALL RMUL(RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
         CALL RADD(RNSUMXY,RDSUMXY,NUM,DEN,RNSUMXY,RDSUMXY)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = RNNN
         RDSTACK(1) = RDNN
   END SELECT

case('S-')                                                  ! S-
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         NN = NN - 1._wp
         SUMX = SUMX - STACK(1)
         SUMX2 = SUMX2 - STACK(1)**2
         SUMY = SUMY - STACK(2)
         SUMY2 = SUMY2 - STACK(2)**2
         SUMXY = SUMXY - STACK(1)*STACK(2)
         LASTX = STACK(1)
         STACK(1) = NN
      CASE (2)
         CNN = CNN - 1._wp
         CSUMX = CSUMX - CSTACK(1)
         CSUMX2 = CSUMX2 - CSTACK(1)**2
         CSUMY = CSUMY - CSTACK(2)
         CSUMY2 = CSUMY2 - CSTACK(2)**2
         CSUMXY = CSUMXY - CSTACK(1)*CSTACK(2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CNN
      CASE (3)
         CALL RADD(RNNN,RDNN,1,1,RNNN,RDNN)
         CALL RSUB(RNSUMX,RDSUMX,RNSTACK(1),RDSTACK(1),RNSUMX,RDSUMX)
         CALL RMUL(RNSTACK(1),RDSTACK(1),RNSTACK(1),RDSTACK(1),NUM,DEN)
         CALL RSUB(RNSUMX2,RDSUMX2,NUM,DEN,RNSUMX2,RDSUMX2)
         CALL RSUB(RNSUMY,RDSUMY,RNSTACK(2),RDSTACK(2),RNSUMY,RDSUMY)
         CALL RMUL(RNSTACK(2),RDSTACK(2),RNSTACK(2),RDSTACK(2),NUM,DEN)
         CALL RSUB(RNSUMY2,RDSUMY2,NUM,DEN,RNSUMY2,RDSUMY2)
         CALL RMUL(RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
         CALL RSUB(RNSUMXY,RDSUMXY,NUM,DEN,RNSUMXY,RDSUMXY)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = RNNN
         RDSTACK(1) = RDNN
   END SELECT

case('SEC')                                                ! SEC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SEC(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SEC(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SEC(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('SECH')                                               ! SECH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SECH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SECH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SECH(STACK(1))
   END SELECT

case('SGN')                                                ! SGN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) < 0._wp) THEN
            TMP = -1._wp
         ELSE IF (isclose(STACK(1), 0._wp)) THEN
            TMP = 0._wp
         ELSE
            TMP = +1._wp
         END IF
         LASTX = STACK(1)
         STACK(1) = TMP
      CASE (2)
         IF (real(CSTACK(1), wp) < 0._wp) THEN
            TMP = -1._wp
         ELSE IF (isclose(real(CSTACK(1), wp), 0._wp)) THEN
            TMP = 0._wp
         ELSE
            TMP = +1._wp
         END IF
         IF (AIMAG(CSTACK(1)) < 0._wp) THEN
            TMP2 = -1._wp
         ELSE IF (isclose(AIMAG(CSTACK(1)), 0._wp)) THEN
            TMP2 = 0._wp
         ELSE
            TMP2 = +1._wp
         END IF
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
      CASE (3)
         IF (RNSTACK(1) < 0) THEN
            ITMP = 1
         ELSE IF (RNSTACK(1) == 0) THEN
            ITMP = 0
         ELSE
            ITMP = +1
         END IF
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = ITMP
         RDSTACK(1) = 1
   END SELECT

case('SIN')                                                ! SIN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SIN(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SIN(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SIN(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('SINC')                                               ! SINC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SINC(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SINC(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SINC(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('SINH')                                               ! SINH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SINH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SINH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SINH(STACK(1))
   END SELECT

case('SINHC')                                             ! SINHC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = SINHC(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSINHC(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = SINHC(STACK(1))
   END SELECT

case('SQR')                                                ! SQR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(1)**2
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(1)**2
      CASE (3)
         NUM = RNSTACK(1)
         DEN = RDSTACK(1)
         CALL RMUL (NUM,DEN,NUM,DEN,NUM2,DEN2)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = NUM2
         RDSTACK(1) = DEN2
   END SELECT

case('SQRT')                                               ! SQRT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (STACK(1) < 0._wp) THEN
            write(stderr, *) '  SQRT Error'
         ELSE
            LASTX = STACK(1)
            STACK(1) = SQRT(STACK(1))
         END IF
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = SQRT(CSTACK(1))
      CASE (3)
         IF (RNSTACK(1) < 0) THEN
            write(stderr, *) '  SQRT Error'
         ELSE
            TMP = SQRT(real(RNSTACK(1), wp))
            TMP2 = SQRT(real(RDSTACK(1), wp))
            IF (ISFRAC(TMP).OR.ISFRAC(TMP2)) THEN
               CALL SWITCH_RAT_TO_REAL
               LASTX = STACK(1)
               STACK(1) = SQRT(STACK(1))
            ELSE
               RNLASTX = RNSTACK(1)
               RDLASTX = RDSTACK(1)
               RNSTACK(1) = NINT(SQRT(real(RNSTACK(1), wp)))
               RDSTACK(1) = NINT(SQRT(real(RDSTACK(1), wp)))
            END IF
         END IF
   END SELECT

case('STEFAN')                                             ! STEFAN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (STEFAN)
      CASE (2)
         CALL push_stack(CMPLX(STEFAN, kind=wp))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         CALL PUSH_STACK (STEFAN)
   END SELECT

case('SUMX')                                               ! SUMX
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (SUMX)
      CASE (2)
         CALL push_stack(CSUMX)
      CASE (3)
         CALL push_stack(RNSUMX,RDSUMX)
   END SELECT

case('SUMX2')                                             ! SUMX2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (SUMX2)
      CASE (2)
         CALL push_stack(CSUMX2)
      CASE (3)
         CALL push_stack(RNSUMX2,RDSUMX2)
   END SELECT

case('SUMXY')                                             ! SUMXY
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (SUMXY)
      CASE (2)
         CALL push_stack(CSUMXY)
      CASE (3)
         CALL push_stack(RNSUMXY,RDSUMXY)
   END SELECT

case('SUMY')                                               ! SUMY
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (SUMY)
      CASE (2)
         CALL push_stack(CSUMY)
      CASE (3)
         CALL push_stack(RNSUMY,RDSUMY)
   END SELECT

case('SUMY2')                                             ! SUMY2
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         CALL PUSH_STACK (SUMY2)
      CASE (2)
         CALL push_stack(CSUMY2)
      CASE (3)
         CALL push_stack(RNSUMY2,RDSUMY2)
   END SELECT

case('TAN')                                                ! TAN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = TAN(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = tan(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = TAN(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('TANC')                                               ! TANC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = TANC(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = TANC(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = TANC(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('TANH')                                               ! TANH
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = TANH(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = TANH(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = TANH(STACK(1))
   END SELECT

case('TANHC')                                             ! TANHC
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = TANHC(STACK(1))
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CTANHC(CSTACK(1))
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = TANHC(STACK(1))
   END SELECT

case('TIME')                                               ! TIME
   CALL DATE_AND_TIME (DATE, TIME, ZONE, DT)
   YEAR = DT(1)
   MONTH = DT(2)
   DAY = DT(3)
   HOUR = DT(5)
   MINUTE = DT(6)
   SECOND = DT(7)
   print '(A,I2.2,A1,I2.2,A1,I4)', '  Date:  ', MONTH,'-', DAY, '-', YEAR
   print '(A,I2.2,A1,I2.2,A1,I2.2)', '  Time:  ', HOUR, ':', MINUTE, ':', SECOND

case('VER')                                                ! VER
   print *, 'Fortran 2018  RPN Calculator.  Version '//VERSION

case('VERS')                                               ! VERS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = VERS(STACK(1)*ANGLE_FACTOR)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CVERS(CSTACK(1)*ANGLE_FACTOR)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = VERS(STACK(1)*ANGLE_FACTOR)
   END SELECT

case('X^')                                                 ! X^
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1) THEN
            write(stderr, *) '  X^ Error'
         ELSE
            CALL LINREG (TMPM,TMPB,TMPR)
            LASTX = STACK(1)
            STACK(1) = (STACK(1)-TMPB)/TMPM
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1) THEN
            write(stderr, *) '  X^ Error'
         ELSE
            CALL CLINREG (CTMPM,CTMPB,CTMPR)
            CLASTX = CSTACK(1)
            CSTACK(1) = (CSTACK(1)-CTMPB)/CTMPM
         END IF
      CASE (3)
         IF (RNNN <= 1) THEN
            write(stderr, *) '  X^ Error'
         ELSE
            CALL RLINREG (NUMM,DENM,NUMB,DENB,TMPR)
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            CALL RSUB(RNSTACK(1),RDSTACK(1),NUMB,DENB,NUM,DEN)
            CALL RDIV(NUM,DEN,NUMM,DENM,NUM2,DEN2)
            RNSTACK(1) = NUM2
            RDSTACK(1) = DEN2
         END IF
   END SELECT

case('XMEAN')                                             ! XMEAN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(NN, 0._wp)) THEN
            write(stderr, *) '  XMEAN Error'
         ELSE
            TMP = SUMX/NN
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (isclose(CNN, C0)) THEN
            write(stderr, *) '  XMEAN Error'
         ELSE
            CTMP = CSUMX/CNN
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN == 0) THEN
            write(stderr, *) '  XMEAN Error'
         ELSE
            CALL RDIV (RNSUMX,RDSUMX,RNNN,RDNN,NUM,DEN)
            CALL push_stack(NUM,DEN)
         END IF
   END SELECT

case('XOR')                                                ! XOR
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = IEOR (INT(STACK(2)), INT(STACK(1)))
         CALL DROP_STACK(2)
      CASE (2)
         TMP = IEOR (INT(real(CSTACK(2), wp)), INT(real(CSTACK(1), wp)))
         TMP2 = IEOR (INT(AIMAG(CSTACK(2))), INT(AIMAG(CSTACK(1))))
         CLASTX = CSTACK(1)
         CSTACK(1) = CMPLX(TMP,TMP2, wp)
         CALL CDROP_STACK(2)
      CASE (3)
         ITMP = RNSTACK(1)/RDSTACK(1)
         ITMP2 = RNSTACK(2)/RDSTACK(2)
         RNLASTX = RNSTACK(1)
         RDLASTX = RDSTACK(1)
         RNSTACK(1) = IEOR (ITMP2, ITMP)
         RDSTACK(1) = 1
         CALL RDROP_STACK(2)
   END SELECT

case('XRT')                                                ! XRT
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         LASTX = STACK(1)
         STACK(1) = STACK(2) ** (1._wp/STACK(1))
         CALL DROP_STACK(2)
      CASE (2)
         CLASTX = CSTACK(1)
         CSTACK(1) = CSTACK(2) ** (1._wp/CSTACK(1))
         CALL CDROP_STACK(2)
      CASE (3)
         CALL SWITCH_RAT_TO_REAL
         LASTX = STACK(1)
         STACK(1) = STACK(2) ** (1._wp/STACK(1))
         CALL DROP_STACK(2)
   END SELECT

case('XS')                                                 ! XS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  XS Error'
         ELSE
            TMP = SQRT((SUMX2-SUMX**2/NN)/(NN-1._wp))
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  XS Error'
         ELSE
            CTMP = SQRT((CSUMX2-CSUMX**2/CNN)/(CNN-1._wp))
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN <= RDNN) THEN
            write(stderr, *) '  XS Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            TMP = SQRT((SUMX2-SUMX**2/NN)/(NN-1._wp))
            CALL PUSH_STACK(TMP)
         END IF
   END SELECT

case('XSIG')                                               ! XSIG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  XSIG Error'
         ELSE
            TMP = SQRT((SUMX2-SUMX**2/NN)/NN)
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  XSIG Error'
         ELSE
            CTMP = SQRT((CSUMX2-CSUMX**2/CNN)/CNN)
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN <= RDNN) THEN
            write(stderr, *) '  XSIG Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            TMP = SQRT((SUMX2-SUMX**2/NN)/NN)
            CALL PUSH_STACK(TMP)
         END IF
   END SELECT

case('XY')                                                 ! XY
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         TMP = STACK(1)
         STACK(1) = STACK(2)
         STACK(2) = TMP
      CASE (2)
         CTMP = CSTACK(1)
         CSTACK(1) = CSTACK(2)
         CSTACK(2) = CTMP
      CASE (3)
         ITMP = RNSTACK(1)
         ITMP2 = RDSTACK(1)
         RNSTACK(1) = RNSTACK(2)
         RDSTACK(1) = RDSTACK(2)
         RNSTACK(2) = ITMP
         RDSTACK(2) = ITMP2
   END SELECT

case('Y^')                                                 ! Y^
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  Y^ Error'
         ELSE
            CALL LINREG (TMPM,TMPB,TMPR)
            LASTX = STACK(1)
            STACK(1) = TMPM*STACK(1)+TMPB
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  Y^ Error'
         ELSE
            CALL CLINREG (CTMPM,CTMPB,CTMPR)
            CLASTX = CSTACK(1)
            CSTACK(1) = CTMPM*CSTACK(1)+CTMPB
         END IF
      CASE (3)
         IF (RNNN <= 1) THEN
            write(stderr, *) '  Y^ Error'
         ELSE
            CALL RLINREG (NUMM,DENM,NUMB,DENB,TMPR)
            RNLASTX = RNSTACK(1)
            RDLASTX = RDSTACK(1)
            CALL RMUL(NUMM,DENM,RNSTACK(1),RDSTACK(1),NUM,DEN)
            CALL RADD(NUM,DEN,NUMB,DENB,NUM2,DEN2)
            RNSTACK(1) = NUM2
            RDSTACK(1) = DEN2
         END IF
   END SELECT

case('YMEAN')                                             ! YMEAN
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (isclose(NN, 0._wp)) THEN
            write(stderr, *) '  YMEAN Error'
         ELSE
            TMP = SUMY/NN
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (isclose(CNN, C0)) THEN
            write(stderr, *) '  YMEAN Error'
         ELSE
            CTMP = CSUMY/CNN
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN == 0) THEN
            write(stderr, *) '  YMEAN Error'
         ELSE
            CALL RDIV (RNSUMY,RDSUMY,RNNN,RDNN,NUM,DEN)
            CALL push_stack(NUM,DEN)
         END IF
   END SELECT

case('YS')                                                 ! YS
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  YS Error'
         ELSE
            TMP = SQRT((SUMY2-SUMY**2/NN)/(NN-1._wp))
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  YS Error'
         ELSE
            CTMP = SQRT((CSUMY2-CSUMY**2/CNN)/(CNN-1._wp))
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN <= RDNN) THEN
            write(stderr, *) '  YS Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            TMP = SQRT((SUMY2-SUMY**2/NN)/(NN-1._wp))
            CALL PUSH_STACK(TMP)
         END IF
   END SELECT

case('YSIG')                                               ! YSIG
   SELECT CASE (DOMAIN_MODE)
      CASE (1)
         IF (NN <= 1._wp) THEN
            write(stderr, *) '  YSIG Error'
         ELSE
            TMP = SQRT((SUMY2-SUMY**2/NN)/NN)
            CALL PUSH_STACK(TMP)
         END IF
      CASE (2)
         IF (real(CNN, wp) <= 1._wp) THEN
            write(stderr, *) '  YSIG Error'
         ELSE
            CTMP = SQRT((CSUMY2-CSUMY**2/CNN)/CNN)
            CALL push_stack(CTMP)
         END IF
      CASE (3)
         IF (RNNN <= RDNN) THEN
            write(stderr, *) '  YSIG Error'
         ELSE
            CALL SWITCH_RAT_TO_REAL
            TMP = SQRT((SUMY2-SUMY**2/NN)/NN)
            CALL PUSH_STACK(TMP)
         END IF
   END SELECT

case default
   call regops(str)
end select parse_cmd

END SUBROUTINE EVAL

subroutine regops(str)

character(*), intent(in) :: str
integer :: ierr, itmp

select case(str(:3))

case('RCL')                                                 ! RCL
  IF (LEN_TRIM(STR) == 3) THEN
    write(stderr, *) '  RCLx requires specifying a integer register x ~ (0..9) to store in.  E.g.  RCL6'
    return
  endif

  READ(STR(4:4), '(I1)', IOSTAT=IERR) ITMP
  IF (IERR /= 0) THEN
    write(stderr, *) '  RCL Error with register '//str(4:4)
    return
  endif

  IF ((ITMP < 0).OR.(ITMP >= REG_SIZE)) THEN
    write(stderr, *) '  RCL Error: no register at',itmp
    return
  endif

  SELECT CASE (DOMAIN_MODE)
    CASE (1)
      CALL PUSH_STACK(REG(ITMP))
    CASE (2)
      CALL push_stack(CREG(ITMP))
    CASE (3)
      CALL push_stack(RNREG(ITMP),RDREG(ITMP))
  END SELECT

  PRINT *, REG(ITMP)

case('STO')                                                 ! STO
  IF (LEN_TRIM(STR) == 3) THEN
    write(stderr, *) '  STOx requires specifying a integer register x ~ (0..9) to store in.  E.g.  STO6'
    return
  endif

  READ (STR(4:4), '(I1)', IOSTAT=IERR) ITMP
  IF (IERR /= 0) THEN
    write(stderr, *) '  STO Error with register '//str(4:4)
    return
  endif

  IF ((ITMP < 0).OR.(ITMP >= REG_SIZE)) THEN
    write(stderr, *) '  STO Error: no register at',itmp
    return
  endif

  SELECT CASE (DOMAIN_MODE)
    CASE (1)
      REG(ITMP) = STACK(1)
    CASE (2)
      CREG(ITMP) = CSTACK(1)
    CASE (3)
      RNREG(ITMP) = RNSTACK(1)
      RDREG(ITMP) = RDSTACK(1)
  END SELECT

  PRINT *, REG(ITMP)

case('ENG')                                                 ! ENG
  IF (LEN_TRIM(STR) == 3) THEN
    write(stderr, *) '  ENG Error: must specify # of digits of precision (0..9)'
    return
  endif

  READ(STR(4:4), '(I1)', IOSTAT=IERR) ITMP
  IF (IERR /= 0) THEN
    write(stderr, *) '  ENG Error: with # digits: '//str(4:4)
    return
  endif

  DISP_MODE = 3
  DISP_DIGITS = ITMP

case('FIX')                                                 ! FIX
  IF (LEN_TRIM(STR) == 3) THEN
    write(stderr, *) '  FIX Error: must specify # of digits of precision (0..9)'
    return
  endif
  READ (UNIT=STR(4:4), FMT=*, IOSTAT=IERR) ITMP
  IF (IERR /= 0) THEN
    write(stderr, *) '  FIX Error: with # digits: '//str(4:4)
    return
  endif

  DISP_MODE = 1
  DISP_DIGITS = ITMP

case('SCI')                                                 ! SCI
   IF (LEN_TRIM(STR) == 3) THEN
      write(stderr, *) '  SCI Error: must specify # of digits of precision (0..9)'
    return
  endif
  READ (UNIT=STR(4:4), FMT=*, IOSTAT=IERR) ITMP
  IF (IERR /= 0) THEN
    write(stderr, *) '  SCI Error: with # digits: '//str(4:4)
    return
  endif

  DISP_MODE = 2
  DISP_DIGITS = ITMP

case default
  WRITE(stderr, *) '  Input error:  "'//TRIM(STR)//'"'
end select

end subroutine regops

subroutine add(mode)
integer, intent(in) :: mode
integer :: NUM, DEN

SELECT CASE (MODE)
  CASE (1)
     LASTX = STACK(1)
     STACK(1) = STACK(2) + STACK(1)
     CALL DROP_STACK(2)
  CASE (2)
     CLASTX = CSTACK(1)
     CSTACK(1) = CSTACK(2) + CSTACK(1)
     CALL CDROP_STACK(2)
  CASE (3)
     CALL RADD (RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
     RNLASTX = RNSTACK(1)
     RDLASTX = RDSTACK(1)
     RNSTACK(1) = NUM
     RDSTACK(1) = DEN
     CALL RDROP_STACK(2)
END SELECT

end subroutine add

subroutine subtract(mode)
integer, intent(in) :: mode
integer :: NUM, DEN

SELECT CASE (MODE)
  CASE (1)
     LASTX = STACK(1)
     STACK(1) = STACK(2) - STACK(1)
     CALL DROP_STACK(2)
  CASE (2)
     CLASTX = CSTACK(1)
     CSTACK(1) = CSTACK(2) - CSTACK(1)
     CALL CDROP_STACK(2)
  CASE (3)
     CALL RSUB (RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
     RNLASTX = RNSTACK(1)
     RDLASTX = RDSTACK(1)
     RNSTACK(1) = NUM
     RDSTACK(1) = DEN
     CALL RDROP_STACK(2)
END SELECT

end subroutine subtract

subroutine multiply(mode)
integer, intent(in) :: mode
integer :: NUM, DEN

SELECT CASE (MODE)
  CASE (1)
     LASTX = STACK(1)
     STACK(1) = STACK(2) * STACK(1)
     CALL DROP_STACK(2)
  CASE (2)
     CLASTX = CSTACK(1)
     CSTACK(1) = CSTACK(2) * CSTACK(1)
     CALL CDROP_STACK(2)
  CASE (3)
     CALL RMUL (RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
     RNLASTX = RNSTACK(1)
     RDLASTX = RDSTACK(1)
     RNSTACK(1) = NUM
     RDSTACK(1) = DEN
     CALL RDROP_STACK(2)
END SELECT

end subroutine multiply

subroutine divide(mode)
integer, intent(in) :: mode
integer :: NUM, DEN

SELECT CASE (MODE)
  CASE (1)
     IF (isclose(stack(1), 0._wp)) THEN
        write(stderr, *) '  Divide by zero Error'
        return
     ENDIF

     LASTX = STACK(1)
     STACK(1) = STACK(2) / STACK(1)
     CALL DROP_STACK(2)

  CASE (2)
     IF (isclose(cstack(1), C0)) THEN
        write(stderr, *) '  Divide by zero Error'
        return
     ENDIF

     CLASTX = CSTACK(1)
     CSTACK(1) = CSTACK(2) / CSTACK(1)
     CALL CDROP_STACK(2)

  CASE (3)
     CALL RDIV (RNSTACK(2),RDSTACK(2),RNSTACK(1),RDSTACK(1),NUM,DEN)
     RNLASTX = RNSTACK(1)
     RDLASTX = RDSTACK(1)
     RNSTACK(1) = NUM
     RDSTACK(1) = DEN
     CALL RDROP_STACK(2)
END SELECT

end subroutine divide

subroutine power(mode)
integer, intent(in) :: mode

SELECT CASE (MODE)
  CASE (1)
     LASTX = STACK(1)
     STACK(1) = STACK(2) ** STACK(1)
     CALL DROP_STACK(2)
  CASE (2)
     CLASTX = CSTACK(1)
     CSTACK(1) = CSTACK(2) ** CSTACK(1)
     CALL CDROP_STACK(2)
  CASE (3)
     IF (RDSTACK(1) == 1) THEN
        RNLASTX = RNSTACK(1)
        RDLASTX = RDSTACK(1)
        RNSTACK(1) = RNSTACK(2) ** RNLASTX
        RDSTACK(1) = RDSTACK(2) ** RNLASTX
        CALL RDROP_STACK(2)
     ELSE
        CALL SWITCH_RAT_TO_REAL
        LASTX = STACK(1)
        STACK(1) = STACK(2) ** STACK(1)
        CALL DROP_STACK(2)
     END IF
END SELECT

end subroutine power

subroutine bsj()
integer :: Nb, ncalc
real(wp), allocatable :: B(:)

associate(X=>stack(1), y=>stack(2))

IF ((x < 0._wp) .OR. (y < 0._wp)) THEN
   write(stderr, *) '  BESSELJ Error 1'
   return
ENDIF

NB = INT(y) + 1
ALLOCATE (B(NB))

CALL RJBESL(X=x, ALPHA=FRAC(y), NB=NB, B=B, NCALC=NCALC)

IF (NCALC < 0) THEN
   write(stderr, *) '  BESSELJ Error 2'
   return
ELSE IF (NCALC /= NB) THEN
   write(stderr, *) '  BESSELJ Error 3'
   return
Endif

LASTX = x
x = B(NB)
CALL DROP_STACK(2)

end associate
end subroutine bsj

subroutine bsy0()

associate(X=>stack(1))

IF (x <= 0) THEN
   write(stderr, *) '  BESSELY0 Error'
ELSE
   LASTX = x
   x = bessel_y0(x)
END IF

end associate

end subroutine bsy0

end module evals