PROGRAM TEST
C
C                             David M. Smith               6-14-96
C
C  This is a test program for FMLIB 1.1, a multiple-precision real
C  arithmetic package.  Most of the FM (floating-point) routines
C  are tested, and the results are checked to 50 significant digits.
C  Most of the IM (integer) routines are tested, with exact results
C  required to pass the tests.
C
C  This program uses FMLIB.f.
C
C  These four common blocks contain information that must be saved
C  between calls, so they should be declared in the main program.
C  The parameter statement defines various array sizes.
C
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION DPMAX
      INTEGER NCALL,KACCSW,IUNKNO,NDG2MX,INTMAX,KSUB
      REAL RUNKNO,SPMAX
      DOUBLE PRECISION MWA,MXEXP,MXEXP2,MEXPUN,MEXPOV,MUNKNO,MXBASE,
     *                 MAXINT
C
      COMMON /FM/ MWA(LMWA),NCALL,KACCSW,MXEXP,MXEXP2,MEXPUN,MEXPOV,
     *            MUNKNO,IUNKNO,RUNKNO,MXBASE,NDG2MX,SPMAX,DPMAX,
     *            MAXINT,INTMAX,KSUB
C
      INTEGER LHASH1,LHASH2
      PARAMETER (LHASH1=0 , LHASH2=256)
      DOUBLE PRECISION DLOGMB,DLOGTN,DLOGTW,DLOGTP,DLOGPI,DPPI,
     *                 DPEPS,DLOGEB
      INTEGER NDIGPI,NDIGE,NDIGLB,NDIGLI,KHASHT,KHASHV,
     *        NGRD21,NGRD52,NGRD22
      DOUBLE PRECISION MBSPI,MBSE,MBSLB,MBSLI,MPISAV,MESAV,MLBSAV,
     *                 MLN1,MLN2,MLN3,MLN4,MBLOGS,MEXPAB
      REAL ALOGMB,ALOGMT,ALOGM2,ALOGMX
C
      COMMON /FMSAVE/ NDIGPI,NDIGE,NDIGLB,NDIGLI,MBSPI,MBSE,MBSLB,MBSLI,
     *                MPISAV(0:LUNPCK),MESAV(0:LUNPCK),MLBSAV(0:LUNPCK),
     *                MLN1(0:LUNPCK),MLN2(0:LUNPCK),MLN3(0:LUNPCK),
     *                MLN4(0:LUNPCK),MBLOGS,MEXPAB,ALOGMB,ALOGM2,ALOGMX,
     *                ALOGMT,DLOGMB,DLOGTN,DLOGTW,DLOGTP,DLOGPI,DPPI,
     *                DPEPS,DLOGEB,KHASHT(LHASH1:LHASH2),
     *                KHASHV(LHASH1:LHASH2),NGRD21,NGRD52,NGRD22
C
      CHARACTER CMBUFF,CMCHAR
      CHARACTER *6 NAMEST
C
      COMMON /FMBUFF/ CMBUFF(LMBUFF),NAMEST(0:50),CMCHAR
C
C             Declare arrays for FM variables.  All are in
C             unpacked format.
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
C             Character strings used for input and output.
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
C             Set precision to give at least 50 significant digits
C             and initialize the FMLIB package.
C
      CALL FMSET(50)
C
C             Write output to the standard FM output (unit KW, defined
C             in subroutine FMSET), and also to the file TESTFM.LOG.
C
      KLOG = 18
      OPEN (KLOG,FILE='TESTFM.LOG')
C
C             NERROR is the number of errors found.
C             NCASE is the number of cases tested.
C
      NERROR = 0
C
C             Test input and output conversion.
C
      CALL TEST1(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test add and subtract.
C
      CALL TEST2(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test multiply, divide and square root.
C
      CALL TEST3(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test stored constants.
C
      CALL TEST4(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test exponentials.
C
      CALL TEST5(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test logarithms.
C
      CALL TEST6(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test trigonometric functions.
C
      CALL TEST7(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test inverse trigonometric functions.
C
      CALL TEST8(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test hyperbolic functions.
C
      CALL TEST9(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test integer input and output conversion.
C
      CALL TEST10(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test integer add and subtract.
C
      CALL TEST11(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test integer multiply and divide.
C
      CALL TEST12(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test conversions between FM and IM format.
C
      CALL TEST13(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test integer power and GCD functions.
C
      CALL TEST14(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             Test integer modular functions.
C
      CALL TEST15(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C             End of tests.
C
      IF (NERROR.EQ.0) THEN
          WRITE (KW,110) NCASE
          WRITE (KLOG,110) NCASE
  110     FORMAT(///1X,I5,' cases tested.  No errors were found.'/)
      ELSE
C
C             Write some of the initialized values in common.
C
          WRITE (KLOG,*)' NDIG,MBASE,JFORM1,JFORM2,KRAD = '
          WRITE (KLOG,*)  NDIG,MBASE,JFORM1,JFORM2,KRAD
          WRITE (KLOG,*)' KW,NTRACE,LVLTRC,KFLAG,KWARN,KROUND = '
          WRITE (KLOG,*)  KW,NTRACE,LVLTRC,KFLAG,KWARN,KROUND
          WRITE (KLOG,*)' NCALL,MXEXP,MXEXP2,KACCSW,MEXPUN,MEXPOV'
          WRITE (KLOG,*)  NCALL,MXEXP,MXEXP2,KACCSW,MEXPUN,MEXPOV
          WRITE (KLOG,*)' MUNKNO,IUNKNO,RUNKNO,MXBASE,NDG2MX = '
          WRITE (KLOG,*)  MUNKNO,IUNKNO,RUNKNO,MXBASE,NDG2MX
          WRITE (KLOG,*)' MAXINT,INTMAX,SPMAX,DPMAX = '
          WRITE (KLOG,*)  MAXINT,INTMAX,SPMAX,DPMAX
          WRITE (KLOG,*)' ALOGMB,ALOGM2,ALOGMX,ALOGMT,DLOGMB,DLOGTN ='
          WRITE (KLOG,*)  ALOGMB,ALOGM2,ALOGMX,ALOGMT,DLOGMB,DLOGTN
          WRITE (KLOG,*)' DLOGTW,DLOGTP,DLOGPI,DPPI ='
          WRITE (KLOG,*)  DLOGTW,DLOGTP,DLOGPI,DPPI
          WRITE (KLOG,*)' DPEPS,DLOGEB ='
          WRITE (KLOG,*)  DPEPS,DLOGEB
C
          WRITE (KW,120) NCASE,NERROR
          WRITE (KLOG,120) NCASE,NERROR
  120     FORMAT(///1X,I5,' cases tested.',I4,' error(s) found.'/)
      ENDIF
      WRITE (KW,*)' End of run.'
C
      STOP
      END
      SUBROUTINE TEST1(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Input and output testing.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
C             Logical function for comparing FM numbers.
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing input and output routines.')
C
      NCASE = 1
      CALL FMST2M('123',MA)
      CALL FMI2M(123,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMI2M(10,MB)
      CALL FMIPWR(MB,-48,MB)
C
C             Use the .NOT. because FMCOMP returns FALSE for special
C             cases like MD = UNKNOWN, and these should be treated
C             as errors for these tests.
C
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMST2M',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 2
      ST1 = '1.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMI2M(131,MB)
      CALL FMI2M(97,MC)
      CALL FMDIV(MB,MC,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMST2M',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 3
      ST1 = '1.3505154639175257731958762886597938144329896907216495E-2'
      CALL FMST2M(ST1,MA)
      CALL FMI2M(131,MB)
      CALL FMI2M(9700,MC)
      CALL FMDIV(MB,MC,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-52',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMST2M',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 4
      ST1 = '1.3505154639175257731958762886597938144329896907216495E-2'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('F40.30',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '         .013505154639175257731958762887'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF ((.NOT.FMCOMP(MD,'LE',MB)) .OR. ST1.NE.ST2) THEN
          CALL ERRPRT('FMFORM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 5
      ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('F53.33',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '13505154639175257.731958762886597938144329896907216'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMFORM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 6
      ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('I24',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '13505154639175258'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMFORM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 7
      ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('E55.49',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '-1.350515463917525773195876288659793814432989690722D16'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMFORM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 8
      ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
      CALL FMST2M(ST1,MA)
      CALL FMFORM('1PE54.46',MA,ST2)
      CALL FMST2M(ST2,MA)
      ST1 = '-1.350515463917525773195876288659793814432989691M+16'
      CALL FMST2M(ST1,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMFORM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST2(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test add and subtract.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing add and subtract routines.')
C
      NCASE = 9
      CALL FMST2M('123',MA)
      CALL FMST2M('789',MB)
      CALL FMADD(MA,MB,MA)
      CALL FMI2M(912,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMADD ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 10
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMADD(MA,MB,MA)
      ST2 = '1.0824742268041237113402061855670103092783505154639175'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMADD ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 11
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMSUB(MA,MB,MA)
      ST2 = '-.3814432989690721649484536082474226804123711340206185'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSUB ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 12
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.3505154639175257731443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMSUB(MA,MB,MA)
      ST2 = '5.15463917525773195876288659793815M-20'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSUB ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 13
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMADDI(MA,1)
      ST2 = '1.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMADDI',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 14
      ST1 = '4.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMADDI(MA,5)
      ST2 = '9.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMADDI',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST3(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test multiply, divide and square root.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing multiply, divide and square root routines.')
C
      NCASE = 15
      CALL FMST2M('123',MA)
      CALL FMST2M('789',MB)
      CALL FMMPY(MA,MB,MA)
      CALL FMI2M(97047,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMMPY ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 16
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMMPY(MA,MB,MA)
      ST2 = '0.2565628653416941226485280051014985652035285365075991'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMMPY ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 17
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMDIV(MA,MB,MA)
      ST2 = '0.4788732394366197183098591549295774647887323943661972'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMDIV ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 18
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMMPYI(MA,14,MA)
      ST2 = '10.2474226804123711340206185567010309278350515463917526'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMMPYI',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 19
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMDIVI(MA,24,MA)
      ST2 = '0.0304982817869415807560137457044673539518900343642612'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMDIVI',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 20
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSQR(MA,MA)
      ST2 = '0.1228610904453183122542246784993091720692953555106813'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSQR ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 21
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSQRT(MA,MA)
      ST2 = '0.5920434645509785316136003710368759268547372945659987'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSQRT',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST4(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test stored constants.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      INTEGER LHASH1,LHASH2
      PARAMETER (LHASH1=0 , LHASH2=256)
      DOUBLE PRECISION DLOGMB,DLOGTN,DLOGTW,DLOGTP,DLOGPI,DPPI,
     *                 DPEPS,DLOGEB
      INTEGER NDIGPI,NDIGE,NDIGLB,NDIGLI,KHASHT,KHASHV,
     *        NGRD21,NGRD52,NGRD22
      DOUBLE PRECISION MBSPI,MBSE,MBSLB,MBSLI,MPISAV,MESAV,MLBSAV,
     *                 MLN1,MLN2,MLN3,MLN4,MBLOGS,MEXPAB
      REAL ALOGMB,ALOGMT,ALOGM2,ALOGMX
C
      COMMON /FMSAVE/ NDIGPI,NDIGE,NDIGLB,NDIGLI,MBSPI,MBSE,MBSLB,MBSLI,
     *                MPISAV(0:LUNPCK),MESAV(0:LUNPCK),MLBSAV(0:LUNPCK),
     *                MLN1(0:LUNPCK),MLN2(0:LUNPCK),MLN3(0:LUNPCK),
     *                MLN4(0:LUNPCK),MBLOGS,MEXPAB,ALOGMB,ALOGM2,ALOGMX,
     *                ALOGMT,DLOGMB,DLOGTN,DLOGTW,DLOGTP,DLOGPI,DPPI,
     *                DPEPS,DLOGEB,KHASHT(LHASH1:LHASH2),
     *                KHASHV(LHASH1:LHASH2),NGRD21,NGRD52,NGRD22
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      DOUBLE PRECISION MLNSV2(0:LUNPCK),MLNSV3(0:LUNPCK),
     *                 MLNSV5(0:LUNPCK),MLNSV7(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      DOUBLE PRECISION MBSAVE
      INTEGER J,JEXP,KLOG,NCASE,NDGSAV,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing stored constants.'//'     Check e.'/)
C
C             Switch to base 10 and check the stored digits.
C
      MBSAVE = MBASE
      NDGSAV = NDIG
      NCASE = 22
      MBASE = 10
      NDIG = 200
      CALL FMCONS
      CALL FMI2M(1,MB)
      CALL FMEXP(MB,MC)
      DO 120 J = 142, 144
         NDIG = J
         NDIGE = 0
         CALL FMI2M(1,MB)
         CALL FMEXP(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J + 1
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' e    ',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 130
         ENDIF
  120 CONTINUE
C
  130 NCASE = 23
      MBASE = 10
      NDIG = 200
      CALL FMI2M(2,MB)
      CALL FMLN(MB,MC)
      CALL FMEQ(MLN1,MLNSV2)
      CALL FMEQ(MLN2,MLNSV3)
      CALL FMEQ(MLN3,MLNSV5)
      CALL FMEQ(MLN4,MLNSV7)
      WRITE (KW,140)
  140 FORMAT('     Check ln(2).'/)
      DO 150 J = 142, 144
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(2,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' ln(2)',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 160
         ENDIF
  150 CONTINUE
C
  160 NCASE = 24
      MBASE = 10
      NDIG = 200
      WRITE (KW,170)
  170 FORMAT('     Check ln(3).'/)
      CALL FMEQ(MLNSV3,MC)
      DO 180 J = 142, 144
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(3,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J + 1
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' ln(3)',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 190
         ENDIF
  180 CONTINUE
C
  190 NCASE = 25
      MBASE = 10
      NDIG = 200
      WRITE (KW,200)
  200 FORMAT('     Check ln(5).'/)
      CALL FMEQ(MLNSV5,MC)
      DO 210 J = 142, 144
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(5,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J + 1
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' ln(5)',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 220
         ENDIF
  210 CONTINUE
C
  220 NCASE = 26
      MBASE = 10
      NDIG = 200
      WRITE (KW,230)
  230 FORMAT('     Check ln(7).'/)
      CALL FMEQ(MLNSV7,MC)
      DO 240 J = 142, 144
         NDIG = J
         NDIGLI = 0
         CALL FMI2M(7,MB)
         CALL FMLN(MB,MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J + 1
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' ln(7)',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 250
         ENDIF
  240 CONTINUE
C
  250 NCASE = 27
      MBASE = 10
      NDIG = 200
      WRITE (KW,260)
  260 FORMAT('     Check pi.')
      CALL FMPI(MC)
      DO 270 J = 142, 144
         NDIG = J
         NDIGPI = 0
         CALL FMPI(MA)
         CALL FMSUB(MA,MC,MD)
         CALL FMABS(MD,MD)
         CALL FMI2M(10,MB)
         JEXP = -J + 1
         CALL FMIPWR(MB,JEXP,MB)
         IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
             CALL ERRPRT(' pi   ',MA,'MA',MC,'MC',MD,'MD',
     *                   NCASE,NERROR,KLOG)
             GO TO 280
         ENDIF
  270 CONTINUE
C
C             Restore base and precision.
C
  280 MBASE = MBSAVE
      NDIG = NDGSAV
      CALL FMCONS
      RETURN
      END
      SUBROUTINE TEST5(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test exponentials.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing exponential routines.')
C
      NCASE = 28
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMEXP(MA,MA)
      ST2 = '0.7043249420381570899426746185150096342459216636010743'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMEXP ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 29
      ST1 = '5.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMEXP(MA,MA)
      ST2 = '210.7168868293979289717186453717687341395104929999527672'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-48',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMEXP ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 30
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMIPWR(MA,13,MA)
      ST2 = '1.205572620050170403854527299272882946980306577287581E-6'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-56',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMIPWR',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 31
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMIPWR(MA,-1234,MA)
      ST2 = '1.673084074011006302103793189789209370839697748745938E167'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E+120',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMIPWR',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 32
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMPWR(MA,MB,MA)
      ST2 = '0.4642420045002127676457665673753493595170650613692580'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMPWR ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 33
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      ST1 = '-34.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MB)
      CALL FMPWR(MA,MB,MA)
      ST2 = '6.504461581246879800523526109766882955934341922848773E15'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-34',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMPWR ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 34
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMRPWR(MA,1,3,MA)
      ST2 = '0.7050756680967220302067310420367584779561732592049823'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMRPWR',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 35
      ST1 = '0.7319587628865979381443298969072164948453608247422680'
      CALL FMST2M(ST1,MA)
      CALL FMRPWR(MA,-17,5,MA)
      ST2 = '2.8889864895853344043562747681699203201333872009477318'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMRPWR',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST6(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test logarithms.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing logarithm routines.')
C
      NCASE = 36
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMLN(MA,MA)
      ST2 = '-1.0483504538872214324499548823726586101452117557127813'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMLN  ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 37
      ST1 = '0.3505154639175257731958762886597938144329896907216495E123'
      CALL FMST2M(ST1,MA)
      CALL FMLN(MA,MA)
      ST2 = '282.1696159843803977017629940438041389247902713456262947'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-47',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMLN  ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 38
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMLG10(MA,MA)
      ST2 = '-0.4552928172239897280304530226127473926500843247517120'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMLG10',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 39
      CALL FMLNI(210,MA)
      ST2 = '5.3471075307174686805185894350500696418856767760333836'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMIPWR',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 40
      CALL FMLNI(211,MA)
      ST2 = '5.3518581334760664957419562654542801180411581735816684'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMPWR ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST7(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test trigonometric functions.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing trigonometric routines.')
C
      NCASE = 41
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS(MA,MA)
      ST2 = '0.9391958366109693586000906984500978377093121163061328'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCOS ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 42
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOS(MA,MA)
      ST2 = '0.8069765551968063243992244125871029909816207609700968'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCOS ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 43
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSIN(MA,MA)
      ST2 = '-0.3433819746180939949443652360333010581867042625893927'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSIN ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 44
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSIN(MA,MA)
      ST2 = '-0.5905834736620182429243173169772978155668602154136946'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSIN ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 45
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTAN(MA,MA)
      ST2 = '0.3656127521360899712035823015565426347554405301360773'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMTAN ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 46
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTAN(MA,MA)
      ST2 = '-0.7318471272291003544610122296764031536071117330470298'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMTAN ',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 47
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCSSN(MA,MA,MC)
      ST2 = '0.9391958366109693586000906984500978377093121163061328'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCSSN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 48
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCSSN(MA,MA,MC)
      ST2 = '0.8069765551968063243992244125871029909816207609700968'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCSSN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 49
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCSSN(MA,MC,MA)
      ST2 = '-0.3433819746180939949443652360333010581867042625893927'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCSSN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 50
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCSSN(MA,MC,MA)
      ST2 = '-0.5905834736620182429243173169772978155668602154136946'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCSSN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST8(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test inverse trigonometric functions.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing inverse trigonometric routines.')
C
      NCASE = 51
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOS(MA,MA)
      ST2 = '1.2126748979730954046873545995574544481988102502510807'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMACOS',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 52
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMACOS(MA,MA)
      ST2 = '1.9289177556166978337752887837220484359983591491240252'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMACOS',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 53
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASIN(MA,MA)
      ST2 = '0.3581214288218012145439670920822969938997744494364723'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMASIN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 54
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMASIN(MA,MA)
      ST2 = '-0.3581214288218012145439670920822969938997744494364723'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMASIN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 55
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATAN(MA,MA)
      ST2 = '0.3371339561772373443347761845672381725353758541616570'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMATAN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 56
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMATAN(MA,MA)
      ST2 = '1.5477326406586162039457549832092678908202994134569781'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMATAN',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST9(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test hyperbolic functions.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing hyperbolic routines.')
C
      NCASE = 57
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH(MA,MA)
      ST2 = '1.0620620786534654254819884264931372964608741056397718'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCOSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 58
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCOSH(MA,MA)
      ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCOSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 59
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSINH(MA,MA)
      ST2 = '-0.3577371366153083355393138079781276622149524420386975'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSINH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 60
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMSINH(MA,MA)
      ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMSINH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 61
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTANH(MA,MA)
      ST2 = '0.3368326049912874057089491946232983472275659538703038'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMTANH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 62
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMTANH(MA,MA)
      ST2 = '0.9999999999999999999999999999999999999556135217341837'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMTANH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 63
      ST1 = '0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCHSH(MA,MA,MC)
      ST2 = '1.0620620786534654254819884264931372964608741056397718'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-49',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCHSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 64
      ST1 = '-43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCHSH(MA,MA,MC)
      ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCHSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 65
      ST1 = '-0.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCHSH(MA,MC,MA)
      ST2 = '-0.3577371366153083355393138079781276622149524420386975'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-50',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCHSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 66
      ST1 = '43.3505154639175257731958762886597938144329896907216495'
      CALL FMST2M(ST1,MA)
      CALL FMCHSH(MA,MC,MA)
      ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
      CALL FMST2M(ST2,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('1.0E-31',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('FMCHSH',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST10(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Input and output testing for IM routines.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
C             Logical function for comparing IM numbers.
C
      LOGICAL IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing integer input and output routines.')
C
      NCASE = 67
      CALL IMST2M('123',MA)
      CALL IMI2M(123,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMST2M',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 68
      ST1 = '-350515'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(-350515,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMST2M',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 69
      ST1 = '19895113660064588580108197261066338165074766609'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(23,MB)
      CALL IMI2M(34,MC)
      CALL IMPWR(MB,MC,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMST2M',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 70
      ST1 = '-20800708073664542533904165663516279809808659679033703'
      CALL IMST2M(ST1,MA)
      CALL IMI2M(-567,MB)
      CALL IMI2M(19,MC)
      CALL IMPWR(MB,MC,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMST2M',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 71
      ST1 = '19895113660064588580108197261066338165074766609'
      CALL IMST2M(ST1,MA)
      CALL IMFORM('I53',MA,ST2)
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMFORM',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 72
      ST1 = '-20800708073664542533904165663516279809808659679033703'
      CALL IMST2M(ST1,MA)
      CALL IMFORM('I73',MA,ST2)
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMFORM',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST11(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test add and subtract for IM routines.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing integer add and subtract routines.')
C
      NCASE = 73
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMADD(MA,MB,MA)
      CALL IMI2M(912,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMADD ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 74
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '7319587628865979381443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMADD(MA,MB,MA)
      ST2 = '10824742268041237113402061855670103092783505154639175'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMADD ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 75
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '7319587628865979381443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMSUB(MA,MB,MA)
      ST2 = '-3814432989690721649484536082474226804123711340206185'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMSUB ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 76
      ST1 = '3505154639175257731958762886597938144329896907216495'
      CALL IMST2M(ST1,MA)
      ST1 = '3505154639175257731443298969072164948453608247422680'
      CALL IMST2M(ST1,MB)
      CALL IMSUB(MA,MB,MA)
      ST2 = '515463917525773195876288659793815'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMSUB ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST12(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test integer multiply and divide.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER IREM,KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing integer multiply, divide and square routines.')
C
      NCASE = 77
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMMPY(MA,MB,MA)
      CALL IMI2M(97047,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPY ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 78
      ST1 = '10430738374625018354698'
      CALL IMST2M(ST1,MA)
      ST1 = '2879494424799214514791045985'
      CALL IMST2M(ST1,MB)
      CALL IMMPY(MA,MB,MA)
      ST2 = '30035252996271960952238822892375588336807158787530'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPY ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 79
      CALL IMST2M('12347',MA)
      CALL IMST2M('47',MB)
      CALL IMDIV(MA,MB,MA)
      CALL IMST2M('262',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIV ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 80
      ST1 = '2701314697583086005158008013691015597308949443159762'
      CALL IMST2M(ST1,MA)
      ST1 = '-978132616472842669976589722394'
      CALL IMST2M(ST1,MB)
      CALL IMDIV(MA,MB,MA)
      CALL IMST2M('-2761705981469115610382',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIV ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 81
      CALL IMST2M('12368',MA)
      CALL IMST2M('67',MB)
      CALL IMMOD(MA,MB,MB)
      CALL IMST2M('40',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMMOD ',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 82
      ST1 = '2701314697583086005158008013691015597308949443159762'
      CALL IMST2M(ST1,MA)
      ST1 = '-978132616472842669976589722394'
      CALL IMST2M(ST1,MB)
      CALL IMMOD(MA,MB,MB)
      CALL IMST2M('450750319653685523300198865254',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMMOD ',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 83
      CALL IMST2M('1234',MA)
      CALL IMST2M('17',MB)
      CALL IMDIVR(MA,MB,MA,MB)
      CALL IMST2M('72',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVR',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
      CALL IMST2M('10',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVR',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 84
      ST1 = '34274652243817531418235301715935108945364446765801943'
      CALL IMST2M(ST1,MA)
      ST1 = '-54708769795848731641842224621693'
      CALL IMST2M(ST1,MB)
      CALL IMDIVR(MA,MB,MA,MB)
      CALL IMST2M('-626492834178447772323',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVR',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
      CALL IMST2M('31059777254296217822749494999104',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVR',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 85
      CALL IMST2M('4866',MA)
      CALL IMMPYI(MA,14,MA)
      CALL IMST2M('68124',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPYI',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 86
      CALL IMST2M('270131469758308600515800801369101559730894',MA)
      CALL IMMPYI(MA,-2895,MA)
      CALL IMST2M('-782030604950303398493243319963549015420938130',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPYI ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 87
      CALL IMST2M('-37179',MA)
      CALL IMDIVI(MA,129,MA)
      CALL IMST2M('-288',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVI',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 88
      ST1 = '8267538919383255454483790743961990401918726073065738'
      CALL IMST2M(ST1,MA)
      CALL IMDIVI(MA,1729,MA)
      ST2 = '4781688212483085861471249707323302719444028960708'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDIVI',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 89
      CALL IMST2M('-71792',MA)
      CALL IMDVIR(MA,65,MA,IREM)
      CALL IMST2M('-1104',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDVIR',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
      CALL IMI2M(IREM,MB)
      CALL IMI2M(-32,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMDVIR',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 90
      ST1 = '97813261647284266997658972239417958580120170263408655'
      CALL IMST2M(ST1,MA)
      CALL IMDVIR(MA,826,MA,IREM)
      ST2 = '118417992309060855929369215786220288837917881674828'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMDVIR',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
      CALL IMI2M(IREM,MB)
      CALL IMI2M(727,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMDVIR',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 91
      CALL IMST2M('538',MA)
      CALL IMSQR(MA,MA)
      CALL IMST2M('289444',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMSQR ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 92
      CALL IMST2M('-47818191879814587168242632',MA)
      CALL IMSQR(MA,MA)
      ST2 = '2286579474654765721668058416662636606051551222287424'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMSQR ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST13(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test conversions between FM and IM format.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL FMCOMP,IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing conversions between FM and IM format.')
C
      NCASE = 93
      CALL IMST2M('123',MA)
      CALL IMI2FM(MA,MB)
      CALL FMI2M(123,MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('IMI2FM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 94
      CALL IMST2M('979282999076598337488362000995916',MA)
      CALL IMI2FM(MA,MB)
      CALL FMST2M('979282999076598337488362000995916',MC)
      CALL FMSUB(MA,MC,MD)
      CALL FMABS(MD,MD)
      CALL FMST2M('0',MB)
      IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
          CALL ERRPRT('IMI2FM',MA,'MA',MC,'MC',MD,'MD',
     *                NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 95
      CALL FMST2M('123.4',MA)
      CALL IMFM2I(MA,MB)
      CALL IMI2M(123,MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMFM2I',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 96
      CALL FMST2M('979282999076598337488362000995916',MA)
      CALL IMFM2I(MA,MB)
      CALL IMST2M('979282999076598337488362000995916',MC)
      IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
          CALL ERRPR2('IMFM2I',MB,'MB',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST14(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test integer power and GCD functions.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing integer GCD and power routines.')
C
      NCASE = 97
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMGCD(MA,MB,MA)
      CALL IMI2M(3,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMGCD ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 98
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MB)
      CALL IMGCD(MA,MB,MA)
      CALL IMST2M('615',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMGCD ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 99
      ST1 = '5877631675869176172956662762822298812326084745145447940'
      CALL IMST2M(ST1,MA)
      ST1 = '10379997509886032090765062511740075746391432253007667'
      CALL IMST2M(ST1,MB)
      CALL IMGCD(MA,MB,MA)
      CALL IMST2M('1',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMGCD ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 100
      CALL IMST2M('47',MA)
      CALL IMST2M('34',MB)
      CALL IMPWR(MA,MB,MA)
      ST2 = '710112520079088427392020925014421733344154169313556279969'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPWR ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 101
      CALL IMST2M('2',MA)
      CALL IMST2M('187',MB)
      CALL IMPWR(MA,MB,MA)
      ST2 = '196159429230833773869868419475239575503198607639501078528'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPWR ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 102
      CALL IMST2M('-3',MA)
      CALL IMST2M('101',MB)
      CALL IMPWR(MA,MB,MA)
      ST2 = '-1546132562196033993109383389296863818106322566003'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPWR ',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE TEST15(MA,MB,MC,MD,ST1,ST2,NCASE,NERROR,KLOG)
C
C  Test integer modular functions.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION MA(0:LUNPCK),MB(0:LUNPCK),MC(0:LUNPCK),
     *                 MD(0:LUNPCK)
C
      LOGICAL IMCOMP
C
      CHARACTER *80 ST1,ST2
      INTEGER KLOG,NCASE,NERROR
C
      WRITE (KW,110)
  110 FORMAT(/' Testing integer modular routines.')
C
      NCASE = 103
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMST2M('997',MC)
      CALL IMMPYM(MA,MB,MC,MA)
      CALL IMI2M(338,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPYM',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 104
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '36346366019557973241042306587666640486264616086971724'
      CALL IMST2M(ST1,MB)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MC)
      CALL IMMPYM(MA,MB,MC,MA)
      ST2 = '458279704440780378752997531208983184411293504187816380'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPYM',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 105
      ST1 = '914726194238000125985765939883182'
      CALL IMST2M(ST1,MA)
      ST1 = '-75505764717193044779376979508186553225192'
      CALL IMST2M(ST1,MB)
      ST1 = '18678872625055834600521936'
      CALL IMST2M(ST1,MC)
      CALL IMMPYM(MA,MB,MC,MA)
      ST2 = '-7769745969769966093344960'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMMPYM',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 106
      CALL IMST2M('123',MA)
      CALL IMST2M('789',MB)
      CALL IMST2M('997',MC)
      CALL IMPMOD(MA,MB,MC,MA)
      CALL IMI2M(240,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPMOD',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 107
      ST1 = '431134020618556701030927835051546391752577319587628885'
      CALL IMST2M(ST1,MA)
      ST1 = '36346366019557973241042306587666640486264616086971724'
      CALL IMST2M(ST1,MB)
      ST1 = '900309278350515463917525773195876288659793814432989640'
      CALL IMST2M(ST1,MC)
      CALL IMPMOD(MA,MB,MC,MA)
      ST2 = '755107893576299697276281907390144058060594744720442385'
      CALL IMST2M(ST2,MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPMOD',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      NCASE = 108
      CALL IMST2M('314159',MA)
      CALL IMST2M('1411695892374393248272691827763664225585897550',MB)
      CALL IMST2M('1411695892374393248272691827763664225585897551',MC)
      CALL IMPMOD(MA,MB,MC,MA)
      CALL IMST2M('1',MC)
      IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
          CALL ERRPR2('IMPMOD',MA,'MA',MC,'MC',NCASE,NERROR,KLOG)
      ENDIF
C
      RETURN
      END
      SUBROUTINE ERRPRT(NROUT,M1,NAME1,M2,NAME2,M3,NAME3,
     *                  NCASE,NERROR,KLOG)
C
C  Print error messages.
C
C  M1 is the value to be tested, as computed by the routine named NROUT.
C  M2 is the reference value, usually converted using FMST2M.
C  M3 is ABS(M1-M2), and ERRPRT is called if this is too big.
C  NAME1,NAME2,NAME3 are strings identifying which variables in main
C                    correspond to M1,M2,M3.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION M1(0:LUNPCK),M2(0:LUNPCK),M3(0:LUNPCK)
C
      CHARACTER *2 NAME1,NAME2,NAME3
      CHARACTER *6 NROUT
      INTEGER KLOG,KWSAVE,NCASE,NERROR
C
      NERROR = NERROR + 1
      WRITE (KW,110) NCASE,NROUT
      WRITE (KLOG,110) NCASE,NROUT
  110 FORMAT(//' Error in case',I3,'.  The routine',
     *       ' being tested was ',A6)
C
C              Temporarily change KW to KLOG so FMPRNT
C              will write to the log file.
C
      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,120) NAME1
  120 FORMAT(1X,A2,' =')
      CALL FMPRNT(M1)
      WRITE (KLOG,120) NAME2
      CALL FMPRNT(M2)
      WRITE (KLOG,120) NAME3
      CALL FMPRNT(M3)
      KW = KWSAVE
      RETURN
      END
      SUBROUTINE ERRPR2(NROUT,M1,NAME1,M2,NAME2,
     *                  NCASE,NERROR,KLOG)
C
C  Print error messages for testing of integer (IM) routines.
C
C  M1 is the value to be tested, as computed by the routine named NROUT.
C  M2 is the reference value, usually converted using IMST2M.
C  NAME1,NAME2 are strings identifying which variables in main
C              correspond to M1,M2.
C
      INTEGER NDIGMX,NBITS,LPACK,LUNPCK,LMWA,LJSUMS,LMBUFF
C
      PARAMETER ( NDIGMX=256 , NBITS=64 ,
     *          LPACK  = (NDIGMX+1)/2 + 1 , LUNPCK = (6*NDIGMX)/5 + 20,
     *          LMWA   = 2*LUNPCK         , LJSUMS = 8*(LUNPCK+2),
     *          LMBUFF = ((LUNPCK+3)*(NBITS-1)*301)/2000 + 6  )
C
      INTEGER NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,KFLAG,
     *        KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
      DOUBLE PRECISION MBASE
C
      COMMON /FMUSER/ MBASE,NDIG,JFORM1,JFORM2,KRAD,KW,NTRACE,LVLTRC,
     *                KFLAG,KWARN,KROUND,KSWIDE,KESWCH,KDEBUG
C
      DOUBLE PRECISION M1(0:LUNPCK),M2(0:LUNPCK)
C
      CHARACTER *2 NAME1,NAME2
      CHARACTER *6 NROUT
      INTEGER KLOG,KWSAVE,NCASE,NERROR
C
      NERROR = NERROR + 1
      WRITE (KW,110) NCASE,NROUT
      WRITE (KLOG,110) NCASE,NROUT
  110 FORMAT(//' Error in case',I3,'.  The routine',
     *       ' being tested was ',A6)
C
C              Temporarily change KW to KLOG so IMPRNT
C              will write to the log file.
C
      KWSAVE = KW
      KW = KLOG
      WRITE (KLOG,120) NAME1
  120 FORMAT(1X,A2,' =')
      CALL IMPRNT(M1)
      WRITE (KLOG,120) NAME2
      CALL IMPRNT(M2)
      KW = KWSAVE
      RETURN
      END