Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/basis_transformation/MPI_T5/FM/src/TestFM.f90
cd1286e2d410improved_sugama

Last Change
Raw File

TestFM.f90
View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
! This is a test program for FM 1.3, a multiple-precision arithmetic package.
! All of the FM (floating-point real) and ZM (floating-point complex) routines are tested.
! Precision is set to 50 significant digits and the results are checked to that accuracy.
! A few constants are computed with 20,000 significant digits to test the routines that
! use special algorithms for very high precision.
! All of the IM (integer) routines are tested, with exact results required to pass the tests.
! All of the USE FMZM derived type interface routines are tested in the same manner as those
! described above.
! If all tests are completed successfully, this line is printed:
! 3268 cases tested. No errors were found.
MODULE TEST_VARS
USE FMVALS
USE FMZM
! Declare the derived type variables of type (FM), (IM), and (ZM).
! These are in the form that would be found in a user program.
TYPE (FM), SAVE :: M_A, M_B, M_C, M_D, MFM1, MFM2, MFM3, MFM4, MFM5, MFM6, MSMALL, &
MFMV1(3), MFMV2(3), MFMV4(3), MFMV3(2), &
MFMA(3,3), MFMB(3,3), MFMC(3,3), MFMD(2,2), MFME(3,2), MFMF(2,3)
! These are the integer multiple precision variables.
TYPE (IM), SAVE :: M_J, M_K, M_L, MIM1, MIM2, MIM3, MIM4, MIM5
TYPE (IM), SAVE, DIMENSION(3) :: MIMV1, MIMV2, MIMV4
TYPE (IM), SAVE, DIMENSION(2) :: MIMV3
TYPE (IM), SAVE, DIMENSION(2,2) :: MIMA, MIMB, MIMC
TYPE (IM), SAVE, DIMENSION(3,2) :: MIMD
TYPE (IM), SAVE, DIMENSION(2,3) :: MIME
TYPE (IM), SAVE, DIMENSION(3,3) :: MIMA2, MIMB2, MIMC2
! These are the complex multiple precision variables.
TYPE (ZM), SAVE :: M_X, M_Y, M_Z, MZM1, MZM2, MZM3, MZM4, MZM5, &
MZMV1(3), MZMV2(3), MZMV4(3), MZMV3(2), MZMV5(4), &
MZMA(2,3), MZMB(3,4), MZMC(2,4), MZMD(3,2), &
MZMA2(3,3), MZMB2(3,3), MZMC2(3,3), MZMA3(3,3)
! Declare and initialize some other multiple precision variables.
! These are in the internal form used in the basic arithmetic routines.
INTEGER :: MA, MB, MC, MD, ME, MP1, MP2, MP3, MP4, MP5, MLNSV2, MLNSV3, MLNSV5, MLNSV7
DATA MA, MB, MC, MD, ME, MP1, MP2, MP3, MP4, MP5, MLNSV2, MLNSV3, MLNSV5, MLNSV7 / 14 * -2 /
INTEGER :: ZA(2), ZB(2), ZC(2), ZD(2), ZE(2), ZP1(2), ZP2(2), ZP3(2), ZP4(2), ZP5(2), ML(2)
DATA ZA, ZB, ZC, ZD, ZE, ZP1, ZP2, ZP3, ZP4, ZP5 / 20 * -2 /
! These are the variables that are not multiple precision.
INTEGER, SAVE :: J1, J2, J3, J4, J5, JV(3), JV2(3,3)
REAL, SAVE :: R1, R2, R3, R4, R5, RSMALL, RV(3), RV2(3,3)
DOUBLE PRECISION, SAVE :: D1, D2, D3, D4, D5, DSMALL, DV(3), DV2(3,3)
COMPLEX, SAVE :: C1, C2, C3, C4, C5, CV(3), CV2(3,3)
COMPLEX (KIND(0.0D0)), SAVE :: CD1, CD2, CD3, CD4, CDV(3), CDV2(3,3)
CHARACTER(80), SAVE :: ST1, ST2, STRING, STV(3), STV2(3,3)
CHARACTER(160), SAVE :: STZ1, STZ2
CHARACTER, SAVE :: LINE(10), LINE2(80), LINE3(160)
INTEGER, SAVE :: I, IREM, J, JERR, JEXP, K, KLOG, L1, L2, KST, KWSAVE, &
NCASE, NDGSAV, NERROR, NSTACK(49), SEED(7)
REAL, SAVE :: TIME1, TIME2
LOGICAL, EXTERNAL :: FMCOMP, FMCOMPARE, FPCOMP, FPCOMPARE, &
IMCOMP, IMCOMPARE, IPCOMP, IPCOMPARE
END MODULE TEST_VARS
MODULE TEST_A
USE TEST_VARS
INTERFACE POWER
MODULE PROCEDURE POWER_FM
MODULE PROCEDURE POWER_IM
MODULE PROCEDURE POWER_ZM
END INTERFACE
INTERFACE MATRIX_PRODUCT
MODULE PROCEDURE MATRIX_PRODUCT_FM
MODULE PROCEDURE MATRIX_PRODUCT_IM
MODULE PROCEDURE MATRIX_PRODUCT_ZM
END INTERFACE
INTERFACE MATRIX_SQUARE
MODULE PROCEDURE MATRIX_SQUARE_FM
MODULE PROCEDURE MATRIX_SQUARE_IM
MODULE PROCEDURE MATRIX_SQUARE_ZM
END INTERFACE
CONTAINS
SUBROUTINE TEST1
! Input and output testing.
IMPLICIT NONE
WRITE (KW,"(/' Testing input and output routines.')")
! NCASE is the number of the case being tested.
NCASE = 1
CALL FMST2M('123',MA)
CALL FMI2M(123,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
! Use the .NOT. because FMCOMPARE returns FALSE for special cases like MD = UNKNOWN,
! and these should be treated as errors for these tests.
IF (.NOT.FMCOMPARE(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 2
ST1 = '1.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMI2M(131,MB)
CALL FMI2M(97,MC)
CALL FMDIV(MB,MC,ME)
CALL FMEQ(ME,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMPARE(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 3
ST1 = '1.3505154639175257731958762886597938144329896907216495E-2'
CALL FMST2M(ST1,MA)
CALL FMI2M(131,MB)
CALL FMI2M(9700,MC)
CALL FMDIV(MB,MC,ME)
CALL FMEQ(ME,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-52',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMST2M',MA,'MA',MC,'MC',MD,'MD')
ENDIF
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF ((.NOT.FMCOMP(MD,'LE',MB)) .OR. ST1 /= ST2) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 8
ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
CALL FMST2M(ST1,MA)
CALL FMFORM('ES54.45',MA,ST2)
CALL FMST2M(ST2,MA)
ST1 = '-1.350515463917525773195876288659793814432989691M+16'
CALL FMST2M(ST1,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 9
ST1 ='-1.3505154639175257731958762886597938144329896907216495E+16'
CALL FMST2M(ST1,MA)
CALL FMFORM('1PE54.45',MA,ST2)
CALL FMST2M(ST2,MA)
ST1 = '-1.350515463917525773195876288659793814432989691M+16'
CALL FMST2M(ST1,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMFORM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
CALL FM_SETVAR(' MBASE = 10000 ')
CALL FM_SETVAR(' NDIG = 7 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 10
STZ1 = '0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 11
STZ1 = '0.12345678901234567890123456785'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 12
STZ1 = '0.12345678901234567890123456785'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 13
STZ1 = '0.12345678901234567890123456775'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 14
STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345679'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 15
STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 16
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 17
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 18
STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 19
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 20
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 21
STZ1 = '0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 22
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 23
STZ1 = '0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 24
STZ1 = '-0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 25
STZ1 = '-0.12345678901234567890123456785'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 26
STZ1 = '-0.12345678901234567890123456785'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 27
STZ1 = '-0.12345678901234567890123456775'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 28
STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345679'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 29
STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 30
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 31
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 32
STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 33
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 34
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345678'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 35
STZ1 = '-0.123456789012345678901234567799999999999999999999999999999999999999999999999999999'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 36
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000000'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 37
STZ1 = '-0.12345678901234567890123456770000000000000000000000000000000000000000000000000001'
M_C = TO_FM(STZ1)
STZ1 = '-0.1234567890123456789012345677'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 1 ')
CALL FM_SETVAR(' MBASE = 2 ')
CALL FM_SETVAR(' NDIG = 53 ')
NCASE = 38
STZ1 = '0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 39
STZ1 = '0.9'
M_C = TO_FM(STZ1)
STZ1 = '0.90000000000000002220446049250313080847263336181640625'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 40
STZ1 = '0.900000000000000077715611723760957829654216766357421875'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 41
STZ1 = '0.900000000000000077715611723760957829654216766357421875000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 42
STZ1 = '0.900000000000000077715611723760957829654216766357421874999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 43
STZ1 = '0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 44
STZ1 = '0.9'
M_C = TO_FM(STZ1)
STZ1 = '0.90000000000000002220446049250313080847263336181640625'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 45
STZ1 = '0.900000000000000022204460492503130808472633361816406250000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(9)/10 , TO_FM(1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 46
STZ1 = '0.900000000000000022204460492503130808472633361816406249999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 47
STZ1 = '0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 48
STZ1 = '0.9'
M_C = TO_FM(STZ1)
STZ1 = '0.899999999999999911182158029987476766109466552734375'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 49
STZ1 = '0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 50
STZ1 = '0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(9)/10 , TO_FM(-1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 51
STZ1 = '0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 52
STZ1 = '0.9'
M_C = TO_FM(STZ1)
STZ1 = '0.899999999999999911182158029987476766109466552734375'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 53
STZ1 = '0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = TO_FM(9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 54
STZ1 = '0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(9)/10 , TO_FM(-1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 55
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 56
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
STZ1 = '-0.90000000000000002220446049250313080847263336181640625'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 57
STZ1 = '-0.900000000000000077715611723760957829654216766357421875'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 58
STZ1 = '-0.900000000000000077715611723760957829654216766357421875000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 59
STZ1 = '-0.900000000000000077715611723760957829654216766357421874999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 60
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 61
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
STZ1 = '-0.899999999999999911182158029987476766109466552734375'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 62
STZ1 = '-0.899999999999999911182158029987476766109466552734375000000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 63
STZ1 = '-0.899999999999999911182158029987476766109466552734374999999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(-9)/10 , TO_FM(1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 64
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 65
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
STZ1 = '-0.90000000000000002220446049250313080847263336181640625'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 66
STZ1 = '-0.90000000000000002220446049250313080847263336181640625000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(-9)/10 , TO_FM(-1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 67
STZ1 = '-0.90000000000000002220446049250313080847263336181640624999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 68
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 69
STZ1 = '-0.9'
M_C = TO_FM(STZ1)
STZ1 = '-0.899999999999999911182158029987476766109466552734375'
M_D = TO_FM(STZ1)
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 70
STZ1 = '-0.8999999999999999111821580299874767661094665527343749999999999999999999999999999'
M_C = TO_FM(STZ1)
M_D = NEAREST( TO_FM(-9)/10 , TO_FM(1) )
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 71
STZ1 = '-0.8999999999999999111821580299874767661094665527343750000000000000000000000000001'
M_C = TO_FM(STZ1)
M_D = TO_FM(-9)/10
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Input',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FM_SETVAR(' MBASE = 10000 ')
CALL FM_SETVAR(' NDIG = 25 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 72
STZ1 = '0.1234567890123456'
M_A = TO_FM(STZ1)
CALL FM_FORM('F20.14',M_A,ST1)
WRITE (ST2,"(F20.14)") TO_DP(M_A)
K = INDEX(ST2,'0.')
IF (K > 0) ST2(K:K) = ' '
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 73
STZ1 = '3.1234567890123456'
M_A = TO_FM(STZ1)
CALL FM_FORM('F20.14',M_A,ST1)
WRITE (ST2,"(F20.14)") TO_DP(M_A)
K = INDEX(ST2,'0.')
IF (K > 0) ST2(K:K) = ' '
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 74
STZ1 = '-3.1234567890123456'
M_A = TO_FM(STZ1)
CALL FM_FORM('F20.13',M_A,ST1)
WRITE (ST2,"(F20.13)") TO_DP(M_A)
K = INDEX(ST2,'0.')
IF (K > 0) ST2(K:K) = ' '
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 75
STZ1 = '3.1234567890123456e4'
M_A = TO_FM(STZ1)
CALL FM_FORM('E25.14',M_A,ST1)
WRITE (ST2,"(E25.14)") TO_DP(M_A)
K = INDEX(ST2,'E+05')
IF (K > 0) ST2(K:K+3) = 'M+5 '
K = INDEX(ST2,'0.')
IF (K > 0) THEN
STZ2 = ST2(K+1:30)
ST2(2:31) = STZ2(1:30)
ENDIF
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 76
STZ1 = '-3.1234567890123456e4'
M_A = TO_FM(STZ1)
CALL FM_FORM('E25.13',M_A,ST1)
WRITE (ST2,"(E25.13)") TO_DP(M_A)
K = INDEX(ST2,'E+05')
IF (K > 0) ST2(K:K+3) = 'M+5 '
K = INDEX(ST2,'-0.')
IF (K > 0) THEN
ST2(K:K+1) = ' -'
STZ2 = ST2(K+1:31)
ST2(1:30) = STZ2(1:30)
ENDIF
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 77
STZ1 = '3.1234567890123456e4'
M_A = TO_FM(STZ1)
CALL FM_FORM('ES25.14',M_A,ST1)
WRITE (ST2,"(ES25.14)") TO_DP(M_A)
K = INDEX(ST2,'E+04')
IF (K > 0) ST2(K:K+3) = 'M+4 '
K = INDEX(ST2,'3.')
IF (K > 0) THEN
STZ2 = ST2(K:30)
ST2(2:31) = STZ2(1:30)
ENDIF
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 78
STZ1 = '-3.1234567890123456e4'
M_A = TO_FM(STZ1)
CALL FM_FORM('ES25.13',M_A,ST1)
WRITE (ST2,"(ES25.13)") TO_DP(M_A)
K = INDEX(ST2,'E+04')
IF (K > 0) ST2(K:K+3) = 'M+4 '
K = INDEX(ST2,'-3.')
IF (K > 0) THEN
STZ2 = ST2(K:31)
ST2(1:30) = STZ2(1:30)
ENDIF
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 79
STZ1 = '0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 80
STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 81
STZ1 = '0.123456789012345678901234567850000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 82
STZ1 = '0.123456789012345678901234567750000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 83
STZ1 = '0.12345678901234567890123456749999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 84
STZ1 = '0.12345678901234567890123456750000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 85
STZ1 = '0.12345678901234567890123456750000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 86
STZ1 = '0.12345678901234567890123456650000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234566'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 87
STZ1 = '-0.123456789012345678901234567849999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 88
STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 89
STZ1 = '-0.123456789012345678901234567850000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 90
STZ1 = '-0.123456789012345678901234567750000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 91
STZ1 = '-0.12345678901234567890123456749999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 92
STZ1 = '-0.12345678901234567890123456750000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 93
STZ1 = '-0.12345678901234567890123456750000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 94
STZ1 = '-0.12345678901234567890123456650000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234566'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SETVAR(' MBASE = 10000 ')
CALL FM_SETVAR(' NDIG = 25 ')
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 95
STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 96
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 97
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 98
STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 99
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 100
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 101
STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 102
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 103
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 104
STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 105
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 106
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SETVAR(' MBASE = 10000 ')
CALL FM_SETVAR(' NDIG = 25 ')
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 107
STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 108
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 109
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 110
STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 111
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 112
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 113
STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 114
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345679'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 115
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 116
STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 117
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234568'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 118
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SETVAR(' MBASE = 10000 ')
CALL FM_SETVAR(' NDIG = 25 ')
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 119
STZ1 = '0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 120
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 121
STZ1 = '0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' .1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 122
STZ1 = '0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 123
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 124
STZ1 = '0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' .123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 125
STZ1 = '-0.123456789012345678901234567899999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 126
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 127
STZ1 = '-0.123456789012345678901234567800000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F35.28',M_A,ST1)
ST2 = ' -.1234567890123456789012345678'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 128
STZ1 = '-0.12345678901234567890123456799999999999999999999999999999999999999999999999999999'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 129
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000001'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 130
STZ1 = '-0.12345678901234567890123456700000000000000000000000000000000000000000000000000000'
M_A = TO_FM(STZ1)
CALL FM_FORM('F34.27',M_A,ST1)
ST2 = ' -.123456789012345678901234567'
ST2 = ' '//ST2
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SETVAR(' MBASE = 2 ')
CALL FM_SETVAR(' NDIG = 53 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 131
M_A = TO_FM('6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.13',M_A,ST1)
ST2 = ' .7700366561890M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 132
M_A = TO_FM('-6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.13',M_A,ST1)
ST2 = '-.7700366561890M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 133
M_A = TO_FM('6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = ' .77003665618896M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 134
M_A = TO_FM('-6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = '-.77003665618895M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 135
M_A = TO_FM('6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = ' .77003665618895M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 136
M_A = TO_FM('-6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = '-.77003665618896M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 137
M_A = TO_FM('6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = ' .77003665618895M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 138
M_A = TO_FM('-6965949469487146') * TO_FM(2)**(-249)
CALL FM_FORM('E25.14',M_A,ST1)
ST2 = '-.77003665618895M-59'
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 139
CALL FMSETVAR(' KROUND = 1 ')
M_A = TO_FM('1.2e+44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' +OVERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 140
M_A = TO_FM('-1.2e+44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' -OVERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 141
M_A = TO_FM('1.2e-44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' +UNDERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 142
M_A = TO_FM('-1.2e-44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' -UNDERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SET(50)
NCASE = 143
M_A = TO_FM('1.2e+44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' +OVERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 144
M_A = TO_FM('-1.2e+44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' -OVERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 145
M_A = TO_FM('1.2e-44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' +UNDERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
NCASE = 146
M_A = TO_FM('-1.2e-44444444444444444444444444444444444444444444444444444444444')
CALL FM_FORM('E25.14',M_A,ST1)
M_B = TO_FM(' -UNDERFLOW ')
CALL FM_FORM('E25.14',M_B,ST2)
IF (.NOT.(ST1 == ST2)) CALL ERRPRT_STR(ST1,ST2)
CALL FM_SET(50)
RETURN
END SUBROUTINE TEST1
SUBROUTINE TEST2
! Test add and subtract.
IMPLICIT NONE
WRITE (KW,"(/' Testing add and subtract routines.')")
NCASE = 147
CALL FMST2M('123',MA)
CALL FMST2M('789',MB)
CALL FMADD(MA,MB,ME)
CALL FMEQ(ME,MA)
CALL FMI2M(912,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMADD ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 148
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMADD(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '1.0824742268041237113402061855670103092783505154639175'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMADD ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 149
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMSUB(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '-.3814432989690721649484536082474226804123711340206185'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSUB ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 150
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.3505154639175257731443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMSUB(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '5.15463917525773195876288659793815M-20'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSUB ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 151
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMADDI',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 152
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,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMADDI',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST2
SUBROUTINE TEST3
! Test multiply, divide and square root.
IMPLICIT NONE
CHARACTER(2000), SAVE :: STB
TYPE (FM), SAVE :: M_H1, M_H2
WRITE (KW,"(/' Testing multiply, divide and square root routines.')")
NCASE = 153
CALL FMST2M('123',MA)
CALL FMST2M('789',MB)
CALL FMMPY(MA,MB,ME)
CALL FMEQ(ME,MA)
CALL FMI2M(97047,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 154
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMMPY(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '0.2565628653416941226485280051014985652035285365075991'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 155
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMDIV(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '0.4788732394366197183098591549295774647887323943661972'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMDIV ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 156
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MA)
CALL FMMPYI(MA,14,ME)
CALL FMEQ(ME,MA)
ST2 = '10.2474226804123711340206185567010309278350515463917526'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMMPYI',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 157
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MA)
CALL FMDIVI(MA,24,ME)
CALL FMEQ(ME,MA)
ST2 = '0.0304982817869415807560137457044673539518900343642612'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMDIVI',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 158
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSQR(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.1228610904453183122542246784993091720692953555106813'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSQR ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 159
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSQRT(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.5920434645509785316136003710368759268547372945659987'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSQRT',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 160
! Test allocate statements by a sequence of operations at increasing precision.
! Also test FM_ENTER_USER_FUNCTION and FM_EXIT_USER_FUNCTION.
CALL FMSET(500)
M_H1 = HARMONIC_SUM(150)
M_H2 = 1
DO J = 2, 150
M_H2 = M_H2 + 1/TO_FM(J)
ENDDO
MFM3 = ABS(M_H2 - M_H1)
CALL FM_ST2M(' 1.0E-495 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 161
MFM3 = M_H1*10**6
CALL FM_FORM("I750",MFM3,STB(1:800))
MFM3 = NINT(M_H1*10**6)
MFM3 = ABS(MFM3 - TO_FM(STB(1:800)))
IF (.NOT.(MFM3 == 0)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 162
MFM3 = M_H1*10**6
CALL FM_FORM("F902.900",MFM3,STB(1:910))
MFM3 = M_H1*10**6
MFM3 = ABS(MFM3 - TO_FM(STB(1:910)))
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 163
MZM3 = M_H1*10**6
CALL ZM_FORM("F902.900","F902.900",MZM3,STB(1:1820))
MZM3 = M_H1*10**6
MFM3 = ABS(MZM3 - TO_ZM(STB(1:1820)))
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
CALL FMSET(50)
NCASE = 164
MFM3 = 200
MFM3 = FACTORIAL(MFM3)
MFM4 = FACTORIAL2(200)
MFM5 = ABS((MFM3-MFM4)/MFM3)
IF (.NOT.(MFM5 < 1.0D-50)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 165
MFM3 = 200
MFM3 = FACTORIAL(MFM3)
MIM4 = I_FACTORIAL(200)
MFM5 = ABS((MFM3-MIM4)/MFM3)
IF (.NOT.(MFM5 < 1.0D-50)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 166
MFM3 = 200
MFM4 = 99
MFM3 = BINOMIAL(MFM3,MFM4)
MZM4 = Z_FACTORIAL(200) / ( Z_FACTORIAL(99) * Z_FACTORIAL(101) )
MFM5 = ABS((MFM3-MZM4)/MFM3)
IF (.NOT.(MFM5 < 1.0D-50)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 167
MIM3 = BINOMIAL(52,7)
MIM4 = FACTORIAL(52) / ( FACTORIAL(7) * FACTORIAL(45) )
IF (.NOT.(MIM3 == MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 168
MIM3 = 200
MIM4 = 99
MIM3 = BINOMIAL(MIM3,MIM4)
MIM4 = FACTORIAL(200) / ( FACTORIAL(99) * FACTORIAL(101) )
IF (.NOT.(MIM3 == MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 169
MIM3 = 5000
MIM4 = 1000
MIM5 = BINOMIAL(MIM3,MIM4)
MFM4 = BINOMIAL(TO_FM(MIM3),TO_FM(MIM4))
IF (.NOT.(TO_FM(MIM5) == MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 170
MIM3 = TO_IM(' 1e+20 ')
MIM4 = 10
MIM5 = BINOMIAL(MIM3,MIM4)
MFM4 = BINOMIAL(TO_FM(MIM3),TO_FM(MIM4))
IF (.NOT.(TO_FM(MIM5) == MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 171
MIM3 = TO_IM(' 1e+20 ')
MIM4 = 10
CALL IM_COMB(MIM3,MIM4,MIM5)
MFM4 = BINOMIAL(TO_FM(MIM3),TO_FM(MIM4))
IF (.NOT.(TO_FM(MIM5) == MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 172
MIM3 = TO_IM(' 1e+20 ')
MIM4 = 100
MIM5 = BINOMIAL(MIM3,MIM4)
MFM4 = BINOMIAL(TO_FM(MIM3),TO_FM(MIM4))
IF (.NOT.(TO_FM(MIM5) == MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 173
CALL H_SUM(TO_FM(0),1,150,MFM3)
MFM4 = HARMONIC_SUM(150)
MFM5 = ABS((MFM3-MFM4)/MFM3)
IF (.NOT.(MFM5 < 1.0D-50)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 174
MFMA(1,1:3) = (/ 3 , 1 , 4 /)
MFMA(2,1:3) = (/ 1 , 5 , 9 /)
MFMA(3,1:3) = (/ 2 , 6 , 5 /)
MFMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /)
DO K = 1, 5
MFMV1 = POWER(MFMA,MFMV1)
ENDDO
MFMV2 = (/ TO_FM(' 3.1542643547290503520828034216804200150468262227735M-1 ') , &
TO_FM(' 7.2306108656733102850197507313845978717562385025770M-1 ') , &
TO_FM(' 6.1456393393765623787137563007322207735298613009209M-1 ') /)
MFM5 = SQRT(DOT_PRODUCT(MFMV2-MFMV1,MFMV2-MFMV1))
IF (.NOT.(MFM5 < 1.0D-20)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 175
MIMA2(1,1:3) = (/ 3 , 1 , 4 /)
MIMA2(2,1:3) = (/ 1 , 5 , 9 /)
MIMA2(3,1:3) = (/ 2 , 6 , 5 /)
MIMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /) * 1.0D+20
DO K = 1, 5
MIMV1 = POWER(MIMA2,MIMV1)
ENDDO
MIMV2 = (/ TO_IM(' 31542643547290503520 ') , &
TO_IM(' 72306108656733102850 ') , &
TO_IM(' 61456393393765623787 ') /)
MFM5 = SQRT(TO_FM(DOT_PRODUCT(MIMV2-MIMV1,MIMV2-MIMV1)))
IF (.NOT.(MFM5 < 1.0D+10)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 176
MZMA2(1,1:3) = (/ 3 , 1 , 4 /)
MZMA2(2,1:3) = (/ 1 , 5 , 9 /)
MZMA2(3,1:3) = (/ 2 , 6 , 5 /)
MZMV1(1:3) = (/ 3.15D0 , 7.23D0 , 6.14D0 /)
MZMV1 = MZMV1 + TO_ZM(' 1E-3 i ')
DO K = 1, 5
MZMV1 = POWER(MZMA2,MZMV1)
ENDDO
MZMV2 = (/ TO_ZM(' 3.1542643130468500872641541678834676897138030382982M-1 +' // &
' 5.1278981926487839881349589767671081443509643262661M-5 i ') , &
TO_ZM(' 7.2306107701240042517092650862644370372071840430102M-1 +' // &
' 1.1754827305696904820108498770289645838406851701631M-4 i ') , &
TO_ZM(' 6.1456392581646724129324988735501670763785588781979M-1 +' // &
' 9.9909857541381365264205184957852886329504658229615M-5 i ') /)
MFM5 = SQRT(ABS(DOT_PRODUCT(MZMV2-MZMV1,MZMV2-MZMV1)))
IF (.NOT.(MFM5 < 1.0D-20)) THEN
CALL PRTERR(KWSAVE)
ENDIF
RETURN
END SUBROUTINE TEST3
FUNCTION HARMONIC_SUM(N)
USE FMZM
IMPLICIT NONE
TYPE (FM) :: HARMONIC_SUM
TYPE (FM), SAVE :: T(500)
INTEGER :: J,N
CALL FM_ENTER_USER_FUNCTION(HARMONIC_SUM)
DO J = 1, N
T(J) = 1/TO_FM(J)
ENDDO
HARMONIC_SUM = 0
DO J = 1, N
HARMONIC_SUM = HARMONIC_SUM + T(J)
ENDDO
CALL FM_EXIT_USER_FUNCTION(HARMONIC_SUM)
END FUNCTION HARMONIC_SUM
FUNCTION FACTORIAL2(N)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (FM) :: FACTORIAL2
TYPE (FM), SAVE :: LOW_PREC, ERR
INTEGER :: J,N,ND1,ND2
CALL FM_ENTER_USER_FUNCTION(FACTORIAL2)
FACTORIAL2 = 1
DO J = 2, N
FACTORIAL2 = J*FACTORIAL2
ENDDO
! Raise precision and compute the error in the first factorial.
ND1 = NDIG
CALL FM_SET(100)
ND2 = NDIG
CALL FM_EQU(FACTORIAL2,LOW_PREC,ND1,ND2)
FACTORIAL2 = 1
DO J = 2, N
FACTORIAL2 = J*FACTORIAL2
ENDDO
ERR = ABS( (FACTORIAL2-LOW_PREC) / FACTORIAL2 )
IF (ERR > 1.0D-50) WRITE (*,*) ' Error is too high in FACTORIAL2.'
CALL FM_SET(50)
FACTORIAL2 = LOW_PREC
CALL FM_EXIT_USER_FUNCTION(FACTORIAL2)
END FUNCTION FACTORIAL2
FUNCTION I_FACTORIAL(N)
USE FMZM
IMPLICIT NONE
TYPE (IM) :: I_FACTORIAL
INTEGER :: J,N
CALL FM_ENTER_USER_FUNCTION(I_FACTORIAL)
I_FACTORIAL = 1
DO J = 2, N
I_FACTORIAL = J*I_FACTORIAL
ENDDO
CALL FM_EXIT_USER_FUNCTION(I_FACTORIAL)
END FUNCTION I_FACTORIAL
FUNCTION Z_FACTORIAL(N)
USE FMVALS
USE FMZM
IMPLICIT NONE
! This complex "factorial" is equal to N! * (1+i)^N.
! For the complex "binomial", the result is always the same as the real binomial.
TYPE (ZM) :: Z_FACTORIAL
TYPE (ZM), SAVE :: TERM, LOW_PREC
TYPE (FM), SAVE :: ERR
INTEGER :: J,N,ND1,ND2
CALL FM_ENTER_USER_FUNCTION(Z_FACTORIAL)
Z_FACTORIAL = CMPLX( TO_FM('1.0D0') , TO_FM('0.0D0') )
TERM = CMPLX( TO_FM('0.0D0') , TO_FM('0.0D0') )
DO J = 1, N
TERM = TERM + CMPLX( TO_FM('1.0D0') , TO_FM('1.0D0') )
Z_FACTORIAL = TERM*Z_FACTORIAL
ENDDO
! Raise precision and compute the error in the first factorial.
ND1 = NDIG
CALL FM_SET(100)
ND2 = NDIG
CALL ZM_EQU(Z_FACTORIAL,LOW_PREC,ND1,ND2)
Z_FACTORIAL = CMPLX( TO_FM('1.0D0') , TO_FM('0.0D0') )
TERM = CMPLX( TO_FM('0.0D0') , TO_FM('0.0D0') )
DO J = 1, N
TERM = TERM + CMPLX( TO_FM('1.0D0') , TO_FM('1.0D0') )
Z_FACTORIAL = TERM*Z_FACTORIAL
ENDDO
ERR = ABS( (Z_FACTORIAL-LOW_PREC) / Z_FACTORIAL )
IF (ERR > 1.0D-50) WRITE (*,*) ' Error is too high in Z_FACTORIAL.'
CALL FM_SET(50)
Z_FACTORIAL = LOW_PREC
CALL FM_EXIT_USER_FUNCTION(Z_FACTORIAL)
END FUNCTION Z_FACTORIAL
SUBROUTINE H_SUM(START,J1,J2,RESULT)
USE FMZM
IMPLICIT NONE
TYPE (FM) :: START, RESULT
INTEGER :: J,J1,J2
CALL FM_ENTER_USER_ROUTINE
RESULT = START
DO J = J1, J2
RESULT = RESULT + TO_FM(1)/J
ENDDO
CALL FM_EXIT_USER_ROUTINE
END SUBROUTINE H_SUM
FUNCTION POWER_FM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (FM) :: A(3,3),X(3),POWER_FM(3)
CALL FM_ENTER_USER_FUNCTION(POWER_FM)
POWER_FM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)
! Normalize the eigenvector (L-2 norm).
POWER_FM = POWER_FM / SQRT( DOT_PRODUCT(POWER_FM,POWER_FM) )
CALL FM_EXIT_USER_FUNCTION(POWER_FM)
END FUNCTION POWER_FM
FUNCTION MATRIX_PRODUCT_FM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (FM) :: A(3,3),X(3),MATRIX_PRODUCT_FM(3)
TYPE (FM), SAVE :: X2(3),A2
INTEGER :: J,K
CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_FM)
! Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
! matmul by hand.
NDIG = 2*NDIG
DO J = 1, 3
MATRIX_PRODUCT_FM(J) = 0
DO K = 1, 3
CALL FM_EQU(A(J,K),A2,NDIG/2,NDIG)
CALL FM_EQU(X(K),X2(K),NDIG/2,NDIG)
MATRIX_PRODUCT_FM(J) = MATRIX_PRODUCT_FM(J) + A2*X2(K)
ENDDO
ENDDO
X2 = MATRIX_PRODUCT_FM
DO J = 1, 3
CALL FM_EQU(X2(J),MATRIX_PRODUCT_FM(J),NDIG,NDIG/2)
ENDDO
NDIG = NDIG/2
CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_FM)
END FUNCTION MATRIX_PRODUCT_FM
FUNCTION MATRIX_SQUARE_FM(A)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (FM) :: A(3,3),MATRIX_SQUARE_FM(3,3)
TYPE (FM), SAVE :: A2(3,3),ROW,COL
INTEGER :: J,K,L
CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_FM)
! Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
! matmul by hand.
NDIG = 2*NDIG
DO J = 1, 3
DO K = 1, 3
MATRIX_SQUARE_FM(J,K) = 0
DO L = 1, 3
CALL FM_EQU(A(J,L),ROW,NDIG/2,NDIG)
CALL FM_EQU(A(L,K),COL,NDIG/2,NDIG)
MATRIX_SQUARE_FM(J,K) = MATRIX_SQUARE_FM(J,K) + ROW*COL
ENDDO
ENDDO
ENDDO
A2 = MATRIX_SQUARE_FM
DO J = 1, 3
DO K = 1, 3
CALL FM_EQU(A2(J,K),MATRIX_SQUARE_FM(J,K),NDIG,NDIG/2)
ENDDO
ENDDO
NDIG = NDIG/2
CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_FM)
END FUNCTION MATRIX_SQUARE_FM
FUNCTION POWER_IM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (IM) :: A(3,3),X(3),POWER_IM(3)
CALL FM_ENTER_USER_FUNCTION(POWER_IM)
POWER_IM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)
! Normalize the eigenvector (L-2 norm).
POWER_IM = POWER_IM / ( TO_FM('1e-20') * SQRT( TO_FM( DOT_PRODUCT(POWER_IM,POWER_IM) ) ) )
CALL FM_EXIT_USER_FUNCTION(POWER_IM)
END FUNCTION POWER_IM
FUNCTION MATRIX_PRODUCT_IM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (IM) :: A(3,3),X(3),MATRIX_PRODUCT_IM(3)
INTEGER :: J,K
CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_IM)
! Test the move logic in FM_EXIT_USER_FUNCTION by doing matmul by hand.
DO J = 1, 3
MATRIX_PRODUCT_IM(J) = 0
DO K = 1, 3
MATRIX_PRODUCT_IM(J) = MATRIX_PRODUCT_IM(J) + A(J,K)*X(K)
ENDDO
ENDDO
CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_IM)
END FUNCTION MATRIX_PRODUCT_IM
FUNCTION MATRIX_SQUARE_IM(A)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (IM) :: A(3,3),MATRIX_SQUARE_IM(3,3)
INTEGER :: J,K,L
CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_IM)
! Test the move logic in FM_EXIT_USER_FUNCTION by setting element 2,3 to a large value.
MATRIX_SQUARE_IM(2,3) = TO_IM(10)**100
DO J = 1, 3
DO K = 1, 3
MATRIX_SQUARE_IM(J,K) = 0
DO L = 1, 3
MATRIX_SQUARE_IM(J,K) = MATRIX_SQUARE_IM(J,K) + A(J,L)*A(L,K)
ENDDO
ENDDO
ENDDO
CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_IM)
END FUNCTION MATRIX_SQUARE_IM
FUNCTION POWER_ZM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (ZM) :: A(3,3),X(3),POWER_ZM(3)
CALL FM_ENTER_USER_FUNCTION(POWER_ZM)
POWER_ZM = MATRIX_PRODUCT(MATRIX_SQUARE(A),X)
! Normalize the eigenvector (L-2 norm).
POWER_ZM = POWER_ZM / SQRT( DOT_PRODUCT(POWER_ZM,POWER_ZM) )
CALL FM_EXIT_USER_FUNCTION(POWER_ZM)
END FUNCTION POWER_ZM
FUNCTION MATRIX_PRODUCT_ZM(A,X)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (ZM) :: A(3,3),X(3),MATRIX_PRODUCT_ZM(3)
TYPE (ZM), SAVE :: X2(3),A2
INTEGER :: J,K
CALL FM_ENTER_USER_FUNCTION(MATRIX_PRODUCT_ZM)
! Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
! matmul by hand.
NDIG = 2*NDIG
DO J = 1, 3
MATRIX_PRODUCT_ZM(J) = 0
DO K = 1, 3
CALL ZM_EQU(A(J,K),A2,NDIG/2,NDIG)
CALL ZM_EQU(X(K),X2(K),NDIG/2,NDIG)
MATRIX_PRODUCT_ZM(J) = MATRIX_PRODUCT_ZM(J) + A2*X2(K)
ENDDO
ENDDO
X2 = MATRIX_PRODUCT_ZM
DO J = 1, 3
CALL ZM_EQU(X2(J),MATRIX_PRODUCT_ZM(J),NDIG,NDIG/2)
ENDDO
NDIG = NDIG/2
CALL FM_EXIT_USER_FUNCTION(MATRIX_PRODUCT_ZM)
END FUNCTION MATRIX_PRODUCT_ZM
FUNCTION MATRIX_SQUARE_ZM(A)
USE FMVALS
USE FMZM
IMPLICIT NONE
TYPE (ZM) :: A(3,3),MATRIX_SQUARE_ZM(3,3)
TYPE (ZM), SAVE :: A2(3,3),ROW,COL
INTEGER :: J,K,L
CALL FM_ENTER_USER_FUNCTION(MATRIX_SQUARE_ZM)
! Test the move logic in FM_EXIT_USER_FUNCTION by raising precision and doing
! matmul by hand.
NDIG = 2*NDIG
DO J = 1, 3
DO K = 1, 3
MATRIX_SQUARE_ZM(J,K) = 0
DO L = 1, 3
CALL ZM_EQU(A(J,L),ROW,NDIG/2,NDIG)
CALL ZM_EQU(A(L,K),COL,NDIG/2,NDIG)
MATRIX_SQUARE_ZM(J,K) = MATRIX_SQUARE_ZM(J,K) + ROW*COL
ENDDO
ENDDO
ENDDO
A2 = MATRIX_SQUARE_ZM
DO J = 1, 3
DO K = 1, 3
CALL ZM_EQU(A2(J,K),MATRIX_SQUARE_ZM(J,K),NDIG,NDIG/2)
ENDDO
ENDDO
NDIG = NDIG/2
CALL FM_EXIT_USER_FUNCTION(MATRIX_SQUARE_ZM)
END FUNCTION MATRIX_SQUARE_ZM
SUBROUTINE TEST4
! Test stored constants.
IMPLICIT NONE
WRITE (KW,"(/' Testing stored constants.'//' Check e.'/)")
! Switch to base 10 and check the stored digits.
M_VAL = MBASE
NDGSAV = NDIG
NCASE = 177
CALL FMSETVAR(' MBASE = 1000 ')
CALL FMSETVAR(' NDIG = 55 ')
CALL FMCONS
CALL FMI2M(1,MB)
CALL FMEXP(MB,MC)
DO J = 49, 51
NDIG = J
NDIGE = 0
CALL FMI2M(1,MB)
CALL FMEXP(MB,MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J + 1
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' e ',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
NCASE = 178
CALL FM_SETVAR(' MBASE = 1000 ')
CALL FM_SETVAR(' NDIG = 55 ')
CALL FMI2M(2,MB)
CALL FMLN(MB,MC)
CALL FMEQ(MLN2,MLNSV2)
CALL FMEQ(MLN3,MLNSV3)
CALL FMEQ(MLN5,MLNSV5)
CALL FMEQ(MLN7,MLNSV7)
WRITE (KW,"(' Check ln(2).'/)")
DO J = 49, 51
NDIG = J
NDIGLI = 0
CALL FMI2M(2,MB)
CALL FMLN(MB,MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' ln(2)',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
NCASE = 179
CALL FMSETVAR(' MBASE = 1000 ')
CALL FMSETVAR(' NDIG = 55 ')
WRITE (KW,"(' Check ln(3).'/)")
CALL FMEQ(MLNSV3,MC)
DO J = 49, 51
NDIG = J
NDIGLI = 0
CALL FMI2M(3,MB)
CALL FMLN(MB,MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J + 1
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' ln(3)',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
NCASE = 180
CALL FMSETVAR(' MBASE = 1000 ')
CALL FMSETVAR(' NDIG = 55 ')
WRITE (KW,"(' Check ln(5).'/)")
CALL FMEQ(MLNSV5,MC)
DO J = 49, 51
NDIG = J
NDIGLI = 0
CALL FMI2M(5,MB)
CALL FMLN(MB,MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J + 1
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' ln(5)',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
NCASE = 181
CALL FMSETVAR(' MBASE = 1000 ')
CALL FMSETVAR(' NDIG = 55 ')
WRITE (KW,"(' Check ln(7).'/)")
CALL FMEQ(MLNSV7,MC)
DO J = 49, 51
NDIG = J
NDIGLI = 0
CALL FMI2M(7,MB)
CALL FMLN(MB,MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J + 1
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' ln(7)',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
NCASE = 182
CALL FMSETVAR(' MBASE = 1000 ')
CALL FMSETVAR(' NDIG = 55 ')
WRITE (KW,"(' Check pi.')")
CALL FMPI(MC)
DO J = 49, 51
NDIG = J
NDIGPI = 0
CALL FMPI(MA)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMI2M(1000,MB)
JEXP = -J + 1
CALL FMIPOWER(MB,JEXP,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM(' pi ',MA,'MA',MC,'MC',MD,'MD')
EXIT
ENDIF
ENDDO
! Restore base and precision.
MBASE = M_VAL
NDIG = NDGSAV
CALL FMCONS
RETURN
END SUBROUTINE TEST4
SUBROUTINE TEST5
! Test exponentials.
IMPLICIT NONE
WRITE (KW,"(/' Testing exponential routines.')")
NCASE = 183
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMEXP(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.7043249420381570899426746185150096342459216636010743'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMEXP ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 184
ST1 = '5.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMEXP(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '210.7168868293979289717186453717687341395104929999527672'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-48',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMEXP ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 185
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMIPOWER(MA,13,ME)
CALL FMEQ(ME,MA)
ST2 = '1.205572620050170403854527299272882946980306577287581E-6'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-56',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMIPWR',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 186
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MA)
CALL FMIPOWER(MA,-1234,ME)
CALL FMEQ(ME,MA)
ST2 = '1.673084074011006302103793189789209370839697748745938E167'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E+120',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMIPWR',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 187
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMPOWER(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '0.4642420045002127676457665673753493595170650613692580'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMPWR ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 188
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '-34.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMPOWER(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '6.504461581246879800523526109766882955934341922848773E15'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-34',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMPWR ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 189
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMRATIONAL_POWER(MA,1,3,ME)
CALL FMEQ(ME,MA)
ST2 = '0.7050756680967220302067310420367584779561732592049823'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMRPWR',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 190
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MA)
CALL FMRATIONAL_POWER(MA,-17,5,ME)
CALL FMEQ(ME,MA)
ST2 = '2.8889864895853344043562747681699203201333872009477318'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMRPWR',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST5
SUBROUTINE TEST6
! Test logarithms.
IMPLICIT NONE
WRITE (KW,"(/' Testing logarithm routines.')")
NCASE = 191
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMLN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-1.0483504538872214324499548823726586101452117557127813'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMLN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 192
ST1 = '0.3505154639175257731958762886597938144329896907216495E123'
CALL FMST2M(ST1,MA)
CALL FMLN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '282.1696159843803977017629940438041389247902713456262947'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-47',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMLN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 193
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMLOG10(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.4552928172239897280304530226127473926500843247517120'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMLG10',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 194
CALL FMLNI(210,MA)
ST2 = '5.3471075307174686805185894350500696418856767760333836'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMLNI ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 195
CALL FMLNI(211,MA)
ST2 = '5.3518581334760664957419562654542801180411581735816684'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMLNI ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST6
SUBROUTINE TEST7
! Test trigonometric functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing trigonometric routines.')")
NCASE = 196
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.9391958366109693586000906984500978377093121163061328'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCOS ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 197
ST1 = '-43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.8069765551968063243992244125871029909816207609700968'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCOS ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 198
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSIN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3433819746180939949443652360333010581867042625893927'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSIN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 199
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSIN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.5905834736620182429243173169772978155668602154136946'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSIN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 200
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMTAN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3656127521360899712035823015565426347554405301360773'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMTAN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 201
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMTAN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.7318471272291003544610122296764031536071117330470298'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMTAN ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 202
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS_SIN(MA,ME,MC)
CALL FMEQ(ME,MA)
ST2 = '0.9391958366109693586000906984500978377093121163061328'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 203
ST1 = '-43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS_SIN(MA,ME,MC)
CALL FMEQ(ME,MA)
ST2 = '0.8069765551968063243992244125871029909816207609700968'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 204
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS_SIN(MA,MC,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3433819746180939949443652360333010581867042625893927'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 205
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOS_SIN(MA,MC,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.5905834736620182429243173169772978155668602154136946'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCSSN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST7
SUBROUTINE TEST8
! Test inverse trigonometric functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing inverse trigonometric routines.')")
NCASE = 206
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMACOS(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '1.2126748979730954046873545995574544481988102502510807'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMACOS',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 207
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMACOS(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '1.9289177556166978337752887837220484359983591491240252'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMACOS',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 208
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMASIN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3581214288218012145439670920822969938997744494364723'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMASIN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 209
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMASIN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3581214288218012145439670920822969938997744494364723'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMASIN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 210
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMATAN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3371339561772373443347761845672381725353758541616570'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMATAN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 211
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMATAN(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '1.5477326406586162039457549832092678908202994134569781'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMATAN',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST8
SUBROUTINE TEST9
! Test hyperbolic functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing hyperbolic routines.')")
NCASE = 212
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '1.0620620786534654254819884264931372964608741056397718'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCOSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 213
ST1 = '-43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-31',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCOSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 214
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSINH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3577371366153083355393138079781276622149524420386975'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSINH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 215
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMSINH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-31',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMSINH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 216
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMTANH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3368326049912874057089491946232983472275659538703038'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMTANH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 217
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMTANH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.9999999999999999999999999999999999999556135217341837'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMTANH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 218
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH_SINH(MA,ME,MC)
CALL FMEQ(ME,MA)
ST2 = '1.0620620786534654254819884264931372964608741056397718'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-49',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 219
ST1 = '-43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH_SINH(MA,ME,MC)
CALL FMEQ(ME,MA)
ST2 = '3.356291383454381441662669560464886179346554730604556E+18'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-31',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 220
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH_SINH(MA,MC,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3577371366153083355393138079781276622149524420386975'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 221
ST1 = '43.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMCOSH_SINH(MA,MC,ME)
CALL FMEQ(ME,MA)
ST2 = '3.356291383454381441662669560464886179197580776059111E+18'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-31',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMCHSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 222
ST1 = '1.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMACOSH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.8145682312133394569318859491699159033639601721643575'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMACSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 223
ST1 = '13.505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMACOSH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '3.2948450962476673647889189297232159569768145674952434'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMACSH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 224
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMASINH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3437080409009545560256440686372325145641850553599511'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMASNH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 225
ST1 = '-0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMASINH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.3437080409009545560256440686372325145641850553599511'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMASNH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 226
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMATANH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '0.3660312984048094281267903969406473770879220797066105'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMATNH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 227
ST1 = '-0.433505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
CALL FMATANH(MA,ME)
CALL FMEQ(ME,MA)
ST2 = '-0.464204949915171741212270022987181478095702210696769987'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMATNH',MA,'MA',MC,'MC',MD,'MD')
ENDIF
RETURN
END SUBROUTINE TEST9
SUBROUTINE TEST10
! Input and output testing for IM routines.
IMPLICIT NONE
WRITE (KW,"(/' Testing integer input and output routines.')")
NCASE = 228
CALL IMST2M('123',MA)
CALL IMI2M(123,MC)
IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMST2M',MA,'MA',MC,'MC')
ENDIF
NCASE = 229
ST1 = '-350515'
CALL IMST2M(ST1,MA)
CALL IMI2M(-350515,MC)
IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMST2M',MA,'MA',MC,'MC')
ENDIF
NCASE = 230
ST1 = '19895113660064588580108197261066338165074766609'
CALL IMST2M(ST1,MA)
CALL IMI2M(23,MB)
CALL IMI2M(34,MC)
CALL IMPOWER(MB,MC,ME)
CALL IMEQ(ME,MC)
IF (.NOT.IMCOMPARE(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
ENDIF
NCASE = 231
ST1 = '-20800708073664542533904165663516279809808659679033703'
CALL IMST2M(ST1,MA)
CALL IMI2M(-567,MB)
CALL IMI2M(19,MC)
CALL IMPOWER(MB,MC,ME)
CALL IMEQ(ME,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
ENDIF
NCASE = 232
ST1 = '19895113660064588580108197261066338165074766609'
CALL IMST2M(ST1,MA)
CALL IMFORM('I53',MA,ST2)
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMFORM',MA,'MA',MC,'MC')
ENDIF
NCASE = 233
ST1 = '-20800708073664542533904165663516279809808659679033703'
CALL IMST2M(ST1,MA)
CALL IMFORM('I73',MA,ST2)
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMFORM',MA,'MA',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST10
SUBROUTINE TEST11
! Test add and subtract for IM routines.
IMPLICIT NONE
WRITE (KW,"(/' Testing integer add and subtract routines.')")
NCASE = 234
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMADD(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(912,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMADD ',MA,'MA',MC,'MC')
ENDIF
NCASE = 235
ST1 = '3505154639175257731958762886597938144329896907216495'
CALL IMST2M(ST1,MA)
ST1 = '7319587628865979381443298969072164948453608247422680'
CALL IMST2M(ST1,MB)
CALL IMADD(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '10824742268041237113402061855670103092783505154639175'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMADD ',MA,'MA',MC,'MC')
ENDIF
NCASE = 236
ST1 = '3505154639175257731958762886597938144329896907216495'
CALL IMST2M(ST1,MA)
ST1 = '7319587628865979381443298969072164948453608247422680'
CALL IMST2M(ST1,MB)
CALL IMSUB(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '-3814432989690721649484536082474226804123711340206185'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMSUB ',MA,'MA',MC,'MC')
ENDIF
NCASE = 237
ST1 = '3505154639175257731958762886597938144329896907216495'
CALL IMST2M(ST1,MA)
ST1 = '3505154639175257731443298969072164948453608247422680'
CALL IMST2M(ST1,MB)
CALL IMSUB(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '515463917525773195876288659793815'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMSUB ',MA,'MA',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST11
SUBROUTINE TEST12
! Test integer multiply and divide.
IMPLICIT NONE
WRITE (KW,"(/' Testing integer multiply, divide and square routines.')")
NCASE = 238
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMMPY(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(97047,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPY ',MA,'MA',MC,'MC')
ENDIF
NCASE = 239
ST1 = '10430738374625018354698'
CALL IMST2M(ST1,MA)
ST1 = '2879494424799214514791045985'
CALL IMST2M(ST1,MB)
CALL IMMPY(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '30035252996271960952238822892375588336807158787530'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPY ',MA,'MA',MC,'MC')
ENDIF
NCASE = 240
CALL IMST2M('12347',MA)
CALL IMST2M('47',MB)
CALL IMDIV(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('262',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIV ',MA,'MA',MC,'MC')
ENDIF
NCASE = 241
ST1 = '2701314697583086005158008013691015597308949443159762'
CALL IMST2M(ST1,MA)
ST1 = '-978132616472842669976589722394'
CALL IMST2M(ST1,MB)
CALL IMDIV(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('-2761705981469115610382',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIV ',MA,'MA',MC,'MC')
ENDIF
NCASE = 242
CALL IMST2M('12368',MA)
CALL IMST2M('67',MB)
CALL IMMOD(MA,MB,ME)
CALL IMEQ(ME,MB)
CALL IMST2M('40',MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMMOD ',MB,'MB',MC,'MC')
ENDIF
NCASE = 243
ST1 = '2701314697583086005158008013691015597308949443159762'
CALL IMST2M(ST1,MA)
ST1 = '-978132616472842669976589722394'
CALL IMST2M(ST1,MB)
CALL IMMOD(MA,MB,ME)
CALL IMEQ(ME,MB)
CALL IMST2M('450750319653685523300198865254',MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMMOD ',MB,'MB',MC,'MC')
ENDIF
NCASE = 244
CALL IMST2M('1234',MA)
CALL IMST2M('17',MB)
CALL IMDIVR(MA,MB,MC,MD)
CALL IMEQ(MC,MA)
CALL IMEQ(MD,MB)
CALL IMST2M('72',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVR',MA,'MA',MC,'MC')
ENDIF
CALL IMST2M('10',MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVR',MB,'MB',MC,'MC')
ENDIF
NCASE = 245
ST1 = '34274652243817531418235301715935108945364446765801943'
CALL IMST2M(ST1,MA)
ST1 = '-54708769795848731641842224621693'
CALL IMST2M(ST1,MB)
CALL IMDIVR(MA,MB,MC,MD)
CALL IMEQ(MC,MA)
CALL IMEQ(MD,MB)
CALL IMST2M('-626492834178447772323',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVR',MA,'MA',MC,'MC')
ENDIF
CALL IMST2M('31059777254296217822749494999104',MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVR',MB,'MB',MC,'MC')
ENDIF
NCASE = 246
CALL IMST2M('4866',MA)
CALL IMMPYI(MA,14,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('68124',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPYI',MA,'MA',MC,'MC')
ENDIF
NCASE = 247
CALL IMST2M('270131469758308600515800801369101559730894',MA)
CALL IMMPYI(MA,-2895,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('-782030604950303398493243319963549015420938130',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPYI ',MA,'MA',MC,'MC')
ENDIF
NCASE = 248
CALL IMST2M('-37179',MA)
CALL IMDIVI(MA,129,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('-288',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVI',MA,'MA',MC,'MC')
ENDIF
NCASE = 249
ST1 = '8267538919383255454483790743961990401918726073065738'
CALL IMST2M(ST1,MA)
CALL IMDIVI(MA,1729,ME)
CALL IMEQ(ME,MA)
ST2 = '4781688212483085861471249707323302719444028960708'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDIVI',MA,'MA',MC,'MC')
ENDIF
NCASE = 250
CALL IMST2M('-71792',MA)
CALL IMDVIR(MA,65,MC,IREM)
CALL IMEQ(MC,MA)
CALL IMST2M('-1104',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDVIR',MA,'MA',MC,'MC')
ENDIF
CALL IMI2M(IREM,MB)
CALL IMI2M(-32,MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMDVIR',MB,'MB',MC,'MC')
ENDIF
NCASE = 251
ST1 = '97813261647284266997658972239417958580120170263408655'
CALL IMST2M(ST1,MA)
CALL IMDVIR(MA,826,MC,IREM)
CALL IMEQ(MC,MA)
ST2 = '118417992309060855929369215786220288837917881674828'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMDVIR',MA,'MA',MC,'MC')
ENDIF
CALL IMI2M(IREM,MB)
CALL IMI2M(727,MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMDVIR',MB,'MB',MC,'MC')
ENDIF
NCASE = 252
CALL IMST2M('538',MA)
CALL IMSQR(MA,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('289444',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMSQR ',MA,'MA',MC,'MC')
ENDIF
NCASE = 253
CALL IMST2M('-47818191879814587168242632',MA)
CALL IMSQR(MA,ME)
CALL IMEQ(ME,MA)
ST2 = '2286579474654765721668058416662636606051551222287424'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMSQR ',MA,'MA',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST12
SUBROUTINE TEST13
! Test conversions between FM and IM format.
IMPLICIT NONE
WRITE (KW,"(/' Testing conversions between FM and IM format.')")
NCASE = 254
CALL IMST2M('123',MA)
CALL IMI2FM(MA,MB)
CALL FMI2M(123,MC)
CALL FMSUB(MB,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'EQ',MB)) THEN
CALL ERRPRTFM('IMI2FM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 255
CALL IMST2M('979282999076598337488362000995916',MA)
CALL IMI2FM(MA,MB)
CALL FMST2M('979282999076598337488362000995916',MC)
CALL FMSUB(MB,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('0',MB)
IF (.NOT.FMCOMP(MD,'EQ',MB)) THEN
CALL ERRPRTFM('IMI2FM',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 256
CALL FMST2M('123.4',MA)
CALL IMFM2I(MA,MB)
CALL IMI2M(123,MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMFM2I',MB,'MB',MC,'MC')
ENDIF
NCASE = 257
CALL FMST2M('979282999076598337488362000995916',MA)
CALL IMFM2I(MA,MB)
CALL IMST2M('979282999076598337488362000995916',MC)
IF (.NOT.IMCOMP(MB,'EQ',MC)) THEN
CALL ERRPRTIM('IMFM2I',MB,'MB',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST13
SUBROUTINE TEST14
! Test integer power and GCD functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing integer GCD and power routines.')")
NCASE = 258
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMGCD(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(3,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
ENDIF
NCASE = 259
ST1 = '431134020618556701030927835051546391752577319587628885'
CALL IMST2M(ST1,MA)
ST1 = '900309278350515463917525773195876288659793814432989640'
CALL IMST2M(ST1,MB)
CALL IMGCD(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('615',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
ENDIF
NCASE = 260
ST1 = '5877631675869176172956662762822298812326084745145447940'
CALL IMST2M(ST1,MA)
ST1 = '10379997509886032090765062511740075746391432253007667'
CALL IMST2M(ST1,MB)
CALL IMGCD(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('1',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD ',MA,'MA',MC,'MC')
ENDIF
NCASE = 261
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMGCD2(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(3,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD2',MA,'MA',MC,'MC')
ENDIF
NCASE = 262
ST1 = '431134020618556701030927835051546391752577319587628885'
CALL IMST2M(ST1,MA)
ST1 = '900309278350515463917525773195876288659793814432989640'
CALL IMST2M(ST1,MB)
CALL IMGCD2(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('615',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD2',MA,'MA',MC,'MC')
ENDIF
NCASE = 263
ST1 = '5877631675869176172956662762822298812326084745145447940'
CALL IMST2M(ST1,MA)
ST1 = '10379997509886032090765062511740075746391432253007667'
CALL IMST2M(ST1,MB)
CALL IMGCD2(MA,MB,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('1',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMGCD2',MA,'MA',MC,'MC')
ENDIF
NCASE = 264
CALL IMST2M('47',MA)
CALL IMST2M('34',MB)
CALL IMPOWER(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '710112520079088427392020925014421733344154169313556279969'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
ENDIF
NCASE = 265
CALL IMST2M('2',MA)
CALL IMST2M('187',MB)
CALL IMPOWER(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '196159429230833773869868419475239575503198607639501078528'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
ENDIF
NCASE = 266
CALL IMST2M('-3',MA)
CALL IMST2M('101',MB)
CALL IMPOWER(MA,MB,ME)
CALL IMEQ(ME,MA)
ST2 = '-1546132562196033993109383389296863818106322566003'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPWR ',MA,'MA',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST14
SUBROUTINE TEST15
! Test integer modular functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing integer modular routines.')")
NCASE = 267
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMST2M('997',MC)
CALL IMMPY_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(338,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
ENDIF
NCASE = 268
ST1 = '431134020618556701030927835051546391752577319587628885'
CALL IMST2M(ST1,MA)
ST1 = '36346366019557973241042306587666640486264616086971724'
CALL IMST2M(ST1,MB)
ST1 = '900309278350515463917525773195876288659793814432989640'
CALL IMST2M(ST1,MC)
CALL IMMPY_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
ST2 = '458279704440780378752997531208983184411293504187816380'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
ENDIF
NCASE = 269
ST1 = '914726194238000125985765939883182'
CALL IMST2M(ST1,MA)
ST1 = '-75505764717193044779376979508186553225192'
CALL IMST2M(ST1,MB)
ST1 = '18678872625055834600521936'
CALL IMST2M(ST1,MC)
CALL IMMPY_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
ST2 = '-7769745969769966093344960'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMMPYM',MA,'MA',MC,'MC')
ENDIF
NCASE = 270
CALL IMST2M('123',MA)
CALL IMST2M('789',MB)
CALL IMST2M('997',MC)
CALL IMPOWER_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
CALL IMI2M(240,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
ENDIF
NCASE = 271
ST1 = '431134020618556701030927835051546391752577319587628885'
CALL IMST2M(ST1,MA)
ST1 = '36346366019557973241042306587666640486264616086971724'
CALL IMST2M(ST1,MB)
ST1 = '900309278350515463917525773195876288659793814432989640'
CALL IMST2M(ST1,MC)
CALL IMPOWER_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
ST2 = '755107893576299697276281907390144058060594744720442385'
CALL IMST2M(ST2,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
ENDIF
NCASE = 272
CALL IMST2M('314159',MA)
CALL IMST2M('1411695892374393248272691827763664225585897550',MB)
CALL IMST2M('1411695892374393248272691827763664225585897551',MC)
CALL IMPOWER_MOD(MA,MB,MC,ME)
CALL IMEQ(ME,MA)
CALL IMST2M('1',MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMPMOD',MA,'MA',MC,'MC')
ENDIF
RETURN
END SUBROUTINE TEST15
SUBROUTINE TEST16
! Complex input and output testing.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex input and output routines.')")
NCASE = 273
CALL ZMST2M('123 + 456 i',ZA)
CALL ZM2I2M(123,456,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
! Use the .NOT. because FMCOMP returns FALSE for special cases like ZD = UNKNOWN,
! and these should be treated as errors for these tests.
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 274
STZ1 = '0.3505154639175257731958762886597938144329896907216495 + ' &
// '0.7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
CALL ZM2I2M(34,71,ZC)
CALL ZMDIVI(ZC,97,ZE)
CALL ZMEQ(ZE,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 275
STZ1 = '0.3505154639175257731958762886597938144329896907216495E-5 ' &
//'+ 0.7319587628865979381443298969072164948453608247422680D-5 i'
CALL ZMST2M(STZ1,ZA)
CALL ZM2I2M(34,71,ZC)
CALL ZMDIVI(ZC,9700000,ZE)
CALL ZMEQ(ZE,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-55,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 276
STZ1 = '7.699115044247787610619469026548672566371681415929204e 03 ' &
//'- 5.221238938053097345132743362831858407079646017699115M 03 I'
CALL ZMST2M(STZ1,ZA)
CALL ZM2I2M(87,-59,ZC)
CALL ZMDIVI(ZC,113,ZE)
CALL ZMEQ(ZE,ZC)
CALL ZMMPYI(ZC,10000,ZE)
CALL ZMEQU(ZE,ZC,NDIG,NDIG)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-47,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMST2M',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 277
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMFORM('F53.33','F50.30',ZA,STZ2)
CALL ZMST2M(STZ2,ZA)
STZ1 = '7699.115044247787610619469026548673 ' &
// '-5221.238938053097345132743362831858 i'
CALL ZMST2M(STZ1,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-30,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 278
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMFORM('I9','I7',ZA,STZ2)
CALL ZMST2M(STZ2,ZA)
STZ1 = '7699 -5221 i'
CALL ZMST2M(STZ1,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(0,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 279
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMFORM('E59.50','E58.49',ZA,STZ2)
CALL ZMST2M(STZ2,ZA)
STZ1 = '7.6991150442477876106194690265486725663716814159292E3' &
//'- 5.221238938053097345132743362831858407079646017699E3 i'
CALL ZMST2M(STZ1,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 280
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMFORM('ES59.50','ES58.49',ZA,STZ2)
CALL ZMST2M(STZ2,ZA)
CALL ZMST2M(STZ1,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-44,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 281
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMFORM('ES59.50','ES58.49',ZA,STZ2)
CALL ZMST2M(STZ2,ZA)
CALL ZMST2M(STZ1,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-44,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMFORM',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST16
SUBROUTINE TEST17
! Test complex add and subtract.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex add and subtract routines.')")
NCASE = 282
CALL ZMST2M('123 + 456 i',ZA)
CALL ZMST2M('789 - 543 i',ZB)
CALL ZMADD(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
CALL ZM2I2M(912,-87,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(0,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMADD ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 283
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMADD(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '1.1204269683423045342578231913146610710701578323145698 ' &
//'+ 0.2098348690812882036310555606240306541373962229723565 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMADD ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 284
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMSUB(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.4193960405072529878660706139950734422041784508712709 ' &
//'- 1.2540826566919076726576042331904023355533254265121795 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSUB ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 285
STZ1 = '.7699115044247787610619469026548672566371681415929204E3 ' &
//'- .5221238938053097345132743362831858407079646017699115E3 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMSUB(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '769.5609889608612352887510263662074628227351519021987045 ' &
//'- 522.8558525681963324514186661800930572028099625946537725 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-47,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSUB ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST17
SUBROUTINE TEST18
! Test complex multiply, divide and square root.
IMPLICIT NONE
WRITE (KW, "(/' Testing complex multiply, divide and square root routines.')")
NCASE = 286
CALL ZMST2M('123 + 456 i',ZA)
CALL ZMST2M('789 - 543 i',ZB)
CALL ZMMPY(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
CALL ZM2I2M(344655,292995,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(0,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMMPY ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 287
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMMPY(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.6520390475321594745005017790347596022260742632971444 ' &
//'+ 0.3805309734513274336283185840707964601769911504424779 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMMPY ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 288
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMDIV(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-.1705178497731560089737969128653459210208765017614861 ' &
//'- 1.1335073636829696356072949942949842987114804337239972 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMDIV ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 289
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMMPYI(ZA,36,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '27.7168141592920353982300884955752212389380530973451327 ' &
//'- 18.7964601769911504424778761061946902654867256637168142 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMMPYI',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 290
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMDIVI(ZA,37,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '2.080841903850753408275532169337479071992346328629514E-2 ' &
//'- 1.411145658933269552738579287251853623535039464243004E-2 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-52,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMDIVI',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 291
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSQR(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.3201503641632077688150990680554467851828647505677813 ' &
//'- 0.8039783851515388832328295089670295246299631921058814 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSQR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 292
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSQRT(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.9219999909012323458336720551458583330580388434229845 ' &
//'- 0.2831474506279259570386845864488094697732718981999941 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSQRT',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST18
SUBROUTINE TEST19
! Test complex exponentials.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex exponential routines.')")
NCASE = 293
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMEXP(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '1.8718374504057787925867989348073888855260008469310002 ' &
//'- 1.0770279996847678711699041910427261417963102075889234 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMEXP ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 294
STZ1 = '5.7699115044247787610619469026548672566371681415929204 ' &
//'- 4.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMEXP(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-60.6144766542152809520229386164396710991242264070603612 ' &
//'+ 314.7254994809539691403004121118801578835669635535466592 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-47,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMEXP ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 295
STZ1 = '1.7699115044247787610619469026548672566371681415929204 ' &
//'- 1.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMIPOWER(ZA,45,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '31595668743300099.70429472191424818167262151605608585179 ' &
//'- 19209634448276799.67717448173630165852744930837930753788 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-33,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMIPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 296
STZ1 = '1.7699115044247787610619469026548672566371681415929204 ' &
//'- 1.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMIPOWER(ZA,-122,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '3.1000215641022021714480000129414241564868699479432E-46 ' &
//'- 1.1687846789859477815450163510927243367234863123667E-45 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-93,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMIPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 297
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMPOWER(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '1.4567089343012352449621841355636496276866203747888724 ' &
//'- 0.3903177712261966292764255714390622205129978923650749 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMPWR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 298
STZ1 = '.3505154639175257731958762886597938144329896907216495 ' &
//'+ .7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
STZ1 = '2.7699115044247787610619469026548672566371681415929204 ' &
//'- 0.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZB)
CALL ZMPOWER(ZA,ZB,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-1.0053105716678380336247948739245187868180079734997482 ' &
// '- 0.0819537653234704467729051473979237153087038930127116 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMPWR ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 299
STZ1 = '0.7699115044247787610619469026548672566371681415929204 ' &
//'- 0.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMRATIONAL_POWER(ZA,2,7,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.9653921326136512316639621651337975772631340364271270 ' &
//'- 0.1659768285667051396562270035411852432430188906482848 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMRPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 300
STZ1 = '0.7699115044247787610619469026548672566371681415929204 ' &
//'- 0.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMRATIONAL_POWER(ZA,-19,7,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-0.0567985880053556315170006800325686036902111276420647 ' &
// '+ 1.2154793972711356706410882510363594270389067962568571 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMRPWR',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST19
SUBROUTINE TEST20
! Test complex logarithms.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex logarithm routines.')")
NCASE = 301
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMLN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-0.0722949652393911311212450699415231782692434885813725 ' &
//'- 0.5959180055163009910007765127008371205749515965219804 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMLN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 302
STZ1 = '.7699115044247787610619469026548672566371681415929204E28 ' &
//'- .5221238938053097345132743362831858407079646017699115E28 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMLN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '64.4000876385938880213825156612206746345615981930242708 ' &
//'- 0.5959180055163009910007765127008371205749515965219804 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMLN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 303
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMLOG10(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-0.0313973044728549715287589498363619677438302809470943 ' &
//'- 0.2588039014625211035392823012785304771809982053965284 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMLG10',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 304
STZ1 = '.7699115044247787610619469026548672566371681415929204E82 ' &
//'- .5221238938053097345132743362831858407079646017699115E82 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMLOG10(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '81.9686026955271450284712410501636380322561697190529057 ' &
//'- 0.2588039014625211035392823012785304771809982053965284 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMLG10',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST20
SUBROUTINE TEST21
! Test complex trigonometric functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex trigonometric routines.')")
NCASE = 305
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOS(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.8180802525254482451348613286211514555816444253416895 ' &
//'+ 0.3801751200076938035500853542125525088505055292851393 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCOS ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 306
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOS(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-1432925478410268113.5816466154230974355002592549420099 ' &
//'- 309002816679456015.00151246245263842483282458519462258 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-31,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCOS ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 307
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSIN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7931260548991613428648822413402447097755865697557818 ' &
//'- 0.3921366045897070762848927655743167937790944353110710 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSIN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 308
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSIN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '-3.090028166794560150015124624526384249047272360765358E17 ' &
//'+ 1.432925478410268113581646615423097435166828182950161E18 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-31,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSIN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 309
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMTAN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.6141156219447569167198437040270236055089243090199979 ' &
//'- 0.7647270337230070156308196055474639461102792169274526 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMTAN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 310
STZ1 = '35.7699115044247787610619469026548672566371681415929204 ' &
//'- 43.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMTAN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '2.068934241218867332441292427642153175237611151321340E-38 ' &
//'- 1.000000000000000000000000000000000000023741659169354 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMTAN ',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 311
STZ1 = '0.3505154639175257731958762886597938144329896907216495 ' &
//'+ 0.7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOS_SIN(ZA,ZE,ZC)
CALL ZMEQ(ZE,ZA)
STZ2 = '1.2022247452809115256533054407001508718694617802593324 ' &
//'- 0.2743936538120352873902095801531325075994392065668943 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCSSN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 312
STZ1 = '0.3505154639175257731958762886597938144329896907216495 ' &
//'+ 0.7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOS_SIN(ZA,ZC,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.4395486978082638069281369170831952476351663772871008 ' &
//'+ 0.7505035100906417134864779281080728222900154610025883 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCSSN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST21
SUBROUTINE TEST22
! Test complex inverse trigonometric functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex inverse trigonometric routines.')")
NCASE = 313
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMACOS(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.8797127900868121872960714368309657795959216549012347 ' &
//'+ 0.6342141347945396859119941874681961111936156338608130 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMACOS',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 314
STZ1 = '.7699115044247787610619469026548672566371681415929204E12 ' &
//'- .5221238938053097345132743362831858407079646017699115E12 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMACOS(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.5959180055163009910007767810953294528367807973983794 ' &
//'+28.2518733312491023865118844008522768856672089946951468 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMACOS',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 315
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMASIN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.6910835367080844319352502548087856625026630447863182 ' &
//'- 0.6342141347945396859119941874681961111936156338608130 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMASIN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 316
STZ1 = '.7699115044247787610619469026548672566371681415929204E13 ' &
//'- .5221238938053097345132743362831858407079646017699115E13 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMASIN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.9748783212785956282305451762549693982010148111568094 ' &
//'-30.5544584242431480705298759613446206186670533428066404 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-48,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMASIN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 317
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMATAN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7417952692265900376512911713942700568648670953521258 ' &
//'- 0.3162747143126729004878357203292329539837025170484857 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMATAN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 318
STZ1 = '.7699115044247787610619469026548672566371681415929204E13 ' &
//'- .5221238938053097345132743362831858407079646017699115E13 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMATAN(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = ' 1.570796326794807650905529836436131532596233124329403 ' &
//'-6.033484162895927601809954710695221401671437742867605E-14 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMATAN',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST22
SUBROUTINE TEST23
! Test complex hyperbolic functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing complex hyperbolic routines.')")
NCASE = 319
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOSH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '1.1365975275870879962259716562608779977957563621412079 ' &
//'- 0.4230463404769118342540441830446134405410543954181579 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCOSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 320
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOSH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '69552104658681.7558589320148420094288419217262200765435 ' &
//'+ 626163773308016.884007302915197616300902876551542156676 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-35,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCOSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 321
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSINH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7352399228186907963608272785465108877302444847897922 ' &
//'- 0.6539816592078560369158600079981127012552558121707655 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSINH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 322
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMSINH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '6.955210465868175585893201484192181376093291191637290E 13 ' &
//'+ 6.261637733080168840073029151984050820616907795167046E 14 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-35,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMSINH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 323
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMTANH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7562684782933185240709480231996041186654551038993505 ' &
//'- 0.2938991498221693198532255749292372853685311106820169 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMTANH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 324
STZ1 = '35.7699115044247787610619469026548672566371681415929204 ' &
//'- 43.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMTANH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '9.999999999999999999999999999998967653135180689424497E-01 ' &
//'+ 1.356718776492102400812550018433337461876455254467192E-31 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMTANH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 325
STZ1 = '0.3505154639175257731958762886597938144329896907216495 ' &
//'+ 0.7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOSH_SINH(ZA,ZE,ZC)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7900326499280864816444807620997665088044412803737969 ' &
//'+ 0.2390857359988804105051429301542214823277594407302781 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCHSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 326
STZ1 = '0.3505154639175257731958762886597938144329896907216495 ' &
//'+ 0.7319587628865979381443298969072164948453608247422680 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMCOSH_SINH(ZA,ZC,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.2661087555034471983220879532235334422670297141428191 ' &
//'+ 0.7098057980612199357870532628105009808447460332437714 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMCHSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 327
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMACOSH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.634214134794539685911994187468196111193615633860813063047 ' &
//'- 0.87971279008681218729607143683096577959592165490123465108 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-49,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMACSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 328
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMACOSH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '4.699185653622843767611457701582029888318689701142758455168 ' &
//'- 0.885442754109270451471936961636924153661585344251816314058 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMACSH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 329
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'- .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMASINH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.7635704534445900566191751364753322249524141520884576620460 ' &
//'- 0.411298860099453379668803021308606607271465469022684432234 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMASNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 330
STZ1 = '34.7699115044247787610619469026548672566371681415929204 ' &
//'- 42.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMASINH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '4.699152741387944521329007830079827163510121700675738493686583 ' &
//'- 0.885280331861437309635169786543313944594109728905497480903944 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMASNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 331
STZ1 = '.7699115044247787610619469026548672566371681415929204 ' &
//'+ .5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMATANH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.586882600199517579230023110103093954108604678368770838853566 ' &
//'+ 0.72129247131145073405158274968147799882646114519254182360306 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMATNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
NCASE = 332
STZ1 = '35.7699115044247787610619469026548672566371681415929204 ' &
//'+ 43.5221238938053097345132743362831858407079646017699115 i'
CALL ZMST2M(STZ1,ZA)
CALL ZMATANH(ZA,ZE)
CALL ZMEQ(ZE,ZA)
STZ2 = '0.01126922171563683586812930494404043654068908857617619358696482 ' &
//'+ 1.5570819093480669764576964089576282282995266513998725538932609 i'
CALL ZMST2M(STZ2,ZC)
CALL ZMSUB(ZA,ZC,ZD)
CALL ZMABS(ZD,MA)
CALL FMI2M(10,MB)
CALL FMIPOWER(MB,-50,ME)
CALL FMEQ(ME,MB)
IF (.NOT.FMCOMP(MA,'LE',MB)) THEN
CALL ERRPRTZM('ZMATNH',ZA,'ZA',ZC,'ZC',ZD,'ZD')
ENDIF
RETURN
END SUBROUTINE TEST23
SUBROUTINE TEST24
! Test the = assignment interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type = interface.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
MSMALL = EPSILON(TO_FM(1))*10000.0
NCASE = 333
J4 = MFM1
IF (J4 /= 581) CALL PRTERR(KW)
NCASE = 334
J4 = MIM1
IF (J4 /= 661) CALL PRTERR(KW)
NCASE = 335
J4 = MZM1
IF (J4 /= 731) CALL PRTERR(KW)
NCASE = 336
R4 = MFM1
IF (ABS((R4-581.21)/581.21) > RSMALL) CALL PRTERR(KW)
NCASE = 337
R4 = MIM1
IF (ABS((R4-661.0)/661.0) > RSMALL) CALL PRTERR(KW)
NCASE = 338
R4 = MZM1
IF (ABS((R4-731.51)/731.51) > RSMALL) CALL PRTERR(KW)
NCASE = 339
D4 = MFM1
IF (ABS((D4-581.21D0)/581.21D0) > DSMALL) CALL PRTERR(KW)
NCASE = 340
D4 = MIM1
IF (ABS((D4-661.0D0)/661.0D0) > DSMALL) CALL PRTERR(KW)
NCASE = 341
D4 = MZM1
IF (ABS((D4-731.51D0)/731.51D0) > DSMALL) CALL PRTERR(KW)
NCASE = 342
C4 = MFM1
IF (ABS((C4-581.21)/581.21) > RSMALL) CALL PRTERR(KW)
NCASE = 343
C4 = MIM1
IF (ABS((C4-661.0)/661.0) > RSMALL) CALL PRTERR(KW)
NCASE = 344
C4 = MZM1
IF (ABS((C4-(731.51,711.41))/(731.51,711.41)) > RSMALL) CALL PRTERR(KW)
NCASE = 345
CD4 = MFM1
IF (ABS((CD4-581.21D0)/581.21D0) > DSMALL) CALL PRTERR(KW)
NCASE = 346
CD4 = MIM1
IF (ABS((CD4-661.0D0)/661.0D0) > DSMALL) CALL PRTERR(KW)
NCASE = 347
CD4 = MZM1
IF (ABS((CD4-(731.51D0,711.41D0))/(731.51D0,711.41D0)) > DSMALL) CALL PRTERR(KW)
NCASE = 348
MFM3 = J2
CALL FM_I2M(131,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ST2M('0',MFM3)
IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 349
MFM3 = J2
CALL FM_I2M(131,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
CALL FM_ST2M('0',MFM3)
IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 350
MFM3 = J2
CALL FM_I2M(131,MFM4)
CALL FM_SUB_R2(MFM3,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
CALL FM_ST2M('0',MFM3)
IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 351
MFM3 = J2
CALL FM_I2M(131,MFM4)
CALL FM_EQU(MFM3,MFM6,NDIG,NDIG)
CALL FM_SUB_R1(MFM6,MFM4)
CALL FM_EQU(MFM6,MFM4,NDIG,NDIG)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQU_R1(MFM6,NDIG,NDIG)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ST2M('0',MFM3)
IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 352
MFM3 = R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMPARE(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 353
MFM3 = D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 354
MFM3 = C2
CALL FM_ST2M('411.11',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 355
MFM3 = CD2
CALL FM_ST2M('431.11',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 356
MFM3 = MFM1
CALL FM_ST2M('581.21',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_EQ(MSMALL,MFM3)
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 357
MFM3 = MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ST2M('0',MFM3)
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 358
MFM3 = MZM1
CALL FM_ST2M('731.51',MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 359
MIM3 = J2
CALL IM_I2M(131,MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 360
MIM3 = R2
CALL IM_ST2M('241',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 361
MIM3 = D2
CALL IM_ST2M('391',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 362
MIM3 = C2
CALL IM_ST2M('411',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 363
MIM3 = CD2
CALL IM_ST2M('431',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMPARE(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 364
MIM3 = MFM1
CALL IM_ST2M('581',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 365
MIM3 = MIM1
CALL IM_ST2M('661',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 366
MIM3 = MZM1
CALL IM_ST2M('731',MIM4)
CALL IM_SUB(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
CALL IM_ST2M('0',MIM3)
IF (IM_COMP(MIM4,'GT',MIM3)) CALL PRTERR(KW)
NCASE = 367
MZM3 = J2
CALL ZM_I2M(131,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM4)
CALL FM_ST2M('0',MFM3)
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 368
MZM3 = R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQU(MZM5,MZM4,NDIG,NDIG)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 369
MZM3 = D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 370
MZM3 = C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 371
MZM3 = CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 372
MZM3 = MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = MSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 373
MZM3 = MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM4)
CALL FM_ST2M('0',MFM3)
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 374
MZM3 = MZM1
CALL ZM_ST2M('731.51 + 711.41 i',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = MSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
END SUBROUTINE TEST24
SUBROUTINE TEST25
! Test the derived type == interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type == interface.')")
NCASE = 375
M_A = 123
M_B = M_A
IF (.NOT.FM_COMP(M_A,'==',M_B)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 376
M_A = 123
M_B = M_A
IF (.NOT.FM_COMP(M_A,'EQ',M_B)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 377
J1 = 123
M_A = J1
IF (.NOT.(M_A == J1)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 378
J1 = 123
M_A = J1
IF (.NOT.(J1 == M_A)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 379
J1 = 123
M_J = J1
IF (.NOT.(M_J == J1)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 380
J1 = 123
M_J = J1
IF (.NOT.(J1 == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 381
J1 = 123
M_Z = J1
IF (.NOT.(M_Z == J1)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 382
J1 = 123
M_Z = ( 123.0 , 34.5 )
IF (M_Z == J1) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 383
J1 = 123
M_Z = J1
IF (.NOT.(J1 == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 384
J1 = 123
M_Z = ( 123.0 , 34.5 )
IF (J1 == M_Z) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 385
R1 = 12.3
M_A = R1
IF (.NOT.(M_A == R1)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 386
R1 = 12.3
M_A = R1
IF (.NOT.(R1 == M_A)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 387
R1 = 123
M_J = R1
IF (.NOT.(M_J == R1)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 388
R1 = 123
M_J = R1
IF (.NOT.(R1 == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 389
R1 = 12.3
M_Z = R1
IF (.NOT.(M_Z == R1)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 390
R1 = 12.3
M_Z = R1
IF (.NOT.(R1 == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 391
D1 = 12.3
M_A = D1
IF (.NOT.(M_A == D1)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 392
D1 = 12.3
M_A = D1
IF (.NOT.(D1 == M_A)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 393
D1 = 123
M_J = D1
IF (.NOT.(M_J == D1)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 394
D1 = 123
M_J = D1
IF (.NOT.(D1 == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 395
D1 = 12.3
M_Z = D1
IF (.NOT.(M_Z == D1)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 396
D1 = 12.3
M_Z = D1
IF (.NOT.(D1 == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 397
C1 = 12.3
M_A = C1
IF (.NOT.(M_A == C1)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 398
C1 = (12.3 , 45.6)
M_A = C1
IF (M_A == C1) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 399
C1 = 12.3
M_A = C1
IF (.NOT.(C1 == M_A)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 400
C1 = (12.3 , 45.6)
M_A = C1
IF (C1 == M_A) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 401
C1 = 123
M_J = C1
IF (.NOT.(M_J == C1)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 402
C1 = (12.3 , 45.6)
M_J = C1
IF (M_J == C1) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 403
C1 = 123
M_J = C1
IF (.NOT.(C1 == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 404
C1 = (12.3 , 45.6)
M_J = C1
IF (C1 == M_J) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 405
C1 = (12.3 , 45.6)
M_Z = C1
IF (.NOT.(M_Z == C1)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 406
C1 = (12.3 , 45.6)
M_Z = C1
IF (.NOT.(C1 == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 407
CD1 = 12.3
M_A = CD1
IF (.NOT.(M_A == CD1)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 408
CD1 = (12.3 , 45.6)
M_A = CD1
IF (M_A == CD1) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 409
CD1 = 12.3
M_A = CD1
IF (.NOT.(CD1 == M_A)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 410
CD1 = (12.3 , 45.6)
M_A = CD1
IF (CD1 == M_A) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 411
CD1 = 123
M_J = CD1
IF (.NOT.(M_J == CD1)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 412
CD1 = (123.0 , 45.6)
M_J = CD1
IF (M_J == CD1) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 413
CD1 = 123
M_J = CD1
IF (.NOT.(CD1 == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 414
CD1 = (123.0 , 45.6)
M_J = CD1
IF (CD1 == M_J) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 415
CD1 = (12.3 , 45.6)
M_Z = CD1
IF (.NOT.(M_Z == CD1)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 416
CD1 = (12.3 , 45.6)
M_Z = CD1
IF (.NOT.(CD1 == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 417
M_B = 12.3
M_A = M_B
IF (.NOT.(M_A == M_B)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 418
M_B = 123
M_J = M_B
IF (.NOT.(M_J == M_B)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 419
M_B = 123.4
M_J = M_B
IF (M_J == M_B) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 420
M_B = 123
M_J = M_B
IF (.NOT.(M_B == M_J)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 421
M_B = 123.4
M_J = M_B
IF (M_B == M_J) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 422
M_B = (12.3 , 45.6)
M_Z = M_B
IF (.NOT.(M_Z == M_B)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 423
M_Z = (12.3 , 45.6)
M_B = M_Z
IF (M_Z == M_B) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 424
M_B = (12.3 , 45.6)
M_Z = M_B
IF (.NOT.(M_B == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 425
M_Z = (12.3 , 45.6)
M_B = M_Z
IF (M_B == M_Z) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 426
M_K = 123
M_J = M_K
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM(' == ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 427
M_K = (12.3 , 45.6)
M_Z = M_K
IF (.NOT.(M_Z == M_K)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 428
M_Z = (12.3 , 45.6)
M_K = M_Z
IF (M_Z == M_K) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 429
M_K = (12.3 , 45.6)
M_Z = M_K
IF (.NOT.(M_K == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 430
M_Z = (12.3 , 45.6)
M_K = M_Z
IF (M_K == M_Z) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 431
M_Y = (12.3 , 45.6)
M_Z = M_Y
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' == ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
RETURN
END SUBROUTINE TEST25
SUBROUTINE TEST26
! Test the derived type /= interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type /= interface.')")
NCASE = 432
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'/=',M_B)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 433
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'NE',M_B)) THEN
CALL ERRPRT_FM(' == ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 434
J1 = 123
M_A = 1 + J1
IF (.NOT.(M_A /= J1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 435
J1 = 123
M_A = 1 + J1
IF (.NOT.(J1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 436
J1 = 123
M_J = 1 + J1
IF (.NOT.(M_J /= J1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 437
J1 = 123
M_J = 1 + J1
IF (.NOT.(J1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 438
J1 = 123
M_Z = 1 + J1
IF (.NOT.(M_Z /= J1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 439
J1 = 123
M_Z = ( 123.0 , 34.5 )
IF (.NOT.(M_Z /= J1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 440
J1 = 123
M_Z = 1 + J1
IF (.NOT.(J1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 441
J1 = 123
M_Z = ( 123.0 , 34.5 )
IF (.NOT.(J1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 442
R1 = 12.3
M_A = 1 + R1
IF (.NOT.(M_A /= R1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 443
R1 = 12.3
M_A = 1 + R1
IF (.NOT.(R1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 444
R1 = 123
M_J = 1 + R1
IF (.NOT.(M_J /= R1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 445
R1 = 123
M_J = 1 + R1
IF (.NOT.(R1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 446
R1 = 12.3
M_Z = 1 + R1
IF (.NOT.(M_Z /= R1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 447
R1 = 12.3
M_Z = ( 12.3 , 34.5 )
IF (.NOT.(M_Z /= R1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 448
R1 = 12.3
M_Z = 1 + R1
IF (.NOT.(R1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 449
R1 = 12.3
M_Z = ( 12.3 , 34.5 )
IF (.NOT.(R1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 450
D1 = 12.3
M_A = 1 + D1
IF (.NOT.(M_A /= D1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 451
D1 = 12.3
M_A = 1 + D1
IF (.NOT.(D1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 452
D1 = 123
M_J = 1 + D1
IF (.NOT.(M_J /= D1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 453
D1 = 123
M_J = 1 + D1
IF (.NOT.(D1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 454
D1 = 12.3
M_Z = 1 + D1
IF (.NOT.(M_Z /= D1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 455
D1 = 12.3
M_Z = ( 12.3 , 34.5 )
IF (.NOT.(M_Z /= D1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 456
D1 = 12.3
M_Z = 1 + D1
IF (.NOT.(D1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 457
D1 = 12.3
M_Z = ( 12.3 , 34.5 )
IF (.NOT.(D1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 458
C1 = 12.3
M_A = 1 + C1
IF (.NOT.(M_A /= C1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 459
C1 = ( 12.3 , 34.5 )
M_A = ( 12.3 , 34.5 )
IF (.NOT.(M_A /= C1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 460
C1 = 12.3
M_A = 1 + C1
IF (.NOT.(C1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 461
C1 = ( 12.3 , 34.5 )
M_A = ( 12.3 , 34.5 )
IF (.NOT.(C1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 462
C1 = 123
M_J = 1 + C1
IF (.NOT.(M_J /= C1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 463
C1 = ( 123.0 , 34.5 )
M_J = ( 123.0 , 34.5 )
IF (.NOT.(M_J /= C1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 464
C1 = 123
M_J = 1 + C1
IF (.NOT.(C1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 465
C1 = ( 123.0 , 34.5 )
M_J = ( 123.0 , 34.5 )
IF (.NOT.(C1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 466
C1 = (12.3 , 45.6)
M_Z = 1 + C1
IF (.NOT.(M_Z /= C1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 467
C1 = (12.3 , 45.6)
M_Z = 1 + C1
IF (.NOT.(C1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 468
CD1 = 12.3
M_A = 1 + CD1
IF (.NOT.(M_A /= CD1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 469
CD1 = (12.3 , 45.6)
M_A = (12.3 , 45.6)
IF (.NOT.(M_A /= CD1)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 470
CD1 = 12.3
M_A = 1 + CD1
IF (.NOT.(CD1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 471
CD1 = (12.3 , 45.6)
M_A = (12.3 , 45.6)
IF (.NOT.(CD1 /= M_A)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 472
CD1 = 123
M_J = 1 + CD1
IF (.NOT.(M_J /= CD1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 473
CD1 = (123.0 , 45.6)
M_J = (123.0 , 45.6)
IF (.NOT.(M_J /= CD1)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 474
CD1 = 123
M_J = 1 + CD1
IF (.NOT.(CD1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 475
CD1 = (123.0 , 45.6)
M_J = (123.0 , 45.6)
IF (.NOT.(CD1 /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 476
CD1 = (12.3 , 45.6)
M_Z = 1 + CD1
IF (.NOT.(M_Z /= CD1)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 477
CD1 = (12.3 , 45.6)
M_Z = 1 + CD1
IF (.NOT.(CD1 /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 478
M_B = 12.3
M_A = 1 + M_B
IF (.NOT.(M_A /= M_B)) THEN
CALL ERRPRT_FM(' /= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 479
M_B = 123
M_J = 1 + M_B
IF (.NOT.(M_J /= M_B)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 480
M_B = 123.4
M_J = M_B
IF (.NOT.(M_J /= M_B)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 481
M_B = 123
M_J = 1 + M_B
IF (.NOT.(M_B /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 482
M_B = 123.4
M_J = M_B
IF (.NOT.(M_B /= M_J)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 483
M_B = (12.3 , 45.6)
M_Z = 1 + M_B
IF (.NOT.(M_Z /= M_B)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 484
M_B = (12.3 , 45.6)
M_Z = (12.3 , 34.5)
IF (.NOT.(M_Z /= M_B)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 485
M_B = (12.3 , 45.6)
M_Z = 1 + M_B
IF (.NOT.(M_B /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 486
M_B = (12.3 , 45.6)
M_Z = (12.3 , 34.5)
IF (.NOT.(M_B /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 487
M_K = 123
M_J = 1 + M_K
IF (.NOT.(M_J /= M_K)) THEN
CALL ERRPRT_IM(' /= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 488
M_K = (12.3 , 45.6)
M_Z = 1 + M_K
IF (.NOT.(M_Z /= M_K)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 489
M_K = (123.0 , 45.6)
M_Z = (123.0 , 34.5)
IF (.NOT.(M_Z /= M_K)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 490
M_K = (12.3 , 45.6)
M_Z = 1 + M_K
IF (.NOT.(M_K /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 491
M_K = (123.0 , 45.6)
M_Z = (123.0 , 34.5)
IF (.NOT.(M_K /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 492
M_Y = (12.3 , 45.6)
M_Z = 1 + M_Y
IF (.NOT.(M_Y /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
NCASE = 493
M_Y = (12.3 , 45.6)
M_Z = (12.3 , 34.5)
IF (.NOT.(M_Y /= M_Z)) THEN
CALL ERRPRT_ZM(' /= ',M_Z,'M_Z',M_Z,'M_Z',M_Z,'M_Z')
ENDIF
RETURN
END SUBROUTINE TEST26
SUBROUTINE TEST27
! Test the derived type > interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type > interface.')")
NCASE = 494
M_A = 125
M_B = 124
IF (.NOT.FM_COMP(M_A,'>',M_B)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 495
M_A = 125
M_B = 124
IF (.NOT.FM_COMP(M_A,'GT',M_B)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 496
J1 = 123
M_A = J1 + 1
IF (.NOT.(M_A > J1)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 497
J1 = 123
M_A = J1 - 1
IF (.NOT.(J1 > M_A)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 498
J1 = 123
M_J = J1 + 1
IF (.NOT.(M_J > J1)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 499
J1 = 123
M_J = J1 - 1
IF (.NOT.(J1 > M_J)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 500
R1 = 12.3
M_A = R1 + 1
IF (.NOT.(M_A > R1)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 501
R1 = 12.3
M_A = R1 - 1
IF (.NOT.(R1 > M_A)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 502
R1 = 123
M_J = R1 + 1
IF (.NOT.(M_J > R1)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 503
R1 = 123
M_J = R1 - 1
IF (.NOT.(R1 > M_J)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 504
D1 = 12.3
M_A = D1 + 1
IF (.NOT.(M_A > D1)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 505
D1 = 12.3
M_A = D1 - 1
IF (.NOT.(D1 > M_A)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 506
D1 = 123
M_J = D1 + 1
IF (.NOT.(M_J > D1)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 507
D1 = 123
M_J = D1 - 1
IF (.NOT.(D1 > M_J)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 508
M_B = 12.3
M_A = M_B + 1
IF (.NOT.(M_A > M_B)) THEN
CALL ERRPRT_FM(' > ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 509
M_B = 123
M_J = M_B + 1
IF (.NOT.(M_J > M_B)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 510
M_B = 123
M_J = M_B - 1
IF (.NOT.(M_B > M_J)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 511
M_K = 123
M_J = M_K + 1
IF (.NOT.(M_J > M_K)) THEN
CALL ERRPRT_IM(' > ',M_J,'M_J',M_J,'M_J')
ENDIF
RETURN
END SUBROUTINE TEST27
SUBROUTINE TEST28
! Test the derived type >= interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type >= interface.')")
NCASE = 512
M_A = 125
M_B = 124
IF (.NOT.FM_COMP(M_A,'>=',M_B)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 513
M_A = 125
M_B = 124
IF (.NOT.FM_COMP(M_A,'GE',M_B)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 514
J1 = 123
M_A = J1 + 1
IF (.NOT.(M_A >= J1)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 515
J1 = 123
M_A = J1 - 1
IF (.NOT.(J1 >= M_A)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 516
J1 = 123
M_J = J1 + 1
IF (.NOT.(M_J >= J1)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 517
J1 = 123
M_J = J1 - 1
IF (.NOT.(J1 >= M_J)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 518
R1 = 12.3
M_A = R1 + 1
IF (.NOT.(M_A >= R1)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 519
R1 = 12.3
M_A = R1 - 1
IF (.NOT.(R1 >= M_A)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 520
R1 = 123
M_J = R1 + 1
IF (.NOT.(M_J >= R1)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 521
R1 = 123
M_J = R1 - 1
IF (.NOT.(R1 >= M_J)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 522
D1 = 12.3
M_A = D1 + 1
IF (.NOT.(M_A >= D1)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 523
D1 = 12.3
M_A = D1 - 1
IF (.NOT.(D1 >= M_A)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 524
D1 = 123
M_J = D1 + 1
IF (.NOT.(M_J >= D1)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 525
D1 = 123
M_J = D1 - 1
IF (.NOT.(D1 >= M_J)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 526
M_B = 12.3
M_A = M_B + 1
IF (.NOT.(M_A >= M_B)) THEN
CALL ERRPRT_FM(' >= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 527
M_B = 123
M_J = M_B + 1
IF (.NOT.(M_J >= M_B)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 528
M_B = 123
M_J = M_B - 1
IF (.NOT.(M_B >= M_J)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 529
M_K = 123
M_J = M_K + 1
IF (.NOT.(M_J >= M_K)) THEN
CALL ERRPRT_IM(' >= ',M_J,'M_J',M_J,'M_J')
ENDIF
RETURN
END SUBROUTINE TEST28
SUBROUTINE TEST29
! Test the derived type < interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type < interface.')")
NCASE = 530
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'<',M_B)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 531
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'LT',M_B)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 532
J1 = 123
M_A = J1 - 2
IF (.NOT.(M_A < J1)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 533
J1 = 123
M_A = J1 + 2
IF (.NOT.(J1 < M_A)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 534
J1 = 123
M_J = J1 - 2
IF (.NOT.(M_J < J1)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 535
J1 = 123
M_J = J1 + 2
IF (.NOT.(J1 < M_J)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 536
R1 = 12.3
M_A = R1 - 2
IF (.NOT.(M_A < R1)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 537
R1 = 12.3
M_A = R1 + 2
IF (.NOT.(R1 < M_A)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 538
R1 = 123
M_J = R1 - 2
IF (.NOT.(M_J < R1)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 539
R1 = 123
M_J = R1 + 2
IF (.NOT.(R1 < M_J)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 540
D1 = 12.3
M_A = D1 - 2
IF (.NOT.(M_A < D1)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 541
D1 = 12.3
M_A = D1 + 2
IF (.NOT.(D1 < M_A)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 542
D1 = 123
M_J = D1 - 2
IF (.NOT.(M_J < D1)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 543
D1 = 123
M_J = D1 + 2
IF (.NOT.(D1 < M_J)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 544
M_B = 12.3
M_A = M_B - 2
IF (.NOT.(M_A < M_B)) THEN
CALL ERRPRT_FM(' < ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 545
M_B = 123
M_J = M_B - 2
IF (.NOT.(M_J < M_B)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 546
M_B = 123
M_J = M_B + 2
IF (.NOT.(M_B < M_J)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 547
M_K = 123
M_J = M_K - 2
IF (.NOT.(M_J < M_K)) THEN
CALL ERRPRT_IM(' < ',M_J,'M_J',M_J,'M_J')
ENDIF
RETURN
END SUBROUTINE TEST29
SUBROUTINE TEST30
! Test the derived type <= interface.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type <= interface.')")
NCASE = 548
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'<=',M_B)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 549
M_A = 123
M_B = 124
IF (.NOT.FM_COMP(M_A,'LE',M_B)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_B,'M_B',M_B,'M_B')
ENDIF
NCASE = 550
J1 = 123
M_A = J1 - 2
IF (.NOT.(M_A <= J1)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 551
J1 = 123
M_A = J1 + 2
IF (.NOT.(J1 <= M_A)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 552
J1 = 123
M_J = J1 - 2
IF (.NOT.(M_J <= J1)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 553
J1 = 123
M_J = J1 + 2
IF (.NOT.(J1 <= M_J)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 554
R1 = 12.3
M_A = R1 - 2
IF (.NOT.(M_A <= R1)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 555
R1 = 12.3
M_A = R1 + 2
IF (.NOT.(R1 <= M_A)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 556
R1 = 123
M_J = R1 - 2
IF (.NOT.(M_J <= R1)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 557
R1 = 123
M_J = R1 + 2
IF (.NOT.(R1 <= M_J)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 558
D1 = 12.3
M_A = D1 - 2
IF (.NOT.(M_A <= D1)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 559
D1 = 12.3
M_A = D1 + 2
IF (.NOT.(D1 <= M_A)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 560
D1 = 123
M_J = D1 - 2
IF (.NOT.(M_J <= D1)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 561
D1 = 123
M_J = D1 + 2
IF (.NOT.(D1 <= M_J)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 562
M_B = 12.3
M_A = M_B - 2
IF (.NOT.(M_A <= M_B)) THEN
CALL ERRPRT_FM(' <= ',M_A,'M_A',M_A,'M_A',M_A,'M_A')
ENDIF
NCASE = 563
M_B = 123
M_J = M_B - 2
IF (.NOT.(M_J <= M_B)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 564
M_B = 123
M_J = M_B + 2
IF (.NOT.(M_B <= M_J)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
NCASE = 565
M_K = 123
M_J = M_K - 2
IF (.NOT.(M_J <= M_K)) THEN
CALL ERRPRT_IM(' <= ',M_J,'M_J',M_J,'M_J')
ENDIF
RETURN
END SUBROUTINE TEST30
SUBROUTINE TEST31
! Test the '+' arithmetic operator.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type + interface.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
NCASE = 566
MFM3 = J2 + MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_ADD(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 567
MFM3 = J2 + MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_ADD_R1(MFM4,MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 568
MFM3 = J2 + MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_ADD_R2(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 569
MIM3 = J2 + MIM1
CALL IM_ST2M('131',MIM4)
CALL IM_ADD(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 570
MZM3 = J2 + MZM1
CALL ZM_ST2M('131',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 571
MFM3 = R2 + MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_ADD(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 572
MFM3 = R2 + MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_ADD(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV_R1(MFM4,MFM3)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 573
CALL FM_ST2M('241.21',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_ADD(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = R2 + MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 574
MZM3 = R2 + MZM1
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 575
MFM3 = D2 + MFM1
CALL FM_ST2M('391.61',MFM4)
CALL FM_ADD(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 576
CALL FM_ST2M('391.61',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_ADD(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = D2 + MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 577
MZM3 = D2 + MZM1
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 578
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 + MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 579
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 + MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 580
MZM3 = C2 + MZM1
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 581
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 + MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 582
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 + MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 583
MZM3 = CD2 + MZM1
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 584
MFM3 = MFM1 + J2
CALL FM_ST2M('131',MFM4)
CALL FM_ADD(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 585
MFM3 = MFM1 + R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_ADD(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 586
MFM3 = MFM1 + D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_ADD(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 587
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ADD(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 + C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 588
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 + CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 589
MFM3 = MFM1 + MFM2
CALL FM_ADD(MFM1,MFM2,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 590
MFM3 = MFM1 + MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_ADD(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 591
MZM3 = MFM1 + MZM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 592
MIM3 = MIM1 + J2
CALL IM_ST2M('131',MIM4)
CALL IM_ADD(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 593
CALL FM_ST2M('241.21',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_ADD(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 + R2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 594
CALL FM_ST2M('391.61',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_ADD(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 + D2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 595
CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 + C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 596
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_ADD(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 + CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 597
MFM3 = MIM1 + MFM1
CALL FM_ST2M('661',MFM4)
CALL FM_ADD(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 598
MIM3 = MIM1 + MIM2
CALL IM_ADD(MIM1,MIM2,MIM4)
IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)
NCASE = 599
MZM3 = MIM1 + MZM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_ADD(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 600
MZM3 = MZM1 + J2
CALL ZM_ST2M('131',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 601
MZM3 = MZM1 + R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 602
MZM3 = MZM1 + D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 603
MZM3 = MZM1 + C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 604
MZM3 = MZM1 + CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 605
MZM3 = MZM1 + MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 606
MZM3 = MZM1 + MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_ADD(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 607
MZM3 = MZM1 + MZM2
CALL ZM_ADD(MZM1,MZM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 608
MFM3 = +MFM1
CALL FM_EQ(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 609
MIM3 = +MIM1
CALL IM_EQ(MIM1,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 610
MZM3 = +MZM1
CALL ZM_EQ(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
END SUBROUTINE TEST31
SUBROUTINE TEST32
! Test the '-' arithmetic operator.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type - interface.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
NCASE = 611
MFM3 = J2 - MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_SUB(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 612
MIM3 = J2 - MIM1
CALL IM_ST2M('131',MIM4)
CALL IM_SUB(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 613
MZM3 = J2 - MZM1
CALL ZM_ST2M('131',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 614
MFM3 = R2 - MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_SUB(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 615
CALL FM_ST2M('241.21',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_SUB(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = R2 - MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 616
MZM3 = R2 - MZM1
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 617
MFM3 = D2 - MFM1
CALL FM_ST2M('391.61',MFM4)
CALL FM_SUB(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 618
CALL FM_ST2M('391.61',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_SUB(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = D2 - MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 619
MZM3 = D2 - MZM1
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 620
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 - MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 621
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 - MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 622
MZM3 = C2 - MZM1
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 623
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 - MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 624
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 - MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 625
MZM3 = CD2 - MZM1
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 626
MFM3 = MFM1 - J2
CALL FM_ST2M('131',MFM4)
CALL FM_SUB(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 627
MFM3 = MFM1 - R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_SUB(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 628
MFM3 = MFM1 - D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_SUB(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 629
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 - C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 630
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 - CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 631
MFM3 = MFM1 - MFM2
CALL FM_SUB(MFM1,MFM2,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 632
MFM3 = MFM1 - MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_SUB(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 633
MZM3 = MFM1 - MZM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 634
MIM3 = MIM1 - J2
CALL IM_ST2M('131',MIM4)
CALL IM_SUB(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 635
CALL FM_ST2M('241.21',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_SUB(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 - R2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 636
CALL FM_ST2M('391.61',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_SUB(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 - D2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 637
CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 - C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 638
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_SUB(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 - CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 639
MFM3 = MIM1 - MFM1
CALL FM_ST2M('661',MFM4)
CALL FM_SUB(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 640
MIM3 = MIM1 - MIM2
CALL IM_SUB(MIM1,MIM2,MIM4)
IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)
NCASE = 641
MZM3 = MIM1 - MZM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 642
MZM3 = MZM1 - J2
CALL ZM_ST2M('131',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 643
MZM3 = MZM1 - R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 644
MZM3 = MZM1 - D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 645
MZM3 = MZM1 - C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 646
MZM3 = MZM1 - CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 647
MZM3 = MZM1 - MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 648
MZM3 = MZM1 - MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_SUB(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 649
MZM3 = MZM1 - MZM2
CALL ZM_SUB(MZM1,MZM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 650
MFM3 = -MFM1
CALL FM_I2M(0,MFM4)
CALL FM_SUB(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 651
MIM3 = -MIM1
CALL IM_I2M(0,MIM4)
CALL IM_SUB(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 652
MZM3 = -MZM1
CALL ZM_I2M(0,MZM4)
CALL ZM_SUB(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
END SUBROUTINE TEST32
END MODULE TEST_A
MODULE TEST_B
USE TEST_VARS
CONTAINS
SUBROUTINE TEST33
! Test the '*' arithmetic operator.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type * interface.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
NCASE = 653
MFM3 = J2 * MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_MPY(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 654
MFM3 = J2 * MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_MPY_R1(MFM4,MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 655
MFM3 = J2 * MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_MPY_R2(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 656
MFM3 = J2 * MFM1
MFM4 = MFM1
CALL FM_MPYI_R1(MFM4,131)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 657
MIM3 = J2 * MIM1
CALL IM_ST2M('131',MIM4)
CALL IM_MPY(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 658
MZM3 = J2 * MZM1
CALL ZM_ST2M('131',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 659
MFM3 = R2 * MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_MPY(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 660
CALL FM_ST2M('241.21',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_MPY(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = R2 * MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 661
MZM3 = R2 * MZM1
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 662
MFM3 = D2 * MFM1
CALL FM_ST2M('391.61',MFM4)
CALL FM_MPY(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 663
CALL FM_ST2M('391.61',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_MPY(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = D2 * MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 664
MZM3 = D2 * MZM1
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 665
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 * MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 666
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 * MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 667
MZM3 = C2 * MZM1
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 668
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 * MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 669
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 * MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 670
MZM3 = CD2 * MZM1
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 671
MFM3 = MFM1 * J2
CALL FM_ST2M('131',MFM4)
CALL FM_MPY(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 672
MFM3 = MFM1 * R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_MPY(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 673
MFM3 = MFM1 * D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_MPY(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 674
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_MPY(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 * C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 675
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 * CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 676
MFM3 = MFM1 * MFM2
CALL FM_MPY(MFM1,MFM2,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 677
MFM3 = MFM1 * MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_MPY(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 678
MZM3 = MFM1 * MZM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 679
MIM3 = MIM1 * J2
CALL IM_ST2M('131',MIM4)
CALL IM_MPY(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 680
CALL FM_ST2M('241.21',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_MPY(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 * R2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 681
CALL FM_ST2M('391.61',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_MPY(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 * D2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 682
CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 * C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 683
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_MPY(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 * CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 684
MFM3 = MIM1 * MFM1
CALL FM_ST2M('661',MFM4)
CALL FM_MPY(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 685
MIM3 = MIM1 * MIM2
CALL IM_MPY(MIM1,MIM2,MIM4)
IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)
NCASE = 686
MZM3 = MIM1 * MZM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_MPY(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 687
MZM3 = MZM1 * J2
CALL ZM_ST2M('131',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 688
MZM3 = MZM1 * R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 689
MZM3 = MZM1 * D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 690
MZM3 = MZM1 * C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 691
MZM3 = MZM1 * CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 692
MZM3 = MZM1 * MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 693
MZM3 = MZM1 * MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_MPY(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 694
MZM3 = MZM1 * MZM2
CALL ZM_MPY(MZM1,MZM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
END SUBROUTINE TEST33
SUBROUTINE TEST34
! Test the '/' arithmetic operator.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type / interface.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
NCASE = 695
MFM3 = J2 / MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_DIV(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 696
MFM3 = J2 / MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_EQ(MFM1,MFM6)
CALL FM_DIV_R2(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 697
MIM3 = J2 / MIM1
CALL IM_ST2M('131',MIM4)
CALL IM_DIV(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 698
MZM3 = J2 / MZM1
CALL ZM_ST2M('131',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 699
MFM3 = R2 / MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_DIV(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 700
CALL FM_ST2M('241.21',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = R2 / MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 701
MZM3 = R2 / MZM1
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 702
MFM3 = D2 / MFM1
CALL FM_ST2M('391.61',MFM4)
CALL FM_DIV(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 703
CALL FM_ST2M('391.61',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = D2 / MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 704
MZM3 = D2 / MZM1
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 705
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 / MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 706
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 / MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 707
MZM3 = C2 / MZM1
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 708
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 / MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 709
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 / MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 710
MZM3 = CD2 / MZM1
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 711
MFM3 = MFM1 / J2
CALL FM_ST2M('131',MFM4)
CALL FM_DIV(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 712
MFM3 = MFM1 / R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_DIV(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 713
MFM3 = MFM1 / D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_DIV(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 714
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_DIV(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 / C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 715
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 / CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 716
MFM3 = MFM1 / MFM2
CALL FM_DIV(MFM1,MFM2,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 717
MFM3 = MFM1 / MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_DIV(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 718
MZM3 = MFM1 / MZM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 719
MIM3 = MIM1 / J2
CALL IM_ST2M('131',MIM4)
CALL IM_DIV(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 720
CALL FM_ST2M('241.21',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 / R2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 721
CALL FM_ST2M('391.61',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 / D2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 722
CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 / C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 723
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_DIV(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 / CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 724
MFM3 = MIM1 / MFM1
CALL FM_ST2M('661',MFM4)
CALL FM_DIV(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 725
MIM3 = MIM1 / MIM2
CALL IM_DIV(MIM1,MIM2,MIM4)
IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)
NCASE = 726
MZM3 = MIM1 / MZM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_DIV(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 727
MZM3 = MZM1 / J2
CALL ZM_ST2M('131',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 728
MZM3 = MZM1 / R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 729
MZM3 = MZM1 / D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 730
MZM3 = MZM1 / C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 731
MZM3 = MZM1 / CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 732
MZM3 = MZM1 / MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 733
MZM3 = MZM1 / MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_DIV(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 734
MZM3 = MZM1 / MZM2
CALL ZM_DIV(MZM1,MZM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
END SUBROUTINE TEST34
SUBROUTINE TEST35
! Test the '**' arithmetic operator.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type ** interface.')")
! Use a larger error tolerance for large exponents.
RSMALL = EPSILON(1.0)*10000.0
DSMALL = EPSILON(1.0D0)*10000.0
NCASE = 735
MFM3 = J2 ** MFM1
CALL FM_ST2M('131',MFM4)
CALL FM_POWER(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 736
J4 = 2
MIM3 = J4 ** MIM1
CALL IM_ST2M('2',MIM4)
CALL IM_POWER(MIM4,MIM1,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 737
MZM3 = J2 ** MZM1
CALL ZM_ST2M('131',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 738
MFM3 = R2 ** MFM1
CALL FM_ST2M('241.21',MFM4)
CALL FM_POWER(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 739
CALL FM_ST2M('241.21',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_POWER(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = R2 ** MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 740
MZM3 = R2 ** MZM1
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 741
MFM3 = D2 ** MFM1
CALL FM_ST2M('391.61',MFM4)
CALL FM_POWER(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 742
CALL FM_ST2M('391.61',MFM4)
CALL FM_ST2M('661',MFM3)
CALL FM_POWER(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = D2 ** MIM1
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 743
MZM3 = D2 ** MZM1
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 744
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 ** MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 745
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = C2 ** MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 746
MZM3 = C2 ** MZM1
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 747
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 ** MFM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 748
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_ST2M('661',MZM3)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = CD2 ** MIM1
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 749
MZM3 = CD2 ** MZM1
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 750
MFM3 = MFM1 ** J2
CALL FM_ST2M('131',MFM4)
CALL FM_POWER(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 751
MFM3 = MFM1 ** R2
CALL FM_ST2M('241.21',MFM4)
CALL FM_POWER(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 752
MFM3 = MFM1 ** D2
CALL FM_ST2M('391.61',MFM4)
CALL FM_POWER(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 753
CALL ZM_ST2M('581.21',MZM3)
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_POWER(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 ** C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 754
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MFM1 ** CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 755
MFM3 = MFM1 ** MFM2
CALL FM_POWER(MFM1,MFM2,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 756
MFM3 = MFM1 ** MIM1
CALL FM_ST2M('661',MFM4)
CALL FM_POWER(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 757
MZM3 = MFM1 ** MZM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 758
J4 = 17
MIM3 = MIM1 ** J4
CALL IM_ST2M('17',MIM4)
CALL IM_POWER(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 759
CALL FM_ST2M('241.21',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_POWER(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 ** R2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 760
CALL FM_ST2M('391.61',MFM3)
CALL FM_ST2M('661',MFM4)
CALL FM_POWER(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = MIM1 ** D2
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 761
CALL ZM_ST2M('411.11 + 421.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 ** C2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 762
CALL ZM_ST2M('431.11 + 441.21 i',MZM3)
CALL ZM_ST2M('661',MZM4)
CALL ZM_POWER(MZM4,MZM3,MZM5)
CALL ZM_EQ(MZM5,MZM4)
MZM3 = MIM1 ** CD2
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 763
MFM3 = MIM1 ** MFM1
CALL FM_ST2M('661',MFM4)
CALL FM_POWER(MFM4,MFM1,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM4 == MFM3)) CALL PRTERR(KW)
NCASE = 764
MIM4 = 19
MIM3 = MIM1 ** MIM4
CALL IM_POWER(MIM1,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM4 == MIM3)) CALL PRTERR(KW)
NCASE = 765
MZM3 = MIM1 ** MZM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_POWER(MZM4,MZM1,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 766
MZM3 = MZM1 ** J2
CALL ZM_ST2M('131',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 767
MZM3 = MZM1 ** R2
CALL ZM_ST2M('241.21',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 768
MZM3 = MZM1 ** D2
CALL ZM_ST2M('391.61',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 769
MZM3 = MZM1 ** C2
CALL ZM_ST2M('411.11 + 421.21 i',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > RSMALL) CALL PRTERR(KW)
NCASE = 770
MZM3 = MZM1 ** CD2
CALL ZM_ST2M('431.11 + 441.21 i',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
IF (MFM4 > DSMALL) CALL PRTERR(KW)
NCASE = 771
MZM3 = MZM1 ** MFM1
CALL ZM_ST2M('581.21',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 772
MZM3 = MZM1 ** MIM1
CALL ZM_ST2M('661',MZM4)
CALL ZM_POWER(MZM1,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
NCASE = 773
MZM3 = MZM1 ** MZM2
CALL ZM_POWER(MZM1,MZM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM4 == MZM3)) CALL PRTERR(KW)
END SUBROUTINE TEST35
SUBROUTINE TEST36
! Test functions ABS, ..., CEILING.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type ABS, ..., CEILING interfaces.')")
NCASE = 774
MFM3 = ABS(MFM1)
CALL FM_ABS(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 775
MIM3 = ABS(MIM1)
CALL IM_ABS(MIM1,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 776
MFM3 = ABS(MZM1)
CALL ZM_ABS(MZM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 777
MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = ABS(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ABS(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 778
MIMV1 = TO_IM( (/ 12, -34, 56 /) )
MIMV2 = ABS(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == ABS(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 779
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV2 = ABS(MZMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ABS(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 780
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = ABS(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ABS(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 781
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = ABS(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == ABS(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 782
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFMB = ABS(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ABS(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 783
CALL FM_ST2M('0.7654',MFM4)
MFM3 = ACOS(MFM4)
CALL FM_ACOS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 784
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ACOS(MZM4)
CALL ZM_ACOS(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 785
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ACOS(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ACOS(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 786
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ACOS(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ACOS(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 787
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ACOS(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ACOS(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 788
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ACOS(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ACOS(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 789
CALL FM_ST2M('1.7654',MFM4)
MFM3 = ACOSH(MFM4)
CALL FM_ACOSH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 790
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ACOSH(MZM4)
CALL ZM_ACOSH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 791
MFMV1 = TO_FM( (/ 1.121123456789D0, 2.342123456789D0, 3.563123456789D0 /) )
MFMV2 = ACOSH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ACOSH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 792
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ACOSH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ACOSH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 793
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = 1 + TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ACOSH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ACOSH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 794
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ACOSH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ACOSH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 795
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MFM3 = AIMAG(MZM4)
CALL ZM_IMAG(MZM4,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 796
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV2 = AIMAG(MZMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == AIMAG(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 797
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFMB = AIMAG(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == AIMAG(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 798
MFM3 = AINT(MFM1)
CALL FM_INT(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 799
MZM3 = AINT(MZM1)
CALL ZM_INT(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 800
MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = AINT(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == AINT(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 801
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = AINT(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == AINT(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 802
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = AINT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == AINT(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 803
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = AINT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == AINT(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 804
MFM3 = ANINT(MFM1)
CALL FM_NINT(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 805
MZM3 = ANINT(MZM1)
CALL ZM_NINT(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 806
MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = ANINT(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ANINT(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 807
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ANINT(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ANINT(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 808
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = ANINT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ANINT(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 809
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ANINT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ANINT(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 810
CALL FM_ST2M('0.7654',MFM4)
MFM3 = ASIN(MFM4)
CALL FM_ASIN(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 811
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ASIN(MZM4)
CALL ZM_ASIN(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 812
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ASIN(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ASIN(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 813
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ASIN(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ASIN(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 814
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ASIN(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ASIN(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 815
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ASIN(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ASIN(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 816
CALL FM_ST2M('0.7654',MFM4)
MFM3 = ASINH(MFM4)
CALL FM_ASINH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 817
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ASINH(MZM4)
CALL ZM_ASINH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 818
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ASINH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ASINH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 819
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ASINH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ASINH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 820
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ASINH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ASINH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 821
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ASINH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ASINH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 822
CALL FM_ST2M('0.7654',MFM4)
MFM3 = ATAN(MFM4)
CALL FM_ATAN(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 823
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ATAN(MZM4)
CALL ZM_ATAN(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 824
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ATAN(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ATAN(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 825
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ATAN(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ATAN(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 826
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ATAN(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ATAN(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 827
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ATAN(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ATAN(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 828
MFM3 = ATAN2(MFM1,MFM2)
CALL FM_ATAN2(MFM1,MFM2,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 829
MFM3 = ATAN2(MFM1,MFM2)
CALL FM_ATAN2(MFM1,MFM2,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 830
CALL FM_ST2M('0.7654',MFM4)
MFM3 = ATANH(MFM4)
CALL FM_ATANH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 831
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = ATANH(MZM4)
CALL ZM_ATANH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 832
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ATANH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ATANH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 833
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = ATANH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == ATANH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 834
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ATANH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ATANH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 835
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = ATANH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == ATANH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 836
JERR = -1
DO J = 0, 10
IF (BTEST(661,J)) THEN
IF (.NOT.BTEST(MIM1,J)) JERR = J
ELSE
IF (BTEST(MIM1,J)) JERR = J
ENDIF
ENDDO
IF (JERR >= 0) CALL PRTERR(KW)
NCASE = 837
CALL FM_ST2M('12.37654',MFM4)
MFM3 = CEILING(MFM4)
CALL FM_ST2M('13',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 838
CALL FM_ST2M('12.0',MFM4)
MFM3 = CEILING(MFM4)
CALL FM_ST2M('12',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 839
CALL FM_ST2M('-12.7654',MFM4)
MFM3 = CEILING(MFM4)
CALL FM_ST2M('-12',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 840
CALL FM_ST2M('-12.7654',MFM4)
CALL FM_CEILING(MFM4,MFM3)
CALL FM_ST2M('-12',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 841
CALL ZM_ST2M('12.37654 - 22.54 i',MZM4)
MZM3 = CEILING(MZM4)
CALL ZM_ST2M('13 - 22 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 842
CALL ZM_ST2M('12.0 - 22.0 i',MZM4)
MZM3 = CEILING(MZM4)
CALL ZM_ST2M('12 - 22 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 843
CALL ZM_ST2M('-12.7654 + 22.31 i',MZM4)
MZM3 = CEILING(MZM4)
CALL ZM_ST2M('-12 + 23 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 844
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = CEILING(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == CEILING(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 845
MIMV1 = TO_IM( (/ 12, -34, 56 /) )
MIMV2 = CEILING(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == CEILING(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 846
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CEILING(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == CEILING(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 847
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = CEILING(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == CEILING(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 848
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = CEILING(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == CEILING(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 849
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CEILING(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == CEILING(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
END SUBROUTINE TEST36
SUBROUTINE TEST37
! Test functions CMPLX, ..., EXPONENT.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type CMPLX, ..., EXPONENT interfaces.')")
NCASE = 850
MZM3 = CMPLX(MFM1,MFM2)
CALL ZM_COMPLEX(MFM1,MFM2,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 851
MZM3 = CMPLX(MFM1,MFM2)
CALL ZMCOMPLEX(MFM1%MFM,MFM2%MFM,MZM5%MZM)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 852
MZM3 = CMPLX(MIM1,MIM2)
CALL IM_I2FM(MIM1,MFM3)
CALL IM_I2FM(MIM2,MFM4)
CALL ZM_COMPLEX(MFM3,MFM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 853
MZM3 = CMPLX(MFM1)
CALL FM_I2M(0,MFM4)
CALL ZM_COMPLEX(MFM1,MFM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 854
MZM3 = CMPLX(MIM1)
CALL IM_I2FM(MIM1,MFM3)
CALL FM_I2M(0,MFM4)
CALL ZM_COMPLEX(MFM3,MFM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 855
MZM3 = CONJG(MZM1)
CALL ZM_CONJUGATE(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 856
MZM3 = CONJG(MZM1)
CALL ZMCONJUGATE(MZM1%MZM,MZM4%MZM)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 857
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CONJG(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == CONJG(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 858
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CONJG(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == CONJG(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 859
CALL FM_ST2M('0.7654',MFM4)
MFM3 = COS(MFM4)
CALL FM_COS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 860
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = COS(MZM4)
CALL ZM_COS(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 861
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = COS(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == COS(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 862
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = COS(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == COS(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 863
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = COS(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == COS(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 864
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = COS(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == COS(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 865
CALL FM_ST2M('0.7654',MFM4)
MFM3 = COSH(MFM4)
CALL FM_COSH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 866
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = COSH(MZM4)
CALL ZM_COSH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 867
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = COSH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == COSH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 868
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = COSH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == COSH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 869
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = COSH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == COSH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 870
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = COSH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == COSH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 871
MFM3 = DBLE(MFM1)
CALL FM_EQ(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 872
MFM3 = DBLE(MIM1)
CALL IM_I2FM(MIM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 873
MFM3 = DBLE(MZM1)
CALL ZM_REAL(MZM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 874
J = DIGITS(MFM1)
IF (J /= NDIG) CALL PRTERR(KW)
NCASE = 875
J = DIGITS(MIM1)
IF (J /= SIZE_OF_MWK/10) CALL PRTERR(KW)
NCASE = 876
J = DIGITS(MZM1)
IF (J /= NDIG) CALL PRTERR(KW)
NCASE = 877
MFM3 = DIM(MFM1,MFM2)
CALL FM_DIM(MFM1,MFM2,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 878
MIM3 = DIM(MIM1,MIM2)
CALL IM_DIM(MIM1,MIM2,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 879
MFM3 = DINT(MFM1)
CALL FM_INT(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 880
MZM3 = DINT(MZM1)
CALL ZM_INT(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 881
MFM3 = TO_FM(' 12.34 ')
IF (IS_OVERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 882
MFM3 = TO_FM(' OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 883
MFM3 = TO_FM(' -OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 884
MIM3 = TO_IM(' 123456e+345 ')
IF (IS_OVERFLOW(MIM3)) CALL PRTERR(KW)
NCASE = 885
MIM3 = TO_IM(' OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MIM3)) CALL PRTERR(KW)
NCASE = 886
MIM3 = TO_IM(' -OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MIM3)) CALL PRTERR(KW)
NCASE = 887
MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
IF (IS_OVERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 888
MZM3 = TO_ZM(' OVERFLOW + OVERFLOW i ')
IF (.NOT. IS_OVERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 889
MZM3 = TO_ZM(' -OVERFLOW - OVERFLOW i ')
IF (.NOT. IS_OVERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 890
MFM3 = TO_FM(' 12.34 ')
IF (IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 891
MFM3 = TO_FM(' UNDERFLOW ')
IF (.NOT. IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 892
MFM3 = TO_FM(' -UNDERFLOW ')
IF (.NOT. IS_UNDERFLOW(MFM3)) CALL PRTERR(KW)
NCASE = 893
MIM3 = TO_IM(' 123456e+345 ')
IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)
! Note TO_IM(' UNDERFLOW ') gives zero.
NCASE = 894
MIM3 = TO_IM(' UNDERFLOW ')
IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)
NCASE = 895
MIM3 = TO_IM(' -UNDERFLOW ')
IF (IS_UNDERFLOW(MIM3)) CALL PRTERR(KW)
NCASE = 896
MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
IF (IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 897
MZM3 = TO_ZM(' UNDERFLOW + UNDERFLOW i ')
IF (.NOT. IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 898
MZM3 = TO_ZM(' -UNDERFLOW - UNDERFLOW i ')
IF (.NOT. IS_UNDERFLOW(MZM3)) CALL PRTERR(KW)
NCASE = 899
MFM3 = TO_FM(' 12.34 ')
IF (IS_UNKNOWN(MFM3)) CALL PRTERR(KW)
NCASE = 900
MFM3 = TO_FM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MFM3)) CALL PRTERR(KW)
NCASE = 901
MFM3 = TO_FM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MFM3)) CALL PRTERR(KW)
NCASE = 902
MIM3 = TO_IM(' 123456e+345 ')
IF (IS_UNKNOWN(MIM3)) CALL PRTERR(KW)
NCASE = 903
MIM3 = TO_IM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MIM3)) CALL PRTERR(KW)
NCASE = 904
MIM3 = TO_IM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MIM3)) CALL PRTERR(KW)
NCASE = 905
MZM3 = TO_ZM(' 45.67 - 0.4321 i ')
IF (IS_UNKNOWN(MZM3)) CALL PRTERR(KW)
NCASE = 906
MZM3 = TO_ZM(' UNKNOWN + 2.6 i ')
IF (.NOT. IS_UNKNOWN(MZM3)) CALL PRTERR(KW)
NCASE = 907
MZM3 = TO_ZM(' -3.7 - UNKNOWN i ')
IF (.NOT. IS_UNKNOWN(MZM3)) CALL PRTERR(KW)
NCASE = 908
CALL FM_ST2M('1.23',MFMV1(1))
CALL FM_ST2M('2.23',MFMV1(2))
CALL FM_ST2M('3.23',MFMV1(3))
CALL FM_ST2M('4.23',MFMV2(1))
CALL FM_ST2M('5.23',MFMV2(2))
CALL FM_ST2M('6.23',MFMV2(3))
MFM3 = DOT_PRODUCT(MFMV1,MFMV2)
MFM4 = 0
DO J = 1, 3
MFM4 = MFM4 + MFMV1(J)*MFMV2(J)
ENDDO
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 909
IF (IS_OVERFLOW(MFMV1)) CALL PRTERR(KW)
NCASE = 910
MFMV1(3) = TO_FM(' OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MFMV1)) CALL PRTERR(KW)
NCASE = 911
IF (IS_UNDERFLOW(MFMV1)) CALL PRTERR(KW)
NCASE = 912
MFMV1(3) = TO_FM(' -UNDERFLOW ')
IF (.NOT. IS_UNDERFLOW(MFMV1)) CALL PRTERR(KW)
NCASE = 913
IF (IS_UNKNOWN(MFMV1)) CALL PRTERR(KW)
NCASE = 914
MFMV1(3) = TO_FM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MFMV1)) CALL PRTERR(KW)
NCASE = 915
CALL IM_ST2M('12',MIMV1(1))
CALL IM_ST2M('23',MIMV1(2))
CALL IM_ST2M('34',MIMV1(3))
CALL IM_ST2M('-14',MIMV2(1))
CALL IM_ST2M('-5',MIMV2(2))
CALL IM_ST2M('16',MIMV2(3))
MIM3 = DOT_PRODUCT(MIMV1,MIMV2)
MIM4 = 0
DO J = 1, 3
MIM4 = MIM4 + MIMV1(J)*MIMV2(J)
ENDDO
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 916
IF (IS_OVERFLOW(MIMV1)) CALL PRTERR(KW)
NCASE = 917
MIMV1(2) = TO_IM(' -OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MIMV1)) CALL PRTERR(KW)
NCASE = 918
IF (IS_UNDERFLOW(MIMV1)) CALL PRTERR(KW)
NCASE = 919
MIMV1(2) = TO_IM(' -UNDERFLOW ')
IF (IS_UNDERFLOW(MIMV1)) CALL PRTERR(KW)
NCASE = 920
IF (IS_UNKNOWN(MIMV1)) CALL PRTERR(KW)
NCASE = 921
MIMV1(2) = TO_IM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MIMV1)) CALL PRTERR(KW)
NCASE = 922
CALL ZM_ST2M('1.23 + 1.67 i',MZMV1(1))
CALL ZM_ST2M('2.23 - 2.56 i',MZMV1(2))
CALL ZM_ST2M('3.23 + 3.45 i',MZMV1(3))
CALL ZM_ST2M('4.23 - 4.34 i',MZMV2(1))
CALL ZM_ST2M('5.23 + 5.23 i',MZMV2(2))
CALL ZM_ST2M('6.23 - 6.12 i',MZMV2(3))
MZM3 = DOT_PRODUCT(MZMV1,MZMV2)
MZM4 = 0
DO J = 1, 3
MZM4 = MZM4 + CONJG(MZMV1(J))*MZMV2(J)
ENDDO
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 923
IF (IS_OVERFLOW(MZMV1)) CALL PRTERR(KW)
NCASE = 924
MZMV1(2) = TO_ZM(' -OVERFLOW - OVERFLOW i ')
IF (.NOT. IS_OVERFLOW(MZMV1)) CALL PRTERR(KW)
NCASE = 925
IF (IS_UNDERFLOW(MZMV1)) CALL PRTERR(KW)
NCASE = 926
MZMV1(2) = TO_ZM(' -UNDERFLOW - UNDERFLOW i ')
IF (.NOT. IS_UNDERFLOW(MZMV1)) CALL PRTERR(KW)
NCASE = 927
IF (IS_UNKNOWN(MZMV1)) CALL PRTERR(KW)
NCASE = 928
MZMV1(2) = TO_ZM(' -3.7 - UNKNOWN i ')
IF (.NOT. IS_UNKNOWN(MZMV1)) CALL PRTERR(KW)
NCASE = 929
MFM3 = EPSILON(MFM1)
CALL FM_I2M(1,MFM4)
CALL FM_ULP(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 930
CALL FM_EPSILON(MFM1,MFM3)
CALL FM_I2M(1,MFM4)
CALL FM_ULP(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 931
CALL FM_ST2M('0.7654',MFM4)
MFM3 = EXP(MFM4)
CALL FM_EXP(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 932
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = EXP(MZM4)
CALL ZM_EXP(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 933
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = EXP(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == EXP(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 934
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = EXP(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == EXP(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 935
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = EXP(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == EXP(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 936
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = EXP(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == EXP(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 937
J = EXPONENT(MFM1)
IF (J /= INT(MWK(START(MFM1%MFM)+2))) CALL PRTERR(KW)
END SUBROUTINE TEST37
SUBROUTINE TEST38
! Test functions FLOOR, ..., MIN.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type FLOOR, ..., MIN interfaces.')")
NCASE = 938
CALL FM_ST2M('12.37654',MFM4)
MFM3 = FLOOR(MFM4)
CALL FM_ST2M('12',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 939
CALL FM_ST2M('12.0',MFM4)
MFM3 = FLOOR(MFM4)
CALL FM_ST2M('12',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 940
CALL FM_ST2M('-12.7654',MFM4)
MFM3 = FLOOR(MFM4)
CALL FM_ST2M('-13',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 941
CALL FM_ST2M('-12.7654',MFM4)
CALL FM_FLOOR(MFM4,MFM3)
CALL FM_ST2M('-13',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 942
CALL IM_ST2M('12',MIM4)
MIM3 = FLOOR(MIM4)
CALL IM_ST2M('12',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 943
CALL IM_ST2M('-123',MIM4)
MIM3 = FLOOR(MIM4)
CALL IM_ST2M('-123',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 944
CALL ZM_ST2M('12.37654 - 22.54 i',MZM4)
MZM3 = FLOOR(MZM4)
CALL ZM_ST2M('12 - 23 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 945
CALL ZM_ST2M('12.0 - 22.0 i',MZM4)
MZM3 = FLOOR(MZM4)
CALL ZM_ST2M('12 - 22 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 946
CALL ZM_ST2M('-12.7654 + 22.31 i',MZM4)
MZM3 = FLOOR(MZM4)
CALL ZM_ST2M('-13 + 22 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 947
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = FLOOR(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == FLOOR(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 948
MIMV1 = TO_IM( (/ 12, -34, 56 /) )
MIMV2 = FLOOR(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == FLOOR(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 949
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = FLOOR(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == FLOOR(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 950
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = FLOOR(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == FLOOR(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 951
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = FLOOR(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == FLOOR(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 952
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = FLOOR(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == FLOOR(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 953
CALL FM_ST2M('12.37654',MFM4)
MFM3 = FRACTION(MFM4)
MWK(START(MFM4%MFM)+2) = 0
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 954
CALL FM_ST2M('12.37654',MFM4)
CALL FM_FRACTION(MFM4,MFM3)
MWK(START(MFM4%MFM)+2) = 0
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 955
CALL ZM_ST2M('12.37654 - 22.54',MZM4)
MZM3 = FRACTION(MZM4)
MWK(START(MZM4%MZM(1))+2) = 0
MWK(START(MZM4%MZM(2))+2) = 0
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 956
MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = FRACTION(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == FRACTION(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 957
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = FRACTION(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == FRACTION(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 958
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = FRACTION(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == FRACTION(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 959
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = FRACTION(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == FRACTION(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 960
MFM3 = HUGE(MFM1)
CALL FM_BIG(MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 961
MIM3 = HUGE(MIM1)
CALL IM_BIG(MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 962
MZM3 = HUGE(MZM1)
CALL FM_BIG(MFM4)
CALL ZM_COMPLEX(MFM4,MFM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 963
MFM3 = TINY(MFM1)
CALL FM_TINY(MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 964
MIM3 = INT(MFM1)
CALL FM_INT(MFM1,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 965
MIM3 = INT(MIM1)
CALL IM_EQ(MIM1,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 966
MIM3 = INT(MZM1)
CALL ZM_INT(MZM1,MZM4)
CALL ZM_REAL(MZM4,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 967
MFMV1 = TO_FM( (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = INT(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == INT(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 968
MIMV1 = TO_IM( (/ 12, -34, 56 /) )
MIMV2 = INT(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == INT(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 969
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = INT(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == INT(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 970
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = INT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == INT(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 971
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = INT(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == INT(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 972
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = INT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == INT(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 973
CALL FM_ST2M('0.7654',MFM4)
MFM3 = LOG(MFM4)
CALL FM_LN(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 974
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = LOG(MZM4)
CALL ZM_LN(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 975
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = LOG(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == LOG(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 976
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = LOG(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == LOG(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 977
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = LOG(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == LOG(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 978
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = LOG(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == LOG(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 979
CALL FM_ST2M('0.7654',MFM4)
MFM3 = LOG10(MFM4)
CALL FM_LOG10(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 980
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = LOG10(MZM4)
CALL ZM_LOG10(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 981
MFMV1 = TO_FM( (/ .121123456789D0, 34.2123456789D0, .563123456789D0 /) )
MFMV2 = LOG10(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == LOG10(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 982
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = LOG10(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == LOG10(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 983
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = LOG10(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == LOG10(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 984
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = LOG10(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == LOG10(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 985
DO I = 1, 3
DO J = 1, 3
MFMA(I,J) = 3*(J-1) + I
MFMB(I,J) = 3*(I-1) + J + 10
ENDDO
ENDDO
MFMC = MATMUL(MFMA,MFMB)
MFM3 = ABS(MFMC(1,1)-186)+ABS(MFMC(1,2)-198)+ABS(MFMC(1,3)-210)+ &
ABS(MFMC(2,1)-228)+ABS(MFMC(2,2)-243)+ABS(MFMC(2,3)-258)+ &
ABS(MFMC(3,1)-270)+ABS(MFMC(3,2)-288)+ABS(MFMC(3,3)-306)
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 986
DO I = 1, 3
DO J = 1, 3
MFMA(I,J) = 3*(J-1) + I
MFMB(I,J) = 3*(I-1) + J + 10
ENDDO
MFMV1(I) = MFMA(1,I)
ENDDO
MFMV2 = MATMUL(MFMV1,MFMB)
MFM3 = ABS(MFMV2(1)-186)+ABS(MFMV2(2)-198)+ABS(MFMV2(3)-210)
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 987
IF (IS_OVERFLOW(MFMA)) CALL PRTERR(KW)
NCASE = 988
MFMA(3,2) = TO_FM(' OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MFMA)) CALL PRTERR(KW)
NCASE = 989
IF (IS_UNDERFLOW(MFMA)) CALL PRTERR(KW)
NCASE = 990
MFMA(3,2) = TO_FM(' UNDERFLOW ')
IF (.NOT. IS_UNDERFLOW(MFMA)) CALL PRTERR(KW)
NCASE = 991
IF (IS_UNKNOWN(MFMA)) CALL PRTERR(KW)
NCASE = 992
MFMA(3,2) = TO_FM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MFMA)) CALL PRTERR(KW)
NCASE = 993
DO I = 1, 3
DO J = 1, 3
MFMA(I,J) = 3*(J-1) + I
MFMB(I,J) = 3*(I-1) + J + 10
ENDDO
MFMV1(I) = MFMB(I,1)
ENDDO
MFMV2 = MATMUL(MFMA,MFMV1)
MFM3 = ABS(MFMV2(1)-186)+ABS(MFMV2(2)-228)+ABS(MFMV2(3)-270)
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 994
DO I = 1, 2
DO J = 1, 2
MIMA(I,J) = 2*(J-1) + I + 20
MIMB(I,J) = 2*(I-1) + J + 30
ENDDO
ENDDO
MIMC = MATMUL(MIMA,MIMB)
MIM3 = ABS(MIMC(1,1)-1410) + ABS(MIMC(1,2)-1454) + &
ABS(MIMC(2,1)-1474) + ABS(MIMC(2,2)-1520)
IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)
NCASE = 995
IF (IS_OVERFLOW(MIMA)) CALL PRTERR(KW)
NCASE = 996
MIMA(1,2) = TO_IM(' OVERFLOW ')
IF (.NOT. IS_OVERFLOW(MIMA)) CALL PRTERR(KW)
NCASE = 997
IF (IS_UNDERFLOW(MIMA)) CALL PRTERR(KW)
NCASE = 998
MIMA(1,2) = TO_IM(' UNDERFLOW ')
IF (IS_UNDERFLOW(MIMA)) CALL PRTERR(KW)
NCASE = 999
IF (IS_UNKNOWN(MIMA)) CALL PRTERR(KW)
NCASE = 1000
MIMA(1,2) = TO_IM(' UNKNOWN ')
IF (.NOT. IS_UNKNOWN(MIMA)) CALL PRTERR(KW)
NCASE = 1001
DO I = 1, 2
DO J = 1, 2
MIMA(I,J) = 2*(J-1) + I + 20
MIMB(I,J) = 2*(I-1) + J + 30
ENDDO
MIMV1(I) = MIMA(I,1)
ENDDO
MIMV2(1:2) = MATMUL(MIMV1(1:2),MIMB)
MIM3 = ABS(MIMV2(1)-1377) + ABS(MIMV2(2)-1420)
IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)
NCASE = 1002
DO I = 1, 2
DO J = 1, 2
MIMA(I,J) = 2*(J-1) + I + 20
MIMB(I,J) = 2*(I-1) + J + 30
ENDDO
MIMV1(I) = MIMB(1,I)
ENDDO
MIMV2(1:2) = MATMUL(MIMA,MIMV1(1:2))
MIM3 = ABS(MIMV2(1)-1387) + ABS(MIMV2(2)-1450)
IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)
NCASE = 1003
DO I = 1, 2
DO J = 1, 3
MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
ENDDO
ENDDO
DO I = 1, 3
DO J = 1, 4
MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
ENDDO
ENDDO
MZMC = MATMUL(MZMA,MZMB)
MFM3 = ABS(MZMC(1,1)-TO_ZM('-270 + 5192 i')) + &
ABS(MZMC(1,2)-TO_ZM('-300 + 5300 i')) + &
ABS(MZMC(1,3)-TO_ZM('-330 + 5408 i')) + &
ABS(MZMC(1,4)-TO_ZM('-360 + 5516 i')) + &
ABS(MZMC(2,1)-TO_ZM('-210 + 5462 i')) + &
ABS(MZMC(2,2)-TO_ZM('-240 + 5576 i')) + &
ABS(MZMC(2,3)-TO_ZM('-270 + 5690 i')) + &
ABS(MZMC(2,4)-TO_ZM('-300 + 5804 i'))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1004
IF (IS_OVERFLOW(MZMA)) CALL PRTERR(KW)
NCASE = 1005
MZMA(2,2) = TO_ZM(' OVERFLOW - 23.45 i ')
IF (.NOT. IS_OVERFLOW(MZMA)) CALL PRTERR(KW)
NCASE = 1006
IF (IS_UNDERFLOW(MZMA)) CALL PRTERR(KW)
NCASE = 1007
MZMA(2,2) = TO_ZM(' UNDERFLOW - 23.45 i ')
IF (.NOT. IS_UNDERFLOW(MZMA)) CALL PRTERR(KW)
NCASE = 1008
IF (IS_UNKNOWN(MZMA)) CALL PRTERR(KW)
NCASE = 1009
MZMA(2,2) = TO_ZM(' UNKNOWN - 23.45 i ')
IF (.NOT. IS_UNKNOWN(MZMA)) CALL PRTERR(KW)
NCASE = 1010
DO I = 1, 2
DO J = 1, 3
MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
ENDDO
ENDDO
DO I = 1, 3
DO J = 1, 4
MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
ENDDO
MZMV1(I) = MZMA(1,I)
ENDDO
MZMV5 = MATMUL(MZMV1,MZMB)
MFM3 = ABS(MZMV5(1)-TO_ZM('-270 + 5192 i')) + &
ABS(MZMV5(2)-TO_ZM('-300 + 5300 i')) + &
ABS(MZMV5(3)-TO_ZM('-330 + 5408 i')) + &
ABS(MZMV5(4)-TO_ZM('-360 + 5516 i'))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1011
DO I = 1, 2
DO J = 1, 3
MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
ENDDO
ENDDO
DO I = 1, 3
DO J = 1, 4
MZMB(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
ENDDO
MZMV1(I) = MZMB(I,1)
ENDDO
MZMV2(1:2) = MATMUL(MZMA,MZMV1)
MFM3 = ABS(MZMV2(1)-TO_ZM('-270 + 5192 i')) + &
ABS(MZMV2(2)-TO_ZM('-210 + 5462 i'))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1012
DO I = 1, 3
DO J = 1, 3
MFMA(I,J) = 3*(J-1) + I
ENDDO
ENDDO
MFMC = TRANSPOSE(MFMA)
MFM3 = ABS(MFMC(1,1)-MFMA(1,1))+ABS(MFMC(1,2)-MFMA(2,1))+ABS(MFMC(1,3)-MFMA(3,1))+ &
ABS(MFMC(2,1)-MFMA(1,2))+ABS(MFMC(2,2)-MFMA(2,2))+ABS(MFMC(2,3)-MFMA(3,2))+ &
ABS(MFMC(3,1)-MFMA(1,3))+ABS(MFMC(3,2)-MFMA(2,3))+ABS(MFMC(3,3)-MFMA(3,3))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1013
DO I = 1, 3
DO J = 1, 2
MFME(I,J) = 7*(J-1) + I
ENDDO
ENDDO
MFMF = TRANSPOSE(MFME)
MFM3 = ABS(MFME(1,1)-MFMF(1,1))+ABS(MFME(1,2)-MFMF(2,1))+ &
ABS(MFME(2,1)-MFMF(1,2))+ABS(MFME(2,2)-MFMF(2,2))+ &
ABS(MFME(3,1)-MFMF(1,3))+ABS(MFME(3,2)-MFMF(2,3))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1014
DO I = 1, 3
DO J = 1, 3
MIMA2(I,J) = 3*(J-1) + I
ENDDO
ENDDO
MIMB2 = TRANSPOSE(MIMA2)
MIM3 = ABS(MIMB2(1,1)-MIMA2(1,1))+ABS(MIMB2(1,2)-MIMA2(2,1))+ABS(MIMB2(1,3)-MIMA2(3,1))+ &
ABS(MIMB2(2,1)-MIMA2(1,2))+ABS(MIMB2(2,2)-MIMA2(2,2))+ABS(MIMB2(2,3)-MIMA2(3,2))+ &
ABS(MIMB2(3,1)-MIMA2(1,3))+ABS(MIMB2(3,2)-MIMA2(2,3))+ABS(MIMB2(3,3)-MIMA2(3,3))
IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)
NCASE = 1015
DO I = 1, 3
DO J = 1, 2
MIMD(I,J) = 7*(J-1) + I
ENDDO
ENDDO
MIME = TRANSPOSE(MIMD)
MIM3 = ABS(MIMD(1,1)-MIME(1,1))+ABS(MIMD(1,2)-MIME(2,1))+ &
ABS(MIMD(2,1)-MIME(1,2))+ABS(MIMD(2,2)-MIME(2,2))+ &
ABS(MIMD(3,1)-MIME(1,3))+ABS(MIMD(3,2)-MIME(2,3))
IF (.NOT.(MIM3 == 0)) CALL PRTERR(KW)
NCASE = 1016
DO I = 1, 3
DO J = 1, 3
MZMA2(I,J) = CMPLX(TO_FM('62.3')+3*(I+3*(J-1)), TO_FM('-72.4')+7*(I+3*(J-1)))
ENDDO
ENDDO
MZMB2 = TRANSPOSE(MZMA2)
MFM3 = ABS(MZMB2(1,1)-MZMA2(1,1))+ABS(MZMB2(1,2)-MZMA2(2,1))+ABS(MZMB2(1,3)-MZMA2(3,1))+ &
ABS(MZMB2(2,1)-MZMA2(1,2))+ABS(MZMB2(2,2)-MZMA2(2,2))+ABS(MZMB2(2,3)-MZMA2(3,2))+ &
ABS(MZMB2(3,1)-MZMA2(1,3))+ABS(MZMB2(3,2)-MZMA2(2,3))+ABS(MZMB2(3,3)-MZMA2(3,3))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1017
DO I = 1, 3
DO J = 1, 2
MZMD(I,J) = CMPLX(TO_FM('62.3')+3*(I+3*(J-1)), TO_FM('-72.4')+7*(I+3*(J-1)))
ENDDO
ENDDO
MZMA = TRANSPOSE(MZMD)
MFM3 = ABS(MZMD(1,1)-MZMA(1,1))+ABS(MZMD(1,2)-MZMA(2,1))+ &
ABS(MZMD(2,1)-MZMA(1,2))+ABS(MZMD(2,2)-MZMA(2,2))+ &
ABS(MZMD(3,1)-MZMA(1,3))+ABS(MZMD(3,2)-MZMA(2,3))
IF (.NOT.(MFM3 == 0)) CALL PRTERR(KW)
NCASE = 1018
MFM3 = MAX(MFM1,MFM2)
CALL FM_MAX(MFM1,MFM2,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1019
CALL FM_ST2M('0.7654',MFM4)
MFM3 = MAX(MFM2,MFM1,MFM4)
CALL FM_MAX(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_MAX(MFM2,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1020
CALL FM_ST2M('0.7654',MFM4)
MFM3 = MAX(MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2)
CALL FM_MAX(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_MAX(MFM2,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1021
MIM3 = MAX(MIM1,MIM2)
CALL IM_MAX(MIM1,MIM2,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1022
CALL IM_ST2M('7654',MIM4)
CALL IM_ST2M('-1654',MIM3)
MIM3 = MAX(MIM2,MIM1,MIM3,MIM4)
CALL IM_ST2M('7654',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1023
CALL IM_ST2M('7654',MIM4)
CALL IM_ST2M('-1654',MIM3)
MIM3 = MAX(MIM2,MIM1,MIM3,MIM4,MIM2,MIM1,MIM3,MIM4,MIM2,MIM1)
CALL IM_ST2M('7654',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1024
J = MAXEXPONENT(MFM1)
IF (J /= INT(MXEXP)+1) CALL PRTERR(KW)
NCASE = 1025
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
MFM3 = MAXVAL(MFMV1)
MFM3 = ABS(MFM3 - MFMV1(3))
CALL FM_ST2M(' 0 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1026
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
IF (.NOT.(MAXLOC(MFMV1) == 3)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1027
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
IF (.NOT.(MINLOC(MFMV1) == 2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1028
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM3 = MAXVAL(MFMA)
MFM3 = ABS(MFM3 - MFMA(3,3))
CALL FM_ST2M(' 0 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1029
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMA(2,3) = 314159.7
ML = MAXLOC(MFMA)
IF (.NOT.(ML(1) == 2 .AND. ML(2) == 3)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1030
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMA(3,1) = -314159.7
ML = MINLOC(MFMA)
IF (.NOT.(ML(1) == 3 .AND. ML(2) == 1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1031
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MIM3 = MAXVAL(MIMV1)
MIM3 = ABS(MIM3 - MIMV1(3))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1032
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
IF (.NOT.(MAXLOC(MIMV1) == 3)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1033
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
IF (.NOT.(MINLOC(MIMV1) == 2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1034
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM3 = MAXVAL(MIMA2)
MIM3 = ABS(MIM3 - MIMA2(3,3))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1035
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMA2(2,3) = 314159
ML = MAXLOC(MIMA2)
IF (.NOT.(ML(1) == 2 .AND. ML(2) == 3)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1036
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMA2(3,1) = -314159
ML = MINLOC(MIMA2)
IF (.NOT.(ML(1) == 3 .AND. ML(2) == 1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1037
MFM3 = MIN(MFM1,MFM2)
CALL FM_MIN(MFM1,MFM2,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1038
CALL FM_ST2M('0.7654',MFM4)
MFM3 = MIN(MFM2,MFM1,MFM4)
CALL FM_MIN(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_MIN(MFM2,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1039
CALL FM_ST2M('0.7654',MFM4)
MFM3 = MIN(MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2,MFM1,MFM4,MFM2)
CALL FM_MIN(MFM1,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_MIN(MFM2,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1040
MIM3 = MIN(MIM1,MIM2)
CALL IM_MIN(MIM1,MIM2,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1041
CALL IM_ST2M('7654',MIM4)
CALL IM_ST2M('-1654',MIM3)
MIM3 = MIN(MIM2,MIM1,MIM3,MIM4)
CALL IM_ST2M('-1654',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1042
CALL IM_ST2M('7654',MIM4)
CALL IM_ST2M('-1654',MIM3)
MIM3 = MIN(MIM2,MIM1,MIM3,MIM4,MIM2,MIM1,MIM3,MIM4,MIM2,MIM1)
CALL IM_ST2M('-1654',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
END SUBROUTINE TEST38
SUBROUTINE TEST39
! Test functions MINEXPONENT, ..., RRSPACING.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type MINEXPONENT, ..., RRSPACING interfaces.')")
NCASE = 1043
J = MINEXPONENT(MFM1)
IF (J /= -INT(MXEXP)) CALL PRTERR(KW)
NCASE = 1044
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM3 = MINVAL(MFMV1)
MFM3 = ABS(MFM3 - MFMV1(2))
CALL FM_ST2M(' 0 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1045
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM3 = MINVAL(MFMA)
MFM3 = ABS(MFM3 - MFMA(1,1))
CALL FM_ST2M(' 0 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1046
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MIM3 = MINVAL(MIMV1)
MIM3 = ABS(MIM3 - MIMV1(2))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1047
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM3 = MINVAL(MIMA2)
MIM3 = ABS(MIM3 - MIMA2(1,1))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1048
CALL FM_ST2M('8',MFM3)
CALL FM_ST2M('5',MFM4)
MFM3 = MOD(MFM3,MFM4)
CALL FM_ST2M('3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1049
CALL FM_ST2M('-8',MFM3)
CALL FM_ST2M('5',MFM4)
MFM3 = MOD(MFM3,MFM4)
CALL FM_ST2M('-3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1050
CALL FM_ST2M('8',MFM3)
CALL FM_ST2M('-5',MFM4)
MFM3 = MOD(MFM3,MFM4)
CALL FM_ST2M('3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1051
CALL FM_ST2M('-8',MFM3)
CALL FM_ST2M('-5',MFM4)
MFM3 = MOD(MFM3,MFM4)
CALL FM_ST2M('-3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1052
CALL IM_ST2M('8',MIM3)
CALL IM_ST2M('5',MIM4)
MIM3 = MOD(MIM3,MIM4)
CALL IM_ST2M('3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1053
CALL IM_ST2M('-8',MIM3)
CALL IM_ST2M('5',MIM4)
MIM3 = MOD(MIM3,MIM4)
CALL IM_ST2M('-3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1054
CALL IM_ST2M('8',MIM3)
CALL IM_ST2M('-5',MIM4)
MIM3 = MOD(MIM3,MIM4)
CALL IM_ST2M('3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1055
CALL IM_ST2M('-8',MIM3)
CALL IM_ST2M('-5',MIM4)
MIM3 = MOD(MIM3,MIM4)
CALL IM_ST2M('-3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1056
CALL FM_ST2M('8',MFM3)
CALL FM_ST2M('5',MFM4)
MFM3 = MODULO(MFM3,MFM4)
CALL FM_ST2M('3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1057
CALL FM_ST2M('8',MFM3)
CALL FM_ST2M('5',MFM4)
CALL FM_MODULO(MFM3,MFM4,MFM5)
CALL FM_EQ(MFM5,MFM3)
CALL FM_ST2M('3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1058
CALL FM_ST2M('-8',MFM3)
CALL FM_ST2M('5',MFM4)
MFM3 = MODULO(MFM3,MFM4)
CALL FM_ST2M('2',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1059
CALL FM_ST2M('8',MFM3)
CALL FM_ST2M('-5',MFM4)
MFM3 = MODULO(MFM3,MFM4)
CALL FM_ST2M('-2',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1060
CALL FM_ST2M('-8',MFM3)
CALL FM_ST2M('-5',MFM4)
MFM3 = MODULO(MFM3,MFM4)
CALL FM_ST2M('-3',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1061
CALL IM_ST2M('8',MIM3)
CALL IM_ST2M('5',MIM4)
MIM3 = MODULO(MIM3,MIM4)
CALL IM_ST2M('3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1062
CALL IM_ST2M('-8',MIM3)
CALL IM_ST2M('5',MIM4)
MIM3 = MODULO(MIM3,MIM4)
CALL IM_ST2M('2',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1063
CALL IM_ST2M('8',MIM3)
CALL IM_ST2M('-5',MIM4)
MIM3 = MODULO(MIM3,MIM4)
CALL IM_ST2M('-2',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1064
CALL IM_ST2M('-8',MIM3)
CALL IM_ST2M('-5',MIM4)
MIM3 = MODULO(MIM3,MIM4)
CALL IM_ST2M('-3',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1065
CALL FM_ST2M('0',MFM4)
CALL FM_ST2M('1',MFM3)
CALL FM_TINY(MFM5)
MFM3 = NEAREST(MFM4,MFM3)
IF (.NOT.(MFM3 == MFM5)) CALL PRTERR(KW)
NCASE = 1066
CALL FM_ST2M('0',MFM4)
CALL FM_ST2M('-1',MFM3)
CALL FM_TINY(MFM5)
CALL FM_MPYI_R1(MFM5,-1)
MFM3 = NEAREST(MFM4,MFM3)
IF (.NOT.(MFM3 == MFM5)) CALL PRTERR(KW)
NCASE = 1067
CALL FM_ST2M('2.345',MFM4)
CALL FM_ST2M('1',MFM3)
MFM3 = NEAREST(MFM4,MFM3)
CALL FM_ULP(MFM4,MFM5)
CALL FM_ADD(MFM4,MFM5,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1068
CALL FM_ST2M('2.345',MFM4)
CALL FM_ST2M('1',MFM3)
CALL FM_NEAREST(MFM4,MFM3,MFM5)
CALL FM_EQ(MFM5,MFM3)
CALL FM_ULP(MFM4,MFM5)
CALL FM_ADD(MFM4,MFM5,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1069
CALL FM_ST2M('2.345',MFM4)
CALL FM_ST2M('-1',MFM3)
MFM3 = NEAREST(MFM4,MFM3)
CALL FM_ULP(MFM4,MFM5)
CALL FM_SUB(MFM4,MFM5,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1070
CALL FM_ST2M('1',MFM4)
CALL FM_ST2M('-1',MFM3)
MFM3 = NEAREST(MFM4,MFM3)
CALL FM_ST2M('0.99',MFM5)
CALL FM_ULP(MFM5,MFM6)
CALL FM_EQ(MFM6,MFM5)
CALL FM_SUB(MFM4,MFM5,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1071
CALL FM_ST2M('-1',MFM4)
CALL FM_ST2M('12',MFM3)
MFM3 = NEAREST(MFM4,MFM3)
CALL FM_ST2M('-0.99',MFM5)
CALL FM_ULP(MFM5,MFM6)
CALL FM_EQ(MFM6,MFM5)
CALL FM_SUB(MFM4,MFM5,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1072
MIM3 = NINT(MFM1)
CALL FM_NINT(MFM1,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1073
MIM3 = NINT(MIM1)
CALL IM_EQ(MIM1,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1074
MIM3 = NINT(MZM1)
CALL ZM_NINT(MZM1,MZM4)
CALL ZM_REAL(MZM4,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1075
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = NINT(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == NINT(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1076
MIMV1 = TO_IM( (/ 12, -34, 56 /) )
MIMV2 = NINT(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == NINT(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1077
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = NINT(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == NINT(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1078
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = NINT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == NINT(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1079
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = (-1)**(J+K) * TO_IM(25+3*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = NINT(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == NINT(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1080
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = NINT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == NINT(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1081
J = PRECISION(MFM1)
IF (J /= INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)) CALL PRTERR(KW)
NCASE = 1082
J = PRECISION(MZM1)
IF (J /= INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)) CALL PRTERR(KW)
NCASE = 1083
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM3 = PRODUCT(MFMV1)
MFM4 = TO_FM('-23335.371886315713067263700860897069')
MFM3 = ABS(MFM3 - MFM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1084
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM3 = PRODUCT(MFMA)
MFM4 = TO_FM('1.11839386498724787888025199410658944266626022455926434E10')
MFM3 = ABS(MFM3 - MFM4)
CALL FM_ST2M(' 1.0E-35 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1085
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MIM3 = PRODUCT(MIMV1)
MIM3 = ABS(MIM3 - (-22848))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1086
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM3 = PRODUCT(MIMA2)
MIM3 = ABS(MIM3 - TO_IM('8821612800'))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1087
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , &
TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM3 = PRODUCT(MZMV1)
MZM4 = TO_ZM('-20423.717467422304481791683360897069 - '// &
' 22129.6037029617409201804816458 i')
MFM3 = ABS(MZM3 - MZM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1088
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM3 = PRODUCT(MZMA2)
MZM4 = TO_ZM('-1.99055822653094068848240107E17 + '// &
' 2.47926597678191251226278026E17 i')
MFM3 = ABS(MZM3 - MZM4)
CALL FM_ST2M(' 1.0E-28 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1089
J = RADIX(MFM1)
IF (J /= INT(MBASE)) CALL PRTERR(KW)
NCASE = 1090
J = RADIX(MIM1)
IF (J /= INT(MBASE)) CALL PRTERR(KW)
NCASE = 1091
J = RADIX(MZM1)
IF (J /= INT(MBASE)) CALL PRTERR(KW)
NCASE = 1092
J = RANGE(MFM1)
IF (J /= NINT((MXEXP+1)*LOG10(DBLE(MBASE)))-1) CALL PRTERR(KW)
NCASE = 1093
J = RANGE(MIM1)
IF (J /= INT(SIZE_OF_MWK/10*LOG10(REAL(MBASE)))) CALL PRTERR(KW)
NCASE = 1094
J = RANGE(MZM1)
IF (J /= NINT((MXEXP+1)*LOG10(DBLE(MBASE)))-1) CALL PRTERR(KW)
NCASE = 1095
MFM3 = REAL(MFM1)
CALL FM_EQ(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1096
MFM3 = REAL(MIM1)
CALL IM_I2FM(MIM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1097
MFM3 = REAL(MZM1)
CALL ZM_REAL(MZM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1098
MFM3 = RRSPACING(MFM1)
CALL FM_ABS(MFM1,MFM4)
MWK(START(MFM4%MFM)+2) = NDIG
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1099
CALL FM_RRSPACING(MFM1,MFM3)
CALL FM_ABS(MFM1,MFM4)
MWK(START(MFM4%MFM)+2) = NDIG
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
END SUBROUTINE TEST39
SUBROUTINE TEST40
! Test functions SCALE, ..., TINY.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type SCALE, ..., TINY interfaces.')")
NCASE = 1100
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SCALE(MFM4,1)
CALL FM_MPYI(MFM4,INT(MBASE),MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1101
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = SCALE(MZM4,-2)
CALL ZM_DIVI(MZM4,INT(MBASE),MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_DIVI(MZM4,INT(MBASE),MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1102
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SETEXPONENT(MFM4,1)
CALL FM_MPYI(MFM4,INT(MBASE),MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1103
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SIGN(MFM4,MFM2)
CALL FM_SIGN(MFM4,MFM2,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1104
CALL IM_ST2M('231',MIM4)
MIM3 = SIGN(MIM4,MIM2)
CALL IM_SIGN(MIM4,MIM2,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1105
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SIN(MFM4)
CALL FM_SIN(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1106
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = SIN(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == SIN(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1107
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = SIN(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == SIN(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1108
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = SIN(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == SIN(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1109
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = SIN(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == SIN(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1110
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = SIN(MZM4)
CALL ZM_SIN(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1111
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SINH(MFM4)
CALL FM_SINH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1112
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = SINH(MZM4)
CALL ZM_SINH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1113
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = SINH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == SINH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1114
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = SINH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == SINH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1115
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = SINH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == SINH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1116
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = SINH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == SINH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1117
CALL FM_ST2M('-0.7654',MFM4)
MFM3 = SPACING(MFM4)
CALL FM_ULP(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1118
CALL FM_ST2M('-0.7654',MFM4)
CALL FM_SPACING(MFM4,MFM3)
CALL FM_ULP(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1119
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SQRT(MFM4)
CALL FM_SQRT(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1120
CALL FM_ST2M('0.7654',MFM4)
MFM3 = SQRT(MFM4)
CALL FM_SQRT_R1(MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1121
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = SQRT(MZM4)
CALL ZM_SQRT(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1122
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = SQRT(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == SQRT(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1123
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = SQRT(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == SQRT(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1124
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = SQRT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == SQRT(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1125
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = SQRT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == SQRT(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1126
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM3 = SUM(MFMV1)
MFM4 = TO_FM('34.2123456789')
MFM3 = ABS(MFM3 - MFM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1127
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM3 = SUM(MFMA)
MFM4 = TO_FM('120')
MFM3 = ABS(MFM3 - MFM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1128
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MIM3 = SUM(MIMV1)
MIM3 = ABS(MIM3 - 34)
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1129
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM3 = SUM(MIMA2)
MIM3 = ABS(MIM3 - TO_IM('117'))
CALL IM_ST2M(' 0 ',MIM4)
IF (.NOT.(MIM3 <= MIM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1130
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , &
TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM3 = SUM(MZMV1)
MZM4 = TO_ZM('34.2123456789 + 4.17498 i')
MFM3 = ABS(MZM3 - MZM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1131
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM3 = SUM(MZMA2)
MZM4 = TO_ZM('695.7 - 336.6 i')
MFM3 = ABS(MZM3 - MZM4)
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1132
CALL FM_ST2M('0.7654',MFM4)
MFM3 = TAN(MFM4)
CALL FM_TAN(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1133
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = TAN(MZM4)
CALL ZM_TAN(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1134
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = TAN(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == TAN(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1135
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = TAN(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == TAN(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1136
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = TAN(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == TAN(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1137
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = TAN(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == TAN(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1138
CALL FM_ST2M('0.7654',MFM4)
MFM3 = TANH(MFM4)
CALL FM_TANH(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1139
CALL ZM_ST2M('0.7654 - 0.3456 i',MZM4)
MZM3 = TANH(MZM4)
CALL ZM_TANH(MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1140
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = TANH(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == TANH(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1141
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = TANH(MZMV1)
DO J = 1, 3
IF (.NOT.(MZMV2(J) == TANH(MZMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1142
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = TANH(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == TANH(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1143
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = TANH(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMB2(J,K) == TANH(MZMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1144
CALL FM_BIG(MFM4)
CALL FM_I2M(1,MFM3)
CALL FM_DIV(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = TINY(MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1145
MIM3 = TINY(MIM1)
CALL IM_I2M(1,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1146
CALL FM_BIG(MFM4)
CALL FM_I2M(1,MFM3)
CALL FM_DIV(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL ZM_COMPLEX(MFM4,MFM4,MZM4)
MZM3 = TINY(MZM1)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
END SUBROUTINE TEST40
SUBROUTINE TEST41
! Test functions TO_FM, TO_IM, TO_ZM, ..., TO_DPZ.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type TO_FM, ..., TO_DPZ interfaces.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
NCASE = 1147
MFM3 = TO_FM(123)
CALL FM_I2M(123,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1148
MFM3 = TO_FM(123.4)
CALL FM_SP2M(123.4,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1149
MFM3 = TO_FM(123.45D0)
CALL FM_DP2M(123.45D0,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1150
MFM3 = TO_FM(CMPLX(123.4,567.8))
CALL FM_SP2M(123.4,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1151
MFM3 = TO_FM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
CALL FM_DP2M(123.4D0,MFM4)
CALL FM_SUB(MFM3,MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_DIV(MFM4,MFM3,MFM6)
CALL FM_EQ(MFM6,MFM4)
CALL FM_ABS(MFM4,MFM6)
CALL FM_EQ(MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1152
MFM3 = TO_FM(MFM1)
CALL FM_EQ(MFM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1153
MFM3 = TO_FM(MIM1)
CALL IM_I2FM(MIM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1154
MFM3 = TO_FM(MZM1)
CALL ZM_REAL(MZM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1155
MFM3 = TO_FM('-123.654')
CALL FM_ST2M('-123.654',MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1156
JV = (/ 123, -432, 567 /)
MFMV1 = TO_FM(JV)
MFMV2 = JV
DO J = 1, 3
IF (.NOT.(MFMV1(J) == MFMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1157
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = TO_FM(RV)
MFMV2 = RV
DO J = 1, 3
IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1158
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = TO_FM(DV)
MFMV2 = DV
DO J = 1, 3
IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1159
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = TO_FM(CV)
MFMV2 = CV
DO J = 1, 3
IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1160
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = TO_FM(CDV)
MFMV2 = CDV
DO J = 1, 3
IF (ABS((MFMV1(J)-MFMV2(J))/MFMV2(J)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1161
MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
MFMV1 = TO_FM(MFMV4)
MFMV2 = MFMV4
DO J = 1, 3
IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1162
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MFMV1 = TO_FM(MIMV1)
MFMV2 = MIMV1
DO J = 1, 3
IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1163
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = TO_FM(MZMV1)
MFMV2 = MZMV1
DO J = 1, 3
IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1164
STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
MFMV1 = TO_FM(STV)
MFMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DO J = 1, 3
IF (ABS(MFMV1(J)-MFMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1165
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(JV2)
MFMB = JV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMA(J,K) == MFMB(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1166
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(RV2)
MFMB = RV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1167
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(DV2)
MFMB = DV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1168
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(CV2)
MFMB = CV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1169
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(CDV2)
MFMB = CDV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MFMA(J,K)-MFMB(J,K))/MFMB(J,K)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1170
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMA = TO_FM(MFMC)
MFMB = MFMC
DO J = 1, 3
DO K = 1, 3
IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1171
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMA = TO_FM(MIMA2)
MFMB = MIMA2
DO J = 1, 3
DO K = 1, 3
IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1172
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFMA = TO_FM(MZMA2)
MFMB = MZMA2
DO J = 1, 3
DO K = 1, 3
IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1173
STV2 = RESHAPE( (/ " 12.1123456789", "-34.2123456789", " 56.3123456789", &
" 23.1123456789", "-36.2123456789", " 66.3123456789", &
" 45.1123456789", "-38.2123456789", " 76.3123456789" &
/) , SHAPE = (/ 3,3 /) )
MFMA = TO_FM(STV2)
MFMB = RESHAPE( (/ TO_FM(" 12.1123456789"), TO_FM("-34.2123456789"), &
TO_FM(" 56.3123456789"), TO_FM(" 23.1123456789"), &
TO_FM("-36.2123456789"), TO_FM(" 66.3123456789"), &
TO_FM(" 45.1123456789"), TO_FM("-38.2123456789"), &
TO_FM(" 76.3123456789") &
/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
IF (ABS(MFMA(J,K)-MFMB(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1174
MIM3 = TO_IM(123)
CALL IM_I2M(123,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1175
MIM3 = TO_IM(123.4)
CALL FM_SP2M(123.4,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1176
MIM3 = TO_IM(1.234E+23)
CALL FM_SP2M(1.234E+23,MFM4)
MFM5 = ABS(MIM3-MFM4)/MFM4
IF (MFM5 >= RSMALL) CALL PRTERR(KW)
NCASE = 1177
MIM3 = TO_IM(123.45D0)
CALL FM_DP2M(123.45D0,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1178
MIM3 = TO_IM(1.234D+23)
CALL FM_DP2M(1.234D+23,MFM4)
MFM5 = ABS(MIM3-MFM4)/MFM4
IF (MFM5 >= DSMALL) CALL PRTERR(KW)
NCASE = 1179
MIM3 = TO_IM(CMPLX(123.4,567.8))
CALL FM_SP2M(123.4,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1180
MIM3 = TO_IM(CMPLX(1.234E+23,1.234E+23))
CALL FM_SP2M(1.234E+23,MFM4)
MFM5 = ABS(MIM3-MFM4)/MFM4
IF (MFM5 >= RSMALL) CALL PRTERR(KW)
NCASE = 1181
MIM3 = TO_IM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
CALL FM_DP2M(123.4D0,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1182
MIM3 = TO_IM(CMPLX(1.234D+23,1.234D+23,KIND(1.0D0)))
CALL FM_DP2M(1.234D+23,MFM4)
MFM5 = ABS(MIM3-MFM4)/MFM4
IF (MFM5 >= DSMALL) CALL PRTERR(KW)
NCASE = 1183
MIM3 = TO_IM(MFM1)
CALL FM_EQ(MFM1,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1184
MIM3 = TO_IM(MIM1)
CALL IM_I2FM(MIM1,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1185
MIM3 = TO_IM(MZM1)
CALL ZM_REAL(MZM1,MFM4)
CALL IM_FM2I(MFM4,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1186
MIM3 = TO_IM('-123654')
CALL IM_ST2M('-123654',MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1187
JV = (/ 123, -432, 567 /)
MIMV1 = TO_IM(JV)
MIMV2 = JV
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1188
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = TO_IM(RV)
MIMV2 = RV
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1189
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = TO_IM(DV)
MIMV2 = DV
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1190
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = TO_IM(CV)
MIMV2 = CV
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1191
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = TO_IM(CDV)
MIMV2 = CDV
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1192
MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
MIMV1 = TO_IM(MFMV4)
MIMV2 = MFMV4
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1193
MIMV4 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MIMV1 = TO_IM(MIMV4)
MIMV2 = MIMV4
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1194
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = TO_IM(MZMV1)
MIMV2 = MZMV1
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1195
STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
MIMV1 = TO_IM(STV)
MIMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DO J = 1, 3
IF (.NOT.(MIMV1(J) == MIMV2(J))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1196
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(JV2)
MIMB2 = JV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1197
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(RV2)
MIMB2 = RV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1198
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(DV2)
MIMB2 = DV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1199
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(CV2)
MIMB2 = CV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1200
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(CDV2)
MIMB2 = CDV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1201
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMA2 = TO_IM(MFMC)
MIMB2 = MFMC
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1202
DO J = 1, 3
DO K = 1, 3
MIMC2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMA2 = TO_IM(MIMC2)
MIMB2 = MIMC2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1203
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIMA2 = TO_IM(MZMA2)
MIMB2 = MZMA2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1204
STV2 = RESHAPE( (/ " 12.1123456789", "-34.2123456789", " 56.3123456789", &
" 23.1123456789", "-36.2123456789", " 66.3123456789", &
" 45.1123456789", "-38.2123456789", " 76.3123456789" &
/) , SHAPE = (/ 3,3 /) )
MIMA2 = TO_IM(STV2)
MIMB2 = RESHAPE( (/ TO_FM(" 12.1123456789"), TO_FM("-34.2123456789"), &
TO_FM(" 56.3123456789"), TO_FM(" 23.1123456789"), &
TO_FM("-36.2123456789"), TO_FM(" 66.3123456789"), &
TO_FM(" 45.1123456789"), TO_FM("-38.2123456789"), &
TO_FM(" 76.3123456789") &
/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMA2(J,K) == MIMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1205
MZM3 = TO_ZM(123)
CALL ZM_I2M(123,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1206
MZM3 = TO_ZM(123,456)
MZM4 = TO_ZM(" 123 + 456 i ")
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1207
MZM3 = TO_ZM(123.4)
CALL FM_SP2M(123.4,MFM4)
CALL FM_I2M(0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1208
MZM3 = TO_ZM(123.4,-456.7)
CALL FM_SP2M(123.4,MFM4)
CALL FM_SP2M(-456.7,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1209
MZM3 = TO_ZM(123.45D0)
CALL FM_DP2M(123.45D0,MFM4)
CALL FM_I2M(0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1210
MZM3 = TO_ZM(123.45D0,-456.78D0)
CALL FM_DP2M(123.45D0,MFM4)
CALL FM_DP2M(-456.78D0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1211
MZM3 = TO_ZM(CMPLX(123.4,567.8))
CALL FM_SP2M(123.4,MFM4)
CALL FM_SP2M(567.8,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = RSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1212
MZM3 = TO_ZM(CMPLX(123.4D0,567.8D0,KIND(1.0D0)))
CALL FM_DP2M(123.4D0,MFM4)
CALL FM_DP2M(567.8D0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
CALL ZM_SUB(MZM3,MZM4,MZM5)
CALL ZM_EQ(MZM5,MZM4)
CALL ZM_ABS(MZM4,MFM5)
CALL ZM_ABS(MZM3,MFM6)
CALL FM_DIV(MFM5,MFM6,MFM4)
MFM3 = DSMALL
IF (FM_COMP(MFM4,'GT',MFM3)) CALL PRTERR(KW)
NCASE = 1213
MZM3 = TO_ZM(MFM1)
CALL FM_EQ(MFM1,MFM4)
CALL FM_I2M(0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1214
MZM3 = TO_ZM(MIM1)
CALL IM_I2FM(MIM1,MFM4)
CALL FM_I2M(0,MFM5)
CALL ZM_COMPLEX(MFM4,MFM5,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1215
MZM3 = TO_ZM(MZM1)
CALL ZM_EQ(MZM1,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1216
MZM3 = TO_ZM('-123.654 + 98.7 i')
CALL ZM_ST2M('-123.654 + 98.7 i',MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1217
JV = (/ 123, -432, 567 /)
MZMV1 = TO_ZM(JV)
MZMV2 = JV
DO J = 1, 3
IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1218
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = TO_ZM(RV)
MZMV2 = RV
DO J = 1, 3
IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1219
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = TO_ZM(DV)
MZMV2 = DV
DO J = 1, 3
IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1220
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = TO_ZM(CV)
MZMV2 = CV
DO J = 1, 3
IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1221
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = TO_ZM(CDV)
MZMV2 = CDV
DO J = 1, 3
IF (ABS((MZMV1(J)-MZMV2(J))/MZMV2(J)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1222
MFMV4 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
MZMV1 = TO_ZM(MFMV4)
MZMV2 = MFMV4
DO J = 1, 3
IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1223
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
MZMV1 = TO_ZM(MIMV1)
MZMV2 = MIMV1
DO J = 1, 3
IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1224
MZMV4 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV1 = TO_ZM(MZMV4)
MZMV2 = MZMV4
DO J = 1, 3
IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1225
STV = (/ " 12.1123456789", "-34.2123456789", " 56.3123456789" /)
MZMV1 = TO_ZM(STV)
MZMV2 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DO J = 1, 3
IF (ABS(MZMV1(J)-MZMV2(J)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1226
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(JV2)
MZMB2 = JV2
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MZMA2(J,K) == MZMB2(J,K))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1227
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(RV2)
MZMB2 = RV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1228
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(DV2)
MZMB2 = DV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1229
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(CV2)
MZMB2 = CV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1230
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(CDV2)
MZMB2 = CDV2
DO J = 1, 3
DO K = 1, 3
IF (ABS((MZMA2(J,K)-MZMB2(J,K))/MZMB2(J,K)) >= DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1231
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMA2 = TO_ZM(MFMC)
MZMB2 = MFMC
DO J = 1, 3
DO K = 1, 3
IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1232
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMA2 = TO_ZM(MIMA2)
MZMB2 = MIMA2
DO J = 1, 3
DO K = 1, 3
IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1233
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMA2 = TO_ZM(MZMA2)
MZMB2 = MZMA2
DO J = 1, 3
DO K = 1, 3
IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1234
STV2 = RESHAPE( (/ " 12.34 + 87.65 i", "-34.21 + 44.55 i", " 56.74 - 88.23 i", &
" 23.11 - 97.53 i", "-36.46 - 83.37 i", " 66.38 + 72.15 i", &
" 45.28 - 28.45 i", "-38.04 - 4.85 i", " 76.31 - 13.67 i" &
/) , SHAPE = (/ 3,3 /) )
MZMA2 = TO_ZM(STV2)
MZMB2 = RESHAPE( (/ TO_ZM(" 12.34 + 87.65 i"), TO_ZM("-34.21 + 44.55 i"), &
TO_ZM(" 56.74 - 88.23 i"), TO_ZM(" 23.11 - 97.53 i"), &
TO_ZM("-36.46 - 83.37 i"), TO_ZM(" 66.38 + 72.15 i"), &
TO_ZM(" 45.28 - 28.45 i"), TO_ZM("-38.04 - 4.85 i"), &
TO_ZM(" 76.31 - 13.67 i") &
/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
IF (ABS(MZMA2(J,K)-MZMB2(J,K)) /= 0) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1235
CALL FM_M2I(MFM1,J3)
IF (TO_INT(MFM1) /= J3) CALL PRTERR(KW)
NCASE = 1236
CALL IM_M2I(MIM1,J3)
IF (TO_INT(MIM1) /= J3) CALL PRTERR(KW)
NCASE = 1237
CALL ZM_M2I(MZM1,J3)
IF (TO_INT(MZM1) /= J3) CALL PRTERR(KW)
NCASE = 1238
CALL FM_M2SP(MFM1,R3)
IF (ABS((TO_SP(MFM1)-R3)/R3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1239
CALL IM_M2DP(MIM1,D3)
R3 = D3
IF (ABS((TO_SP(MIM1)-R3)/R3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1240
CALL ZM_REAL(MZM1,MFM4)
CALL FM_M2SP(MFM4,R3)
IF (ABS((TO_SP(MZM1)-R3)/R3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1241
CALL FM_M2DP(MFM1,D3)
IF (ABS((TO_DP(MFM1)-D3)/D3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1242
CALL IM_M2DP(MIM1,D3)
IF (ABS((TO_DP(MIM1)-D3)/D3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1243
CALL ZM_REAL(MZM1,MFM4)
CALL FM_M2DP(MFM4,D3)
IF (ABS((TO_DP(MZM1)-D3)/D3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1244
CALL FM_M2SP(MFM1,R3)
C3 = R3
IF (ABS((TO_SPZ(MFM1)-C3)/C3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1245
CALL IM_M2DP(MIM1,D3)
C3 = D3
IF (ABS((TO_SPZ(MIM1)-C3)/C3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1246
CALL ZM_M2Z(MZM1,C3)
IF (ABS((TO_SPZ(MZM1)-C3)/C3) > RSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1247
CALL FM_M2DP(MFM1,D3)
CD3 = D3
IF (ABS((TO_DPZ(MFM1)-CD3)/CD3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1248
CALL IM_M2DP(MIM1,D3)
CD3 = D3
IF (ABS((TO_DPZ(MIM1)-CD3)/CD3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1249
CALL ZM_REAL(MZM1,MFM4)
CALL FM_M2DP(MFM4,D3)
CALL ZM_IMAG(MZM1,MFM4)
CALL FM_M2DP(MFM4,D4)
CD3 = CMPLX( D3 , D4 , KIND(0.0D0) )
IF (ABS((TO_DPZ(MZM1)-CD3)/CD3) > DSMALL) THEN
CALL PRTERR(KW)
ENDIF
NCASE = 1250
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DV = TO_INT(MFMV1)
DO J = 1, 3
IF (ABS((DV(J)-INT(MFMV1(J)))/INT(MFMV1(J))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1251
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
DV = TO_INT(MIMV1)
DO J = 1, 3
IF (ABS((DV(J)-INT(MIMV1(J)))/INT(MIMV1(J))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1252
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
DV = TO_INT(MZMV1)
DO J = 1, 3
IF (ABS((DV(J)-INT(REAL(MZMV1(J))))/INT(REAL(MZMV1(J)))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1253
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_INT(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-INT(MFMA(J,K)))/INT(MFMA(J,K))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1254
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_INT(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-INT(MIMA2(J,K)))/INT(MIMA2(J,K))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1255
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DV2 = TO_INT(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-INT(REAL(MZMA2(J,K))))/INT(REAL(MZMA2(J,K)))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1256
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DV = TO_SP(MFMV1)
DO J = 1, 3
IF (ABS((DV(J)-MFMV1(J))/MFMV1(J)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1257
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
DV = TO_SP(MIMV1)
DO J = 1, 3
IF (ABS((DV(J)-MIMV1(J))/MIMV1(J)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1258
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
DV = TO_SP(MZMV1)
DO J = 1, 3
IF (ABS((DV(J)-REAL(MZMV1(J)))/REAL(MZMV1(J))) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1259
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_SP(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-MFMA(J,K))/MFMA(J,K)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1260
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_SP(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1261
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DV2 = TO_SP(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-REAL(MZMA2(J,K)))/REAL(MZMA2(J,K))) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1262
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
DV = TO_DP(MFMV1)
DO J = 1, 3
IF (ABS((DV(J)-MFMV1(J))/MFMV1(J)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1263
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
DV = TO_DP(MIMV1)
DO J = 1, 3
IF (ABS((DV(J)-MIMV1(J))/MIMV1(J)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1264
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
DV = TO_DP(MZMV1)
DO J = 1, 3
IF (ABS((DV(J)-REAL(MZMV1(J)))/REAL(MZMV1(J))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1265
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_DP(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-MFMA(J,K))/MFMA(J,K)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1266
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = TO_DP(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1267
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DV2 = TO_DP(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((DV2(J,K)-REAL(MZMA2(J,K)))/REAL(MZMA2(J,K))) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1268
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
CV = TO_SPZ(MFMV1)
DO J = 1, 3
IF (ABS((CV(J)-MFMV1(J))/MFMV1(J)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1269
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
CV = TO_SPZ(MIMV1)
DO J = 1, 3
IF (ABS((CV(J)-MIMV1(J))/MIMV1(J)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1270
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
CV = TO_SPZ(MZMV1)
DO J = 1, 3
IF (ABS((CV(J)-MZMV1(J))/MZMV1(J)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1271
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CV2 = TO_SPZ(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CV2(J,K)-MFMA(J,K))/MFMA(J,K)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1272
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CV2 = TO_SPZ(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1273
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
CV2 = TO_SPZ(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CV2(J,K)-MZMA2(J,K))/MZMA2(J,K)) > RSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1274
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , &
TO_FM('56.3123456789') /)
CDV = TO_DPZ(MFMV1)
DO J = 1, 3
IF (ABS((CDV(J)-MFMV1(J))/MFMV1(J)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1275
MIMV1 = (/ TO_IM('12') , TO_IM('-34') , TO_IM('56') /)
CDV = TO_DPZ(MIMV1)
DO J = 1, 3
IF (ABS((CDV(J)-MIMV1(J))/MIMV1(J)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1276
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
CDV = TO_DPZ(MZMV1)
DO J = 1, 3
IF (ABS((CDV(J)-MZMV1(J))/MZMV1(J)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1277
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CDV2 = TO_DPZ(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CDV2(J,K)-MFMA(J,K))/MFMA(J,K)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1278
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CDV2 = TO_DPZ(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CDV2(J,K)-MIMA2(J,K))/MIMA2(J,K)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1279
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), &
TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
CDV2 = TO_DPZ(MZMA2)
DO J = 1, 3
DO K = 1, 3
IF (ABS((CDV2(J,K)-MZMA2(J,K))/MZMA2(J,K)) > DSMALL) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
END SUBROUTINE TEST41
SUBROUTINE TEST42
! Test the derived-type interface routines that are not used elsewhere in this program.
IMPLICIT NONE
WRITE (KW,"(/' Testing the derived type ADDI, ..., Z2M interfaces.')")
RSMALL = EPSILON(1.0)*100.0
DSMALL = EPSILON(1.0D0)*100.0
MSMALL = EPSILON(TO_FM(1))*10000.0
NCASE = 1280
MFM3 = MFM1 + 123
MFM4 = MFM1
CALL FM_ADDI(MFM4,123)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1281
CALL FM_COSH_SINH(MFM1,MFM4,MFM3)
MFM3 = COSH(MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1282
CALL FM_COSH_SINH(MFM1,MFM3,MFM4)
MFM3 = SINH(MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1283
CALL FM_COS_SIN(MFM1,MFM4,MFM3)
MFM3 = COS(MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1284
CALL FM_COS_SIN(MFM1,MFM3,MFM4)
MFM3 = SIN(MFM1)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1285
MFM3 = MFM1 / 123
CALL FM_DIVI(MFM1,123,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1286
MFM3 = MFM1 / 123
MFM4 = MFM1
CALL FM_DIVI_R1(MFM4,123)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1287
MFM3 = 123.45D0
CALL FM_DPM(123.45D0,MFM4)
IF (ABS((MFM3-MFM4)/MFM4) > DSMALL) CALL PRTERR(KW)
NCASE = 1288
CALL FM_FORM('F70.56',MFM1,STRING)
CALL FM_ST2M(STRING(1:70),MFM4)
IF (ABS((MFM1-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1289
STRING = FM_FORMAT('F70.56',MFM1)
CALL FM_ST2M(STRING(1:70),MFM4)
IF (ABS((MFM1-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1290
MFM3 = MFM1 ** 123
CALL FM_IPOWER(MFM1,123,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1291
MFM3 = LOG(TO_FM(123))
CALL FM_LNI(123,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1292
D4 = MFM1
CALL FM_M2DP(MFM1,D5)
IF (ABS((D4-D5)/D4) > DSMALL) CALL PRTERR(KW)
NCASE = 1293
J4 = MFM1
CALL FM_M2I(MFM1,J5)
IF (J4 /= J5) CALL PRTERR(KW)
NCASE = 1294
R4 = MFM1
CALL FM_M2SP(MFM1,R5)
IF (ABS((R4-R5)/R4) > RSMALL) CALL PRTERR(KW)
NCASE = 1295
MFM3 = 2.67
CALL FM_MOD(MFM1,MFM3,MFM4)
MFM3 = MOD(MFM1,MFM3)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1296
CALL FM_PI(MFM4)
MFM3 = 4*ATAN(TO_FM(1))
IF (ABS((MFM3-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1297
MFM3 = MFM1 ** (TO_FM(1)/TO_FM(3))
CALL FM_RATIONAL_POWER(MFM1,1,3,MFM4)
IF (ABS((MFM3-MFM4)/MFM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1298
CALL FM_SQR(MFM1,MFM4)
MFM3 = MFM1*MFM1
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1299
CALL FM_EQ(MFM1,MFM4)
CALL FM_SQR_R1(MFM4)
MFM3 = MFM1*MFM1
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1300
MIM3 = MIM1 / 13
CALL IM_DIVI(MIM1,13,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1301
MIM3 = 13
CALL IM_DIVR(MIM1,MIM3,MIM5,MIM4)
MIM3 = MOD(MIM1,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1302
MIM3 = 13
CALL IM_DIVR(MIM1,MIM3,MIM5,MIM4)
CALL IM_EQ(MIM5,MIM3)
MIM4 = MIM1 / 13
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1303
MIM3 = MIM1 / 13
CALL IM_DVIR(MIM1,13,MIM4,J5)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1304
J4 = MOD(MIM1,TO_IM(13))
CALL IM_DVIR(MIM1,13,MIM4,J5)
IF (J4 /= J5) CALL PRTERR(KW)
NCASE = 1305
CALL IM_FORM('I70',MIM1,STRING)
CALL IM_ST2M(STRING(1:70),MIM4)
IF (.NOT.(MIM1 == MIM4)) CALL PRTERR(KW)
NCASE = 1306
STRING = IM_FORMAT('I70',MIM1)
CALL IM_ST2M(STRING(1:70),MIM4)
IF (.NOT.(MIM1 == MIM4)) CALL PRTERR(KW)
NCASE = 1307
MIM3 = 40833
MIM4 = 16042
CALL IM_GCD(MIM3,MIM4,MIM5)
CALL IM_EQ(MIM5,MIM4)
IF (.NOT.(MIM4 == 13)) CALL PRTERR(KW)
NCASE = 1308
MIM3 = 40833
MIM4 = 16042
MIM4 = GCD(MIM3,MIM4)
IF (.NOT.(MIM4 == 13)) CALL PRTERR(KW)
NCASE = 1309
D4 = MIM1
CALL IM_M2DP(MIM1,D5)
IF (ABS((D4-D5)/D4) > DSMALL) CALL PRTERR(KW)
NCASE = 1310
J4 = MIM1
CALL IM_M2I(MIM1,J5)
IF (J4 /= J5) CALL PRTERR(KW)
NCASE = 1311
MIM3 = 6
CALL IM_MOD(MIM1,MIM3,MIM4)
MIM3 = MOD(MIM1,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1312
MIM3 = MIM1 * 123
CALL IM_MPYI(MIM1,123,MIM4)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1313
MIM2 = 3141
MIM3 = 133
CALL IM_MPY_MOD(MIM1,MIM2,MIM3,MIM4)
MIM3 = MOD(MIM1*MIM2,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1314
MIM2 = 3141
MIM3 = 133
MIM4 = MULTIPLY_MOD(MIM1,MIM2,MIM3)
MIM3 = MOD(MIM1*MIM2,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1315
MIM2 = 31
MIM3 = 147
CALL IM_POWER_MOD(MIM1,MIM2,MIM3,MIM4)
MIM3 = MOD(MIM1**MIM2,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1316
MIM2 = 31
MIM3 = 147
MIM4 = POWER_MOD(MIM1,MIM2,MIM3)
MIM3 = MOD(MIM1**MIM2,MIM3)
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
CALL IM_ST2M('-602',MIM2)
NCASE = 1317
CALL IM_SQR(MIM1,MIM4)
MIM3 = MIM1*MIM1
IF (.NOT.(MIM3 == MIM4)) CALL PRTERR(KW)
NCASE = 1318
MZM3 = MZM1 + 123
MZM4 = MZM1
CALL ZM_ADDI(MZM4,123)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1319
MFM3 = ATAN2(AIMAG(MZM1),REAL(MZM1))
CALL ZM_ARG(MZM1,MFM4)
IF (.NOT.(MFM3 == MFM4)) CALL PRTERR(KW)
NCASE = 1320
CALL ZM_COSH_SINH(MZM1,MZM4,MZM3)
MZM3 = COSH(MZM1)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1321
CALL ZM_COSH_SINH(MZM1,MZM3,MZM4)
MZM3 = SINH(MZM1)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1322
CALL ZM_COS_SIN(MZM1,MZM4,MZM3)
MZM3 = COS(MZM1)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1323
CALL ZM_COS_SIN(MZM1,MZM3,MZM4)
MZM3 = SIN(MZM1)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1324
CALL ZM_FORM('F35.26','F35.26',MZM1,STRING)
CALL ZM_ST2M(STRING(1:75),MZM4)
IF (ABS((MZM1-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1325
STRING = ZM_FORMAT('F35.26','F35.26',MZM1)
CALL ZM_ST2M(STRING(1:75),MZM4)
IF (ABS((MZM1-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1326
MZM3 = TO_ZM('123-456i')
CALL ZM_2I2M(123,-456,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1327
MZM3 = MZM1 ** 123
CALL ZM_IPOWER(MZM1,123,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1328
J4 = MZM1
CALL ZM_M2I(MZM1,J5)
IF (J4 /= J5) CALL PRTERR(KW)
NCASE = 1329
C4 = MZM1
CALL ZM_M2Z(MZM1,C5)
IF (ABS((C4-C5)/C4) > RSMALL) CALL PRTERR(KW)
NCASE = 1330
MZM3 = MZM1 * 123
CALL ZM_MPYI(MZM1,123,MZM4)
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1331
MZM3 = MZM1 ** (TO_ZM(1)/TO_ZM(3))
CALL ZM_RATIONAL_POWER(MZM1,1,3,MZM4)
IF (ABS((MZM3-MZM4)/MZM4) > MSMALL) CALL PRTERR(KW)
NCASE = 1332
CALL ZM_SQR(MZM1,MZM4)
MZM3 = MZM1*MZM1
IF (.NOT.(MZM3 == MZM4)) CALL PRTERR(KW)
NCASE = 1333
MZM3 = C2
CALL ZM_Z2M(C2,MZM4)
IF (ABS((MZM3-MZM4)/MZM3) > RSMALL) CALL PRTERR(KW)
END SUBROUTINE TEST42
SUBROUTINE TEST43
! Test Bernoulli numbers, Pochhammer's function, Euler's constant.
IMPLICIT NONE
WRITE (KW,"(/' Testing Bernoulli, Pochhammer, Euler.')")
NCASE = 1334
M_A = 1
CALL FM_BERN(10,M_A,M_C)
M_D = TO_FM('7.5757575757575757575757575757575757575757575757575758M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1335
M_A = 1
CALL FM_BERN(0,M_A,M_C)
M_D = TO_FM('1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1336
M_A = 1
CALL FM_BERN(1,M_A,M_C)
M_D = TO_FM('-0.5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1337
M_A = 1
CALL FM_BERN(41,M_A,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1338
M_A = 0
CALL FM_BERN(52,M_A,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1339
M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
CALL FM_BERN(102,M_A,M_C)
M_D = TO_FM('5.7022917356035929245914353639470138260075545712953255M+80')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1340
M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
CALL FM_BERN(76,M_A,M_C)
M_D = TO_FM('-6.3274121765674850311763600458139008604123253720098077M+50')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1341
CALL FM_BERNOULLI(76,M_C)
M_D = TO_FM('-8.2183629419784575692290653468617333014550892762886003M+50')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1342
M_C = BERNOULLI(278)
M_D = TO_FM('5.4809571213188766395120969944139922843271762639028329M+338')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1343
M_C = BERNOULLI(10**5)
M_D = TO_FM('-5.8222943146133508236497045360612887555320691004307968525M+376755')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1344
M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
M_C = BERNOULLI(76)*M_A
M_D = TO_FM('-6.3274121765674850311763600458139008604123253720098077M+50')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1345
M_A = 76
M_C = BERNOULLI_FM1(76)
M_D = TO_FM('-8.218362941978457569229065346861733301455089276288600333M+50')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1346
M_A = 78
M_C = BERNOULLI_FM2(78)
M_D = TO_FM('1.250290432716699301673233982970289552417719636444847750M+53')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1347
M_A = 80
M_C = BERNOULLI_IM1(80)
M_D = TO_FM('-2.001558323324837027492532919881329876872422013282591592M+55')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1348
M_A = 82
M_C = BERNOULLI_IM2(82)
M_D = TO_FM('3.367498291536437423339667690333875301621959894719384367M+57')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1349
M_A = 84
M_C = BERNOULLI_ZM1(84)
M_D = TO_FM('-5.947097050313544771866049684405154084057907156510690499M+59')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1350
M_A = 86
M_C = BERNOULLI_ZM2(86)
M_D = TO_FM('1.101191032362797755956413079043769160463051144422314886M+62')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BERN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1351
M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
CALL FM_POCH(M_A,10,M_C)
M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M+28')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1352
M_A = TO_FM('7699.115044247787610619469026548672566371681415929204')
CALL FM_POCH(M_A,2222,M_C)
M_D = TO_FM('1.330632198579290013040965245531889745992136035131794M+8763')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1353
M_A = TO_FM('-7')
CALL FM_POCH(M_A,12,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1354
M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M+281')
CALL FM_POCH(M_A,6,M_C)
M_D = TO_FM('2.178354371001981973863113631260449017724481835653894M+1691')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1355
M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
CALL FM_POCH(M_A,8,M_C)
M_D = TO_FM('3.9094766630018687963592259355141261587610735673971624M-277')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1356
M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
CALL FM_POCH(M_A,1,M_C)
M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1357
M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
CALL FM_POCH(M_A,0,M_C)
M_D = TO_FM('1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1358
M_A = TO_FM('0')
CALL FM_POCH(M_A,8,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1359
M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
M_C = POCHHAMMER(M_A,10)
M_D = TO_FM('7.7568981408767238023000514593534249181767332686451635M+28')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' POCH ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1360
CALL FM_EULER(M_C)
M_D = TO_FM('.5772156649015328606065120900824024310421593359399236')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1361
CALL FMEULER(M_C%MFM)
M_D = TO_FM('.5772156649015328606065120900824024310421593359399236')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1362
NDGSAV = NDIG
NDIG = INT(1785*DLOGTN/DLOGMB)+2
CALL FM_EULER(M_C)
M_D = TO_FM( &
'.5772156649015328606065120900824024310421593359399235988057672348848'// &
'67726777664670936947063291746749514631447249807082480960504014486542'// &
'83622417399764492353625350033374293733773767394279259525824709491600'// &
'87352039481656708532331517766115286211995015079847937450857057400299'// &
'21354786146694029604325421519058775535267331399254012967420513754139'// &
'54911168510280798423487758720503843109399736137255306088933126760017'// &
'24795378367592713515772261027349291394079843010341777177808815495706'// &
'61075010161916633401522789358679654972520362128792265559536696281763'// &
'88792726801324310104765059637039473949576389065729679296010090151251'// &
'95950922243501409349871228247949747195646976318506676129063811051824'// &
'19744486783638086174945516989279230187739107294578155431600500218284'// &
'40960537724342032854783670151773943987003023703395183286900015581939'// &
'88042707411542227819716523011073565833967348717650491941812300040654'// &
'69314299929777956930310050308630341856980323108369164002589297089098'// &
'54868257773642882539549258736295961332985747393023734388470703702844'// &
'12920166417850248733379080562754998434590761643167103146710722370021'// &
'81074504441866475913480366902553245862544222534518138791243457350136'// &
'12977822782881489459098638460062931694718871495875254923664935204732'// &
'43641097268276160877595088095126208404544477992299157248292516251278'// &
'42765965708321461029821461795195795909592270420898962797125536321794'// &
'88737642106606070659825619901028807561251991375116782176436190570584'// &
'40783573501580056077457934213144988500786415171615194565706170432450'// &
'75008168705230789093704614306684817916496842549150496724312183783875'// &
'35648949508684541023406016225085155838672349441878804409407701068837'// &
'95111307872023426395226920971608856908382511378712836820491178925944'// &
'78486199118529391029309905925526691727446892044386971114717457157457'// &
'3203935209122316085086828')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= MAX(TO_FM('1.0E-1785'),10*EPSILON(M_C)))) THEN
CALL ERRPRT_FM(' EULER',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NDIG = NDGSAV
RETURN
END SUBROUTINE TEST43
FUNCTION BERNOULLI_FM1(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_FM1
TYPE (FM), ALLOCATABLE :: T(:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_FM1)
ALLOCATE(T( -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_FM1. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(-1:0) = 2
T(1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 2 , J/2
T(K) = T(K-1) + T(K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 - 1 , -J/2 , -1
T(K) = T(K+1) + T(K)
ENDDO
ENDDO
T(0) = TO_FM(2)**N
BERNOULLI_FM1 = (-1)**(N/2) * ( N / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_FM1)
END FUNCTION BERNOULLI_FM1
FUNCTION BERNOULLI_FM2(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_FM2
TYPE (FM), ALLOCATABLE :: T(:,:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_FM2)
ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_FM2. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(1,-1:0) = 2
T(1,1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 1 , J/2
T(2,K) = T(2,K-1) + T(1,K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 , -J/2 , -1
T(1,K) = T(1,K+1) + T(2,K)
ENDDO
ENDDO
T(1,0) = TO_FM(2)**N
BERNOULLI_FM2 = (-1)**(N/2) * ( N / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_FM2)
END FUNCTION BERNOULLI_FM2
FUNCTION BERNOULLI_IM1(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_IM1
TYPE (IM), ALLOCATABLE :: T(:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_IM1)
ALLOCATE(T( -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_IM1. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(-1:0) = 2
T(1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 2 , J/2
T(K) = T(K-1) + T(K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 - 1 , -J/2 , -1
T(K) = T(K+1) + T(K)
ENDDO
ENDDO
T(0) = TO_FM(2)**N
BERNOULLI_IM1 = (-1)**(N/2) * ( TO_FM(N) / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_IM1)
END FUNCTION BERNOULLI_IM1
FUNCTION BERNOULLI_IM2(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_IM2
TYPE (IM), ALLOCATABLE :: T(:,:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_IM2)
ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_IM2. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(1,-1:0) = 2
T(1,1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 1 , J/2
T(2,K) = T(2,K-1) + T(1,K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 , -J/2 , -1
T(1,K) = T(1,K+1) + T(2,K)
ENDDO
ENDDO
T(1,0) = TO_FM(2)**N
BERNOULLI_IM2 = (-1)**(N/2) * ( TO_FM(N) / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_IM2)
END FUNCTION BERNOULLI_IM2
FUNCTION BERNOULLI_ZM1(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_ZM1
TYPE (ZM), ALLOCATABLE :: T(:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_ZM1)
ALLOCATE(T( -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_ZM1. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(-1:0) = 2
T(1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 2 , J/2
T(K) = T(K-1) + T(K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 - 1 , -J/2 , -1
T(K) = T(K+1) + T(K)
ENDDO
ENDDO
T(0) = TO_FM(2)**N
BERNOULLI_ZM1 = (-1)**(N/2) * ( TO_FM(N) / ( T(0) - T(0)**2 ) ) * T(-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_ZM1)
END FUNCTION BERNOULLI_ZM1
FUNCTION BERNOULLI_ZM2(N)
! Seidel's recurrence for T(n).
! This uses only addition of integers.
! B(n) = (-1)^(n/2) ( n / ( 2^n - 4^n ) ) T(n)
USE FMZM
IMPLICIT NONE
INTEGER :: J,K,N
TYPE (FM) :: BERNOULLI_ZM2
TYPE (ZM), ALLOCATABLE :: T(:,:)
CALL FM_ENTER_USER_FUNCTION(BERNOULLI_ZM2)
ALLOCATE(T( 2 , -N/2 : N/2 ),STAT=J)
IF (J /= 0) THEN
WRITE (*,"(/' Error in BERNOULLI_ZM2. Unable to allocate T with size ',I8/)") N
STOP
ENDIF
! Initialize.
T = 0
T(1,-1:0) = 2
T(1,1) = 1
! Recurrence.
DO J = 5, N, 2
! Row J of the table is filled left to right.
DO K = -J/2 + 1 , J/2
T(2,K) = T(2,K-1) + T(1,K)
ENDDO
! Row J+1 of the table is filled right to left.
DO K = J/2 , -J/2 , -1
T(1,K) = T(1,K+1) + T(2,K)
ENDDO
ENDDO
T(1,0) = TO_FM(2)**N
BERNOULLI_ZM2 = (-1)**(N/2) * ( TO_FM(N) / ( T(1,0) - T(1,0)**2 ) ) * T(1,-N/2+1)
CALL FM_DEALLOCATE(T)
DEALLOCATE(T)
CALL FM_EXIT_USER_FUNCTION(BERNOULLI_ZM2)
END FUNCTION BERNOULLI_ZM2
SUBROUTINE TEST44
! Test Gamma, Factorial, Log(Gamma), Beta, Binomial.
IMPLICIT NONE
WRITE (KW,"(/' Testing Gamma, Factorial, Log(Gamma), Beta, Binomial.')")
NCASE = 1363
M_A = 19
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('6.402373705728M+15')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1364
M_A = TO_FM('.7699115044247787610619469026548672566371681415929204')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('1.1998023858495967876496039855917100290498970370440326')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1365
M_A = TO_FM('-.7699115044247787610619469026548672566371681415929204')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('-5.14110071322331700055471385717142758748739973201063050214')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1366
M_A = TO_FM('5.7699115044247787610619469026548672566371681415929204')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('8.1434691207877806133071511233406796488474685081500979M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1367
M_A = TO_FM('7.7568981408767238023000514593534249181767332686451635M-281')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('1.2891751081921193691625844770542239587773115818085396M+280')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1368
M_A = TO_FM('2')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1369
M_A = TO_FM('5.7699115044247787610619469026548672566371681415929204')
M_C = GAMMA(M_A)
M_D = TO_FM('8.1434691207877806133071511233406796488474685081500979M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' GAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1370
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = GAMMA(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == GAMMA(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1371
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = GAMMA(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == GAMMA(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1372
M_A = 33
CALL FM_FACT(M_A,M_C)
M_D = TO_FM('8.68331761881188649551819440128M+36')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1373
M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
CALL FM_FACT(M_A,M_C)
M_D = TO_FM('5.998259003357134762219307127916529472560301341339449M+1889')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1374
M_A = TO_FM('769.9115044247787610619469026548672566371681415929204')
M_C = FACTORIAL(M_A)
M_D = TO_FM('5.998259003357134762219307127916529472560301341339449M+1889')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' FACT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1375
CALL IMFACT(0,MA)
CALL IMI2M(1,MC)
IF (.NOT.IMCOMP(MA,'EQ',MC)) THEN
CALL ERRPRTIM('IMFACT',MA,'MA',MC,'MC')
ENDIF
NCASE = 1376
CALL IM_FACT(7,M_J)
CALL IM_I2M(5040,M_K)
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM('IM_FACT',M_J,'M_J',M_K,'M_K')
ENDIF
NCASE = 1377
CALL IM_FACT(12,M_J)
CALL IM_I2M(479001600,M_K)
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM('IM_FACT',M_J,'M_J',M_K,'M_K')
ENDIF
NCASE = 1378
M_J = FACTORIAL(50)
M_K = TO_IM('30414093201713378043612608166064768844377641568960512000000000000')
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
ENDIF
NCASE = 1379
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = FACTORIAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == FACTORIAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1380
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = FACTORIAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == FACTORIAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1381
M_J = 56
M_J = FACTORIAL(M_J)
M_K = TO_IM('710998587804863451854045647463724949736497978881168458687447040000000000000')
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
ENDIF
NCASE = 1382
MIMV1 = TO_IM( (/ 12 , 123 , 456 /) )
MIMV2 = FACTORIAL(MIMV1)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == FACTORIAL(MIMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1383
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_IM(25+31*(J+3*(K-1)))
ENDDO
ENDDO
MIMB2 = FACTORIAL(MIMA2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == FACTORIAL(MIMA2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1384
JV = (/ 12 , 123 , 456 /)
MIMV2 = FACTORIAL(JV)
DO J = 1, 3
IF (.NOT.(MIMV2(J) == FACTORIAL(JV(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1385
DO J = 1, 3
DO K = 1, 3
JV2(J,K) = 25+31*(J+3*(K-1))
ENDDO
ENDDO
MIMB2 = FACTORIAL(JV2)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MIMB2(J,K) == FACTORIAL(JV2(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1386
M_A = TO_FM('1.0M-222')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('5.1117389064467814185199410293992885408744453047558760M+2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1387
M_A = TO_FM('2')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1388
M_A = TO_FM('33')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('8.1557959456115037178502968666011206687099284403417368M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1389
M_A = TO_FM('2.00000000000000000001')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('4.2278433509846713939671258025183870114019600466320121M-21')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1390
M_C = LOG_GAMMA(TO_FM('33'))
M_D = TO_FM('8.1557959456115037178502968666011206687099284403417368M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LNGM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1391
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = LOG_GAMMA(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == LOG_GAMMA(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1392
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = LOG_GAMMA(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == LOG_GAMMA(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 1393
M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-223')
M_B = TO_FM('.78')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+222')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1394
M_A = TO_FM('.78')
M_B = TO_FM('2.0706137739520290320140007735608464643737932737070189M-223')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+222')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1395
M_A = TO_FM('-4.5')
M_B = TO_FM('4.5')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1396
M_A = TO_FM('-5.5')
M_B = TO_FM('4.5')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1397
M_A = TO_FM('10')
M_B = TO_FM('4')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('3.4965034965034965034965034965034965034965034965034965M-4')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1398
M_A = TO_FM('1.0M+1234')
M_B = TO_FM('2.2')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('1.746239267231954787655429292265211001580693244013921M-2715')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1399
M_A = TO_FM('10')
M_B = TO_FM('5.3')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('7.0836036771097107530120640698518155187687458162734679M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1400
M_A = TO_FM('10.3')
M_B = TO_FM('5')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('8.8146035423244390793072072569173028531206477712519934M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1401
M_A = TO_FM('10.3')
M_B = TO_FM('5')
M_C = BETA(M_A,M_B)
M_D = TO_FM('8.8146035423244390793072072569173028531206477712519934M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1402
M_A = TO_FM('12.5')
M_B = TO_FM('0')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1403
M_A = TO_FM('5')
M_B = TO_FM('-2')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1404
M_A = TO_FM('12.5')
M_B = TO_FM('12.5')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1405
M_A = TO_FM('-4.5')
M_B = TO_FM('4.5')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1406
M_A = TO_FM('-4.5')
M_B = TO_FM('4.5')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1407
M_A = TO_FM('-10')
M_B = TO_FM('3')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('-220')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1408
M_A = TO_FM('52')
M_B = TO_FM('5')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('2.59896M+6')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1409
M_A = TO_FM('1.0M+1234')
M_B = TO_FM('7')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('1.984126984126984126984126984126984126984126984126984M+8634')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1410
M_A = TO_FM('1.0M+123')
M_B = TO_FM('2.2')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('1.6423797032130683531106846289429264567307029528308099M+270')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1411
M_A = TO_FM('1.0M-100')
M_B = TO_FM('4')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('-2.5M-101')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1412
M_A = TO_FM('1.0M+123')
M_B = TO_FM('2.2')
M_C = BINOMIAL(M_A,M_B)
M_D = TO_FM('1.6423797032130683531106846289429264567307029528308099M+270')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' COMB ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST44
END MODULE TEST_B
MODULE TEST_C
USE TEST_VARS
CONTAINS
SUBROUTINE TEST45
! Test Incomplete Gamma, Incomplete Beta.
IMPLICIT NONE
WRITE (KW,"(/' Testing Incomplete Gamma, Incomplete Beta.')")
NCASE = 1413
M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-145')
M_B = TO_FM('.34')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('4.8294858876137637017880452468052846823385248996130407M+144')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1414
M_A = TO_FM('1.0E-50')
M_B = TO_FM('1.0E+555')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('9.9999999999999999999999999999999999999999999999999423M+49')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1415
M_A = TO_FM('1.2')
M_B = TO_FM('2.3')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('7.9163089830797686672658085698101181778608009481363580M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1416
M_A = TO_FM('23.4')
M_B = TO_FM('456.7')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('3.9191215305400046110416169991395759293572844563673750M+21')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1417
M_A = TO_FM('1.2')
M_B = TO_FM('0')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1418
M_A = TO_FM('-1234.5')
M_B = TO_FM('3.4')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('-2.089243913181003055673082477964338279776719826973623M-661')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1419
M_A = TO_FM('10.3')
M_B = TO_FM('230.7')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('7.1643068906237524454762965471616445342244699109269471M+5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1420
M_A = TO_FM('1.2')
M_B = TO_FM('2.3')
M_C = INCOMPLETE_GAMMA1(M_A,M_B)
M_D = TO_FM('7.9163089830797686672658085698101181778608009481363580M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM1 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1421
M_A = TO_FM('0')
M_B = TO_FM('4.5')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('2.0734007547146144328855938695797884889319725701443004M-3')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1422
M_A = TO_FM('4.5')
M_B = TO_FM('0')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('1.1631728396567448929144224109426265262108918305803166M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1423
M_A = TO_FM('1.2')
M_B = TO_FM('2.3')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('1.2653784409178374391437079820481858290074190484504480M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1424
M_A = TO_FM('3.4')
M_B = TO_FM('456.7')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('1.1043526800164195407100289367720949121507981651704628M-192')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1425
M_A = TO_FM('1.0E-30')
M_B = TO_FM('40.7')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('5.0619447546123889551107110735110897294460083487536391M-20')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1426
M_A = TO_FM('-8000.3')
M_B = TO_FM('1.0e-10')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('1.24995312663273564605221746530224928996650914518900M+79999')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1427
M_A = TO_FM('1')
M_B = TO_FM('-10.7')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('4.4355855130297866938628363428602120081387560278336788M+4')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1428
M_A = TO_FM('1.2')
M_B = TO_FM('2.3')
M_C = INCOMPLETE_GAMMA2(M_A,M_B)
M_D = TO_FM('1.2653784409178374391437079820481858290074190484504480M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IGM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1429
M_A = TO_FM('0.1')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('5.8731980918960730463350151650813268739874201571164800M-27')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1430
M_A = TO_FM('8.115640517330775M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.0112520048150164306467955877563719782378767062440103M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1431
M_A = TO_FM('9.01737835258975M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.2512248738228585976753517954889151150428002974819213M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1432
M_A = TO_FM('9.6097615596216720E-01')
M_B = TO_FM('1.970425178583792')
M_C = TO_FM('5.5680052333367')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.8619456987740165364092968281459448023932520843535423M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1433
M_A = TO_FM('4.764360371097952E-01')
M_B = TO_FM('1.161514683661584E+01')
M_C = TO_FM('2.937801562768354E-01')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1434
M_A = TO_FM('0.9')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('7.3148127865937299821246829407023943740949130742928268M-18')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1435
M_A = TO_FM('9.99496253868099M-1')
M_B = TO_FM('2.47067979368109M+6')
M_C = TO_FM('6.09475681774953M-100')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('1.7681753021411259894614747665450637683755190050365931M-544')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1436
M_A = TO_FM('6.213433771653724M-1')
M_B = TO_FM('8.854622686031200M-1')
M_C = TO_FM('5.00000854049816M-121')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('1.1281271573737080091147788530326864610276172049831497M+0')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1437
M_A = TO_FM('5.304391676698501M-15')
M_B = TO_FM('4.870186358377400M+2')
M_C = TO_FM('4.999955247889730M-98')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('8.789231448295684789660412810680366252747943306875046M-6956')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1438
M_A = TO_FM('1.882803169800314M-7')
M_B = TO_FM('1.591547060066600M-169')
M_C = TO_FM('3.521822614438970M+6')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('6.2831946669434576663925763649227277100409122269443137M+168')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1439
M_A = TO_FM('.9999999999999')
M_B = TO_FM('8.591098092677430M+2')
M_C = TO_FM('1.863210949748253M+1')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('3.9062929191651064065641350979581425238442928803700306M-40')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1440
M_A = TO_FM('2.531772074701081M-99')
M_B = TO_FM('3.547571261801072M+2')
M_C = TO_FM('1.974896958876250M+6')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('4.09572371031661966931910120566898398359503771147050M-34981')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1441
M_A = TO_FM('.99999999999999')
M_B = TO_FM('1.0E-123')
M_C = TO_FM('1.0E-134')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('1.0M+123')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1442
M_A = TO_FM('1')
M_B = TO_FM('2.65')
M_C = TO_FM('4.88')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('1.5020204575152306127604878970920601604169827852591720M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1443
M_A = TO_FM('0')
M_B = TO_FM('2.65')
M_C = TO_FM('4.88')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('0')
M_D = ABS(M_C - M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1444
M_A = TO_FM('.998')
M_B = TO_FM('759.6')
M_C = TO_FM('4.95e-57')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('9.7133692099062434492386763673434080317019087637060970M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1445
M_A = TO_FM('4.764360371097952E-01')
M_B = TO_FM('1.161514683661584E+01')
M_C = TO_FM('2.937801562768354E-01')
M_C = INCOMPLETE_BETA(M_A,M_B,M_C)
M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST45
SUBROUTINE TEST46
! Test the Polygamma, Psi functions.
IMPLICIT NONE
WRITE (KW,"(/' Testing Polygamma, Psi.')")
NCASE = 1446
M_A = TO_FM('4.5')
CALL FM_PGAM(0,M_A,M_C)
M_D = TO_FM('1.3888709263595289015114046193821968137592213477205183M+0')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1447
M_A = TO_FM('1.0E-123')
CALL FM_PGAM(1,M_A,M_C)
M_D = TO_FM('1.0M+246')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1448
M_A = TO_FM('1.0E-123')
CALL FM_PGAM(2,M_A,M_C)
M_D = TO_FM('-2.0M+369')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1449
M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
CALL FM_PGAM(1,M_A,M_C)
M_D = TO_FM('2.4580954480899934124966756607870377560864828849100481M+1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1450
M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
CALL FM_PGAM(6,M_A,M_C)
M_D = TO_FM('-4.4120531379423056741117517146346730469682094212273241M+7')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1451
M_A = TO_FM('2.0706137739520290320140007735608464643737932737070189M-1')
CALL FM_PGAM(23,M_A,M_C)
M_D = TO_FM('6.7006365293376930742991440911935017694098601683947073M+38')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1452
M_A = TO_FM('1.0E+123')
CALL FM_PGAM(4,M_A,M_C)
M_D = TO_FM('-6.0M-492')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1453
M_A = TO_FM('-6.499999840238790109')
CALL FM_PGAM(4,M_A,M_C)
M_D = TO_FM('1.0135142464863270830609416082237513111216512170936928M-16')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1454
M_C = POLYGAMMA(2,TO_FM('1.0E-123'))
M_D = TO_FM('-2.0M+369')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PGAM ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1455
M_A = TO_FM('1.0E-135')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('-1.0M+135')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1456
M_A = TO_FM('1.2')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('-2.8903989659218829554720796244995210482558827420664281M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1457
M_A = TO_FM('-3.4')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('2.3844508141180140670320531380285019520468887144980679M+0')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1458
M_A = TO_FM('57')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('4.0342536898816977739559850955847848905386809772893269M+0')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1459
M_A = TO_FM('1.0E+56')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('1.2894476520766655830500752146232439562566168336321129M+2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1460
M_A = TO_FM('1.0')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('-5.7721566490153286060651209008240243104215933593992360M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1461
M_A = TO_FM('1.0E+23456')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('5.4009435941268335564326007561076446853491436517276499M+4')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1462
M_A = TO_FM('1.46163214496836234126266')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('4.4287869692570149446165609601581442013784186419176534M-25')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1463
M_C = PSI(TO_FM('1.2'))
M_D = TO_FM('-2.8903989659218829554720796244995210482558827420664281M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' PSI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1464
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = PSI(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == PSI(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 1465
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = PSI(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == PSI(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
RETURN
END SUBROUTINE TEST46
SUBROUTINE TEST47
! Test the different rounding modes.
IMPLICIT NONE
WRITE (KW,"(/' Testing the different rounding modes.')")
CALL FMSETVAR(' MBASE = 10 ')
CALL FMSETVAR(' NDIG = 20 ')
M_A = 0
NCASE = 1466
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('2')/TO_FM('3')
M_D = TO_FM('.66666666666666666667')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1467
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('2')/TO_FM('3')
M_D = TO_FM('.66666666666666666666')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1468
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('2')/TO_FM('3')
M_D = TO_FM('.66666666666666666666')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1469
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('2')/TO_FM('3')
M_D = TO_FM('.66666666666666666667')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1470
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('1')/TO_FM('3')
M_D = TO_FM('.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1471
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('1')/TO_FM('3')
M_D = TO_FM('.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1472
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('1')/TO_FM('3')
M_D = TO_FM('.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1473
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('1')/TO_FM('3')
M_D = TO_FM('.33333333333333333334')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1474
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('-1')/TO_FM('3')
M_D = TO_FM('-.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1475
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('-1')/TO_FM('3')
M_D = TO_FM('-.33333333333333333334')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1476
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('-1')/TO_FM('3')
M_D = TO_FM('-.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1477
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('-1')/TO_FM('3')
M_D = TO_FM('-.33333333333333333333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1478
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('-2')/TO_FM('3')
M_D = TO_FM('-.66666666666666666667')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1479
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('-2')/TO_FM('3')
M_D = TO_FM('-.66666666666666666667')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1480
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('-2')/TO_FM('3')
M_D = TO_FM('-.66666666666666666666')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1481
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('-2')/TO_FM('3')
M_D = TO_FM('-.66666666666666666666')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1482
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('1') + TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1483
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('1') + TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1484
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('1') + TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1485
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('1') + TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1486
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('1') - TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1487
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('1') - TO_FM('3E-555')
M_D = TO_FM('.99999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1488
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('1') - TO_FM('3E-555')
M_D = TO_FM('.99999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1489
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('1') - TO_FM('3E-555')
M_D = TO_FM('1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1490
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('-1') + TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1491
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('-1') + TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1492
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('-1') + TO_FM('3E-555')
M_D = TO_FM('-.99999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1493
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('-1') + TO_FM('3E-555')
M_D = TO_FM('-.99999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1494
CALL FMSETVAR(' KROUND = 1 ')
M_C = TO_FM('-1') - TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1495
CALL FMSETVAR(' KROUND = -1 ')
M_C = TO_FM('-1') - TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1496
CALL FMSETVAR(' KROUND = 0 ')
M_C = TO_FM('-1') - TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1497
CALL FMSETVAR(' KROUND = 2 ')
M_C = TO_FM('-1') - TO_FM('3E-555')
M_D = TO_FM('-1.0000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' MBASE = 2 ')
CALL FMSETVAR(' NDIG = 53 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 1498
M_A = TO_FM('0.125')
M_B = TO_FM('23.25')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('6.1345805065305141873M-25')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1499
M_A = TO_FM('0.52')
M_B = TO_FM('2.01')
M_C = TO_FM('1.6')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('1.0304844627978347604M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1500
M_A = TO_FM('9.01737835258975M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.2512248738228585986M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1501
M_A = TO_FM('9.6097615596216720E-01')
M_B = TO_FM('1.970425178583792')
M_C = TO_FM('5.5680052333367')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.8619456987740165927M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1502
M_A = TO_FM('4.764360371097952E-01')
M_B = TO_FM('1.161514683661584E+01')
M_C = TO_FM('2.937801562768354E-01')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.3604503996731113869M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1503
M_A = TO_FM('0.9')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('7.3148127865937395334M-18')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-15'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
CALL FMSETVAR(' MBASE = 3 ')
CALL FMSETVAR(' NDIG = 55 ')
NCASE = 1504
M_A = TO_FM('0.1')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('5.87319809189607304633501593392681M-27')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1505
M_A = TO_FM('0.52')
M_B = TO_FM('2.1')
M_C = TO_FM('1.6')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('9.25745341552810210762563659429375M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1506
M_A = TO_FM('9.01737835258975M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.25122487382285859767535178829535M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1507
M_A = TO_FM('9.6097615596216720E-01')
M_B = TO_FM('1.970425178583792')
M_C = TO_FM('5.5680052333367')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.861945698774016536409296855493M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1508
M_A = TO_FM('4.764360371097952E-01')
M_B = TO_FM('1.161514683661584E+01')
M_C = TO_FM('2.937801562768354E-01')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.36045039967311138687915158221269M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1509
M_A = TO_FM('0.9')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('7.31481278659372998212468429642039M-18')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1510
CALL FPST2M('1.67',MP1)
CALL FPST2M('2.64',MP2)
CALL FPADD(MP1,MP2,MP3)
CALL FPEQ(MP3,MP1)
CALL FPST2M('-3.91',MP2)
CALL FPSUB(MP1,MP2,MP3)
CALL FPEQ(MP3,MP1)
CALL FPST2M('4.58',MP2)
CALL FPMPY(MP1,MP2,MP3)
CALL FPEQ(MP3,MP1)
CALL FPST2M('0.27',MP2)
CALL FPDIV(MP1,MP2,MP3)
CALL FPEQ(MP3,MP1)
CALL FPADDI(MP1,2)
CALL FPMPYI(MP1,13,MP3)
CALL FPEQ(MP3,MP1)
CALL FPDIVI(MP1,11,MP3)
CALL FPEQ(MP3,MP1)
CALL FPLN(MP1,MP3)
CALL FPEQ(MP3,MP1)
CALL FPSIN(MP1,MP3)
CALL FPEQ(MP3,MP1)
CALL FPCOS(MP1,MP3)
CALL FPEQ(MP3,MP1)
CALL FPEXP(MP1,MP3)
CALL FPEQ(MP3,MP1)
CALL FPGAM(MP1,MP3)
CALL FPEQ(MP3,MP1)
CALL FMUNPK(MP1,M3FM)
CALL FMEQ(M3FM,M_C%MFM)
M_D = TO_FM('0.941122001974472326543759839200398')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-24'))) THEN
CALL ERRPRT_FM(' Pack ',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1511
CALL FM_RANDOM_SEED_SIZE(J)
SEED = (/ 2718281,8284590,4523536,0287471,3526624,9775724,7093699 /)
CALL FM_RANDOM_SEED_PUT(SEED)
DO J1 = 1, 10
CALL FM_RANDOM_NUMBER(D1)
ENDDO
CALL FM_RANDOM_SEED_GET(SEED)
M_C = D1
M_D = TO_FM('0.931628836663817')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-10')) .OR. .NOT.(J == 7)) THEN
CALL ERRPRT_FM(' Rand ',M_C,'M_C',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST47
SUBROUTINE TEST48
! Test cases close to 1/2 ulp rounding error, so a retry is required for perfect rounding.
! Some cases are also included for results close to a representable number, to check perfect
! rounding in the other three rounding modes: toward -infinity, toward zero, toward +infinity.
IMPLICIT NONE
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 10 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 1512
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768402')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1513
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768401')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1514
M_A = TO_FM('5.000000000000000000000000000000000000001e-37')
M_C = M_A
CALL FM_ADDI(M_C,2)
M_D = TO_FM('2.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1515
M_C = TO_FM('4.999999999999999999999999999999999999999e-37')
CALL FM_ADDI(M_C,2)
M_D = TO_FM('2.000000000000000000000000000000000000000')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1516
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768400')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1517
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768401')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1518
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('0.5257635728213180166595247703159528791601')
M_C = M_A * M_B
M_D = TO_FM('0.3303469955801149926388139215009285936894')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1519
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('0.4742364271786819833404752296840471208399')
M_C = M_A * M_B
M_D = TO_FM('0.2979715351378436550537147551549719831507')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1520
M_A = TO_FM('0.6318370867781348553996520736856019490561')
CALL FM_MPYI(M_A,46101123,M_C)
M_D = TO_FM('29128399.25352046867936657440618499878248')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1521
M_A = TO_FM('0.8135122987796887463349472568784450350361')
CALL FM_MPYI(M_A,20316759,M_C)
M_D = TO_FM('16527933.31784293035429925669571046007157')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1522
M_A = TO_FM('0.6318370867781348553996520736856019490561')
CALL FM_MPYI_R1(M_A,46101123)
M_C = M_A
M_D = TO_FM('29128399.25352046867936657440618499878248')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1523
M_A = TO_FM('0.8135122987796887463349472568784450350361')
CALL FM_MPYI_R1(M_A,20316759)
M_C = M_A
M_D = TO_FM('16527933.31784293035429925669571046007157')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1524
M_A = TO_FM('0.3976743471825143687216599350592794108215')
M_B = TO_FM('0.9424777960769379715387930149838508652591')
M_C = M_A / M_B
M_D = TO_FM('0.4219455872995980174105705502942218606745')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1525
M_A = TO_FM('0.6919325506063328369126062247898634980537')
M_B = TO_FM('0.9424777960769379715387930149838508652591')
M_C = M_A / M_B
M_D = TO_FM('0.7341632381012059477682883491173344179766')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1526
M_A = TO_FM('36461617.89732034137767779122871087621687')
CALL FM_DIVI(M_A,63388493,M_C)
M_D = TO_FM('.5752087827252864550302180433396780109108')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1527
M_A = TO_FM('37124279.59189018208711544238998994234663')
CALL FM_DIVI(M_A,75134789,M_C)
M_D = TO_FM('.4941024003127257346409190340574449786054')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1528
M_A = TO_FM('36461617.89732034137767779122871087621687')
CALL FM_DIVI_R1(M_A,63388493)
M_C = M_A
M_D = TO_FM('.5752087827252864550302180433396780109108')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1529
M_A = TO_FM('37124279.59189018208711544238998994234663')
CALL FM_DIVI_R1(M_A,75134789)
M_C = M_A
M_D = TO_FM('.4941024003127257346409190340574449786054')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1530
M_A = TO_FM('0.9999999999999999999999999999999999999999')
M_C = SQRT(M_A)
M_D = TO_FM('0.9999999999999999999999999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1531
M_A = TO_FM('0.0812551668996974871345739579795687707841')
M_C = SQRT(M_A)
M_D = TO_FM('0.2850529194723279573072539887330984043228')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1532
M_A = TO_FM('0.5985846996875529104874722961539082031432e-36')
M_C = ACOS(M_A)
M_D = TO_FM('1.570796326794896619231321691639751441')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1533
M_A = TO_FM('0.5985846996875529104874722961539082031430e-36')
M_C = ACOS(M_A)
M_D = TO_FM('1.570796326794896619231321691639751442')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1534
M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
M_C = ASIN(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1535
M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
M_C = ASIN(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1536
M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
M_C = ATAN(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1537
M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
M_C = ATAN(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1538
M_A = TO_FM('24.662120743304701014916113231545890428')
M_B = TO_FM('1M+20')
M_C = ATAN(M_A,M_B)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1539
M_A = TO_FM('24.662120743304701014916113231545890427')
M_B = TO_FM('1M+20')
CALL FM_ATAN2(M_A,M_B,M_C)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1540
M_A = TO_FM('24.662120743304701014916113231545890428')
M_B = TO_FM('19.598731519274866200933093993663363141')
M_C = HYPOT(M_A,M_B)
M_D = TO_FM('31.5012773823849581936652001656744299068083994252835506543708')
IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
CALL ERRPRT_FM('HYPOT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1541
M_A = TO_FM('24.662120743304701014916113231545890428')
M_B = TO_FM('19.598731519274866200933093993663363141')
CALL FM_HYPOT(M_A,M_B,M_C)
M_D = TO_FM('31.5012773823849581936652001656744299068083994252835506543708')
IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
CALL ERRPRT_FM('HYPOT ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1542
MFMV1 = (/ TO_FM('24.662120743304701014916113231545890428') , &
TO_FM('19.598731519274866200933093993663363141') , &
TO_FM('23.520738351029238695449251124646311397') /)
M_C = NORM2(MFMV1)
M_D = TO_FM('39.3135550325779588382790713936439732249056062358880803608351')
IF (.NOT.(ABS(M_C-M_D) < TO_FM('1.0e-48'))) THEN
CALL ERRPRT_FM('NORM2 ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1543
M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
M_C = SIN(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1544
M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
M_C = SIN(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1545
M_A = TO_FM('1.0e-20')
M_C = COS(M_A)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1546
M_A = TO_FM('1.000000000000000000000000000000000001e-20')
M_C = COS(M_A)
M_D = TO_FM('0.9999999999999999999999999999999999999999')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1547
M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
CALL FM_CSSN(M_A,M_B,M_C)
M_D = TO_FM('.9999999999999999999999999999999999999517')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1548
M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
CALL FM_CSSN(M_A,M_B,M_C)
M_D = TO_FM('.9999999999999999999999999999999999999517')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1549
M_A = TO_FM('1.0e-20')
CALL FM_CSSN(M_A,M_B,M_C)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('1.0e-20')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1550
M_A = TO_FM('1.000000000000000000000000000000000001e-20')
CALL FM_CSSN(M_A,M_B,M_C)
M_D = TO_FM('0.9999999999999999999999999999999999999999')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('1.000000000000000000000000000000000001e-20')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1551
M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
M_C = SINH(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1552
M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
M_C = SINH(M_A)
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1553
M_A = TO_FM('1.0e-18')
M_C = COSH(M_A)
M_D = TO_FM('1.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1554
M_A = TO_FM('9.9999999999999999999999999999999999988e-19')
M_C = COSH(M_A)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1555
M_A = TO_FM('3.1072325059538588668776624275223863629e-19')
CALL FM_CHSH(M_A,M_B,M_C)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('3.1072325059538588668776624275223863630e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1556
M_A = TO_FM('3.1072325059538588668776624275223863628e-19')
CALL FM_CHSH(M_A,M_B,M_C)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('3.1072325059538588668776624275223863628e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1557
M_A = TO_FM('1.0e-18')
CALL FM_CHSH(M_A,M_B,M_C)
M_D = TO_FM('1.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('1.00000000000000000000000000000000000017e-18')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1558
M_A = TO_FM('9.9999999999999999999999999999999999988e-19')
CALL FM_CHSH(M_A,M_B,M_C)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_B)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_B,'M_B',M_D,'M_D')
ENDIF
M_D = TO_FM('1.00000000000000000000000000000000000005e-18')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1559
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000000001e-41')
M_C = DIM(M_A,M_B)
M_D = TO_FM('0.6283185307179586476925286766559005768400')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1560
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999999e-41')
M_C = DIM(M_A,M_B)
M_D = TO_FM('0.6283185307179586476925286766559005768401')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1561
M_A = TO_FM('0.5e-36')
M_C = EXP(M_A)
M_D = TO_FM('1.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1562
M_A = TO_FM('0.4999999999999999999999999999999999989999e-36')
M_C = EXP(M_A)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1563
M_A = TO_FM('1.0000000000000000000000000000000000005000000000000000000000000000000000001')
M_C = M_A
M_D = TO_FM('1.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1564
M_A = TO_FM('1.000000000000000000000000000000000000499999999999999999999999999999999999999')
M_C = M_A
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1565
M_A = TO_FM('1.000000000000000000707106781186547524')
M_C = M_A ** 2
M_D = TO_FM('1.000000000000000001414213562373095048')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1566
M_A = TO_FM('1.000000000000000000707106781186547525')
M_C = M_A ** 2
M_D = TO_FM('1.000000000000000001414213562373095051')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1567
M_A = TO_FM('1.000000000000000000707106781186547524')
CALL FM_SQR(M_A,M_C)
M_D = TO_FM('1.000000000000000001414213562373095048')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1568
M_A = TO_FM('1.000000000000000000707106781186547525')
CALL FM_SQR(M_A,M_C)
M_D = TO_FM('1.000000000000000001414213562373095051')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1569
M_A = TO_FM('0.9999999999999999994067407863053487817742')
M_C = LOG(M_A)
M_D = TO_FM('-5.9325921369465121840177824731679791984e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1570
M_A = TO_FM('0.9999999999999999993793990486547925547640')
M_C = LOG(M_A)
M_D = TO_FM('-6.2060095134520744542857277040528826945e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1571
M_A = TO_FM('1.000000000000000000958662527832292178')
M_C = LOG10(M_A)
M_D = TO_FM('4.1634184584498706665047310953955053593e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1572
M_A = TO_FM('0.9999999999999999994778241676797874940004')
M_C = LOG10(M_A)
M_D = TO_FM('-2.2677808255990599106049606546937597102e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1573
CALL FM_LNI(2895833,M_C)
M_D = TO_FM('14.878783365079154638251408713480965444')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1574
CALL FM_LNI(2531896,M_C)
M_D = TO_FM('14.744478987153028713006171333463425116')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1575
M_A = TO_FM('.8830071479276119336989609534710013727931')
M_B = TO_FM('.2983029918655860363206006071417293306070')
M_C = M_A ** M_B
M_D = TO_FM('.9635648854663441602276295143804091214980')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1576
M_A = TO_FM('.2046822834634936204259667947178397091054')
M_B = TO_FM('.0113741193573152263874178352602582175058')
M_C = M_A ** M_B
M_D = TO_FM('.9821190715107246840300334336752116983076')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1577
M_A = TO_FM('.7668605659739208337937419810211254654597')
CALL FM_RATIONAL_POWER(M_A,3,7,M_C)
M_D = TO_FM('.8924681893919363302730585208912593273843')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1578
M_A = TO_FM('.9062372571831410794348152141805768025855')
CALL FM_RATIONAL_POWER(M_A,3,7,M_C)
M_D = TO_FM('.9586831750229133225694901565227212287703')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1579
M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
M_C = TAN(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890429e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1580
M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
M_C = TAN(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1581
M_A = TO_FM('2.4662120743304701014916113231545890428e-19')
M_C = TANH(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1582
M_A = TO_FM('2.4662120743304701014916113231545890427e-19')
M_C = TANH(M_A)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1583
M_X = TO_ZM('0.6283185307179586476925286766559005768401 + 2 i')
M_Y = TO_ZM('5.000000000000000000000000000000000000001e-41 + 3 i')
M_Y = M_X + M_Y
M_Z = TO_ZM('0.6283185307179586476925286766559005768402 + 5 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1584
M_X = TO_ZM(' 2 + 0.6283185307179586476925286766559005768401 i ')
M_Y = TO_ZM(' 3 + 4.999999999999999999999999999999999999999e-41 i ')
M_Y = M_X + M_Y
M_Z = TO_ZM(' 5 + 0.6283185307179586476925286766559005768401 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1585
M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + '// &
' 5.000000000000000000000000000000000000001e-41 i ')
M_Y = TO_ZM(' 4.999999999999999999999999999999999999999e-41 + '// &
' 0.6283185307179586476925286766559005768401 i ')
M_Y = M_X + M_Y
M_Z = TO_ZM(' 0.6283185307179586476925286766559005768401 + '// &
' 0.6283185307179586476925286766559005768402 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1586
M_X = TO_ZM('0.6283185307179586476925286766559005768401 + 2 i')
M_Y = TO_ZM('5.000000000000000000000000000000000000001e-41 - 3 i')
M_Y = M_X - M_Y
M_Z = TO_ZM('0.6283185307179586476925286766559005768400 + 5 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1587
M_X = TO_ZM(' 2 + 0.6283185307179586476925286766559005768401 i ')
M_Y = TO_ZM('-3 + 4.999999999999999999999999999999999999999e-41 i ')
M_Y = M_X - M_Y
M_Z = TO_ZM(' 5 + 0.6283185307179586476925286766559005768401 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1588
M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + '// &
' 5.000000000000000000000000000000000000001e-41 i ')
M_Y = TO_ZM(' 4.999999999999999999999999999999999999999e-41 + '// &
' 0.6283185307179586476925286766559005768401 i ')
M_Y = M_X - M_Y
M_Z = TO_ZM(' 0.6283185307179586476925286766559005768401 - '// &
' 0.6283185307179586476925286766559005768400 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1589
M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + 2e-71 i ')
M_Y = TO_ZM(' 0.5257635728213180166595247703159528791601 + 3e-72 i ')
M_Y = M_X * M_Y
M_Z = TO_ZM(' 0.3303469955801149926388139215009285936894 + '// &
' 1.2400227048580236276268081436286759314e-71 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1590
M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 + 2e-71 i ')
M_Y = TO_ZM(' 3e-72 + 0.4742364271786819833404752296840471208399 i ')
M_Y = M_X * M_Y
M_Z = TO_ZM(' -7.599772951419763723731918563713240686e-72 + '// &
' 0.2979715351378436550537147551549719831507 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1591
M_X = TO_ZM(' 0.6283185307179586476925286766559005768401 ')
M_Y = TO_ZM(' 3e-72 + 0.4742364271786819833404752296840471208399 i ')
M_Y = M_X * M_Y
M_Z = TO_ZM(' 1.884955592153875943077586029967701731e-72 + '// &
' 0.2979715351378436550537147551549719831507 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1592
M_X = TO_ZM(' 0.3976743471825143687216599350592794108215 + 2e-71 i ')
M_Y = TO_ZM(' 0.9424777960769379715387930149838508652591 + 3e-72 i ')
M_Y = M_X / M_Y
M_Z = TO_ZM(' 0.4219455872995980174105705502942218606745 + '// &
' 1.9877564560228500546418079520211719271e-71 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1593
M_X = TO_ZM(' 0.6919325506063328369126062247898634980537 + 2e-71 i ')
M_Y = TO_ZM(' 3e-72 + 0.9424777960769379715387930149838508652591 i ')
M_Y = M_X / M_Y
M_Z = TO_ZM(' 2.3557573246522558864973918862865235752e-71 - '// &
' 0.7341632381012059477682883491173344179766 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1594
M_X = TO_ZM(' 0.6919325506063328369126062247898634980537 + 2e-71 i ')
M_Y = TO_ZM(' 0 + 0.9424777960769379715387930149838508652591 i ')
M_Y = M_X / M_Y
M_Z = TO_ZM(' 2.1220659078919378102517835116335248271e-71 - '// &
' 0.7341632381012059477682883491173344179766 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1595
M_Y = TO_ZM('5.000000000000000000000000000000000000001e-37 + 4 i')
CALL ZM_ADDI(M_Y,2)
M_Z = TO_ZM('2.000000000000000000000000000000000001 + 4 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1596
M_Y = TO_ZM('4.999999999999999999999999999999999999999e-37 + 6 i')
CALL ZM_ADDI(M_Y,3)
M_Z = TO_ZM('3 + 6 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1597
M_X = TO_ZM('1 + e-18 i')
M_C = ABS(M_X)
M_D = TO_FM('1.0')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',TO_ZM(M_C),'M_C',TO_ZM(M_D),'M_D')
ENDIF
NCASE = 1598
M_X = TO_ZM('1 + e-18 i') + TO_ZM(' e-52 i ')
M_C = ABS(M_X)
M_D = TO_FM('1.000000000000000000000000000000000001')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',TO_ZM(M_C),'M_C',TO_ZM(M_D),'M_D')
ENDIF
NCASE = 1599
M_X = TO_ZM('0.5985846996875529104874722961539082031432e-36 + e-50 i')
M_Y = ACOS(M_X)
M_Z = TO_ZM('1.570796326794896619231321691639751441 - e-50')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1600
M_X = TO_ZM('0.5985846996875529104874722961539082031430e-36 + e-50 i')
M_Y = ACOS(M_X)
M_Z = TO_ZM('1.570796326794896619231321691639751442 - e-50')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1601
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863628e-19 i')
M_Y = ACOS(M_X)
M_Z = TO_ZM('1.570796326794896619231321691639751442') - &
TO_ZM('3.1072325059538588668776624275223863628e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1602
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863630e-19 i')
M_Y = ACOS(M_X)
M_Z = TO_ZM('1.570796326794896619231321691639751442') - &
TO_ZM('3.1072325059538588668776624275223863629e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1603
M_X = TO_ZM(' 1e+20 + 24.662120743304701014916113231545890428 i ')
CALL ZM_ARG(M_X,M_C)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1604
M_X = TO_ZM(' 1e+20 + 24.662120743304701014916113231545890427 i ')
CALL ZM_ARG(M_X,M_C)
M_D = TO_FM('2.4662120743304701014916113231545890427e-19')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1605
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863628e-19 i')
M_Y = ASIN(M_X)
M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') + &
TO_ZM('3.1072325059538588668776624275223863628e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1606
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863630e-19 i')
M_Y = ASIN(M_X)
M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') + &
TO_ZM('3.1072325059538588668776624275223863629e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1607
M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
M_Y = ATAN(M_X)
M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') + &
TO_ZM('.99999999999999999999999999999999999994e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1608
M_X = TO_ZM('2.4662120743304701014916113231545890427e-19 + e-50 i')
M_Y = ATAN(M_X)
M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') + &
TO_ZM('.99999999999999999999999999999999999994e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1609
M_X = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
M_Y = SINH(M_X)
M_Z = TO_ZM('3.1072325059538588668776624275223863630e-19') + &
TO_ZM('1.00000000000000000000000000000000000005e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1610
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
M_Y = SINH(M_X)
M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') + &
TO_ZM('3.1072325059538588668776624275223863628e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1611
M_X = TO_ZM('1.0e-18 + e-50 i')
M_Y = COSH(M_X)
M_Z = TO_ZM('1.000000000000000000000000000000000001') + &
TO_ZM('1.0E-68 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1612
M_X = TO_ZM('9.9999999999999999999999999999999999988e-19 + e-50 i')
M_Y = COSH(M_X)
M_Z = TO_ZM('1.0 + e-68 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1613
M_Z = TO_ZM('9.9999999999999999999999999999999999988e-19 + e-50 i')
CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
M_Z = TO_ZM('1.0 + e-68 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('1.00000000000000000000000000000000000005e-18') + &
TO_ZM('1.0000000000000000000000000000000000005e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1614
M_Z = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
M_Z = TO_ZM('0.9999999999999999999999999999999999999517') + &
TO_ZM('3.10723250595385886687766242752238636285e-69 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('9.9999999999999999999999999999999999995e-51') + &
TO_ZM('3.1072325059538588668776624275223863628e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1615
M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
CALL ZM_COSH_SINH(M_Z,M_X,M_Y)
M_Z = TO_ZM('1.0 + 3.10723250595385886687766242752238636295e-69 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('3.1072325059538588668776624275223863630e-19') + &
TO_ZM('1.00000000000000000000000000000000000005e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1616
M_X = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
M_Y = SIN(M_X)
M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') + &
TO_ZM('9.9999999999999999999999999999999999995e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1617
M_X = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
M_Y = SIN(M_X)
M_Z = TO_ZM('1.00000000000000000000000000000000000005e-50') + &
TO_ZM('3.1072325059538588668776624275223863630e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1618
M_X = TO_ZM('1.0e-20 + e-50 i')
M_Y = COS(M_X)
M_Z = TO_ZM('1.0 - 1.0e-70 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1619
M_X = TO_ZM('1.000000000000000000000000000000000001e-20 + e-50 i')
M_Y = COS(M_X)
M_Z = TO_ZM('0.9999999999999999999999999999999999999999') - &
TO_ZM('1.00000000000000000000000000000000000100e-70 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1620
M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
CALL ZM_COS_SIN(M_Z,M_X,M_Y)
M_Z = TO_ZM('.9999999999999999999999999999999999999517') - &
TO_ZM('3.107232505953858866877662427522386362850e-69 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') + &
TO_ZM('9.9999999999999999999999999999999999995e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1621
M_Z = TO_ZM('e-50 + 3.1072325059538588668776624275223863629e-19 i')
CALL ZM_COS_SIN(M_Z,M_X,M_Y)
M_Z = TO_ZM('1.0 - 3.107232505953858866877662427522386362950e-69 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('1.00000000000000000000000000000000000005e-50') + &
TO_ZM('3.1072325059538588668776624275223863630e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1622
M_Z = TO_ZM('3.1072325059538588668776624275223863629e-19 + e-50 i')
CALL ZM_COS_SIN(M_Z,M_X,M_Y)
M_Z = TO_ZM('9.999999999999999999999999999999999999517e-1') - &
TO_ZM('3.107232505953858866877662427522386362850e-69 i')
IF (.NOT.(M_X == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
M_Z = TO_ZM('3.1072325059538588668776624275223863628e-19') + &
TO_ZM('9.9999999999999999999999999999999999995e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1623
M_X = TO_ZM('0.5e-36 + e-80 i')
M_Y = EXP(M_X)
M_Z = TO_ZM('1.000000000000000000000000000000000001') + &
TO_ZM('1.000000000000000000000000000000000001e-80 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1624
M_X = TO_ZM('4.999999999999999999999999999999999989999e-37 + e-80 i')
M_Y = EXP(M_X)
M_Z = TO_ZM('1.0 + e-80 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1625
M_X = TO_ZM('1.000000000000000000707106781186547524 + e-50 i')
M_Y = M_X ** 2
M_Z = TO_ZM('1.000000000000000001414213562373095048') + &
TO_ZM('2.000000000000000001414213562373095048e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1626
M_X = TO_ZM('e-50 + 1.000000000000000000707106781186547525 i')
M_Y = M_X ** 2
M_Z = TO_ZM('-1.000000000000000001414213562373095051') + &
TO_ZM(' 2.000000000000000001414213562373095050e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1627
M_X = TO_ZM('0.9999999999999999994778241676797874940004 + e-50 i')
M_Y = LOG10(M_X)
M_Z = TO_ZM('-2.2677808255990599106049606546937597102E-19') + &
TO_ZM(' 4.3429448190325182787790700147651107341e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1628
M_X = TO_ZM('.8455190010494953391255848876096865326839') + &
TO_ZM(' .7861461988847145319251164691167782914963 i')
M_Y = LOG10(M_X)
M_Z = TO_ZM('.0624033825129988962409024321757246973134') + &
TO_ZM('.3252980116488363982766948434519904605853 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1629
M_X = TO_ZM('0.9999999999999999993793990486547925547640 + e-50 i')
M_Y = LOG(M_X)
M_Z = TO_ZM('-6.2060095134520744542857277040528826945e-19') + &
TO_ZM(' 1.00000000000000000062060095134520744562e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1630
M_X = TO_ZM('1e+20 + 24.662120743304701014916113231545890428 i')
M_Y = LOG(M_X)
M_Z = TO_ZM('46.051701859880913680359829093687284152') + &
TO_ZM('2.4662120743304701014916113231545890427e-19 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1631
M_X = TO_ZM('.8830071479276119336989609534710013727931 + e-50 i')
M_Y = TO_ZM('.2983029918655860363206006071417293306070 - e-51 i')
M_Y = M_X ** M_Y
M_Z = TO_ZM('0.9635648854663441602276295143804091214980') + &
TO_ZM('3.3750637551181513929342847538584028563e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1632
M_X = TO_ZM('.2046822834634936204259667947178397091054 + e-50 i')
M_Y = TO_ZM('.0113741193573152263874178352602582175058 - e-51 i')
M_Y = M_X ** M_Y
M_Z = TO_ZM('.9821190715107246840300334336752116983076') + &
TO_ZM('2.1036918503256548440548740118221763962e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1633
M_X = TO_ZM('.7668605659739208337937419810211254654597 + e-50 i')
CALL ZM_RATIONAL_POWER(M_X,3,7,M_Y)
M_Z = TO_ZM('0.8924681893919363302730585208912593273843') + &
TO_ZM('4.9876911638623221362078386375958597571e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1634
M_X = TO_ZM('.9062372571831410794348152141805768025855 + e-50 i')
CALL ZM_RATIONAL_POWER(M_X,3,7,M_Y)
M_Z = TO_ZM('.9586831750229133225694901565227212287703') + &
TO_ZM('4.533737877253610724793982869327765542e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1635
M_X = TO_ZM('1.000000000000000000707106781186547524 + e-50 i')
CALL ZM_SQR(M_X,M_Y)
M_Z = TO_ZM('1.000000000000000001414213562373095048') + &
TO_ZM('2.000000000000000001414213562373095048e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1636
M_X = TO_ZM('1.000000000000000000707106781186547525 + e-50 i')
CALL ZM_SQR(M_X,M_Y)
M_Z = TO_ZM('1.000000000000000001414213562373095051') + &
TO_ZM('2.000000000000000001414213562373095050e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1637
M_X = TO_ZM('0.9999999999999999999999999999999999999999 + e-50 i')
CALL ZM_SQRT(M_X,M_Y)
M_Z = TO_ZM('0.9999999999999999999999999999999999999999') + &
TO_ZM('5e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1638
M_X = TO_ZM('0.0812551668996974871345739579795687707841 + e-50 i')
CALL ZM_SQRT(M_X,M_Y)
M_Z = TO_ZM('0.2850529194723279573072539887330984043228') + &
TO_ZM('1.75406026686402147370502782695083137048e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1639
M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
CALL ZM_TAN(M_X,M_Y)
M_Z = TO_ZM('2.4662120743304701014916113231545890429e-19') + &
TO_ZM('1.00000000000000000000000000000000000006e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1640
M_X = TO_ZM('2.4662120743304701014916113231545890427e-19 + e-50 i')
CALL ZM_TAN(M_X,M_Y)
M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') + &
TO_ZM('1.00000000000000000000000000000000000006e-50 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1641
M_X = TO_ZM('2.4662120743304701014916113231545890428e-19 + e-50 i')
CALL ZM_TANH(M_X,M_Y)
M_Z = TO_ZM('2.4662120743304701014916113231545890427e-19') + &
TO_ZM('9.9999999999999999999999999999999999994e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
NCASE = 1642
M_X = TO_ZM('2.4662120743304701014916113231545890429e-19 + e-50 i')
CALL ZM_TANH(M_X,M_Y)
M_Z = TO_ZM('2.4662120743304701014916113231545890428e-19') + &
TO_ZM('9.9999999999999999999999999999999999994e-51 i')
IF (.NOT.(M_Y == M_Z)) THEN
CALL ERRPRT_ZM(' Round',M_X,'M_X',M_Y,'M_Y',M_Z,'M_Z')
ENDIF
RETURN
END SUBROUTINE TEST48
SUBROUTINE TEST49
! Round toward +infinity.
IMPLICIT NONE
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 10 ')
CALL FMSETVAR(' KROUND = 2 ')
NCASE = 1643
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768407')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1644
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1645
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1646
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768405')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1647
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1648
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768395')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1649
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768397')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1650
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1651
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1652
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1653
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1654
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('-0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1655
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1656
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = -M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1657
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541580')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1658
M_A = TO_FM('-0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('-0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541580')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1659
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.3997431577248499881970027038678588808455')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1660
M_A = TO_FM('-0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = -M_A + TO_FM('0.5649365180369')
MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1661
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('0.2844558260571')
MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541580')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.8815842236052348640130150036752442950679')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1662
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('-0.2844558260571')
MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541580')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.8815842236052348640130150036752442950678')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1663
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.3997431577248499881970027038678588808455')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1664
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('-0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1665
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('0.5142899005070373097659012225902504129228')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1666
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('-0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1667
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('1.878706647477504308190417437970331887')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1668
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('-0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('-1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1669
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.5142899005070373097659012225902504129228')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870773')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1670
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870773')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1671
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('2.788483144777492522933050948973640361')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('1.878706647477504308190417437970331887')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1672
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-2.788483144777492522933050948973640360')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST49
SUBROUTINE TEST50
! Round toward -infinity.
IMPLICIT NONE
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 10 ')
CALL FMSETVAR(' KROUND = -1 ')
NCASE = 1673
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1674
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768407')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1675
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768405')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1676
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1677
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768395')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1678
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1679
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1680
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768397')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1681
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1682
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('-0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1683
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1684
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('-0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('-0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1685
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1686
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = -M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1687
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1688
M_A = TO_FM('-0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('-0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1689
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1690
M_A = TO_FM('-0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = -M_A + TO_FM('0.5649365180369')
MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605757')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.3997431577248499881970027038678588808455')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1691
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('0.2844558260571')
MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.8815842236052348640130150036752442950678')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1692
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('-0.2844558260571')
MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409099')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.8815842236052348640130150036752442950679')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1693
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1694
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('-0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.3997431577248499881970027038678588808455')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.1598437505049341638922976633191829202699')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1695
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1696
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('-0.5142899005070373097659012225902504129228')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1697
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1698
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('-0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('-1.878706647477504308190417437970331887')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1699
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870772')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1700
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-.5142899005070373097659012225902504129228')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870772')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1701
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('2.788483144777492522933050948973640360')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1702
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-2.788483144777492522933050948973640361')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-1.878706647477504308190417437970331887')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST50
SUBROUTINE TEST51
! Round toward zero.
IMPLICIT NONE
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 10 ')
CALL FMSETVAR(' KROUND = 0 ')
NCASE = 1703
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1704
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768406')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1705
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('0.6283185307179586476925286766559005768405')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1706
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A + M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768405')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1707
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768395')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1708
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-5.000000000000000000000000000000000001e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768395')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1709
M_A = TO_FM('0.6283185307179586476925286766559005768401')
M_B = TO_FM('4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1710
M_A = TO_FM('-0.6283185307179586476925286766559005768401')
M_B = TO_FM('-4.999999999999999999999999999999999999e-40')
M_C = M_A - M_B
M_D = TO_FM('-0.6283185307179586476925286766559005768396')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1711
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1712
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
M_C = M_A * M_B
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1713
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1714
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('-0.2844558260571')
M_C = M_A * M_B
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1715
M_A = TO_FM('0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1716
M_A = TO_FM('-0.282941083469653908817180471388519729')
M_B = TO_FM('0.5649365180369')
MFMV1(1) = -M_A + M_B
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1717
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1718
M_A = TO_FM('-0.696614681390281171833211321255418669')
M_B = M_A + TO_FM('-0.2844558260571')
MFMV1(1) = TO_FM('0.2844558260571')
CALL FMMPYD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1719
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1720
M_A = TO_FM('-0.282941083469653908817180471388519729')
MFMV1(1) = TO_FM('0.5649365180369')
MFMV1(2) = -M_A + TO_FM('0.5649365180369')
MFMV1(3) = -M_A + 2*TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1721
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('0.2844558260571')
MFMV1(3) = M_A + 2*TO_FM('0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.8815842236052348640130150036752442950678')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1722
M_A = TO_FM('0.696614681390281171833211321255418669')
MFMV1(1) = M_A + TO_FM('0.2844558260571')
MFMV1(2) = TO_FM('-0.2844558260571')
MFMV1(3) = -M_A + 2*TO_FM('-0.2844558260571')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.6834281189668589065995658881433064541579')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-0.1981561046383759574134491155319378409098')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.8815842236052348640130150036752442950678')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1723
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = M_A + 2*TO_FM('0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1724
M_A = TO_FM('0.282941083469653908817180471388519729')
MFMV1(1) = -M_A + 2*TO_FM('-0.5649365180369')
MFMV1(2) = M_A + TO_FM('0.5649365180369')
MFMV1(3) = TO_FM('-0.5649365180369')
CALL FMMPYE(M_A%MFM,MFMV1(1)%MFM,MFMV1(2)%MFM,MFMV1(3)%MFM, &
MFMV2(1)%MFM,MFMV2(2)%MFM,MFMV2(3)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-0.3997431577248499881970027038678588808454')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.2398994072199158243047050405486759605756')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(3)
M_D = TO_FM('-0.1598437505049341638922976633191829202698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1725
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1726
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921')
M_C = M_A / M_B
M_D = TO_FM('-0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1727
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1728
M_A = TO_FM('0.4693356799052036759819703352946208572489')
M_B = TO_FM('-0.2498185017524528219383570234374166958944')
M_C = M_A / M_B
M_D = TO_FM('-1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1729
M_A = TO_FM('0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') - M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('0.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870772')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1730
M_A = TO_FM('-0.4248927758509876073065623506584042361272')
M_B = TO_FM('0.8261736725377782666616486764041757591921') + M_A
MFMV1(1) = TO_FM('0.8261736725377782666616486764041757591921')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-.5142899005070373097659012225902504129227')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('0.4857100994929626902340987774097495870772')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1731
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('2.788483144777492522933050948973640360')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1732
M_A = TO_FM('0.696614681390281171833211321255418669')
M_B = TO_FM('0.4693356799052036759819703352946208572489')
MFMV1(1) = TO_FM('-0.2498185017524528219383570234374166958944')
CALL FMDIVD(M_A%MFM,M_B%MFM,MFMV1(1)%MFM,MFMV2(1)%MFM,MFMV2(2)%MFM)
M_C = MFMV2(1)
M_D = TO_FM('-2.788483144777492522933050948973640360')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
M_C = MFMV2(2)
M_D = TO_FM('-1.878706647477504308190417437970331886')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST51
SUBROUTINE TEST52
! Test cases close to 1/2 ulp rounding error for special functions.
IMPLICIT NONE
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 10 ')
CALL FMSETVAR(' KROUND = 1 ')
NCASE = 1733
M_A = TO_FM('.2328386190529659228832053957071072125573')
CALL FM_BERN(24,M_A,M_C)
M_D = TO_FM('-20159.22657221596015247800092403139140')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1734
M_A = TO_FM('.9451765100122574216552754520712319556089')
CALL FM_BERN(24,M_A,M_C)
M_D = TO_FM('-81833.62147384601623719886358367428881')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1735
M_A = TO_FM('.5821684750579093589504314571127397718728')
M_B = TO_FM('.5276586479483013778818324226131214725295')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('2.718685192837677534284224946262289328')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1736
M_A = TO_FM('.0045177228684763844273939828899034713744')
M_B = TO_FM('.7071703810032528448210532389136837995613')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('221.971401823711307460442393160140748062')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1737
M_A = TO_FM('.2910233266900902429391868324973905211679')
M_B = TO_FM('.2686978655316086409504709070690468302996')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('1.008221342235108731639228823278327453')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1738
M_A = TO_FM('.1496244761646217127068665425798759041706')
M_B = TO_FM('.5208004094353136060294490790695580983140')
CALL FM_COMB(M_A,M_B,M_C)
M_D = TO_FM('.7373815284360172522038196138611166769208')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1739
M_A = TO_FM('.8818763003667274658259474897327495825393')
CALL FM_FACT(M_A,M_C)
M_D = TO_FM('.9556856818324261868773320949535856718209')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1740
M_A = TO_FM('.4949226557823776089070415346269135914019')
CALL FM_FACT(M_A,M_C)
M_D = TO_FM('.8860734400698097304792845052056675778507')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1741
M_A = TO_FM('.3761598409707025773715937538446685849102')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('2.362889562494552736407145620878970868')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1742
M_A = TO_FM('.1672675981473020062920707493172560265625')
CALL FM_GAM(M_A,M_C)
M_D = TO_FM('5.545212721835892382245850289336741506')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1743
M_A = TO_FM('.4614584565062692160383906583541987167546')
M_B = TO_FM('.5951149438121376420146106335369913012772')
M_C = TO_FM('.5135832693383946635459024061261877609871')
CALL FM_IBTA(M_A,M_B,M_C,M_D)
M_C = M_D
M_D = TO_FM('1.175720760325729892558264431672632920')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1744
M_A = TO_FM('.4081940034223790033948418644820959999190')
M_B = TO_FM('.1180588713006268461672671906643209312650')
M_C = TO_FM('.3149184009440604069173388778384328835109')
CALL FM_IBTA(M_A,M_B,M_C,M_D)
M_C = M_D
M_D = TO_FM('7.900309247533697782193990826692658854')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1745
M_A = TO_FM('.0427267171132272876071206331149137449302')
M_B = TO_FM('.5105188999386855843675421276828724346974')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('22.321595915082369762690531066589279138')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1746
M_A = TO_FM('.4794594023597792560960161318337194611725')
M_B = TO_FM('.4519909618067343602717438997268702891724')
CALL FM_IGM1(M_A,M_B,M_C)
M_D = TO_FM('1.241872690864524980937587750040289597')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1747
M_A = TO_FM('.2261686600832506249009095185947406573375')
M_B = TO_FM('.5015127240787333498711528283826321561631')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('.5549442049131076957568567379492812192955')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1748
M_A = TO_FM('.5094842013600974599082648516536815144934')
M_B = TO_FM('.3482871781307067261980605367667982396401')
CALL FM_IGM2(M_A,M_B,M_C)
M_D = TO_FM('.7151073736823869119517083475220619366219')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1749
M_A = TO_FM('.2068069932686212583647656539146963022688')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('1.488657022360415732776205520278718644')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1750
M_A = TO_FM('.1193692518130361861966262640397336872045')
CALL FM_LNGM(M_A,M_C)
M_D = TO_FM('2.067720011879939917820025488153571130')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1751
M_A = TO_FM('.2576495214584462521245806915946723616023')
CALL FM_PGAM(4,M_A,M_C)
M_D = TO_FM('-21146.16261340494528903688834773180156')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1752
M_A = TO_FM('.7962098719476029756078555617481483300242')
CALL FM_PGAM(4,M_A,M_C)
M_D = TO_FM('-76.473397969955670235128480927719957319')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1753
M_A = TO_FM('.2903751291177076383370995341599159483511')
CALL FM_POCH(M_A,10,M_C)
M_D = TO_FM('226382.58826609244992525125582538977845')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1754
M_A = TO_FM('.6535382063050879489012218891599782182586')
CALL FM_POCH(M_A,10,M_C)
M_D = TO_FM('1172527.33029198368051435459325948991873')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1755
M_A = TO_FM('.6974141103846349693484255734679991971531')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('-1.227373681669287236661348744017575764')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1756
M_A = TO_FM('.1489240375392748170922697013324334780161')
CALL FM_PSI(M_A,M_C)
M_D = TO_FM('-7.070608127091923241761976851770484074')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1757
M_A = TO_FM('.1418132137659642168028407618412830046398')
CALL FM_BESJ(2,M_A,M_C)
M_D = TO_FM('.0025096630568893136653901659219379348639')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1758
M_A = TO_FM('.1788169540762649644737416406458567693875')
CALL FM_BESJ(2,M_A,M_C)
M_D = TO_FM('.0039862981780302297384350008335271212665')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1759
M_A = TO_FM('.5805890744092277015557299624869968071680')
CALL FM_BESY(3,M_A,M_C)
M_D = TO_FM('-27.170050571120923815100314544070890349')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1760
M_A = TO_FM('.1727566160014456348350360062835911734820')
CALL FM_BESY(3,M_A,M_C)
M_D = TO_FM('-991.492233932025018825422382282585945571')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1761
M_A = TO_FM('.4016568782932617682033356419955298473240')
CALL FM_C(M_A,M_C)
M_D = TO_FM('.3990851528696198643615325503826128715808')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1762
M_A = TO_FM('.5530524251328989351390869029628343285806')
CALL FM_C(M_A,M_C)
M_D = TO_FM('.5404216519412922344321401126915592210606')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1763
M_A = TO_FM('.3132698047591739833827682199637207397498')
CALL FM_CHI(M_A,M_C)
M_D = TO_FM('-0.5588397635338133878184786033023681883232')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1764
M_A = TO_FM('.9021393609362524403130756737458658526952')
CALL FM_CHI(M_A,M_C)
M_D = TO_FM('.6847189967592175982961668075227015086895')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1765
M_A = TO_FM('.4629298516778537800282633125284364103977')
CALL FM_CI(M_A,M_C)
M_D = TO_FM('-0.2460639652015249005042894314555107778450')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1766
M_A = TO_FM('.0549423062812426822427336674003262253111')
CALL FM_CI(M_A,M_C)
M_D = TO_FM('-2.325010525455479068147552564259710333')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1767
M_A = TO_FM('.6072730938561594792843888804993271348637')
CALL FM_EI(M_A,M_C)
M_D = TO_FM('.7919157659390910345415002387390308359006')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1768
M_A = TO_FM('.9503051536465725719993585687558366320625')
CALL FM_EI(M_A,M_C)
M_D = TO_FM('1.759976172298062963545208718828109308')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1769
M_A = TO_FM('.2340205975024858648191209097882767518758')
CALL FM_EN(3,M_A,M_C)
M_D = TO_FM('.3330926301696971928355749328109205940940')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1770
M_A = TO_FM('.0400995594332772093627899515751956369449')
CALL FM_EN(3,M_A,M_C)
M_D = TO_FM('.4632389771805115242616797414710747077664')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1771
M_A = TO_FM('.7886473371721963111084785258161883958469')
CALL FM_ERF(M_A,M_C)
M_D = TO_FM('.7352848658941150054408574269874333390461')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1772
M_A = TO_FM('.7609436172163287325768460098497054081684')
CALL FM_ERF(M_A,M_C)
M_D = TO_FM('.7181339130361657639451467578071178631777')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1773
M_A = TO_FM('.6100881772504833944803283072200079400836')
CALL FM_ERFC(M_A,M_C)
M_D = TO_FM('.3882502027357936095789040007851801672816')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1774
M_A = TO_FM('.6243617029740179628590302641485755306347')
CALL FM_ERFC(M_A,M_C)
M_D = TO_FM('.3772466516971787018401366908961968549338')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1775
M_A = TO_FM('.9707757617868134478807410067239461677428')
CALL FM_LERC(M_A,M_C)
M_D = TO_FM('-1.773202710864594278785176372612043038')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1776
M_A = TO_FM('.5982919135705171840846535893551708254495')
CALL FM_LERC(M_A,M_C)
M_D = TO_FM('-.9225855862015127266997763635874449606237')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1777
M_A = TO_FM('.3075187515156989643790009724751097014093')
CALL FM_LI(M_A,M_C)
M_D = TO_FM('-.1637252161858283068213216668816736669698')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1778
M_A = TO_FM('.1187059517092358051891453031444894386999')
CALL FM_LI(M_A,M_C)
M_D = TO_FM('-.0408414304985139641159873359583412863556')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1779
M_A = TO_FM('.5437226766721640071140744727072520535257')
CALL FM_S(M_A,M_C)
M_D = TO_FM('.0828773122511780478009671826497228619741')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1780
M_A = TO_FM('.9617114410081342679366219277397124076033')
CALL FM_S(M_A,M_C)
M_D = TO_FM('.4000602273249795258822738271587288566974')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1781
M_A = TO_FM('.8655870024154057721077141187964875276485')
CALL FM_SHI(M_A,M_C)
M_D = TO_FM('.9024368708930004866080405665890701363253')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1782
M_A = TO_FM('.7550498406342259261861893754142408822008')
CALL FM_SHI(M_A,M_C)
M_D = TO_FM('.7793769513468371612732453792935391553448')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1783
M_A = TO_FM('.7336740214990864267606810631343342550790')
CALL FM_SI(M_A,M_C)
M_D = TO_FM('.7120850765110427480344276510598853655741')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1784
M_A = TO_FM('.8448202102736804118406485838696405421819')
CALL FM_SI(M_A,M_C)
M_D = TO_FM('.8120307046646463143924793647173595754174')
IF (.NOT.(M_D == M_C)) THEN
CALL ERRPRT_FM(' Round',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
RETURN
END SUBROUTINE TEST52
SUBROUTINE TEST53
! Test special cases and error cases.
IMPLICIT NONE
WRITE (KW,"(/' Testing special cases and error cases.')")
MBASE = MXBASE
CALL FMCONS
NDIG = 2 + 52*DLOGTN/DLOGMB
! Turn error message printing off while testing the error case code.
CALL FMSETVAR(' KWARN = 0 ')
M_A = 0
NCASE = 1785
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMMPY(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '0.2565628653416941226485280051014985652035285365075991'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMMPY ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 1786
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FMST2M(ST1,MA)
ST1 = '0.7319587628865979381443298969072164948453608247422680'
CALL FMST2M(ST1,MB)
CALL FMDIV(MA,MB,ME)
CALL FMEQ(ME,MA)
ST2 = '0.4788732394366197183098591549295774647887323943661972'
CALL FMST2M(ST2,MC)
CALL FMSUB(MA,MC,MD)
CALL FMABS(MD,ME)
CALL FMEQ(ME,MD)
CALL FMST2M('1.0E-50',MB)
IF (.NOT.FMCOMP(MD,'LE',MB)) THEN
CALL ERRPRTFM('FMDIV ',MA,'MA',MC,'MC',MD,'MD')
ENDIF
NCASE = 1787
M_A = TO_FM('10')
M_B = TO_FM('5.3')
CALL FM_BETA(M_A,M_B,M_C)
M_D = TO_FM('7.0836036771097107530120640698518155187687458162734679M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BETA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1788
M_A = TO_FM('0.1')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('5.8731980918960730463350151650813268739874201571164800M-27')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1789
M_A = TO_FM('8.115640517330775M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.0112520048150164306467955877563719782378767062440103M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1790
M_A = TO_FM('9.01737835258975M-1')
M_B = TO_FM('2.00853601446773')
M_C = TO_FM('1.59735792202923')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.2512248738228585976753517954889151150428002974819213M-1')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1791
M_A = TO_FM('9.6097615596216720E-01')
M_B = TO_FM('1.970425178583792')
M_C = TO_FM('5.5680052333367')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.8619456987740165364092968281459448023932520843535423M-2')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1792
M_A = TO_FM('4.764360371097952E-01')
M_B = TO_FM('1.161514683661584E+01')
M_C = TO_FM('2.937801562768354E-01')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('2.3604503996731113868791517339909092506365724801689105M-5')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 1793
M_A = TO_FM('0.9')
M_B = TO_FM('23.4')
M_C = TO_FM('34.5')
CALL FM_IBTA(M_A,M_B,M_C,MFM6)
CALL FM_EQ(MFM6,M_C)
M_D = TO_FM('7.3148127865937299821246829407023943740949130742928268M-18')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' IBTA ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
CALL ZMSET(50)
CALL ZM_SET(50)
CALL FMSET(50)
NCASE = 1794
MIM3 = 1
MIM4 = 0
MIM5 = MIM3/MIM4
IF (MWK(START(MIM5%MIM)+2) /= MUNKNO .OR. MWK(START(MIM5%MIM)) /= 1) CALL PRTERR(KW)
NCASE = 1795
MIM5 = MIM3*MIM5
IF (MWK(START(MIM5%MIM)+2) /= MUNKNO .OR. MWK(START(MIM5%MIM)) /= 1) CALL PRTERR(KW)
NCASE = 1796
MIM4 = 1.23E+23
MFM4 = MIM4
MFM5 = TO_FM('1.23E+23')
IF (.NOT. ABS((MFM5-MFM4)/MFM5) < RSMALL) CALL PRTERR(KW)
NCASE = 1797
MIM4 = 1.23D+45
MFM4 = MIM4
MFM5 = TO_FM('1.23D+45')
IF (.NOT. ABS((MFM5-MFM4)/MFM5) < DSMALL) CALL PRTERR(KW)
NCASE = 1798
MIM4 = CMPLX(1.23E+23,9.87E+24)
MFM4 = MIM4
MFM5 = TO_FM('1.23E+23')
IF (.NOT. ABS((MFM5-MFM4)/MFM5) < RSMALL) CALL PRTERR(KW)
NCASE = 1799
MIM4 = CMPLX(1.23D+23,9.87D+24, KIND(0.0D0))
MFM4 = MIM4
MFM5 = TO_FM('1.23D+23')
IF (.NOT. ABS((MFM5-MFM4)/MFM5) < DSMALL) CALL PRTERR(KW)
NCASE = 1800
CALL FM_ST2M('1.23',MFMV1(1))
CALL FM_ST2M('2.23',MFMV1(2))
CALL FM_ST2M('3.23',MFMV1(3))
CALL FM_ST2M('4.23',MFMV3(1))
CALL FM_ST2M('5.23',MFMV3(2))
MFM3 = DOT_PRODUCT(MFMV1,MFMV3)
IF (MWK(START(MFM3%MFM)+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1801
CALL IM_ST2M('12',MIMV1(1))
CALL IM_ST2M('23',MIMV1(2))
CALL IM_ST2M('34',MIMV1(3))
CALL IM_ST2M('-14',MIMV3(1))
CALL IM_ST2M('-5',MIMV3(2))
MIM3 = DOT_PRODUCT(MIMV1,MIMV3)
IF (MWK(START(MIM3%MIM)+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1802
CALL ZM_ST2M('1.23 + 1.67 i',MZMV1(1))
CALL ZM_ST2M('2.23 - 2.56 i',MZMV1(2))
CALL ZM_ST2M('3.23 + 3.45 i',MZMV1(3))
CALL ZM_ST2M('4.23 - 4.34 i',MZMV3(1))
CALL ZM_ST2M('5.23 + 5.23 i',MZMV3(2))
MZM3 = DOT_PRODUCT(MZMV1,MZMV3)
IF (MWK(START(MZM3%MZM(1))+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1803
DO I = 1, 3
DO J = 1, 3
MFMA(I,J) = 3*(J-1) + I
ENDDO
ENDDO
DO I = 1, 2
DO J = 1, 2
MFMD(I,J) = 3*(J-1) + I
ENDDO
ENDDO
MFME = MATMUL(MFMA,MFMD)
IF (MWK(START(MFME(1,1)%MFM)+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1804
DO I = 1, 2
DO J = 1, 2
MIMA(I,J) = 2*(J-1) + I + 20
ENDDO
ENDDO
DO I = 1, 3
DO J = 1, 2
MIMD(I,J) = 2*(J-1) + I + 20
ENDDO
ENDDO
MIMC = MATMUL(MIMA,MIMD)
IF (MWK(START(MIMC(1,1)%MIM)+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1805
DO I = 1, 2
DO J = 1, 3
MZMA(I,J) = CMPLX(TO_FM(2*(J-1)+I+10),TO_FM(2*(J-1)+I+20))
ENDDO
ENDDO
DO I = 1, 2
DO J = 1, 4
MZMC(I,J) = CMPLX(TO_FM(4*(I-1)+J+50),TO_FM(4*(I-1)+J+30))
ENDDO
ENDDO
MZMC = MATMUL(MZMA,MZMC)
IF (MWK(START(MZMC(1,1)%MZM(1))+2) /= MUNKNO) CALL PRTERR(KW)
NCASE = 1806
MFM4 = HUGE(MFM1)
MFM3 = SCALE(MFM4,12)
IF (MWK(START(MFM3%MFM)+2) /= MEXPOV) CALL PRTERR(KW)
NCASE = 1807
MZM4 = HUGE(MFM1)
MZM3 = SCALE(MZM4,12)
IF (MWK(START(MZM3%MZM(1))+2) /= MEXPOV) CALL PRTERR(KW)
RETURN
END SUBROUTINE TEST53
SUBROUTINE TEST54
! Test packed array routines and error messages.
IMPLICIT NONE
WRITE (KW,"(/' Testing packed array routines and error messages.')")
! Turn error message printing on while testing the error case code, and write the
! error messages on unit 22.
CALL FMSETVAR(' KWARN = 1 ')
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
CALL FMSETVAR(' NTRACE = -2 ')
CALL FMSETVAR(' LVLTRC = 1 ')
CALL FMSETVAR(' MBASE = 10000 ')
CALL FMSETVAR(' NDIG = 14 ')
NCASE = 1808
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('-1.67',MP1)
CALL FPABS(MP1,MP3)
CALL FPST2M('1.67',MP4)
IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1809
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('8374251785837425178583792',MP3)
CALL IPEQ(MP3,MP2)
CALL IPDIVR(MP1,MP2,MP5,MP4)
CALL IPST2M('3666412140861684892372583',MP3)
IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1810
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPM2DP(MP1,D1)
CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL FPM2DP(MP1,D3)
IF (.NOT. (ABS(D3-D1) < DSMALL)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1811
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('0',MP1)
MBLOGS = 0
CALL FPACOS(MP1,MP3)
CALL FPPI(MP2)
CALL FPDIVI(MP2,2,MP4)
CALL FPSUB(MP3,MP4,MP2)
CALL FPEQ(MP2,MP3)
CALL FPABS(MP3,MP2)
CALL FPST2M('1.0E-49',MP1)
IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1812
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('-UNDERFLOW',MP1)
CALL FPACOS(MP1,MP3)
CALL FPPI(MP2)
CALL FPDIVI(MP2,2,MP4)
CALL FPSUB(MP3,MP4,MP2)
CALL FPEQ(MP2,MP3)
CALL FPABS(MP3,MP2)
CALL FPST2M('1.0E-49',MP1)
IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1813
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 0
CALL FPST2M('-0.5',MP1)
CALL FPACOS(MP1,MP3)
CALL FPST2M('120',MP4)
KRAD = 1
IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1814
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.7654',MP1)
MBLOGS = 0
CALL FPACOSH(MP1,MP3)
CALL FPST2M('1.16946418704054815282376713618783111908417864000514252424243757',MP4)
CALL FPSUB(MP3,MP4,MP2)
CALL FPEQ(MP2,MP3)
CALL FPABS(MP3,MP2)
CALL FPST2M('1.0E-49',MP1)
IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1815
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('24.662120743304701014916113231545890428',MP1)
CALL FPST2M('19.598731519274866200933093993663363141',MP2)
MBLOGS = 0
CALL FPHYPOT(MP1,MP2,MP3)
CALL FPST2M('31.5012773823849581936652001656744299068083994252835506543708',MP4)
CALL FPSUB(MP3,MP4,MP2)
CALL FPEQ(MP2,MP3)
CALL FPABS(MP3,MP2)
CALL FPST2M('1.0E-49',MP1)
IF (.NOT.FPCOMPARE(MP2,'<',MP1)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1816
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMSETVAR(' NTRACE = -1 ')
CALL FPST2M('12.0',MP1)
CALL FPST2M('13.0',MP2)
MBLOGS = 0
CALL FPADD(MP1,MP2,MP3)
CALL FPST2M('25.0',MP4)
IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1817
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.0',MP1)
CALL FPST2M('13.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FPADD(MP1,MP2,MP3)
KDEBUG = J
CALL FPST2M('25.0',MP4)
IF (.NOT.FPCOMPARE(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1818
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.0',MP1)
CALL FPST2M('13.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FPSUB(MP1,MP2,MP3)
KDEBUG = J
CALL FPST2M('-1.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1819
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.0',MP1)
CALL FPST2M('0.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FPADD(MP1,MP2,MP3)
KDEBUG = J
CALL FPST2M('12.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1820
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.0',MP1)
CALL FPST2M('0.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FPSUB(MP1,MP2,MP3)
KDEBUG = J
CALL FPST2M('12.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1821
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPBIG(MP1)
CALL FPBIG(MP2)
CALL FPADD(MP1,MP2,MP3)
IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1822
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPBIG(MP1)
CALL FPI2M(0,MP3)
CALL FPSUB(MP3,MP1,MP2)
CALL FPSUB(MP1,MP2,MP3)
IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1823
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPTINY(MP1)
CALL FPDIVI(MP1,2,MP3)
IF (.NOT.(MWK(START(MP3)+2) == MEXPUN)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1824
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMSETVAR(' NTRACE = -2 ')
CALL FPST2M('12.0',MP1)
CALL FPST2M('13.0',MP2)
MBLOGS = 0
CALL FMUNPK(MP1,MA)
CALL FMUNPK(MP2,MB)
CALL FMADD_R1(MA,MB)
CALL FMPACK(MA,MP1)
CALL FPEQ(MP1,MP3)
CALL FPST2M('25.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1825
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPACOS(ZP1,ZP4)
CALL ZPST2M('0.70600062465538060328041859335986022136042273675348823497' &
// ' - 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1826
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMSETVAR(' NTRACE = 2 ')
CALL FM_SET(50)
CALL FPST2M('12.0',MP1)
CALL FPST2M('13.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FMUNPK(MP1,MA)
CALL FMUNPK(MP2,MB)
CALL FMADD_R1(MA,MB)
CALL FMPACK(MA,MP1)
CALL FPEQ(MP1,MP3)
KDEBUG = J
CALL FPST2M('25.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1827
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.0',MP1)
CALL FPST2M('0.0',MP2)
J = KDEBUG
KDEBUG = 1
CALL FMUNPK(MP1,MA)
CALL FMUNPK(MP2,MB)
CALL FMADD_R1(MA,MB)
CALL FMPACK(MA,MP1)
CALL FPEQ(MP1,MP3)
KDEBUG = J
CALL FPST2M('12.0',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1828
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPBIG(MP1)
CALL FPBIG(MP2)
CALL FMUNPK(MP1,MA)
CALL FMUNPK(MP2,MB)
CALL FMADD_R1(MA,MB)
CALL FMPACK(MA,MP1)
CALL FPEQ(MP1,MP3)
IF (.NOT.(MWK(START(MP3)+2) == MEXPOV)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1829
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' 1.732050808 ',MA)
CALL FMPRINT(MA)
NCASE = 1830
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FM_ST2M(' 1.732050808 ',M_A)
CALL FM_PRINT(M_A)
NCASE = 1831
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IM_ST2M(' 11732050808 ',M_J)
CALL IM_PRINT(M_J)
NCASE = 1832
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IM_ST2M(' 11732050808 ',M_J)
CALL IMPRINT(M_J%MIM)
NCASE = 1833
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMFPRINT(' F12.7 ',MA)
NCASE = 1834
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMFPRINT(' ES25.15 ',MA)
NCASE = 1835
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMFPRINT(' 1PE25.15 ',MA)
NCASE = 1836
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMFPRINT(' E25.15 ',MA)
NCASE = 1837
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FM_FPRINT(' F12.7 ',M_A)
NCASE = 1838
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
M_J = 12343
CALL IMFPRINT(' I10 ',M_J%MIM)
NCASE = 1839
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
M_J = 12343
CALL IM_FPRINT(' I10 ',M_J)
NCASE = 1840
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZM_ST2M(' 1.23 - 4.56 i ',M_Z)
CALL ZM_FPRINT(' F12.7 ',' F12.7 ',M_Z)
NCASE = 1841
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZMST2M(' 1.23 - 4.56 i ',ZA)
CALL ZMFPRINT(' F12.7 ',' F12.7 ',ZA)
NCASE = 1842
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FM_FPRINT(' F12.7 ',M_A)
NCASE = 1843
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
CALL FMINP(LINE,MA,1,10)
CALL FMFPRINT(' F14.9 ',MA)
NCASE = 1844
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
CALL FM_INP(LINE,M_A,1,10)
CALL FM_FPRINT(' F14.9 ',M_A)
NCASE = 1845
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','2','7','3','2','0','5','0','8','1' /)
CALL IM_INP(LINE,M_J,1,10)
CALL IM_FPRINT(' F14.9 ',M_J)
NCASE = 1846
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
CALL ZM_INP(LINE,M_Z,1,10)
CALL ZM_FPRINT(' F14.9 ',' F14.9 ',M_Z)
NCASE = 1847
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
CALL ZMINP(LINE,ZA,1,10)
CALL ZMFPRINT(' F14.9 ',' F14.9 ',ZA)
NCASE = 1848
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FM_OUT(M_A,LINE2,80)
WRITE (22,*) LINE2
NCASE = 1849
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IM_OUT(M_J,LINE2,80)
WRITE (22,*) LINE2
NCASE = 1850
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZM_OUT(M_Z,LINE3,160,L1,L2)
WRITE (22,*) LINE3(1:L1)
WRITE (22,*) LINE3(L1+1:L2)
NCASE = 1851
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZM_PRINT(M_Z)
NCASE = 1852
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZMPRINT(M_Z%MZM)
NCASE = 1853
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
OPEN (23,FILE='TEMPFM')
CALL FMWRITE(23,MA)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FMREAD(23,MB)
CLOSE(23)
IF (.NOT.FMCOMP(MA,'==',MB)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1854
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
OPEN (23,FILE='TEMPFM')
CALL FM_WRITE(23,M_A)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_B)
CLOSE(23)
IF (.NOT.FMCOMP(MA,'==',MB)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1855
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IMST2M(' 8765432 ',MA)
OPEN (23,FILE='TEMPFM')
CALL IM_WRITE(23,M_J)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL IM_READ(23,M_K)
CLOSE(23)
IF (.NOT.IM_COMP(M_J,'==',M_K)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1856
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
OPEN (23,FILE='TEMPFM')
CALL IM_WRIT(23,M_J)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL IM_READ(23,M_K)
CLOSE(23)
IF (.NOT.IM_COMP(M_J,'==',M_K)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1857
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
OPEN (23,FILE='TEMPFM')
CALL ZMWRITE(23,ZA)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL ZMREAD(23,ZB)
CLOSE(23)
CALL ZMSUB(ZA,ZB,ZC)
CALL ZMABS(ZC,MA)
IF (.NOT.(MWK(START(MA)+3)==0)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1858
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
M_X = TO_ZM(' 123456789.0123 + .00000000000987654321098765 i ')
OPEN (23,FILE='TEMPFM')
CALL ZM_WRITE(23,M_X)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL ZM_READ(23,M_Y)
CLOSE(23)
CALL ZM_SUB(M_X,M_Y,M_Z)
CALL ZM_ABS(M_Z,M_A)
IF (.NOT.(M_A==0)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST54
END MODULE TEST_C
MODULE TEST_D
USE TEST_VARS
CONTAINS
SUBROUTINE TEST55
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 1859
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MAXINT = 31
CALL FMSET(50)
NCASE = 1860
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MAXINT = HUGE(MAXINT)
CALL FMSET(50)
NCASE = 1861
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
INTMAX = 31
CALL FMSET(50)
NCASE = 1862
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
INTMAX = HUGE(INTMAX)
CALL FMSET(50)
NCASE = 1863
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
DPMAX = 31
CALL FMSET(50)
NCASE = 1864
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
DPMAX = HUGE(DPMAX)
CALL FMSET(50)
NCASE = 1865
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
SPMAX = 31
CALL FMSET(50)
NCASE = 1866
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
SPMAX = HUGE(SPMAX)
CALL FMSET(50)
NCASE = 1867
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MXBASE = 31
CALL FMSET(50)
NCASE = 1868
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MXBASE = HUGE(MXBASE)
CALL FMSET(50)
NCASE = 1869
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMSET(123456789)
CALL FMSET(50)
NCASE = 1870
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MXEXP2 = 31
CALL FMSET(50)
NCASE = 1871
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MXEXP2 = HUGE(MXEXP2)
CALL FMSET(50)
NCASE = 1872
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MEXPUN = 31
CALL FMSET(50)
NCASE = 1873
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MEXPUN = -(HUGE(MEXPUN)/2)
CALL FMSET(50)
NCASE = 1874
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MEXPOV = 31
CALL FMSET(50)
NCASE = 1875
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MEXPOV = HUGE(MEXPOV)
CALL FMSET(50)
NCASE = 1876
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MUNKNO = 31
CALL FMSET(50)
NCASE = 1877
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
MUNKNO = HUGE(MUNKNO)
CALL FMSET(50)
NCASE = 1878
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
DPEPS = 31
CALL FMSET(50)
NCASE = 1879
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
DPEPS = TINY(DPEPS)
CALL FMSET(50)
NCASE = 1880
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMACOS(MA,MB)
NCASE = 1881
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMI2M(2,MB)
CALL FMSUB_R1(MA,MB)
NCASE = 1882
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMI2M(2,MB)
MBLOGS = 0
CALL FMADD_R2(MA,MB)
NCASE = 1883
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMI2M(2,MB)
MBLOGS = 0
CALL FMSUB_R2(MA,MB)
NCASE = 1884
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMI2M(2,MB)
MBLOGS = 0
CALL FMSUB_R2(MB,MA)
NCASE = 1885
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' UNDERFLOW ',MA)
CALL FMI2M(2,MB)
CALL FMSUB_R1(MB,MA)
NCASE = 1886
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMBIG(MA)
CALL FMBIG(MB)
CALL FMADD_R1(MB,MA)
NCASE = 1887
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMBIG(MA)
CALL FMBIG(MB)
CALL FMADD_R2(MB,MA)
NCASE = 1888
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMBIG(MA)
CALL FMBIG(MB)
MWK(START(MB)) = -1
CALL FMSUB_R1(MB,MA)
NCASE = 1889
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMBIG(MA)
CALL FMBIG(MB)
MWK(START(MB)) = -1
CALL FMSUB_R2(MB,MA)
NCASE = 1890
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 1
CALL FMBIG(MA)
CALL FMRATIONAL_POWER(MA,2,3,MB)
CALL FMI2M(1,MC)
CALL FMDIV(MC,MB,MA)
CALL FMATAN2(MA,MB,MC)
NCASE = 1891
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 1
CALL FMST2M(' OVERFLOW ',MA)
CALL FMST2M(' -OVERFLOW ',MB)
CALL FMATAN2(MA,MB,MC)
NCASE = 1892
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 1
CALL FMST2M(' OVERFLOW ',MA)
CALL FMST2M(' OVERFLOW ',MB)
CALL FMSUB_R2(MA,MB)
NCASE = 1893
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 1
CALL FMBIG(MA)
CALL FMRATIONAL_POWER(MA,2,3,MB)
CALL FMCOS(MB,MC)
NCASE = 1894
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
KRAD = 1
CALL FMBIG(MA)
CALL FMRATIONAL_POWER(MA,2,3,MB)
CALL FMI2M(1,MC)
CALL FMDIV(MC,MB,MA)
CALL FMEXP(MA,MC)
NCASE = 1895
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMST2M(' 9.87654321 ',MA)
CALL FMADDI(MA,1)
CALL FMST2M(' 10.87654321 ',MB)
IF (.NOT.FMCOMP(MA,'==',MB)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1896
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMI2M(0,MA)
CALL FMI2M(10,MB)
CALL FMSUB_R2(MA,MB)
KW = KWSAVE
RETURN
END SUBROUTINE TEST55
SUBROUTINE TEST56
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 1897
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.3',MP1)
CALL FPST2M('13.4',MP2)
MBLOGS = 0
CALL FPADD_R1(MP1,MP2)
CALL FPEQ(MP1,MP3)
CALL FPST2M('25.7',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1898
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('12.3',MP1)
CALL FPST2M('13.4',MP2)
MBLOGS = 0
CALL FPADD_R2(MP1,MP2)
CALL FPEQ(MP2,MP3)
CALL FPST2M('25.7',MP4)
IF (.NOT.FPCOMP(MP3,'==',MP4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1899
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPASIN(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.1549366595480165482162668772711462026055032526229215'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1900
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPASINH(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.15371150629581261264064074147602400563488601232863865993318169'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1901
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPACOS(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '1.72573298634291316744758856891089764470408795231047443'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1902
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPATAN(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.1531097611932166866656026454043044303832710577681088'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1903
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '0.94560848060096528389929229868402683067804981169173247'
CALL FPST2M(ST1,MP1)
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP2)
CALL FPATAN2(MP1,MP2,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '1.73256418659578182618854912685922800721811839353964281'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1904
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPATANH(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.15556029109708269346385810732889430739725390446117551460013646'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1905
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPCOSH_SINH(MP1,MP5,MP3)
CALL FPEQ(MP5,MP1)
ST2 = '1.01193059616357146189046397247688618707733939978160410'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-49',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1906
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPCOSH_SINH(MP1,MP3,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.1549307311412463123459415264870282740222134044307085'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-49',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1907
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.94560848060096528389929229868402683067804981169173247'
CALL FPST2M(ST1,MP1)
CALL FPCOSH(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '1.481411250434183525381236609413838568985012681608897254'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-49',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1908
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.94560848060096528389929229868402683067804981169173247'
CALL FPST2M(ST1,MP1)
CALL FPSINH(MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-1.09296811157186613424915073409970877381016076745694536'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-49',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1909
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.28774393113505190047124972239269330732580050085069004'
CALL FPST2M(ST1,MP1)
CALL FPCOS_SIN(MP1,MP5,MP3)
CALL FPEQ(MP5,MP1)
ST2 = '0.958886564221161298875708475997367442261190043299635289'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
ENDIF
NCASE = 1910
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.28774393113505190047124972239269330732580050085069004'
CALL FPST2M(ST1,MP1)
CALL FPCOS_SIN(MP1,MP3,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '-0.28378963504000055007660394052727537030693318515060125'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1911
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPDIG(NSTACK,KST)
NCASE = 1912
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FPST2M(ST1,MP1)
ST1 = '0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP2)
CALL FPDIM(MP1,MP2,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '0.1961979460329520811830831348163129844349414342734330'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1913
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '0.3505154639175257731958762886597938144329896907216495'
CALL FPST2M(ST1,MP1)
ST1 = '0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP2)
CALL FPDIM(MP2,MP1,MP5)
CALL FPEQ(MP5,MP1)
ST2 = '0.0'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1914
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
ST1 = '0.94560848060096528389929229868402683067804981169173247'
CALL FPST2M(ST1,MP2)
CALL FPDIV_R1(MP1,MP2)
ST2 = '-0.1631938810304448993189068089843600996344185378132402'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1915
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
ST1 = '0.94560848060096528389929229868402683067804981169173247'
CALL FPST2M(ST1,MP2)
CALL FPDIV_R2(MP1,MP2)
CALL FPEQ(MP2,MP1)
ST2 = '-0.1631938810304448993189068089843600996344185378132402'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1916
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMFLAG(J)
IF (.NOT.J==0) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1917
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FM_FLAG(J)
IF (.NOT.J==0) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1918
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPFLAG(J)
IF (.NOT.J==0) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1919
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '-0.1543175178845736920127931538434808299980482564482165'
CALL FPST2M(ST1,MP1)
CALL FPDIVI_R1(MP1,314)
ST2 = '-4.9145706332666780895793998039325105094919826894336465M-4'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('1.0E-50',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1920
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPDP2M(3.1415926536D0,MP1)
ST2 = '3.1415926536D0'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPDPM(DSMALL,MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1921
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPDP2M(3.1415926536D0,MP1)
ST2 = '3.1415926536D0'
CALL FPST2M(ST2,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQU(MP5,MP4,NDIG,NDIG)
CALL FPDPM(DSMALL,MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
CALL FMSETVAR(' MBASE = 2 ')
CALL FMSETVAR(' NDIG = 100 ')
NCASE = 1922
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '3.1415926536D0'
CALL FPST2M(ST1,MP1)
CALL FPEQU_R1(MP1,100,53)
CALL FPDP2M(3.1415926536D0,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPDPM(DSMALL,MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1923
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPI2M(1,MP1)
CALL FPDIVI(MP1,3,MP2)
CALL FPI2M(3,MP3)
CALL FPDIVI(MP3,7,MP1)
CALL ZPCOMPLEX(MP2,MP1,ZP1)
CALL FPI2M(2,MP1)
CALL FPDIVI(MP1,11,MP2)
CALL FPI2M(5,MP3)
CALL FPDIVI(MP3,-13,MP1)
CALL ZPCOMPLEX(MP2,MP1,ZP2)
CALL ZPMPY(ZP2,ZP1,ZP3)
CALL ZP2I2M(677,-151,ZP2)
CALL ZPDIVI(ZP2,3003,ZP4)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-28 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1924
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('0.1',MP1)
CALL FPST2M('23.4',MP2)
CALL FPST2M('34.5',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('5.8731980918960730463350151650813268739874201571164800M-27',&
MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1925
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('8.115640517330775M-1',MP1)
CALL FPST2M('2.00853601446773',MP2)
CALL FPST2M('1.59735792202923',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('2.0112520048150164306467955877563719782378767062440103M-1',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1926
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.01737835258975M-1',MP1)
CALL FPST2M('2.00853601446773',MP2)
CALL FPST2M('1.59735792202923',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('2.2512248738228585976753517954889151150428002974819213M-1',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1927
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPST2M('5.5680052333367',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('2.8619456987740165364092968281459448023932520843535423M-2',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1928
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('4.764360371097952E-01',MP1)
CALL FPST2M('1.161514683661584E+01',MP2)
CALL FPST2M('2.937801562768354E-01',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('2.3604503996731113868791517339909092506365724801689105M-5',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1929
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('0.9',MP1)
CALL FPST2M('23.4',MP2)
CALL FPST2M('34.5',MP3)
CALL FPIBTA(MP1,MP2,MP3,MP5)
CALL FPEQ(MP5,MP3)
CALL FPST2M('7.3148127865937299821246829407023943740949130742928268M-18',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-28',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
CALL FMSET(50)
NCASE = 1930
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
ST1 = '1.3505154639175257731958762886597938144329896907216495E+16'
CALL FPST2M(ST1,MP1)
CALL FPFORM('F53.33',MP1,ST2)
CALL FPST2M(ST2,MP1)
ST1 = '13505154639175257.731958762886597938144329896907216'
CALL FPST2M(ST1,MP3)
CALL FPSUB(MP1,MP3,MP4)
CALL FPABS(MP4,MP5)
CALL FPEQ(MP5,MP4)
CALL FPST2M('0',MP2)
IF (.NOT.FPCOMP(MP4,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1931
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPFPRINT(' F12.7 ',MP1)
NCASE = 1932
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','0','5','0','8','1' /)
CALL FPINP(LINE,MP1,1,10)
CALL FPFPRINT(' F14.9 ',MP1)
NCASE = 1933
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPDP2M(3.1415926536D0,MP1)
CALL FPINT(MP1,MP4)
CALL FPI2M(3,MP2)
IF (.NOT.FPCOMP(MP4,'EQ',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1934
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('23.4',MP1)
CALL FPIPOWER(MP1,3141,MP3)
CALL FPST2M('5.09340400268261822666046780299885179315709583071835M+4300',&
MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST56
SUBROUTINE TEST57
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 1935
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('23.4',MP1)
CALL FPLOG10(MP1,MP3)
CALL FPST2M('1.36921585741014283901029985917705207599817679823056854M+0',&
MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1936
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPLNI(314159,MP3)
CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1937
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
MP4)
CALL FPM2DP(MP4,D4)
D3 = 12.6576545061554068013063698538D0
IF (.NOT.(ABS((D3-D4)/D3) <= DSMALL)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1938
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
MP4)
CALL FPM2I(MP4,J4)
J3 = 12
IF (.NOT.(J3 == J4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1939
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.26576545061554068013063698538579804967961002514885554M+1',&
MP4)
CALL FPM2SP(MP4,R4)
R3 = 12.6576545061554068013063698538D0
IF (.NOT.(ABS((R3-R4)/R3) <= RSMALL)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1940
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMAX(MP1,MP2,MP3)
CALL FPEQ(MP2,MP4)
IF (.NOT.(FPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1941
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMIN(MP1,MP2,MP3)
CALL FPEQ(MP1,MP4)
IF (.NOT.(FPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1942
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMOD(MP2,MP1,MP3)
CALL FPST2M('4.84728666594576M-2',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1943
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMPY_R1(MP2,MP1)
CALL FPEQ(MP2,MP3)
CALL FPST2M('1.8935316137265192583672271140224',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1944
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMPY_R2(MP2,MP1)
CALL FPEQ(MP1,MP3)
CALL FPST2M('1.8935316137265192583672271140224',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1945
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPMPYI_R1(MP1,3141)
CALL FPEQ(MP1,MP3)
CALL FPST2M('3.0184261058771671752M+3',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1946
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP2)
CALL FPNINT(MP2,MP3)
CALL FPST2M('2',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1947
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP2)
CALL FPOUT(MP2,LINE2,80)
WRITE (22,*) LINE2
NCASE = 1948
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP2)
CALL FPPRINT(MP2)
NCASE = 1949
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPPOWER(MP1,MP2,MP3)
CALL FPST2M('9.2456296989927890349870950485447101281994309260378M-1',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1950
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.2456296989927890349870950485447101281994309260378M-1',MP1)
OPEN (23,FILE='TEMPFM')
CALL FPWRITE(23,MP1)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FPREAD(23,MP2)
CLOSE(23)
IF (.NOT.FPCOMP(MP1,'==',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1951
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M(' 8765432 ',MP1)
OPEN (23,FILE='TEMPFM')
CALL IPWRITE(23,MP1)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL IPREAD(23,MP2)
CLOSE(23)
IF (.NOT.IPCOMPARE(MP1,'==',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1952
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M(' 8765432 - 3.1415926535 i ',ZP1)
OPEN (23,FILE='TEMPFM')
CALL ZPWRITE(23,ZP1)
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL ZPREAD(23,ZP2)
CLOSE(23)
CALL ZPSUB(ZP1,ZP2,ZP3)
CALL ZPABS(ZP3,MP1)
IF (.NOT.(MWK(START(MP1)+3)==0)) THEN
CALL PRTERR(KWSAVE)
ENDIF
CALL FPSET(50)
CALL ZPSET(50)
CALL FPSETVAR(' KROUND = 1 ')
NCASE = 1953
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPRATIONAL_POWER(MP1,-17,3,MP3)
CALL FPST2M('1.2530311443238039320917124735975084865516365445493',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1954
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('1.970425178583792',MP2)
CALL FPSIGN(MP1,MP2,MP3)
CALL FPST2M('9.6097615596216720E-01',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1955
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('-1.970425178583792',MP2)
CALL FPSIGN(MP1,MP2,MP3)
CALL FPST2M('-9.6097615596216720E-01',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1956
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPSP2M(9.6097615596216720E-01,MP1)
CALL FPEQ(MP1,MP3)
CALL FPST2M('9.6097615596216720E-01',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPDP2M(DBLE(RSMALL),MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1957
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('-1.970425178583792',MP1)
CALL FPSQR(MP1,MP3)
CALL FPST2M('3.882575384396968595370765099264',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1958
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('-1.970425178583792',MP1)
CALL FPSQR_R1(MP1)
CALL FPEQ(MP1,MP3)
CALL FPST2M('3.882575384396968595370765099264',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1959
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP1)
CALL FPSQRT(MP1,MP3)
CALL FPST2M('1.4037183401892959523361955370723206435382400513186',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1960
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP1)
CALL FPSQRT_R1(MP1)
CALL FPEQ(MP1,MP3)
CALL FPST2M('1.4037183401892959523361955370723206435382400513186',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1961
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('-1.970425178583792',MP2)
CALL FPSUB_R1(MP1,MP2)
CALL FPEQ(MP1,MP3)
CALL FPST2M('2.9314013345459592',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1962
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('9.6097615596216720E-01',MP1)
CALL FPST2M('-1.970425178583792',MP2)
CALL FPSUB_R2(MP1,MP2)
CALL FPEQ(MP2,MP3)
CALL FPST2M('2.9314013345459592',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1963
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP1)
CALL FPTAN(MP1,MP3)
CALL FPST2M('-2.367672024680099040477317736673741484868333249781053',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1964
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('1.970425178583792',MP1)
CALL FPTANH(MP1,MP3)
CALL FPST2M('0.96187741826338453069125363260768470953417284943678332',MP4)
CALL FPSUB(MP3,MP4,MP1)
CALL FPDIV(MP1,MP4,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1965
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('0.970425178583792',MP1)
CALL FPULP(MP1,MP4)
CALL FPST2M('1.0E-49',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST57
SUBROUTINE TEST58
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
CALL FMSETVAR(' KDEBUG = 1 ')
CALL FMSETVAR(' NTRACE = 0 ')
NCASE = 1966
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPBIG(MP1)
NCASE = 1967
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('1',MP2)
CALL IPADD(MP1,MP2,MP3)
CALL FMSETVAR(' NTRACE = -2 ')
NCASE = 1968
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('-97042517858374251785837425178583792',MP1)
CALL IPABS(MP1,MP4)
CALL IPST2M('97042517858374251785837425178583792',MP3)
IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1969
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('-97042517858374251785837425178583792',MP1)
CALL IPST2M('9618774182633845306912536326076847095',MP2)
CALL IPADD(MP1,MP2,MP4)
CALL IPST2M('9521731664775471055126698900898263303',MP3)
IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1970
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('9618774182633845306912536326076847095',MP1)
CALL IPST2M('97042517858374251785837425178583792',MP2)
CALL IPDIM(MP1,MP2,MP4)
CALL IPST2M('9521731664775471055126698900898263303',MP3)
IF (.NOT.(IPCOMPARE(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1971
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('97042517858374251785837425178583792',MP2)
CALL IPDIV(MP1,MP2,MP4)
CALL IPST2M('9911917368706',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1972
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPDIVI(MP1,141421356,MP4)
CALL IPST2M('6801500462655615681490949353260002232803',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1973
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('8374251785837425178583792',MP2)
CALL IPDIVR(MP1,MP2,MP4,MP5)
CALL IPST2M('114861296610416734545911',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1974
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('8374251785837425178583792',MP2)
CALL IPDIVR(MP1,MP2,MP5,MP4)
CALL IPST2M('3666412140861684892372583',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1975
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPDVIR(MP1,314159,MP4,K)
CALL IPST2M('3061753501454309858037853950596202993790013',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1976
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPDVIR(MP1,314159,MP4,K)
CALL IPI2M(K,MP4)
CALL IPST2M('153028',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1977
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPFACT(42,MP1)
CALL IPST2M('1405006117752879898543142606244511569936384000000000',MP3)
IF (.NOT.(IPCOMP(MP1,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1978
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPFORM('I60',MP1,ST1)
WRITE (22,*) TRIM(ST1)
CALL IPFORM('I65',MP1,ST1)
WRITE (22,*) TRIM(ST1)
CALL IPFORM('I70',MP1,ST1)
WRITE (22,*) TRIM(ST1)
CALL IPFPRINT('I55',MP1)
NCASE = 1979
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPFM2I(MP1,MP4)
CALL IPST2M('961877418263384530691314159265352536326076847095',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1980
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('501617681971661768197016151614655',MP2)
CALL IPGCD(MP1,MP2,MP4)
CALL IPST2M('2995',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1981
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPI2FM(MP1,MP4)
CALL FPST2M('961877418263384530691314159265352536326076847095',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1982
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','2','7','3','2','0','5','0','8','1' /)
CALL IPINP(LINE,MP1,1,10)
CALL IPFPRINT(' I19 ',MP1)
NCASE = 1983
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('9618774',MP1)
CALL IPM2I(MP1,J)
IF (.NOT.(J==9618774)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1984
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352',MP1)
CALL IPST2M('501617681971661768197016151614655',MP2)
CALL IPMAX(MP1,MP2,MP4)
CALL IPEQ(MP1,MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1985
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352',MP1)
CALL IPST2M('501617681971661768197016151614655',MP2)
CALL IPMIN(MP1,MP2,MP4)
CALL IPEQ(MP2,MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1986
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159265352536326076847095',MP1)
CALL IPST2M('501617681971661768197016151614655',MP2)
CALL IPMOD(MP1,MP2,MP4)
CALL IPST2M('145259323199683353738381582948755',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1987
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPST2M('501617681971661768197016151',MP2)
CALL IPMPY(MP1,MP2,MP4)
CALL IPST2M('482494720890165508515231424715486981447117196737982009',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1988
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('9618774182633845306913141592653525363260768479',MP1)
CALL IPMPYI(MP1,27182818,MP4)
CALL IPST2M('261465387989634577617974069721330917007901356104793822',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1989
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPST2M('501617681971661768197016151',MP2)
CALL IPST2M('890165508515231424715486981',MP3)
CALL IPMPY_MOD(MP1,MP2,MP3,MP4)
CALL IPST2M('858797890729021380597497877',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1990
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPPRINT(MP1)
CALL IPOUT(MP1,LINE2,80)
WRITE (22,*) LINE2
NCASE = 1991
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPST2M('501617681971661768197016151',MP2)
CALL IPST2M('890165508515231424715486981',MP3)
CALL IPPOWER_MOD(MP1,MP2,MP3,MP4)
CALL IPST2M('633132741667454490327909790',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1992
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('3',MP1)
CALL IPST2M('99',MP2)
CALL IPPOWER(MP1,MP2,MP4)
CALL IPST2M('171792506910670443678820376588540424234035840667',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1993
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPST2M('-501617681971661768197016151',MP2)
CALL IPSIGN(MP1,MP2,MP4)
CALL IPST2M('-961877418263384530691314159',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1994
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPSQR(MP1,MP4)
CALL IPST2M('925208167765033988714377447579006734179035806433877281',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1995
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL IPST2M('961877418263384530691314159',MP1)
CALL IPST2M('-501617681971661768197016151',MP2)
CALL IPSUB(MP1,MP2,MP4)
CALL IPST2M('1463495100235046298888330310',MP3)
IF (.NOT.(IPCOMP(MP4,'==',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST58
SUBROUTINE TEST59
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 1996
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPACOS(ZP1,ZP4)
CALL ZPST2M('0.70600062465538060328041859335986022136042273675348823497' &
// ' - 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1997
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPACOSH(ZP1,ZP4)
CALL ZPST2M('0.7115660488391767717946749135772158108512093397785316736309103' &
// ' + 0.706000624655380603280418593359860221360422736753488234970530511 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1998
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
C2 = ( 411.11D0 , 421.21D0 )
CALL ZPZ2M(C2,ZP1)
CALL ZPM2Z(ZP1,C3)
IF (.NOT.(ABS(C2-C3)<=10*RSMALL)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 1999
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M(' UNKNOWN + UNKNOWN i',ZP1)
CALL ZPABS(ZP1,MP1)
NCASE = 2000
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
CALL ZPADD(ZP1,ZP2,ZP4)
CALL ZPST2M('1.767910222449318129295372 - .175561785519695959610924 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2001
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPADDI(ZP1,23)
CALL ZPEQ(ZP1,ZP4)
CALL ZPST2M('23.961877418263384530693159 + .501617681971661761970161 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2002
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPARG(ZP1,MP2)
CALL FPST2M('.480698159960890424820899647062999936490174031143315855',MP3)
CALL FPSUB(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2003
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPASIN(ZP1,ZP4)
CALL ZPST2M('0.86479570213951601595090309827989122073816196293406467551' &
// ' + 0.71156604883917677179467491357721581085120933977853167363 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2004
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPASINH(ZP1,ZP4)
CALL ZPST2M('0.900207272015178844823089941054098242773062607541078739877027' &
// ' + 0.35754352192968121012869758291917347170198797130828159120183063 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2005
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPATAN(ZP1,ZP4)
CALL ZPST2M('0.83122857933580380367837122090555657350450640595902544783' &
// ' + 0.24920779958101410179847467515196375836302942974441567571 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2006
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPATANH(ZP1,ZP4)
CALL ZPST2M('0.696301009291630587124616922905971442353634900594022530558111' &
// ' + 0.87263127573022465079716048906002337234036921023338585331161049 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2007
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
CALL ZPST2M('1.31467350963913258828454157251213529780144052082464935752' &
// ' + 0.53720666283416318345036206080606650334019117579553972797 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2008
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
CALL ZPEQ(ZP5,ZP4)
CALL ZPST2M('.979580485714651735857744392650346362731955914349750961769' &
// ' + 0.72097329329143451318183379449877600176209183488881542857 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2009
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
CALL ZPEQ(ZP5,ZP4)
CALL FPST2M('.979580485714651735857744392650346362731955914349750962',MP1)
CALL FPST2M('.720973293291434513181833794498776001762091834888815429',MP2)
CALL ZPCOMPLEX(MP1,MP2,ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2010
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOSH_SINH(ZP1,ZP4,ZP5)
CALL ZPEQ(ZP5,ZP4)
CALL FPST2M('.979580485714651735857744392650346362731955914349750962',MP1)
CALL FPST2M('-.72097329329143451318183379449877600176209183488881543',MP2)
CALL ZPCOMPLEX(MP1,MP2,ZP5)
CALL ZPCONJUGATE(ZP5,ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2011
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOSH(ZP1,ZP4)
CALL ZPST2M('1.31467350963913258828454157251213529780144052082464935752' &
// ' + 0.53720666283416318345036206080606650334019117579553972797 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2012
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPSINH(ZP1,ZP4)
CALL ZPST2M('.979580485714651735857744392650346362731955914349750961769' &
// ' + 0.72097329329143451318183379449877600176209183488881542857 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2013
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOS_SIN(ZP1,ZP4,ZP5)
CALL ZPST2M('.645463644587284986570788327890260087314797257046253121008' &
// ' - 0.42893405213103227551382784541030693750489674471244174226 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2014
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOS_SIN(ZP1,ZP4,ZP5)
CALL ZPEQ(ZP5,ZP4)
CALL ZPST2M('.925646878732852518234454333124909696895019818561899130649' &
// ' + 0.29910038367448814287423577861472924609286011958848280525 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2015
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPCOS(ZP1,ZP4)
CALL ZPST2M('.645463644587284986570788327890260087314797257046253121008' &
// ' - 0.42893405213103227551382784541030693750489674471244174226 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2016
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPSIN(ZP1,ZP4)
CALL ZPST2M('.925646878732852518234454333124909696895019818561899130649' &
// ' + 0.29910038367448814287423577861472924609286011958848280525 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2017
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
CALL ZPDIV(ZP1,ZP2,ZP4)
CALL ZPST2M('.393065886385899116192752703080718648267156986016216110380' &
// ' + .952559034342193734113670482385007317974710202767761766583 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2018
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPDIVI(ZP1,17,ZP3)
CALL ZPEQU(ZP3,ZP4,NDIG,NDIG)
CALL ZPST2M('.056581024603728501805479941176470588235294117647058823529' &
// ' + .029506922468921280115891823529411764705882352941176470588 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2019
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPEXP(ZP1,ZP4)
CALL ZPST2M('2.29425399535378432414228596516248166053339643517440031928' &
// ' + 1.25817995612559769663219585530484250510228301068435515654 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2020
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
STZ1 = '7.699115044247787610619469026548672566371681415929204e+3 ' &
//'- 5.221238938053097345132743362831858407079646017699115M+3 i'
CALL ZPST2M(STZ1,ZP1)
CALL ZPFORM('F53.33','F50.30',ZP1,STZ2)
CALL ZPFPRINT('F53.33','F50.30',ZP1)
CALL ZPST2M(STZ2,ZP1)
STZ1 = '7699.115044247787610619469026548673 - 5221.238938053097345132743362831858 i'
CALL ZPST2M(STZ1,ZP3)
CALL ZPSUB(ZP1,ZP3,ZP4)
CALL ZPABS(ZP4,MP1)
CALL FPI2M(10,MP2)
CALL FPIPOWER(MP2,-30,MP5)
CALL FPEQ(MP5,MP2)
IF (.NOT.FPCOMP(MP1,'LE',MP2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2021
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPIMAG(ZP1,MP2)
CALL FPST2M('.501617681971661761970161',MP3)
CALL FPSUB(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2022
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('961.877418263384530693159 - 50161.7681971661761970161 i',ZP1)
CALL ZPINT(ZP1,ZP4)
CALL ZPST2M('961 - 50161 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2023
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPIPOWER(ZP1,-17,ZP3)
CALL ZPEQU(ZP3,ZP4,NDIG,NDIG)
CALL ZPST2M('-0.0783198382158008596797674342388290245832366478080809199' &
// ' - 0.23802087499028856650937161618337776943798676633749916344 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPEQU_R1(ZP2,NDIG,NDIG)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2024
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPLOG10(ZP1,ZP4)
CALL ZPST2M('0.03535658255837767759890583679877500609113178092547835860' &
// ' + 0.20876455833206137887867112816112836681425288379320453778 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2025
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPLN(ZP1,ZP4)
CALL ZPST2M('0.08141153993813371843860406013667319698707451321662014634' &
// ' + 0.48069815996089042482089964706299993649017403114331585543 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2026
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZP2I2M(311,242,ZP1)
CALL ZPLN(ZP1,ZP4)
CALL ZPST2M('5.97650870861072332214638522053994842350413381557547832020' &
// ' + 0.66126573728680700894734815861149103459820486160667323526 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2027
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZP2I2M(0,1,ZP2)
CALL ZPI2M(242,ZP1)
CALL ZPMPY(ZP2,ZP1,ZP3)
CALL ZPI2M(311,ZP2)
CALL ZPADD(ZP2,ZP3,ZP1)
CALL ZPLN(ZP1,ZP4)
CALL ZPST2M('5.97650870861072332214638522053994842350413381557547832020' &
// ' + 0.66126573728680700894734815861149103459820486160667323526 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2028
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
LINE = (/ '1','.','7','3','2','-','5','.','8','i' /)
CALL ZPINP(LINE,ZP3,1,10)
CALL ZPFPRINT(' F14.9 ',' F14.9 ',ZP3)
NCASE = 2029
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZP2I2M(0,1,ZP2)
CALL ZPI2M(242,ZP1)
CALL ZPMPY(ZP2,ZP1,ZP3)
CALL ZPI2M(311,ZP2)
CALL ZPADD(ZP2,ZP3,ZP1)
CALL ZPM2I(ZP1,K)
CALL ZPI2M(K,ZP4)
CALL ZPI2M(311,ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2030
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
CALL ZPMPY(ZP1,ZP2,ZP4)
CALL ZPST2M('1.114989947487781115990363612078996929155913365552' &
// ' - 0.247043331062694339517150562789101008517858731222 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2031
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPMPYI(ZP1,63387,ZP4)
CALL ZPST2M('60970.523911461155247047269533 + 31796.040007137724106002595307 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2032
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('7.46187741826338453069315 - 11.5016176819716617619701 i',ZP1)
CALL ZPNINT(ZP1,ZP4)
CALL ZPST2M('7 - 12 I',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2033
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('7.4618774182633845306931 - 11.5016176819716617619701 i',ZP1)
CALL ZPOUT(ZP1,LINE3,160,L1,L2)
WRITE (22,*) LINE3(1:L1)
WRITE (22,*) LINE3(L1+1:L2)
CALL ZPPRINT(ZP1)
NCASE = 2034
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPST2M('.806032804185933598602213 - .677179467491357721581085 i',ZP2)
CALL ZPPOWER(ZP1,ZP2,ZP4)
CALL ZPST2M('1.39775982163051551688131453335764913350785862824257646215' &
// ' + 0.48240656957195221898158057319722954101453374897327805790 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2035
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPREAL(ZP1,MP4)
CALL FPST2M('0.961877418263384530693159',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2036
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPRATIONAL_POWER(ZP1,2,3,ZP4)
CALL ZPST2M('1.00202360107782552892042821152548849581875484236296485859' &
// ' + 0.33257768446397834834871578362882211629744208653087094696 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2037
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPSQR(ZP1,ZP4)
CALL ZPST2M('0.67358786889841078726210758566713980197275503336' &
// ' + 0.964989441780331005053370946075151648549609657198 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2038
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPSQRT(ZP1,ZP4)
CALL ZPST2M('1.01160631388938404645144168377130820925509481210302287649' &
// ' + 0.24793127281059658860683266919655766045064329364530970818 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2039
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPTAN(ZP1,ZP4)
CALL ZPST2M('0.78117053617929045357436659926266970251614000121758973149' &
// ' + 0.98250464217661207723158350609409132905007077433947956202 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2040
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL ZPST2M('.961877418263384530693159 + .501617681971661761970161 i',ZP1)
CALL ZPTANH(ZP1,ZP4)
CALL ZPST2M('0.83052827119349045667199695567558847711641456190882938853' &
// ' + 0.20903134528783898803996574942036149916960793736034264482 i',ZP3)
CALL ZPSUB(ZP4,ZP3,ZP2)
CALL ZPABS(ZP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST59
SUBROUTINE TEST60
! Test packed array routines and error messages.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2041
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPBERN(6,MP1,MP4)
CALL FPST2M('.018139938530080584064122845276611475515756237384957075',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2042
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.76187741826338453069315950161768197166176197016819E-30',MP1)
CALL FPBERN(56,MP1,MP4)
CALL FPST2M('-2.1712568779835074200430675247025298102245771733788731',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2043
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPBERNOULLI(754,MP4)
CALL FPST2M('2.46143453963085054575745389497735050525111549008129322M+1242',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP4)
CALL FPABS(MP4,MP2)
CALL FPEQ(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2044
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('UNKNOWN',MP1)
CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
CALL FPBETA(MP1,MP2,MP4)
NCASE = 2045
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
CALL FPBETA(MP1,MP2,MP4)
CALL FPST2M('2.99150917174738777323834998550737132112608848764083126',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2046
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPCMBI(52,7,MP4)
CALL FPST2M('133784560',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2047
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FMSETVAR(' NTRACE = 0 ')
CALL FPCMBI(152,47,MP4)
CALL FPST2M('4688795937593084907665736021700474766400',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2048
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPCMBI(524,257,MP4)
CALL FPST2M('1.7394867054111349048750219854973569921796001236423E156',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
CALL FMSETVAR(' NTRACE = 2 ')
NCASE = 2049
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
CALL FPCOMB(MP1,MP2,MP4)
CALL FPST2M('1.16776225886340871791424789455418366405513640340362234',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2050
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPEULER(MP4)
CALL FPST2M('0.57721566490153286060651209008240243104215933593992360',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2051
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPFACT(MP1,MP4)
CALL FPST2M('0.92181747044639815204253427093098440709300519155172509',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2052
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
CALL FPIGM1(MP1,MP2,MP4)
CALL FPST2M('0.54012222681292420650853318537501826484216332470115287',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2053
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPST2M('.384530693159501617681971661761970168197166161761877418',MP2)
CALL FPIGM2(MP1,MP2,MP4)
CALL FPST2M('0.66980662571505767554186612265050822469259270495177049',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2054
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPLNGM(MP1,MP4)
CALL FPST2M('0.19056155831623627284176293227248235560520674439064473',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2055
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPPGAM(12,MP1,MP4)
CALL FPST2M('-1.6437610934504989650413401960008051459064634656830e10',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2056
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPPSI(MP1,MP4)
CALL FPST2M('-1.0560385061434708930901856824702932941189426061196201',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPABS(MP2,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2057
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPPOCH(MP1,19,MP4)
CALL FPST2M('4.96330494211633715298220189277411152814525032466164E16',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST60
SUBROUTINE TEST61
! Test special functions BESJ, ..., SI.
IMPLICIT NONE
WRITE (KW,"(/' Testing special functions Bessel J, ..., Sine integral.')")
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2058
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPBESJ(1,MP1,MP4)
CALL FPST2M('0.35395934550649481043706011910726694906877434623666577',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2059
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_BESJ(1,M_A,M_C)
M_D = TO_FM('0.025076313747902851151016887592625714022097197246242295753')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BESJ ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2060
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = BESSEL_J(1,M_A)
M_D = TO_FM('0.580613481388098517450802341770789762709610311496482470588')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BESJ ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2061
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPBESJ(2,MP1,MP4)
CALL FPST2M('-.01952848241900729944980296190098199680508467281412306',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2062
M_A = TO_FM('10.76313747902851151016887592625714022')
M_C = BESSEL_J0(M_A)
M_D = TO_FM('-0.208312158576553370144898171757804508454706793929928218991535')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_J0',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2063
M_A = TO_FM('11.76313747902851151016887592625714022')
M_C = BESSEL_J1(M_A)
M_D = TO_FM('-0.2329271333218008613387948290084894573276990964794253279143')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_J1',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2064
M_A = TO_FM('25.76313747902851151016887592625714022')
M_C = BESSEL_JN(5,M_A)
M_D = TO_FM('0.0508922548494461703324004764815922773488007444429836272407555')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_JN',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2065
M_A = TO_FM('35.76313747902851151016887592625714022')
MFMV2 = BESSEL_JN(0,2,M_A)
DO J = 1, 3
M_D = BESSEL_J(J-1,M_A)
IF (.NOT.(M_D == MFMV2(J))) THEN
CALL ERRPRT_FM('BES_JN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
ENDIF
ENDDO
NCASE = 2066
M_A = TO_FM('45.76313747902851151016887592625714022')
MFMV2 = BESSEL_JN(5,7,M_A)
DO J = 1, 3
M_D = BESSEL_J(J+4,M_A)
IF (.NOT.(M_D == MFMV2(J))) THEN
CALL ERRPRT_FM('BES_JN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
ENDIF
ENDDO
NCASE = 2067
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPBESY(1,MP1,MP4)
CALL FPST2M('-1.0229628883608938340543466176704780443299917729340212',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2068
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPBESY(3,MP1,MP4)
CALL FPST2M('.019458484184348814542380224640044909138243842997041552',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2069
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_BESY(1,M_A,M_C)
M_D = TO_FM('0.415283138512818266781669706694859586834446116171226914427')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BESY ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2070
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = BESSEL_Y(1,M_A)
M_D = TO_FM('-0.24596633539686028736976213837495696096219154732970115661')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' BESY ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2071
M_A = TO_FM('10.76313747902851151016887592625714022')
M_C = BESSEL_Y0(M_A)
M_D = TO_FM('-0.12526481112719290404360204423259007560755779258223692939574')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_Y0',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2072
M_A = TO_FM('11.76313747902851151016887592625714022')
M_C = BESSEL_Y1(M_A)
M_D = TO_FM('-0.003248393370801429476804249855075203160449295789759231111044843')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_Y1',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2073
M_A = TO_FM('25.76313747902851151016887592625714022')
M_C = BESSEL_YN(5,M_A)
M_D = TO_FM('-0.150310703577113473623573293096522058774420127187598125599602')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('BES_YN',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2074
M_A = TO_FM('35.76313747902851151016887592625714022')
MFMV2 = BESSEL_YN(0,2,M_A)
DO J = 1, 3
M_D = BESSEL_Y(J-1,M_A)
IF (.NOT.(M_D == MFMV2(J))) THEN
CALL ERRPRT_FM('BES_YN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
ENDIF
ENDDO
NCASE = 2075
M_A = TO_FM('45.76313747902851151016887592625714022')
MFMV2 = BESSEL_YN(5,7,M_A)
DO J = 1, 3
M_D = BESSEL_Y(J+4,M_A)
IF (.NOT.(M_D == MFMV2(J))) THEN
CALL ERRPRT_FM('BES_YN',M_A,'M_A',MFMV2(J),'M_C',M_D,'M_D')
ENDIF
ENDDO
NCASE = 2076
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPC(MP1,MP4)
CALL FPST2M('0.70093080766765024647108053129311787400047652090339761',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2077
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPC(MP1,MP4)
CALL FPST2M('0.50039725503716926991543653820001681893864568953849831',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2078
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_C(M_A,M_C)
M_D = TO_FM('0.474185047305100802036571447978041504166048152999958048195')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' C ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2079
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = FRESNEL_C(M_A)
M_D = TO_FM('0.323694749294869464549126969706085301507654288830977216874')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' C ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2080
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = FRESNEL_C(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == FRESNEL_C(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2081
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = FRESNEL_C(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == FRESNEL_C(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2082
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPCI(MP1,MP4)
CALL FPST2M('0.16359653190526440803969970201664214390677012794223332',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2083
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPCI(MP1,MP4)
CALL FPST2M('0.00131149972931578659459371814940608018872333303675684',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2084
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_CI(M_A,M_C)
M_D = TO_FM('-0.09741800567259753506641387590335440898467110400622055004')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' CI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2085
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = COS_INTEGRAL(M_A)
M_D = TO_FM('0.461138635729125521212988221957593798317545122640768597596')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' CI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2086
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = COS_INTEGRAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == COS_INTEGRAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2087
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = COS_INTEGRAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == COS_INTEGRAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2088
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPCHI(MP1,MP4)
CALL FPST2M('0.45391567917918361783871059919514892434083540938287730',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2089
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPCHI(MP1,MP4)
CALL FPST2M('4.97524761172698478085053978815976047476478376994146601603E+327',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2090
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_CHI(M_A,M_C)
M_D = TO_FM('8.369873724415932287335807611146084488445255497226133667162')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' CHI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2091
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = COSH_INTEGRAL(M_A)
M_D = TO_FM('2.029389481780475855055661101690384319730636141596070218552')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' CHI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2092
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = COSH_INTEGRAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == COSH_INTEGRAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2093
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = COSH_INTEGRAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == COSH_INTEGRAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2094
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPEI(MP1,MP4)
CALL FPST2M('1.24079391564823418645696678687520762323754599014641389',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2095
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPEI(MP1,MP4)
CALL FPST2M('9.95049522345396956170107957631952094952956753988293203207e327',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2096
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('-76.187741826338453069315950161768197166176197016819716',MP1)
CALL FPEI(MP1,MP4)
CALL FPST2M('-1.0582953867286369384402649747001954422153942812201779081e-35',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2097
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_EI(M_A,M_C)
M_D = TO_FM('16.74474823903927976564480561675304621451626105015241561691')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2098
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = EXP_INTEGRAL_EI(M_A)
M_D = TO_FM('4.126976466117941107497767353354627810661198867641799416837')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2099
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = EXP_INTEGRAL_EI(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == EXP_INTEGRAL_EI(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2100
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = EXP_INTEGRAL_EI(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == EXP_INTEGRAL_EI(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2101
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPEN(2,MP1,MP4)
CALL FPST2M('0.21311259166852101417208662675364586968103289659979351',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2102
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_EN(1,M_A,M_C)
M_D = TO_FM('0.005000790207415190973190394460877237625750055700148282582')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2103
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = EXP_INTEGRAL_EN(2,M_A)
M_D = TO_FM('0.051264349837010471403529969401060258628812446447171003753')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' EN ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2104
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPERF(MP1,MP4)
CALL FPST2M('0.71872401755779946235619478212012889850923788333405962',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2105
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_ERF(M_A,M_C)
M_D = TO_FM('0.999999902573705653018913609266972468861889295927486074244')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' ERF ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2106
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = ERF(M_A)
M_D = TO_FM('0.987349264543733922694659969705283287445319385344849039875')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' ERF ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2107
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ERF(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ERF(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2108
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ERF(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ERF(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2109
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPERFC(MP1,MP4)
CALL FPST2M('0.28127598244220053764380521787987110149076211666594038',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2110
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_ERFC(M_A,M_C)
M_D = TO_FM('9.742629434698108639073302753113811070407251392575621797281293e-8')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' ERFC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2111
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = ERFC(M_A)
M_D = TO_FM('0.012650735456266077305340030294716712554680614655150960125')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' ERFC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2112
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = ERFC(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ERFC(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2113
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ERFC(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ERFC(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2114
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPLERC(MP1,MP4)
CALL FPST2M('-1.2684189477137498562516625540971134601277248866639213',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2115
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.76187741826338453069315950161768197166176197016819e166',MP1)
CALL FPLERC(MP1,MP4)
CALL FPST2M('-5.80457200459680176440663633717748607007309664599M+331',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-47 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2116
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('7618.77418263384530693159501617681971661761970168197166',MP1)
CALL FPLERC(MP1,MP4)
CALL FPST2M('-5.80457295567037365018902816623993644716703242747682e7',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2117
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_LERC(M_A,M_C)
M_D = TO_FM('-16.1441697002365667213529634391734146510026147989134315461')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LERC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2118
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = LOG_ERFC(M_A)
M_D = TO_FM('-4.37003992666334136276330328324363949591706428743873191723')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LERC ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2119
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = LOG_ERFC(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == LOG_ERFC(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2120
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = LOG_ERFC(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == LOG_ERFC(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2121
M_A = TO_FM('22.3')
M_C = ERFC_SCALED(M_A)
M_D = TO_FM('0.0252746198169048451531557506211538386878558334721659442813097')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('ERFC_S',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2122
M_A = TO_FM('22.3')
CALL FM_ERFC_SCALED(M_A,M_C)
M_D = TO_FM('0.0252746198169048451531557506211538386878558334721659442813097')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM('ERFC_S',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2123
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('22.3',MP1)
CALL FPERFCS(MP1,MP4)
CALL FPST2M('0.0252746198169048451531557506211538386878558334721659442813097',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2124
MFMV1 = TO_FM( (/ 12.1123456789D0, 34.2123456789D0, 56.3123456789D0 /) )
MFMV2 = ERFC_SCALED(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == ERFC_SCALED(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2125
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = 31 + TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = ERFC_SCALED(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == ERFC_SCALED(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2126
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPLI(MP1,MP4)
CALL FPST2M('-0.9793900433217607572331466402453083681659945255591914',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2127
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_LI(M_A,M_C)
M_D = TO_FM('2.797997089943573501800184831901782240262866606296541185584')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2128
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = LOG_INTEGRAL(M_A)
M_D = TO_FM('0.668796391754850708354080921181694708542231838607797144120')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' LI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2129
MFMV1 = TO_FM( (/ .121123456789D0, .342123456789D0, .563123456789D0 /) )
MFMV2 = LOG_INTEGRAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == LOG_INTEGRAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2130
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = LOG_INTEGRAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == LOG_INTEGRAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2131
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPS(MP1,MP4)
CALL FPST2M('0.21816325134409825621860357629665121608937929116536471',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2132
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPS(MP1,MP4)
CALL FPST2M('0.50012939294593301301098168046160096978366608125882900',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2133
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_S(M_A,M_C)
M_D = TO_FM('0.580281902413501913366950218788087272320285927001746179124')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' S ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2134
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = FRESNEL_S(M_A)
M_D = TO_FM('0.486368483997269340556953893768418549490362828623678106725')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' S ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2135
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = FRESNEL_S(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == FRESNEL_S(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2136
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = FRESNEL_S(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == FRESNEL_S(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2137
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPSI(MP1,MP4)
CALL FPST2M('0.73773231897820644930684330520081942495672326643513847',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2138
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPSI(MP1,MP4)
CALL FPST2M('1.57084866664732825971020846026968465003368780298508651',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2139
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_SI(M_A,M_C)
M_D = TO_FM('1.798158893955183419022680508529636904015624233443431352508')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' SI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2140
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = SIN_INTEGRAL(M_A)
M_D = TO_FM('1.485583783707077764617204020897763202398558637245905748694')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' SI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2141
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = SIN_INTEGRAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == SIN_INTEGRAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2142
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = SIN_INTEGRAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == SIN_INTEGRAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2143
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('.761877418263384530693159501617681971661761970168197166',MP1)
CALL FPSHI(MP1,MP4)
CALL FPST2M('0.78687823646905056861825618768005869889671058076353659',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2144
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('761.877418263384530693159501617681971661761970168197166',MP1)
CALL FPSHI(MP1,MP4)
CALL FPST2M('4.97524761172698478085053978815976047476478376994146601603E+327',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-49 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2145
M_A = TO_FM('3.7699115044247787610619469026548672566371681415929204')
CALL FM_SHI(M_A,M_C)
M_D = TO_FM('8.374874514623347478308998005606961726071005552926281949744')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' SHI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2146
M_A = TO_FM('1.76313747902851151016887592625714022097197246242295753')
M_C = SINH_INTEGRAL(M_A)
M_D = TO_FM('2.097586984337465252442106251664243490930562726045729198285')
M_D = ABS((M_C - M_D)/M_D)
IF (.NOT.(M_D <= TO_FM('1.0E-49'))) THEN
CALL ERRPRT_FM(' SHI ',M_A,'M_A',M_C,'M_C',M_D,'M_D')
ENDIF
NCASE = 2147
MFMV1 = TO_FM( (/ .121123456789D0, -.342123456789D0, .563123456789D0 /) )
MFMV2 = SINH_INTEGRAL(MFMV1)
DO J = 1, 3
IF (.NOT.(MFMV2(J) == SINH_INTEGRAL(MFMV1(J)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
NCASE = 2148
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = (-1)**(J+K) * TO_FM(25+3*(J+3*(K-1)))/60
ENDDO
ENDDO
MFMB = SINH_INTEGRAL(MFMA)
DO J = 1, 3
DO K = 1, 3
IF (.NOT.(MFMB(J,K) == SINH_INTEGRAL(MFMA(J,K)))) THEN
CALL PRTERR(KW)
EXIT
ENDIF
ENDDO
ENDDO
NCASE = 2149
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('7.418263384530693159501617681971661761970168197166e+99',MP1)
CALL FPST2M('6.8259710208460269684650033687802985086166176197016819',MP2)
CALL FPBETA(MP1,MP2,MP4)
CALL FPST2M('1.01162064582829378146463715877011489612774362551e-679',MP3)
CALL FPSUB(MP4,MP3,MP2)
CALL FPDIV(MP2,MP3,MP5)
CALL FPABS(MP5,MP4)
CALL FPST2M(' 1.0E-45 ',MP3)
IF (.NOT.(FPCOMP(MP4,'<=',MP3))) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2150
WRITE (22,*) ' '
WRITE (22,"(A,I6)") ' NCASE = ',NCASE
WRITE (22,*) ' '
CALL FPST2M('7.418263384530693159501617681971661761970168197166e+99',MP1)
CALL FPGAM(MP1,MP4)
IF (.NOT.(MWK(START(MP4)+2) == MEXPOV)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST61
SUBROUTINE TEST62
! Test type (FM) array equal assignments.
IMPLICIT NONE
WRITE (KW,"(/' Testing derived-type array operations.')")
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
CALL FMSETVAR(' NTRACE = 0 ')
NCASE = 2151
MFMV1 = 123
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - 123)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2152
MFMV1 = 123.45
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - 123.45)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2153
MFMV1 = 123.456789D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - 123.456789D0)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2154
MFMV1 = (123.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - 123.67)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2155
MFMV1 = (123.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - 123.987654D0)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2156
MFM3 = TO_FM('234.56')
JV = MFM3
J5 = 0
DO J = 1, 3
J5 = J5 + ABS(JV(J) - 234)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2157
MFM3 = TO_FM('234.56')
RV = MFM3
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(RV(J) - 234.56)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2158
MFM3 = TO_FM('234.56789')
DV = MFM3
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(DV(J) - 234.56789D0)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2159
MFM3 = TO_FM('234.56')
CV = MFM3
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(CV(J) - 234.56)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2160
MFM3 = TO_FM('234.56789')
CDV = MFM3
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(CDV(J) - 234.56789D0)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2161
MFM3 = TO_FM('1234.56789')
MFMV1 = MFM3
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234.56789'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2162
MIM1 = TO_IM('123456789012345')
MFMV1 = MIM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('123456789012345'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2163
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MFMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234567.89012345'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2164
MFM3 = TO_FM('1234.56789')
MIMV1 = MFM3
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2165
MFM3 = TO_FM('1234.56789')
MZMV1 = MFM3
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('1234.56789'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2166
JV = (/ 12, -34, 56 /)
MFMV1 = JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - JV(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2167
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - RV(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2168
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - DV(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2169
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - REAL(CV(J)))
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2170
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - REAL(CDV(J),KIND(0.0D0)))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2171
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
JV = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(JV(J) - INT(MFMV1(J)))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2172
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
RV = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(RV(J) - MFMV1(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2173
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
DV = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(DV(J) - MFMV1(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2174
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
CV = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CV(J) - MFMV1(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2175
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
CDV = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CDV(J) - MFMV1(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2176
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV1 = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - MFMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2177
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(REAL(MZMV1(J)) - MFMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST62
SUBROUTINE TEST63
! Test type (IM) array equal assignments.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2178
MIMV1 = 123
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV1(J) - 123)
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2179
MIMV1 = 123.45
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - 123)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2180
MIMV1 = 123.456789D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - 123)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2181
MIMV1 = (124.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - 124)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2182
MIMV1 = (125.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - 125)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2183
MIM1 = TO_FM('234.56')
JV = MIM1
J5 = 0
DO J = 1, 3
J5 = J5 + ABS(JV(J) - 234)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2184
MIM1 = TO_FM('234.56')
RV = MIM1
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(RV(J) - 234)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2185
MIM1 = TO_FM('234.56789')
DV = MIM1
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(DV(J) - 234)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2186
MIM1 = TO_FM('234.56')
CV = MIM1
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(CV(J) - 234)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2187
MIM1 = TO_FM('234.56789')
CDV = MIM1
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(CDV(J) - 234)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2188
MIM1 = TO_FM('1234.56789')
MIMV1 = MIM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - 1234)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2189
MIM1 = TO_IM('123456789012345')
MIMV1 = MIM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('123456789012345'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2190
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MIMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234567'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2191
MIM1 = TO_FM('1234.56789')
MZMV1 = MIM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('1234'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2192
JV = (/ 12, -34, 56 /)
MIMV1 = JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2193
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = RV
MFM3 = 0
JV = RV
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2194
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = DV
MFM3 = 0
JV = DV
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2195
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = CV
MFM3 = 0
JV = CV
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2196
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = CDV
MFM3 = 0
JV = CDV
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - JV(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2197
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
JV = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(JV(J) - INT(MIMV1(J)))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2198
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
RV = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(RV(J) - MIMV1(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2199
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
DV = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(DV(J) - MIMV1(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2200
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
CV = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CV(J) - MIMV1(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2201
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
CDV = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CDV(J) - MIMV1(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2202
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = MZMV1
MFM3 = 0
JV = (/ 12, -34, 56 /)
DO J = 1, 3
MFM3 = MFM3 + ABS(JV(J) - MIMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST63
SUBROUTINE TEST64
! Test type (ZM) array equal assignments.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2203
MZMV1 = 123
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - 123)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2204
MZMV1 = 123.45
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - 123.45)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2205
MZMV1 = 123.456789D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - 123.456789D0)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2206
MZMV1 = (123.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - (123.67 , 987.65 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2207
MZMV1 = (123.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - (123.987654D0 , 987.123456D0))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2208
MZM1 = TO_ZM('234.56 - 65.32 i')
JV = MZM1
J5 = 0
DO J = 1, 3
J5 = J5 + ABS(JV(J) - 234)
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2209
MZM1 = TO_ZM('234.56 - 65.32 i')
RV = MZM1
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(RV(J) - 234.56)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2210
MZM1 = TO_ZM('234.56789 - 765.765432 i')
DV = MZM1
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(DV(J) - 234.56789D0)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2211
MZM1 = TO_ZM('234.56 - 65.32 i')
CV = MZM1
R5 = 0
DO J = 1, 3
R5 = R5 + ABS(CV(J) - MZM1)
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2212
MZM1 = TO_ZM('234.56789 - 765.765432 i')
CDV = MZM1
D5 = 0
DO J = 1, 3
D5 = D5 + ABS(CDV(J) - MZM1)
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2213
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MFMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - TO_FM('1234.56789'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2214
MIM1 = TO_IM('123456789012345')
MZMV1 = MIM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - TO_FM('123456789012345'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2215
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MZMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - TO_ZM('1234567.89012345 - 31.654 i'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2216
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MIMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - TO_FM('1234'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2217
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MZMV1 = MZM1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - TO_ZM('1234.56789 - 4.374659586'))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2218
JV = (/ 12, -34, 56 /)
MZMV1 = JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - JV(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2219
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - RV(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2220
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - DV(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2221
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - CV(J))
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2222
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV1(J) - CDV(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2223
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
JV = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(JV(J) - REAL(INT(MZMV1(J))))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2224
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
RV = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(RV(J) - REAL(MZMV1(J)))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2225
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
DV = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(DV(J) - REAL(MZMV1(J)))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2226
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
CV = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CV(J) - MZMV1(J))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2227
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
CDV = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(CDV(J) - MZMV1(J))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2228
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV1 = MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV1(J) - MZMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2229
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV1 = MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV1(J) - MZMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2230
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - MZMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST64
SUBROUTINE TEST65
! Test type (FM) array equal assignments.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
CALL FMSETVAR(' NTRACE = 0 ')
NCASE = 2231
MFMA = 123
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - 123)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2232
MFMA = 123.45
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - 123.45)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2233
MFMA = 123.456789D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - 123.456789D0)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2234
MFMA = (123.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - 123.67)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2235
MFMA = (123.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - 123.987654D0)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2236
MFM3 = TO_FM('234.56')
JV2 = MFM3
J5 = 0
DO J = 1, 3
DO K = 1, 3
J5 = J5 + ABS(JV2(J,K) - 234)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2237
MFM3 = TO_FM('234.56')
RV2 = MFM3
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(RV2(J,K) - 234.56)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2238
MFM3 = TO_FM('234.56789')
DV2 = MFM3
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(DV2(J,K) - 234.56789D0)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2239
MFM3 = TO_FM('234.56')
CV2 = MFM3
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(CV2(J,K) - 234.56)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2240
MFM3 = TO_FM('234.56789')
CDV2 = MFM3
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(CDV2(J,K) - 234.56789D0)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2241
MFM3 = TO_FM('1234.56789')
MFMA = MFM3
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234.56789'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2242
MIM1 = TO_IM('123456789012345')
MFMA = MIM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('123456789012345'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2243
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MFMA = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234567.89012345'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2244
MFM3 = TO_FM('1234.56789')
MIMA2 = MFM3
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2245
MFM3 = TO_FM('1234.56789')
MZMA2 = MFM3
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('1234.56789'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2246
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - JV2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2247
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - RV2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2248
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - DV2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2249
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - REAL(CV2(J,K)))
ENDDO
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2250
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFMA = CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - REAL(CDV2(J,K),KIND(0.0D0)))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2251
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
JV2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(JV2(J,K) - INT(MFMA(J,K)))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2252
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
RV2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(RV2(J,K) - MFMA(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2253
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(DV2(J,K) - MFMA(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2254
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CV2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CV2(J,K) - MFMA(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2255
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CDV2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CDV2(J,K) - MFMA(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2256
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMA = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - MFMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2257
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFMA = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(REAL(MZMA2(J,K)) - MFMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST65
SUBROUTINE TEST66
! Test type (IM) array equal assignments.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2258
MIMA2 = 123
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMA2(J,K) - 123)
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2259
MIMA2 = 123.45
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - 123)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2260
MIMA2 = 123.456789D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - 123)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2261
MIMA2 = (124.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - 124)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2262
MIMA2 = (125.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - 125)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2263
MIM1 = TO_FM('234.56')
JV2 = MIM1
J5 = 0
DO J = 1, 3
DO K = 1, 3
J5 = J5 + ABS(JV2(J,K) - 234)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2264
MIM1 = TO_FM('234.56')
RV2 = MIM1
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(RV2(J,K) - 234)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2265
MIM1 = TO_FM('234.56789')
DV2 = MIM1
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(DV2(J,K) - 234)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2266
MIM1 = TO_FM('234.56')
CV2 = MIM1
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(CV2(J,K) - 234)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2267
MIM1 = TO_FM('234.56789')
CDV2 = MIM1
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(CDV2(J,K) - 234)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2268
MIM1 = TO_FM('1234.56789')
MIMA2 = MIM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - 1234)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2269
MIM1 = TO_IM('123456789012345')
MIMA2 = MIM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('123456789012345'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2270
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MIMA2 = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234567'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2271
MIM1 = TO_FM('1234.56789')
MZMA2 = MIM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('1234'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2272
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2273
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = RV2
MFM3 = 0
JV2 = RV2
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2274
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = DV2
MFM3 = 0
JV2 = DV2
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2275
DO J = 1, 3
DO K = 1, 3
CV2(J,K) = CMPLX(12.3+3*(J+3*(K-1)),-32.4+7*(J+3*(K-1)))
ENDDO
ENDDO
MIMA2 = CV2
MFM3 = 0
JV2 = CV2
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2276
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIMA2 = CDV2
MFM3 = 0
JV2 = CDV2
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2277
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
JV2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(JV2(J,K) - INT(MIMA2(J,K)))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2278
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
RV2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(RV2(J,K) - MIMA2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2279
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DV2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(DV2(J,K) - MIMA2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2280
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CV2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CV2(J,K) - MIMA2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2281
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
CDV2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CDV2(J,K) - MIMA2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2282
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIMA2 = MZMA2
MFM3 = 0
JV2 = RESHAPE( (/(62.3+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(JV2(J,K) - MIMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST66
END MODULE TEST_D
MODULE TEST_E
USE TEST_VARS
CONTAINS
SUBROUTINE TEST67
! Test type (ZM) array equal assignments.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2283
MZMA2 = 123
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - 123)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2284
MZMA2 = 123.45
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - 123.45)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2285
MZMA2 = 123.456789D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - 123.456789D0)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2286
MZMA2 = (123.67 , 987.65 )
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - (123.67 , 987.65 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2287
MZMA2 = (123.987654D0 , 987.123456D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - (123.987654D0 , 987.123456D0))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2288
MZM1 = TO_ZM('234.56 - 65.32 i')
JV2 = MZM1
J5 = 0
DO J = 1, 3
DO K = 1, 3
J5 = J5 + ABS(JV2(J,K) - 234)
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(TO_FM(J5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2289
MZM1 = TO_ZM('234.56 - 65.32 i')
RV2 = MZM1
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(RV2(J,K) - 234.56)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2290
MZM1 = TO_ZM('234.56789 - 765.765432 i')
DV2 = MZM1
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(DV2(J,K) - 234.56789D0)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2291
MZM1 = TO_ZM('234.56 - 65.32 i')
CV2 = MZM1
R5 = 0
DO J = 1, 3
DO K = 1, 3
R5 = R5 + ABS(CV2(J,K) - MZM1)
ENDDO
ENDDO
MFM4 = RSMALL*234
IF (.NOT.(TO_FM(R5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2292
MZM1 = TO_ZM('234.56789 - 765.765432 i')
CDV2 = MZM1
D5 = 0
DO J = 1, 3
DO K = 1, 3
D5 = D5 + ABS(CDV2(J,K) - MZM1)
ENDDO
ENDDO
MFM4 = DSMALL*234
IF (.NOT.(TO_FM(D5) <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2293
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MFMA = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - TO_FM('1234.56789'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2294
MIM1 = TO_IM('123456789012345')
MZMA2 = MIM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_FM('123456789012345'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2295
MZM1 = TO_ZM('1234567.89012345 - 31.654 i')
MZMA2 = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_ZM('1234567.89012345 - 31.654 i'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2296
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MIMA2 = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - TO_FM('1234'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2297
MZM1 = TO_ZM('1234.56789 - 4.374659586')
MZMA2 = MZM1
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - TO_ZM('1234.56789 - 4.374659586'))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2298
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - JV2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2299
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - RV2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2300
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - DV2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2301
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - CV2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*84*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2302
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZMA2 = CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA2(J,K) - CDV2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2303
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
JV2 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(JV2(J,K) - REAL(INT(MZMA2(J,K))))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2304
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
RV2 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(RV2(J,K) - REAL(MZMA2(J,K)))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2305
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DV2 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(DV2(J,K) - REAL(MZMA2(J,K)))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2306
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
CV2 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CV2(J,K) - MZMA2(J,K))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2307
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
CDV2 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(CDV2(J,K) - MZMA2(J,K))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2308
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMA2 = MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMA(J,K) - MZMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2309
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMA2 = MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMA2(J,K) - MZMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2310
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMA3 = MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMA3(J,K) - MZMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST67
SUBROUTINE TEST68
! Test type (FM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2311
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2312
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.8 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 + MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2313
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.87D0 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 + MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2314
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2315
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2316
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2317
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2318
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2319
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2320
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2321
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 + JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2322
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2323
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2324
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2325
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2326
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = JV + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) + MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2327
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = RV + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) + MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2328
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = DV + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) + MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2329
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CV + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2330
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CDV + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2331
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2332
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFMV1 + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2333
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MIM2 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2334
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MFMV1 + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2335
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2336
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MFMV1 + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2337
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2338
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MIMV1 + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) + MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2339
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2340
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MZMV1 + MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST68
SUBROUTINE TEST69
! Test type (FM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2341
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = JV + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2342
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2343
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = RV + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2344
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2345
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = DV + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2346
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2347
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2348
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2349
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2350
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2351
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MFMV2 = MFMV1 + MFMV4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MFMV4(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2352
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MFMV1 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2353
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MIMV1 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2354
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 + MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2355
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2356
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = +MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - MFMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2357
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = +MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - MIMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2358
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = +MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - MZMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2359
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = -MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) + MFMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2360
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = -MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) + MIMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2361
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = -MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) + MZMV1(J))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2362
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = +MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - MFMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2363
DO J = 1, 2
DO K = 1, 2
MIMA(J,K) = TO_IM(257+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB = +MIMA
MFM3 = 0
DO J = 1, 2
DO K = 1, 2
MFM3 = MFM3 + ABS(MIMB(J,K) - MIMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2364
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = +MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - MZMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2365
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = -MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) + MFMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2366
DO J = 1, 2
DO K = 1, 2
MIMA(J,K) = TO_IM(257+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB = -MIMA
MFM3 = 0
DO J = 1, 2
DO K = 1, 2
MFM3 = MFM3 + ABS(MIMB(J,K) + MIMA(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2367
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = -MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) + MZMA2(J,K))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST69
SUBROUTINE TEST70
! Test type (IM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2368
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = 4 + MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 + MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2369
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.8 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 + MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2370
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.87D0 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 + MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2371
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2372
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2373
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + 4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + 4 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2374
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2375
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2376
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2377
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2378
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 + JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 + JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2379
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 + RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2380
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 + DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2381
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2382
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2383
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = JV + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) + MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2384
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = RV + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) + MIM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2385
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = DV + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) + MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2386
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CV + MIM2
MFM3 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) + MIM2 ))
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2387
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CDV + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2388
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 + MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 + MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2389
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIMV1 + MIM2
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + MIM2 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2390
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2391
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MIMV1 + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2392
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2393
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MZMV1 + MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST70
SUBROUTINE TEST71
! Test type (IM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2394
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = JV + MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) + MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2395
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + JV
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + JV(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2396
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = RV + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2397
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2398
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = DV + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2399
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) + DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2400
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2401
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2402
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2403
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2404
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MIMV2 = MIMV1 + MIMV4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) + MIMV4(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2405
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 + MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2406
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST71
SUBROUTINE TEST72
! Test type (ZM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2407
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2408
MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.8 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 + MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2409
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.87D0 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 + MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2410
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.8,5.9) + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) + MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2411
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.87D0,5.98D0) + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) + MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2412
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2413
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2414
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2415
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2416
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2417
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 + JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2418
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2419
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2420
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2421
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2422
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = JV + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) + MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2423
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = RV + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) + MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2424
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = DV + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) + MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2425
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CV + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2426
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CDV + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2427
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2428
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZMV1 + MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST72
SUBROUTINE TEST73
! Test type (ZM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2429
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = JV + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2430
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2431
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = RV + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2432
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2433
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = DV + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2434
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2435
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CV + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2436
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2437
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CDV + MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) + MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2438
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 + CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) + CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2439
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') , &
TO_ZM('5.63123456789 + 0.00345 i') /)
MZMV4 = MZMV1 + MZMV2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) + MZMV2(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST73
SUBROUTINE TEST74
! Test type (FM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2440
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2441
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.8 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 + MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2442
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.87D0 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 + MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2443
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2444
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2445
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2446
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2447
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2448
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2449
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2450
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 + JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2451
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2452
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2453
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2454
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2455
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = JV2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) + MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2456
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = RV2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) + MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2457
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = DV2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) + MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2458
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CV2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2459
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CDV2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2460
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2461
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFMA + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2462
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MIM2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2463
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MFMA + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2464
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2465
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MFMA + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2466
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2467
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MIMA2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) + MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2468
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2469
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MZMA2 + MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST74
SUBROUTINE TEST75
! Test type (FM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2470
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = JV2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2471
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2472
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = RV2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2473
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2474
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = DV2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2475
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2476
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2477
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2478
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2479
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2480
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + MFMC
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MFMC(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2481
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2482
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MIMA2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2483
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 + MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2484
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST75
SUBROUTINE TEST76
! Test type (IM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2485
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4 + MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 + MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2486
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.8 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 + MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2487
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.87D0 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 + MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2488
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2489
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2490
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + 4
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + 4 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2491
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2492
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2493
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2494
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2495
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 + JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 + JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2496
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 + RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2497
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 + DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2498
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2499
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2500
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = JV2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) + MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2501
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = RV2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) + MIM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2502
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = DV2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) + MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2503
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CV2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) + MIM2 ))
ENDDO
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2504
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CDV2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2505
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 + MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 + MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2506
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIMA2 + MIM2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + MIM2 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2507
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2508
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MIMA2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2509
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2510
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MZMA2 + MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST76
SUBROUTINE TEST77
! Test type (IM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2511
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = JV2 + MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2512
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + JV2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + JV2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2513
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = RV2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2514
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2515
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = DV2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2516
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) + DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2517
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2518
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2519
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2520
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2521
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 + MIMC2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) + MIMC2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2522
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 + MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2523
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST77
SUBROUTINE TEST78
! Test type (ZM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2524
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2525
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.8 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 + MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2526
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.87D0 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 + MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2527
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.8,5.9) + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) + MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2528
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) + MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2529
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2530
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2531
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2532
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2533
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2534
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 + JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2535
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2536
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2537
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2538
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2539
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = JV2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) + MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2540
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = RV2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) + MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2541
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = DV2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) + MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2542
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CV2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2543
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CDV2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2544
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2545
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZMA2 + MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST78
END MODULE TEST_E
MODULE TEST_F
USE TEST_VARS
CONTAINS
SUBROUTINE TEST79
! Test type (ZM) array addition operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2546
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = JV2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2547
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2548
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = RV2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2549
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2550
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = DV2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2551
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2552
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CV2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2553
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2554
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CDV2 + MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) + MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2555
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 + CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) + CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2556
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
ENDDO
ENDDO
MZMC2 = MZMA2 + MZMB2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) + MZMB2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST79
SUBROUTINE TEST80
! Test type (FM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2557
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2558
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.8 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 - MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2559
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.87D0 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 - MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2560
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2561
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2562
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2563
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2564
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2565
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2566
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2567
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 - JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2568
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2569
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2570
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2571
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2572
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = JV - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) - MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2573
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = RV - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) - MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2574
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = DV - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) - MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2575
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CV - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2576
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CDV - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2577
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2578
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFMV1 - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2579
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MIM2 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2580
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MFMV1 - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2581
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2582
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MFMV1 - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2583
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2584
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MIMV1 - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) - MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2585
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2586
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MZMV1 - MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST80
SUBROUTINE TEST81
! Test type (FM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2587
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = JV - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2588
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2589
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = RV - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2590
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2591
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = DV - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2592
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2593
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2594
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2595
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2596
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2597
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MFMV2 = MFMV1 - MFMV4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MFMV4(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2598
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MFMV1 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2599
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MIMV1 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2600
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 - MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2601
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST81
SUBROUTINE TEST82
! Test type (IM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2602
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = 4 - MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 - MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2603
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.8 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 - MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2604
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.87D0 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 - MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2605
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2606
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2607
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - 4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - 4 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2608
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2609
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2610
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2611
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2612
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 - JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 - JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2613
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 - RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2614
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 - DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2615
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2616
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2617
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = JV - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) - MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2618
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = RV - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) - MIM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2619
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = DV - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) - MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2620
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CV - MIM2
MFM3 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) - MIM2 ))
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2621
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CDV - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2622
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 - MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 - MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2623
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIMV1 - MIM2
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - MIM2 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2624
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2625
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MIMV1 - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2626
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2627
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MZMV1 - MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST82
SUBROUTINE TEST83
! Test type (IM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2628
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = JV - MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) - MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2629
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - JV
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - JV(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2630
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = RV - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2631
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2632
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = DV - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2633
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) - DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2634
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2635
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2636
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2637
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2638
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MIMV2 = MIMV1 - MIMV4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) - MIMV4(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2639
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 - MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2640
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST83
SUBROUTINE TEST84
! Test type (ZM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2641
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2642
MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.8 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 - MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2643
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.87D0 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 - MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2644
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.8,5.9) - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) - MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2645
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.87D0,5.98D0) - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) - MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2646
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2647
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2648
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2649
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2650
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2651
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 - JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2652
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2653
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2654
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2655
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2656
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = JV - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) - MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2657
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = RV - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) - MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2658
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = DV - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) - MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2659
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CV - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2660
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CDV - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2661
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2662
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZMV1 - MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST84
SUBROUTINE TEST85
! Test type (ZM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2663
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = JV - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2664
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2665
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = RV - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2666
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2667
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = DV - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2668
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2669
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CV - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2670
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2671
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CDV - MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) - MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2672
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 - CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) - CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2673
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') , &
TO_ZM('5.63123456789 + 0.00345 i') /)
MZMV4 = MZMV1 - MZMV2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) - MZMV2(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST85
SUBROUTINE TEST86
! Test type (FM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2674
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2675
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.8 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 - MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2676
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.87D0 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 - MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2677
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2678
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2679
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2680
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2681
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2682
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2683
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2684
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 - JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2685
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2686
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2687
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2688
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2689
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = JV2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) - MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2690
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = RV2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) - MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2691
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = DV2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) - MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2692
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CV2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2693
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CDV2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2694
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2695
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFMA - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2696
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MIM2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2697
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MFMA - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2698
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2699
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MFMA - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2700
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2701
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MIMA2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) - MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2702
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2703
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MZMA2 - MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST86
SUBROUTINE TEST87
! Test type (FM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2704
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = JV2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2705
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2706
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = RV2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2707
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2708
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = DV2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2709
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2710
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2711
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2712
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2713
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2714
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - MFMC
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MFMC(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2715
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2716
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MIMA2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2717
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 - MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2718
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST87
SUBROUTINE TEST88
! Test type (IM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2719
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4 - MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 - MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2720
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.8 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 - MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2721
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.87D0 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 - MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2722
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2723
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2724
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - 4
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - 4 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2725
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2726
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2727
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2728
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2729
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 - JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 - JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2730
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 - RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2731
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 - DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2732
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2733
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2734
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = JV2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) - MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2735
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = RV2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) - MIM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2736
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = DV2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) - MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2737
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CV2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) - MIM2 ))
ENDDO
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2738
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CDV2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2739
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 - MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 - MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2740
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIMA2 - MIM2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - MIM2 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2741
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2742
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MIMA2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2743
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2744
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MZMA2 - MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST88
SUBROUTINE TEST89
! Test type (IM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2745
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = JV2 - MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2746
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - JV2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - JV2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2747
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = RV2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2748
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2749
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = DV2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2750
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) - DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2751
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2752
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2753
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2754
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2755
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 - MIMC2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) - MIMC2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2756
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 - MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2757
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST89
SUBROUTINE TEST90
! Test type (ZM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2758
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2759
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.8 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 - MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2760
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.87D0 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 - MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2761
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.8,5.9) - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) - MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2762
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) - MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2763
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2764
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2765
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2766
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2767
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2768
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 - JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2769
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2770
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2771
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2772
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2773
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = JV2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) - MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2774
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = RV2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) - MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2775
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = DV2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) - MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2776
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CV2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2777
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CDV2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2778
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2779
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZMA2 - MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST90
END MODULE TEST_F
MODULE TEST_G
USE TEST_VARS
CONTAINS
SUBROUTINE TEST91
! Test type (ZM) array subtraction operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2780
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = JV2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2781
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2782
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = RV2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2783
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2784
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = DV2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2785
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2786
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CV2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2787
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2788
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CDV2 - MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) - MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2789
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 - CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) - CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2790
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
ENDDO
ENDDO
MZMC2 = MZMA2 - MZMB2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) - MZMB2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST91
SUBROUTINE TEST92
! Test type (FM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2791
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2792
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.8 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 * MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2793
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.87D0 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 * MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2794
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2795
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2796
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2797
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2798
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2799
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2800
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2801
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 * JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2802
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2803
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2804
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2805
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2806
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = JV * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) * MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2807
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = RV * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) * MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2808
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = DV * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) * MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2809
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CV * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2810
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CDV * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2811
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2812
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFMV1 * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2813
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MIM2 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2814
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MFMV1 * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2815
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2816
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MFMV1 * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2817
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2818
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MIMV1 * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) * MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2819
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2820
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MZMV1 * MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST92
SUBROUTINE TEST93
! Test type (FM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2821
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = JV * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2822
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2823
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = RV * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2824
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2825
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = DV * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2826
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2827
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2828
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2829
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2830
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2831
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MFMV2 = MFMV1 * MFMV4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MFMV4(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2832
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MFMV1 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2833
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MIMV1 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2834
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 * MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2835
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST93
SUBROUTINE TEST94
! Test type (IM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2836
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = 4 * MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 * MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2837
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.8 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 * MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2838
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.87D0 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 * MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2839
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2840
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2841
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * 4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * 4 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2842
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2843
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2844
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2845
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2846
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 * JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 * JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2847
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 * RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2848
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 * DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2849
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2850
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2851
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = JV * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) * MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2852
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = RV * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) * MIM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2853
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = DV * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) * MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2854
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CV * MIM2
MFM3 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) * MIM2 ))
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2855
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CDV * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2856
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 * MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 * MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2857
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIMV1 * MIM2
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * MIM2 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2858
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2859
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MIMV1 * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2860
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2861
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MZMV1 * MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST94
SUBROUTINE TEST95
! Test type (IM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2862
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = JV * MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) * MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2863
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * JV
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * JV(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2864
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = RV * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2865
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2866
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = DV * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2867
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) * DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2868
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2869
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2870
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2871
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2872
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MIMV2 = MIMV1 * MIMV4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) * MIMV4(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2873
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 * MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2874
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST95
SUBROUTINE TEST96
! Test type (ZM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2875
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2876
MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.8 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 * MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2877
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.87D0 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 * MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2878
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.8,5.9) * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) * MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2879
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.87D0,5.98D0) * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) * MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2880
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2881
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2882
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2883
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2884
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2885
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 * JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2886
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2887
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2888
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2889
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2890
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = JV * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) * MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2891
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = RV * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) * MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2892
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = DV * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) * MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2893
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CV * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2894
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CDV * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2895
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2896
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZMV1 * MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST96
SUBROUTINE TEST97
! Test type (ZM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2897
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = JV * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2898
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2899
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = RV * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2900
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2901
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = DV * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2902
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2903
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CV * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2904
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2905
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CDV * MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) * MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2906
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 * CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) * CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2907
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') , &
TO_ZM('5.63123456789 + 0.00345 i') /)
MZMV4 = MZMV1 * MZMV2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) * MZMV2(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST97
SUBROUTINE TEST98
! Test type (FM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2908
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2909
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.8 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 * MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2910
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.87D0 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 * MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2911
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2912
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2913
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2914
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2915
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2916
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2917
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2918
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 * JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2919
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2920
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2921
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2922
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2923
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = JV2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) * MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2924
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = RV2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) * MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2925
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = DV2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) * MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2926
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CV2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2927
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CDV2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2928
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2929
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFMA * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2930
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MIM2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2931
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MFMA * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2932
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2933
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MFMA * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2934
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2935
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MIMA2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) * MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2936
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2937
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MZMA2 * MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST98
SUBROUTINE TEST99
! Test type (FM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2938
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = JV2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2939
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2940
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = RV2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2941
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2942
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = DV2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2943
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2944
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2945
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2946
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2947
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2948
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * MFMC
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MFMC(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2949
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2950
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MIMA2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2951
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 * MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2952
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST99
SUBROUTINE TEST100
! Test type (IM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2953
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4 * MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 4 * MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2954
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.8 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.8 * MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2955
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 4.87D0 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 4.87D0 * MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2956
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2957
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2958
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * 4
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * 4 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2959
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2960
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2961
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2962
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2963
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 * JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 * JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2964
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 * RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2965
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 * DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2966
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2967
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2968
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = JV2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) * MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2969
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = RV2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) * MIM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2970
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = DV2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) * MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2971
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CV2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) * MIM2 ))
ENDDO
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2972
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CDV2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2973
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 * MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 * MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2974
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIMA2 * MIM2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * MIM2 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2975
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2976
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MIMA2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2977
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2978
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MZMA2 * MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST100
SUBROUTINE TEST101
! Test type (IM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2979
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = JV2 * MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2980
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * JV2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * JV2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2981
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = RV2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2982
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2983
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = DV2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2984
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) * DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2985
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2986
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2987
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2988
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2989
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 * MIMC2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) * MIMC2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2990
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 * MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2991
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST101
SUBROUTINE TEST102
! Test type (ZM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 2992
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2993
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.8 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 * MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2994
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.87D0 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 * MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2995
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.8,5.9) * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) * MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2996
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) * MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2997
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2998
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 2999
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3000
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3001
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3002
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 * JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3003
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3004
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3005
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3006
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3007
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = JV2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) * MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3008
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = RV2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) * MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3009
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = DV2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) * MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3010
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CV2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3011
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CDV2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3012
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3013
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZMA2 * MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST102
SUBROUTINE TEST103
! Test type (ZM) array multiplication operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3014
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = JV2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3015
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3016
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = RV2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3017
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3018
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = DV2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3019
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3020
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CV2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3021
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3022
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CDV2 * MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) * MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3023
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 * CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) * CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3024
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
ENDDO
ENDDO
MZMC2 = MZMA2 * MZMB2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) * MZMB2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST103
END MODULE TEST_G
MODULE TEST_H
USE TEST_VARS
CONTAINS
SUBROUTINE TEST104
! Test type (FM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3025
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4 / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3026
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.8 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.8 / MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3027
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = 4.87D0 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( 4.87D0 / MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3028
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MFMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3029
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MFMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3030
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3031
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3032
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3033
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3034
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3035
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 / JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3036
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3037
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3038
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3039
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3040
JV = (/ 12, -34, 56 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = JV / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) / MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3041
RV = (/ 12.1, -34.2, 56.3 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = RV / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) / MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3042
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = DV / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) / MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3043
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CV / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MFM4 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3044
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = CDV / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MFM4 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3045
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3046
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFMV1 / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3047
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MIM2 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIM2 / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3048
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_IM('121123456789')
MFMV2 = MFMV1 / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3049
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3050
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MFMV1 / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3051
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MFM4 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFM4 / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3052
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFM4 = TO_FM('12.1123456789')
MFMV2 = MIMV1 / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) / MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3053
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MFM4 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFM4 / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3054
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFM4 = TO_FM('12.1123456789')
MZMV2 = MZMV1 / MFM4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MFM4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST104
SUBROUTINE TEST105
! Test type (FM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3055
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = JV / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( JV(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3056
JV = (/ 12, -34, 56 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3057
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = RV / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( RV(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3058
RV = (/ 12.1, -34.2, 56.3 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3059
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = DV / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( DV(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3060
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV2 = MFMV1 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3061
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3062
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3063
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3064
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3065
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MFMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MFMV2 = MFMV1 / MFMV4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MFMV4(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3066
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MFMV1 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MFMV1(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3067
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MFMV2 = MIMV1 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MFMV2(J) - ( MIMV1(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3068
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 / MFMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MFMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3069
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MFMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MFMV1 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MFMV1(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST105
SUBROUTINE TEST106
! Test type (IM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3070
MIMV1 = (/ TO_IM('121123456789') , TO_IM('-342123456789') , TO_IM('563123456789') /)
MIMV2 = 4 / MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( 4 / MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3071
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.8 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.8 / MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3072
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = 4.87D0 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( 4.87D0 / MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3073
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.8,5.9) / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MIMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3074
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = (4.87D0,5.98D0) / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MIMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3075
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / 4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / 4 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3076
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3077
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3078
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3079
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3080
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 / JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( MIM2 / JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3081
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 / RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3082
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIM2 / DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3083
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3084
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3085
JV = (/ 12, -34, 56 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = JV / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - ( JV(J) / MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3086
RV = (/ 12.1, -34.2, 56.3 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = RV / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) / MIM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3087
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = DV / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) / MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3088
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CV / MIM2
MFM3 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MZMV2(J) - ( CV(J) / MIM2 ))
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3089
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = CDV / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MIM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3090
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIM2 / MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIM2 / MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3091
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIM2 = TO_FM('12.1123456789')
MIMV2 = MIMV1 / MIM2
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / MIM2 ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3092
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3093
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MIMV1 / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3094
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MIM2 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIM2 / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3095
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIM2 = TO_FM('12.1123456789')
MZMV2 = MZMV1 / MIM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MIM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST106
SUBROUTINE TEST107
! Test type (IM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3096
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = JV / MIMV1
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( JV(J) / MIMV1(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3097
JV = (/ 12, -34, 56 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / JV
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / JV(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3098
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = RV / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( RV(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3099
RV = (/ 12.1, -34.2, 56.3 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3100
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = DV / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( DV(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3101
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV2 = MIMV1 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MIMV2(J) - INT( MIMV1(J) / DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3102
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CV / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3103
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3104
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = CDV / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3105
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3106
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MIMV4 = (/ TO_FM('1.21123456789') , TO_FM('-3.42123456789') , TO_FM('5.63123456789') /)
MIMV2 = MIMV1 / MIMV4
MIM1 = 0
DO J = 1, 3
MIM1 = MIM1 + ABS(MIMV2(J) - ( MIMV1(J) / MIMV4(J) ))
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3107
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MZMV1 / MIMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MIMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3108
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MIMV1 = (/ TO_FM('12.1123456789') , TO_FM('-34.2123456789') , TO_FM('56.3123456789') /)
MZMV2 = MIMV1 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MIMV1(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST107
SUBROUTINE TEST108
! Test type (ZM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3109
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4 / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3110
MFMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.8 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.8 / MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3111
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = 4.87D0 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( 4.87D0 / MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3112
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.8,5.9) / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.8,5.9) / MZMV1(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3113
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (4.87D0,5.98D0) / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( (4.87D0,5.98D0) / MZMV1(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3114
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / 4
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3115
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / 4.8
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4.8 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3116
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / 4.87D0
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / 4.87D0 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3117
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / (4.8,5.9) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3118
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / (4.87D0,5.98D0) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3119
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 / JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3120
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / RV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3121
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / DV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3122
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / CV(J) ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3123
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = MZM2 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / CDV(J) ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3124
JV = (/ 12, -34, 56 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = JV / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) / MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3125
RV = (/ 12.1, -34.2, 56.3 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = RV / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) / MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3126
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = DV / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) / MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3127
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CV / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MZM2 ))
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3128
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMV2 = CDV / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MZM2 ))
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3129
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZM2 / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZM2 / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3130
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMV2 = MZMV1 / MZM2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / MZM2 ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST108
SUBROUTINE TEST109
! Test type (ZM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3131
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = JV / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( JV(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3132
JV = (/ 12, -34, 56 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / JV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / JV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3133
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = RV / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( RV(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3134
RV = (/ 12.1, -34.2, 56.3 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / RV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / RV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3135
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = DV / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( DV(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3136
DV = (/ 12.1123456789D0, -34.2123456789D0, 56.3123456789D0 /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / DV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / DV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3137
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CV / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CV(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3138
CV = (/ (12.1,65.4) , (-34.2,54.3) , (56.3,-84.5) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / CV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / CV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3139
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = CDV / MZMV1
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( CDV(J) / MZMV1(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3140
CDV = (/ (12.1123456789D0,34.57D0) , (-34.2123456789D0,987.43D0) , &
(56.3123456789D0,-465.84D0) /)
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = MZMV1 / CDV
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV2(J) - ( MZMV1(J) / CDV(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3141
MZMV1 = (/ TO_ZM('12.1123456789 + 9.574635 i') , TO_ZM('-34.2123456789 - 5.4 i') , &
TO_ZM('56.3123456789 + 0.000345 i') /)
MZMV2 = (/ TO_ZM('1.21123456789 + 0.9574635 i') , TO_ZM('-3.42123456789 - 0.54 i') , &
TO_ZM('5.63123456789 + 0.00345 i') /)
MZMV4 = MZMV1 / MZMV2
MFM3 = 0
DO J = 1, 3
MFM3 = MFM3 + ABS(MZMV4(J) - ( MZMV1(J) / MZMV2(J) ))
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST109
SUBROUTINE TEST110
! Test type (FM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3142
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4 / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3143
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.8 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.8 / MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3144
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = 4.87D0 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( 4.87D0 / MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3145
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3146
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MFMA(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3147
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3148
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3149
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3150
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3151
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3152
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 / JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3153
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3154
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3155
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3156
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3157
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = JV2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) / MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3158
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = RV2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) / MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3159
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MFMB = DV2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) / MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3160
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CV2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MFM4 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3161
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MFM4 = TO_FM('12.1123456789')
MZMB2 = CDV2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MFM4 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3162
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3163
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFMA / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3164
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MIM2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIM2 / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3165
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_IM('121123456789')
MFMB = MFMA / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3166
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3167
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MFMA / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3168
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MFM4 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFM4 / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3169
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MFMB = MIMA2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) / MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3170
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MFM4 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFM4 / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3171
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MFM4 = TO_FM('12.1123456789')
MZMB2 = MZMA2 / MFM4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MFM4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST110
SUBROUTINE TEST111
! Test type (FM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3172
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = JV2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( JV2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3173
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3174
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = RV2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( RV2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3175
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3176
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = DV2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( DV2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3177
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3178
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3179
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3180
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3181
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3182
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMC(J,K) = TO_FM(55+5*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / MFMC
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MFMC(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3183
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MFMA / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MFMA(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3184
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MFMB = MIMA2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MFMB(J,K) - ( MIMA2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3185
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 / MFMA
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MFMA(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3186
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MFMA(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MFMA / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MFMA(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST111
SUBROUTINE TEST112
! Test type (IM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3187
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 412345 / MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( 412345 / MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3188
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 412345.8 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 412345.8 / MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3189
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = 412345.87D0 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( 412345.87D0 / MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3190
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.8,5.9) / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3191
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MIMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3192
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / 4
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / 4 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3193
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3194
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3195
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3196
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3197
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 / JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( MIM2 / JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3198
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 / RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3199
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIM2 / DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3200
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3201
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3202
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = JV2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - ( JV2(J,K) / MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3203
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = RV2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) / MIM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3204
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MIMB2 = DV2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) / MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3205
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CV2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MZMB2(J,K) - ( CV2(J,K) / MIM2 ))
ENDDO
ENDDO
MIM2 = RSMALL*56*3
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3206
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MIM2 = TO_FM('12.1123456789')
MZMB2 = CDV2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MIM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3207
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIM2 / MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIM2 / MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3208
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MIMB2 = MIMA2 / MIM2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / MIM2 ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3209
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3210
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MIMA2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3211
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MIM2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIM2 / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3212
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MIM2 = TO_FM('12.1123456789')
MZMB2 = MZMA2 / MIM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MIM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST112
SUBROUTINE TEST113
! Test type (IM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3213
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = JV2 / MIMA2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( JV2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3214
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / JV2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / JV2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3215
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = RV2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( RV2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3216
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3217
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = DV2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( DV2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3218
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MIMB2(J,K) - INT( MIMA2(J,K) / DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3219
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CV2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3220
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3221
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = CDV2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3222
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3223
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMC2(J,K) = TO_FM(37+11*(J+3*(K-1)))/3
ENDDO
ENDDO
MIMB2 = MIMA2 / MIMC2
MIM1 = 0
DO J = 1, 3
DO K = 1, 3
MIM1 = MIM1 + ABS(MIMB2(J,K) - ( MIMA2(J,K) / MIMC2(J,K) ))
ENDDO
ENDDO
CALL IM_ST2M(' 0 ',MIM2)
IF (.NOT.(MIM1 <= MIM2)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3224
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MZMA2 / MIMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MIMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3225
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MIMA2(J,K) = TO_FM(25+3*(J+3*(K-1)))/3
ENDDO
ENDDO
MZMB2 = MIMA2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MIMA2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST113
SUBROUTINE TEST114
! Test type (ZM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3226
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4 / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3227
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.8 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.8 / MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3228
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = 4.87D0 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( 4.87D0 / MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3229
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.8,5.9) / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.8,5.9) / MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3230
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = (4.87D0,5.98D0) / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( (4.87D0,5.98D0) / MZMA2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3231
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / 4
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3232
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / 4.8
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4.8 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3233
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / 4.87D0
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / 4.87D0 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3234
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / (4.8,5.9)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / (4.8,5.9) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3235
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / (4.87D0,5.98D0)
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / (4.87D0,5.98D0) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3236
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 / JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3237
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / RV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3238
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / DV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3239
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / CV2(J,K) ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3240
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = MZM2 / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / CDV2(J,K) ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3241
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = JV2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) / MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3242
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = RV2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) / MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3243
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = DV2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) / MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3244
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CV2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MZM2 ))
ENDDO
ENDDO
MFM4 = RSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3245
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
MZM2 = TO_ZM('12.1123456789 - 53.837465 i')
MZMB2 = CDV2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MZM2 ))
ENDDO
ENDDO
MFM4 = DSMALL*56*3
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3246
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZM2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZM2 / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3247
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZM2 = TO_ZM('-123.654 + 98.7 i')
MZMB2 = MZMA2 / MZM2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / MZM2 ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST114
SUBROUTINE TEST115
! Test type (ZM) array division operations.
IMPLICIT NONE
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
NCASE = 3248
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = JV2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( JV2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3249
JV2 = RESHAPE( (/(11+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / JV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / JV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3250
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = RV2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( RV2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3251
RV2 = RESHAPE( (/(11.345+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / RV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / RV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3252
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = DV2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( DV2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3253
DV2 = RESHAPE( (/(12.3456789D0+3*J,J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / DV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / DV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3254
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CV2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CV2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3255
CV2 = RESHAPE( (/(CMPLX(12.3+3*J,-32.4+7*J),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / CV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / CV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3256
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = CDV2 / MZMA2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( CDV2(J,K) / MZMA2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3257
CDV2 = RESHAPE( (/(CMPLX(13.3D0+3*J,-22.4D0+7*J,KIND(1.0D0)),J=1,9)/) , SHAPE = (/ 3,3 /) )
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
MZMB2 = MZMA2 / CDV2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMB2(J,K) - ( MZMA2(J,K) / CDV2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3258
DO J = 1, 3
DO K = 1, 3
MZMA2(J,K) = CMPLX(TO_FM('62.3')+3*(J+3*(K-1)), TO_FM('-72.4')+7*(J+3*(K-1)))
ENDDO
ENDDO
DO J = 1, 3
DO K = 1, 3
MZMB2(J,K) = CMPLX(TO_FM(48.3+5*(J+3*(K-1))), TO_FM(-31.4+8*(J+3*(K-1))))
ENDDO
ENDDO
MZMC2 = MZMA2 / MZMB2
MFM3 = 0
DO J = 1, 3
DO K = 1, 3
MFM3 = MFM3 + ABS(MZMC2(J,K) - ( MZMA2(J,K) / MZMB2(J,K) ))
ENDDO
ENDDO
CALL FM_ST2M(' 1.0E-45 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST115
SUBROUTINE TEST116
! Test higher precision operations.
IMPLICIT NONE
WRITE (KW,"(/' Testing higher precision operations using 20,000 significant digits.')")
CALL FMSET(20000)
KWSAVE = KW
CALL FMSETVAR(' KW = 22 ')
CALL FMSETVAR(' KDEBUG = 0 ')
NCASE = 3259
WRITE (KWSAVE,"(/' Check pi.')")
CALL FM_PI(M_A)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '3.1415926535897932384626433832795028841971693993751058209749445923078164062862&'
WRITE (23,*) '089986280348253421170679821480865132823066470938446095505822317253594081284811&'
WRITE (23,*) '174502841027019385211055596446229489549303819644288109756659334461284756482337&'
WRITE (23,*) '867831652712019091456485669234603486104543266482133936072602491412737245870066&'
WRITE (23,*) '063155881748815209209628292540917153643678925903600113305305488204665213841469&'
WRITE (23,*) '519415116094330572703657595919530921861173819326117931051185480744623799627495&'
WRITE (23,*) '673518857527248912279381830119491298336733624406566430860213949463952247371907&'
WRITE (23,*) '021798609437027705392171762931767523846748184676694051320005681271452635608277&'
WRITE (23,*) '857713427577896091736371787214684409012249534301465495853710507922796892589235&'
WRITE (23,*) '420199561121290219608640344181598136297747713099605187072113499999983729780499&'
WRITE (23,*) '510597317328160963185950244594553469083026425223082533446850352619311881710100&'
WRITE (23,*) '031378387528865875332083814206171776691473035982534904287554687311595628638823&'
WRITE (23,*) '537875937519577818577805321712268066130019278766111959092164201989380952572010&'
WRITE (23,*) '654858632788659361533818279682303019520353018529689957736225994138912497217752&'
WRITE (23,*) '834791315155748572424541506959508295331168617278558890750983817546374649393192&'
WRITE (23,*) '550604009277016711390098488240128583616035637076601047101819429555961989467678&'
WRITE (23,*) '374494482553797747268471040475346462080466842590694912933136770289891521047521&'
WRITE (23,*) '620569660240580381501935112533824300355876402474964732639141992726042699227967&'
WRITE (23,*) '823547816360093417216412199245863150302861829745557067498385054945885869269956&'
WRITE (23,*) '909272107975093029553211653449872027559602364806654991198818347977535663698074&'
WRITE (23,*) '265425278625518184175746728909777727938000816470600161452491921732172147723501&'
WRITE (23,*) '414419735685481613611573525521334757418494684385233239073941433345477624168625&'
WRITE (23,*) '189835694855620992192221842725502542568876717904946016534668049886272327917860&'
WRITE (23,*) '857843838279679766814541009538837863609506800642251252051173929848960841284886&'
WRITE (23,*) '269456042419652850222106611863067442786220391949450471237137869609563643719172&'
WRITE (23,*) '874677646575739624138908658326459958133904780275900994657640789512694683983525&'
WRITE (23,*) '957098258226205224894077267194782684826014769909026401363944374553050682034962&'
WRITE (23,*) '524517493996514314298091906592509372216964615157098583874105978859597729754989&'
WRITE (23,*) '301617539284681382686838689427741559918559252459539594310499725246808459872736&'
WRITE (23,*) '446958486538367362226260991246080512438843904512441365497627807977156914359977&'
WRITE (23,*) '001296160894416948685558484063534220722258284886481584560285060168427394522674&'
WRITE (23,*) '676788952521385225499546667278239864565961163548862305774564980355936345681743&'
WRITE (23,*) '241125150760694794510965960940252288797108931456691368672287489405601015033086&'
WRITE (23,*) '179286809208747609178249385890097149096759852613655497818931297848216829989487&'
WRITE (23,*) '226588048575640142704775551323796414515237462343645428584447952658678210511413&'
WRITE (23,*) '547357395231134271661021359695362314429524849371871101457654035902799344037420&'
WRITE (23,*) '073105785390621983874478084784896833214457138687519435064302184531910484810053&'
WRITE (23,*) '706146806749192781911979399520614196634287544406437451237181921799983910159195&'
WRITE (23,*) '618146751426912397489409071864942319615679452080951465502252316038819301420937&'
WRITE (23,*) '621378559566389377870830390697920773467221825625996615014215030680384477345492&'
WRITE (23,*) '026054146659252014974428507325186660021324340881907104863317346496514539057962&'
WRITE (23,*) '685610055081066587969981635747363840525714591028970641401109712062804390397595&'
WRITE (23,*) '156771577004203378699360072305587631763594218731251471205329281918261861258673&'
WRITE (23,*) '215791984148488291644706095752706957220917567116722910981690915280173506712748&'
WRITE (23,*) '583222871835209353965725121083579151369882091444210067510334671103141267111369&'
WRITE (23,*) '908658516398315019701651511685171437657618351556508849099898599823873455283316&'
WRITE (23,*) '355076479185358932261854896321329330898570642046752590709154814165498594616371&'
WRITE (23,*) '802709819943099244889575712828905923233260972997120844335732654893823911932597&'
WRITE (23,*) '463667305836041428138830320382490375898524374417029132765618093773444030707469&'
WRITE (23,*) '211201913020330380197621101100449293215160842444859637669838952286847831235526&'
WRITE (23,*) '582131449576857262433441893039686426243410773226978028073189154411010446823252&'
WRITE (23,*) '716201052652272111660396665573092547110557853763466820653109896526918620564769&'
WRITE (23,*) '312570586356620185581007293606598764861179104533488503461136576867532494416680&'
WRITE (23,*) '396265797877185560845529654126654085306143444318586769751456614068007002378776&'
WRITE (23,*) '591344017127494704205622305389945613140711270004078547332699390814546646458807&'
WRITE (23,*) '972708266830634328587856983052358089330657574067954571637752542021149557615814&'
WRITE (23,*) '002501262285941302164715509792592309907965473761255176567513575178296664547791&'
WRITE (23,*) '745011299614890304639947132962107340437518957359614589019389713111790429782856&'
WRITE (23,*) '475032031986915140287080859904801094121472213179476477726224142548545403321571&'
WRITE (23,*) '853061422881375850430633217518297986622371721591607716692547487389866549494501&'
WRITE (23,*) '146540628433663937900397692656721463853067360965712091807638327166416274888800&'
WRITE (23,*) '786925602902284721040317211860820419000422966171196377921337575114959501566049&'
WRITE (23,*) '631862947265473642523081770367515906735023507283540567040386743513622224771589&'
WRITE (23,*) '150495309844489333096340878076932599397805419341447377441842631298608099888687&'
WRITE (23,*) '413260472156951623965864573021631598193195167353812974167729478672422924654366&'
WRITE (23,*) '800980676928238280689964004824354037014163149658979409243237896907069779422362&'
WRITE (23,*) '508221688957383798623001593776471651228935786015881617557829735233446042815126&'
WRITE (23,*) '272037343146531977774160319906655418763979293344195215413418994854447345673831&'
WRITE (23,*) '624993419131814809277771038638773431772075456545322077709212019051660962804909&'
WRITE (23,*) '263601975988281613323166636528619326686336062735676303544776280350450777235547&'
WRITE (23,*) '105859548702790814356240145171806246436267945612753181340783303362542327839449&'
WRITE (23,*) '753824372058353114771199260638133467768796959703098339130771098704085913374641&'
WRITE (23,*) '442822772634659470474587847787201927715280731767907707157213444730605700733492&'
WRITE (23,*) '436931138350493163128404251219256517980694113528013147013047816437885185290928&'
WRITE (23,*) '545201165839341965621349143415956258658655705526904965209858033850722426482939&'
WRITE (23,*) '728584783163057777560688876446248246857926039535277348030480290058760758251047&'
WRITE (23,*) '470916439613626760449256274204208320856611906254543372131535958450687724602901&'
WRITE (23,*) '618766795240616342522577195429162991930645537799140373404328752628889639958794&'
WRITE (23,*) '757291746426357455254079091451357111369410911939325191076020825202618798531887&'
WRITE (23,*) '705842972591677813149699009019211697173727847684726860849003377024242916513005&'
WRITE (23,*) '005168323364350389517029893922334517220138128069650117844087451960121228599371&'
WRITE (23,*) '623130171144484640903890644954440061986907548516026327505298349187407866808818&'
WRITE (23,*) '338510228334508504860825039302133219715518430635455007668282949304137765527939&'
WRITE (23,*) '751754613953984683393638304746119966538581538420568533862186725233402830871123&'
WRITE (23,*) '282789212507712629463229563989898935821167456270102183564622013496715188190973&'
WRITE (23,*) '038119800497340723961036854066431939509790190699639552453005450580685501956730&'
WRITE (23,*) '229219139339185680344903982059551002263535361920419947455385938102343955449597&'
WRITE (23,*) '783779023742161727111723643435439478221818528624085140066604433258885698670543&'
WRITE (23,*) '154706965747458550332323342107301545940516553790686627333799585115625784322988&'
WRITE (23,*) '273723198987571415957811196358330059408730681216028764962867446047746491599505&'
WRITE (23,*) '497374256269010490377819868359381465741268049256487985561453723478673303904688&'
WRITE (23,*) '383436346553794986419270563872931748723320837601123029911367938627089438799362&'
WRITE (23,*) '016295154133714248928307220126901475466847653576164773794675200490757155527819&'
WRITE (23,*) '653621323926406160136358155907422020203187277605277219005561484255518792530343&'
WRITE (23,*) '513984425322341576233610642506390497500865627109535919465897514131034822769306&'
WRITE (23,*) '247435363256916078154781811528436679570611086153315044521274739245449454236828&'
WRITE (23,*) '860613408414863776700961207151249140430272538607648236341433462351897576645216&'
WRITE (23,*) '413767969031495019108575984423919862916421939949072362346468441173940326591840&'
WRITE (23,*) '443780513338945257423995082965912285085558215725031071257012668302402929525220&'
WRITE (23,*) '118726767562204154205161841634847565169998116141010029960783869092916030288400&'
WRITE (23,*) '269104140792886215078424516709087000699282120660418371806535567252532567532861&'
WRITE (23,*) '291042487761825829765157959847035622262934860034158722980534989650226291748788&'
WRITE (23,*) '202734209222245339856264766914905562842503912757710284027998066365825488926488&'
WRITE (23,*) '025456610172967026640765590429099456815065265305371829412703369313785178609040&'
WRITE (23,*) '708667114965583434347693385781711386455873678123014587687126603489139095620099&'
WRITE (23,*) '393610310291616152881384379099042317473363948045759314931405297634757481193567&'
WRITE (23,*) '091101377517210080315590248530906692037671922033229094334676851422144773793937&'
WRITE (23,*) '517034436619910403375111735471918550464490263655128162288244625759163330391072&'
WRITE (23,*) '253837421821408835086573917715096828874782656995995744906617583441375223970968&'
WRITE (23,*) '340800535598491754173818839994469748676265516582765848358845314277568790029095&'
WRITE (23,*) '170283529716344562129640435231176006651012412006597558512761785838292041974844&'
WRITE (23,*) '236080071930457618932349229279650198751872127267507981255470958904556357921221&'
WRITE (23,*) '033346697499235630254947802490114195212382815309114079073860251522742995818072&'
WRITE (23,*) '471625916685451333123948049470791191532673430282441860414263639548000448002670&'
WRITE (23,*) '496248201792896476697583183271314251702969234889627668440323260927524960357996&'
WRITE (23,*) '469256504936818360900323809293459588970695365349406034021665443755890045632882&'
WRITE (23,*) '250545255640564482465151875471196218443965825337543885690941130315095261793780&'
WRITE (23,*) '029741207665147939425902989695946995565761218656196733786236256125216320862869&'
WRITE (23,*) '222103274889218654364802296780705765615144632046927906821207388377814233562823&'
WRITE (23,*) '608963208068222468012248261177185896381409183903673672220888321513755600372798&'
WRITE (23,*) '394004152970028783076670944474560134556417254370906979396122571429894671543578&'
WRITE (23,*) '468788614445812314593571984922528471605049221242470141214780573455105008019086&'
WRITE (23,*) '996033027634787081081754501193071412233908663938339529425786905076431006383519&'
WRITE (23,*) '834389341596131854347546495569781038293097164651438407007073604112373599843452&'
WRITE (23,*) '251610507027056235266012764848308407611830130527932054274628654036036745328651&'
WRITE (23,*) '057065874882256981579367897669742205750596834408697350201410206723585020072452&'
WRITE (23,*) '256326513410559240190274216248439140359989535394590944070469120914093870012645&'
WRITE (23,*) '600162374288021092764579310657922955249887275846101264836999892256959688159205&'
WRITE (23,*) '600101655256375678566722796619885782794848855834397518744545512965634434803966&'
WRITE (23,*) '420557982936804352202770984294232533022576341807039476994159791594530069752148&'
WRITE (23,*) '293366555661567873640053666564165473217043903521329543529169414599041608753201&'
WRITE (23,*) '868379370234888689479151071637852902345292440773659495630510074210871426134974&'
WRITE (23,*) '595615138498713757047101787957310422969066670214498637464595280824369445789772&'
WRITE (23,*) '330048764765241339075920434019634039114732023380715095222010682563427471646024&'
WRITE (23,*) '335440051521266932493419673977041595683753555166730273900749729736354964533288&'
WRITE (23,*) '869844061196496162773449518273695588220757355176651589855190986665393549481068&'
WRITE (23,*) '873206859907540792342402300925900701731960362254756478940647548346647760411463&'
WRITE (23,*) '233905651343306844953979070903023460461470961696886885014083470405460742958699&'
WRITE (23,*) '138296682468185710318879065287036650832431974404771855678934823089431068287027&'
WRITE (23,*) '228097362480939962706074726455399253994428081137369433887294063079261595995462&'
WRITE (23,*) '624629707062594845569034711972996409089418059534393251236235508134949004364278&'
WRITE (23,*) '527138315912568989295196427287573946914272534366941532361004537304881985517065&'
WRITE (23,*) '941217352462589548730167600298865925786628561249665523533829428785425340483083&'
WRITE (23,*) '307016537228563559152534784459818313411290019992059813522051173365856407826484&'
WRITE (23,*) '942764411376393866924803118364453698589175442647399882284621844900877769776312&'
WRITE (23,*) '795722672655562596282542765318300134070922334365779160128093179401718598599933&'
WRITE (23,*) '849235495640057099558561134980252499066984233017350358044081168552653117099570&'
WRITE (23,*) '899427328709258487894436460050410892266917835258707859512983441729535195378855&'
WRITE (23,*) '345737426085902908176515578039059464087350612322611200937310804854852635722825&'
WRITE (23,*) '768203416050484662775045003126200800799804925485346941469775164932709504934639&'
WRITE (23,*) '382432227188515974054702148289711177792376122578873477188196825462981268685817&'
WRITE (23,*) '050740272550263329044976277894423621674119186269439650671515779586756482399391&'
WRITE (23,*) '760426017633870454990176143641204692182370764887834196896861181558158736062938&'
WRITE (23,*) '603810171215855272668300823834046564758804051380801633638874216371406435495561&'
WRITE (23,*) '868964112282140753302655100424104896783528588290243670904887118190909494533144&'
WRITE (23,*) '218287661810310073547705498159680772009474696134360928614849417850171807793068&'
WRITE (23,*) '108546900094458995279424398139213505586422196483491512639012803832001097738680&'
WRITE (23,*) '662877923971801461343244572640097374257007359210031541508936793008169980536520&'
WRITE (23,*) '276007277496745840028362405346037263416554259027601834840306811381855105979705&'
WRITE (23,*) '664007509426087885735796037324514146786703688098806097164258497595138069309449&'
WRITE (23,*) '401515422221943291302173912538355915031003330325111749156969174502714943315155&'
WRITE (23,*) '885403922164097229101129035521815762823283182342548326111912800928252561902052&'
WRITE (23,*) '630163911477247331485739107775874425387611746578671169414776421441111263583553&'
WRITE (23,*) '871361011023267987756410246824032264834641766369806637857681349204530224081972&'
WRITE (23,*) '785647198396308781543221166912246415911776732253264335686146186545222681268872&'
WRITE (23,*) '684459684424161078540167681420808850280054143613146230821025941737562389942075&'
WRITE (23,*) '713627516745731891894562835257044133543758575342698699472547031656613991999682&'
WRITE (23,*) '628247270641336222178923903176085428943733935618891651250424404008952719837873&'
WRITE (23,*) '864805847268954624388234375178852014395600571048119498842390606136957342315590&'
WRITE (23,*) '796703461491434478863604103182350736502778590897578272731305048893989009923913&'
WRITE (23,*) '503373250855982655867089242612429473670193907727130706869170926462548423240748&'
WRITE (23,*) '550366080136046689511840093668609546325002145852930950000907151058236267293264&'
WRITE (23,*) '537382104938724996699339424685516483261134146110680267446637334375340764294026&'
WRITE (23,*) '682973865220935701626384648528514903629320199199688285171839536691345222444708&'
WRITE (23,*) '045923966028171565515656661113598231122506289058549145097157553900243931535190&'
WRITE (23,*) '902107119457300243880176615035270862602537881797519478061013715004489917210022&'
WRITE (23,*) '201335013106016391541589578037117792775225978742891917915522417189585361680594&'
WRITE (23,*) '741234193398420218745649256443462392531953135103311476394911995072858430658361&'
WRITE (23,*) '935369329699289837914941939406085724863968836903265564364216644257607914710869&'
WRITE (23,*) '984315733749648835292769328220762947282381537409961545598798259891093717126218&'
WRITE (23,*) '283025848112389011968221429457667580718653806506487026133892822994972574530332&'
WRITE (23,*) '838963818439447707794022843598834100358385423897354243956475556840952248445541&'
WRITE (23,*) '392394100016207693636846776413017819659379971557468541946334893748439129742391&'
WRITE (23,*) '433659360410035234377706588867781139498616478747140793263858738624732889645643&'
WRITE (23,*) '598774667638479466504074111825658378878454858148962961273998413442726086061872&'
WRITE (23,*) '455452360643153710112746809778704464094758280348769758948328241239292960582948&'
WRITE (23,*) '619196670918958089833201210318430340128495116203534280144127617285830243559830&'
WRITE (23,*) '032042024512072872535581195840149180969253395075778400067465526031446167050827&'
WRITE (23,*) '682772223534191102634163157147406123850425845988419907611287258059113935689601&'
WRITE (23,*) '431668283176323567325417073420817332230462987992804908514094790368878687894930&'
WRITE (23,*) '546955703072619009502076433493359106024545086453628935456862958531315337183868&'
WRITE (23,*) '265617862273637169757741830239860065914816164049449650117321313895747062088474&'
WRITE (23,*) '802365371031150898427992754426853277974311395143574172219759799359685252285745&'
WRITE (23,*) '263796289612691572357986620573408375766873884266405990993505000813375432454635&'
WRITE (23,*) '967504844235284874701443545419576258473564216198134073468541117668831186544893&'
WRITE (23,*) '776979566517279662326714810338643913751865946730024434500544995399742372328712&'
WRITE (23,*) '494834706044063471606325830649829795510109541836235030309453097335834462839476&'
WRITE (23,*) '304775645015008507578949548931393944899216125525597701436858943585877526379625&'
WRITE (23,*) '597081677643800125436502371412783467926101995585224717220177723700417808419423&'
WRITE (23,*) '948725406801556035998390548985723546745642390585850216719031395262944554391316&'
WRITE (23,*) '631345308939062046784387785054239390524731362012947691874975191011472315289326&'
WRITE (23,*) '772533918146607300089027768963114810902209724520759167297007850580717186381054&'
WRITE (23,*) '967973100167870850694207092232908070383263453452038027860990556900134137182368&'
WRITE (23,*) '370991949516489600755049341267876436746384902063964019766685592335654639138363&'
WRITE (23,*) '185745698147196210841080961884605456039038455343729141446513474940784884423772&'
WRITE (23,*) '175154334260306698831768331001133108690421939031080143784334151370924353013677&'
WRITE (23,*) '631084913516156422698475074303297167469640666531527035325467112667522460551199&'
WRITE (23,*) '581831963763707617991919203579582007595605302346267757943936307463056901080114&'
WRITE (23,*) '942714100939136913810725813781357894005599500183542511841721360557275221035268&'
WRITE (23,*) '037357265279224173736057511278872181908449006178013889710770822931002797665935&'
WRITE (23,*) '838758909395688148560263224393726562472776037890814458837855019702843779362407&'
WRITE (23,*) '825052704875816470324581290878395232453237896029841669225489649715606981192186&'
WRITE (23,*) '584926770403956481278102179913217416305810554598801300484562997651121241536374&'
WRITE (23,*) '515005635070127815926714241342103301566165356024733807843028655257222753049998&'
WRITE (23,*) '837015348793008062601809623815161366903341111386538510919367393835229345888322&'
WRITE (23,*) '550887064507539473952043968079067086806445096986548801682874343786126453815834&'
WRITE (23,*) '280753061845485903798217994599681154419742536344399602902510015888272164745006&'
WRITE (23,*) '820704193761584547123183460072629339550548239557137256840232268213012476794522&'
WRITE (23,*) '644820910235647752723082081063518899152692889108455571126603965034397896278250&'
WRITE (23,*) '016110153235160519655904211844949907789992007329476905868577878720982901352956&'
WRITE (23,*) '613978884860509786085957017731298155314951681467176959760994210036183559138777&'
WRITE (23,*) '817698458758104466283998806006162298486169353373865787735983361613384133853684&'
WRITE (23,*) '211978938900185295691967804554482858483701170967212535338758621582310133103877&'
WRITE (23,*) '668272115726949518179589754693992642197915523385766231676275475703546994148929&'
WRITE (23,*) '041301863861194391962838870543677743224276809132365449485366768000001065262485&'
WRITE (23,*) '473055861598999140170769838548318875014293890899506854530765116803337322265175&'
WRITE (23,*) '662207526951791442252808165171667766727930354851542040238174608923283917032754&'
WRITE (23,*) '257508676551178593950027933895920576682789677644531840404185540104351348389531&'
WRITE (23,*) '201326378369283580827193783126549617459970567450718332065034556644034490453627&'
WRITE (23,*) '560011250184335607361222765949278393706478426456763388188075656121689605041611&'
WRITE (23,*) '390390639601620221536849410926053876887148379895599991120991646464411918568277&'
WRITE (23,*) '004574243434021672276445589330127781586869525069499364610175685060167145354315&'
WRITE (23,*) '814801054588605645501332037586454858403240298717093480910556211671546848477803&'
WRITE (23,*) '944756979804263180991756422809873998766973237695737015808068229045992123661689&'
WRITE (23,*) '025962730430679316531149401764737693873514093361833216142802149763399189835484&'
WRITE (23,*) '875625298752423873077559555955465196394401821840998412489826236737714672260616&'
WRITE (23,*) '336432964063357281070788758164043814850188411431885988276944901193212968271588&'
WRITE (23,*) '841338694346828590066640806314077757725705630729400492940302420498416565479736&'
WRITE (23,*) '705485580445865720227637840466823379852827105784319753541795011347273625774080&'
WRITE (23,*) '213476826045022851579795797647467022840999561601569108903845824502679265942055&'
WRITE (23,*) '503958792298185264800706837650418365620945554346135134152570065974881916341359&'
WRITE (23,*) '556719649654032187271602648593049039787489589066127250794828276938953521753621&'
WRITE (23,*) '850796297785146188432719223223810158744450528665238022532843891375273845892384&'
WRITE (23,*) '422535472653098171578447834215822327020690287232330053862163479885094695472004&'
WRITE (23,*) '795231120150432932266282727632177908840087861480221475376578105819702226309717&'
WRITE (23,*) '495072127248479478169572961423658595782090830733233560348465318730293026659645&'
WRITE (23,*) '013718375428897557971449924654038681799213893469244741985097334626793321072686&'
WRITE (23,*) '870768062639919361965044099542167627840914669856925715074315740793805323925239&'
WRITE (23,*) '477557441591845821562518192155233709607483329234921034514626437449805596103307&'
WRITE (23,*) '994145347784574699992128599999399612281615219314888769388022281083001986016549&'
WRITE (23,*) '416542616968586788372609587745676182507275992950893180521872924610867639958916&'
WRITE (23,*) '145855058397274209809097817293239301067663868240401113040247007350857828724627&'
WRITE (23,*) '134946368531815469690466968693925472519413992914652423857762550047485295476814&'
WRITE (23,*) '795467007050347999588867695016124972282040303995463278830695976249361510102436&'
WRITE (23,*) '555352230690612949388599015734661023712235478911292547696176005047974928060721&'
WRITE (23,*) '268039226911027772261025441492215765045081206771735712027180242968106203776578&'
WRITE (23,*) '837166909109418074487814049075517820385653909910477594141321543284406250301803'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3260
J1 = MBASE
J2 = NDIG
IF (12345678 <= MXBASE) THEN
CALL FM_SETVAR(" MBASE = 12345678 ")
CALL FM_SETVAR(" NDIG = 2822 ")
ELSE IF (12345 <= MXBASE) THEN
CALL FM_SETVAR(" MBASE = 12345 ")
CALL FM_SETVAR(" NDIG = 4890 ")
ELSE
CALL FM_SETVAR(" MBASE = 123 ")
CALL FM_SETVAR(" NDIG = 9572 ")
ENDIF
CALL FM_PI(M_A)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_C)
CLOSE(23)
MFM3 = ABS(M_A - M_C)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3261
CALL FM_CHANGEBASE(M_A,M_B,J1,J2)
CALL FMSET(20000)
MFM3 = ABS(M_B - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3262
WRITE (KWSAVE,"(/' Check e.')")
M_B = 1
M_A = EXP(M_B)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '2.7182818284590452353602874713526624977572470936999595749669676277240766303535&'
WRITE (23,*) '475945713821785251664274274663919320030599218174135966290435729003342952605956&'
WRITE (23,*) '307381323286279434907632338298807531952510190115738341879307021540891499348841&'
WRITE (23,*) '675092447614606680822648001684774118537423454424371075390777449920695517027618&'
WRITE (23,*) '386062613313845830007520449338265602976067371132007093287091274437470472306969&'
WRITE (23,*) '772093101416928368190255151086574637721112523897844250569536967707854499699679&'
WRITE (23,*) '468644549059879316368892300987931277361782154249992295763514822082698951936680&'
WRITE (23,*) '331825288693984964651058209392398294887933203625094431173012381970684161403970&'
WRITE (23,*) '198376793206832823764648042953118023287825098194558153017567173613320698112509&'
WRITE (23,*) '961818815930416903515988885193458072738667385894228792284998920868058257492796&'
WRITE (23,*) '104841984443634632449684875602336248270419786232090021609902353043699418491463&'
WRITE (23,*) '140934317381436405462531520961836908887070167683964243781405927145635490613031&'
WRITE (23,*) '072085103837505101157477041718986106873969655212671546889570350354021234078498&'
WRITE (23,*) '193343210681701210056278802351930332247450158539047304199577770935036604169973&'
WRITE (23,*) '297250886876966403555707162268447162560798826517871341951246652010305921236677&'
WRITE (23,*) '194325278675398558944896970964097545918569563802363701621120477427228364896134&'
WRITE (23,*) '225164450781824423529486363721417402388934412479635743702637552944483379980161&'
WRITE (23,*) '254922785092577825620926226483262779333865664816277251640191059004916449982893&'
WRITE (23,*) '150566047258027786318641551956532442586982946959308019152987211725563475463964&'
WRITE (23,*) '479101459040905862984967912874068705048958586717479854667757573205681288459205&'
WRITE (23,*) '413340539220001137863009455606881667400169842055804033637953764520304024322566&'
WRITE (23,*) '135278369511778838638744396625322498506549958862342818997077332761717839280349&'
WRITE (23,*) '465014345588970719425863987727547109629537415211151368350627526023264847287039&'
WRITE (23,*) '207643100595841166120545297030236472549296669381151373227536450988890313602057&'
WRITE (23,*) '248176585118063036442812314965507047510254465011727211555194866850800368532281&'
WRITE (23,*) '831521960037356252794495158284188294787610852639813955990067376482922443752871&'
WRITE (23,*) '846245780361929819713991475644882626039033814418232625150974827987779964373089&'
WRITE (23,*) '970388867782271383605772978824125611907176639465070633045279546618550966661856&'
WRITE (23,*) '647097113444740160704626215680717481877844371436988218559670959102596862002353&'
WRITE (23,*) '718588748569652200050311734392073211390803293634479727355955277349071783793421&'
WRITE (23,*) '637012050054513263835440001863239914907054797780566978533580489669062951194324&'
WRITE (23,*) '730995876552368128590413832411607226029983305353708761389396391779574540161372&'
WRITE (23,*) '236187893652605381558415871869255386061647798340254351284396129460352913325942&'
WRITE (23,*) '794904337299085731580290958631382683291477116396337092400316894586360606458459&'
WRITE (23,*) '251269946557248391865642097526850823075442545993769170419777800853627309417101&'
WRITE (23,*) '634349076964237222943523661255725088147792231519747780605696725380171807763603&'
WRITE (23,*) '462459278778465850656050780844211529697521890874019660906651803516501792504619&'
WRITE (23,*) '501366585436632712549639908549144200014574760819302212066024330096412704894390&'
WRITE (23,*) '397177195180699086998606636583232278709376502260149291011517177635944602023249&'
WRITE (23,*) '300280401867723910288097866605651183260043688508817157238669842242201024950551&'
WRITE (23,*) '881694803221002515426494639812873677658927688163598312477886520141174110913601&'
WRITE (23,*) '164995076629077943646005851941998560162647907615321038727557126992518275687989&'
WRITE (23,*) '302761761146162549356495903798045838182323368612016243736569846703785853305275&'
WRITE (23,*) '833337939907521660692380533698879565137285593883499894707416181550125397064648&'
WRITE (23,*) '171946708348197214488898790676503795903669672494992545279033729636162658976039&'
WRITE (23,*) '498576741397359441023744329709355477982629614591442936451428617158587339746791&'
WRITE (23,*) '897571211956187385783644758448423555581050025611492391518893099463428413936080&'
WRITE (23,*) '383091662818811503715284967059741625628236092168075150177725387402564253470879&'
WRITE (23,*) '089137291722828611515915683725241630772254406337875931059826760944203261924285&'
WRITE (23,*) '317018781772960235413060672136046000389661093647095141417185777014180606443636&'
WRITE (23,*) '815464440053316087783143174440811949422975599314011888683314832802706553833004&'
WRITE (23,*) '693290115744147563139997221703804617092894579096271662260740718749975359212756&'
WRITE (23,*) '084414737823303270330168237193648002173285734935947564334129943024850235732214&'
WRITE (23,*) '597843282641421684878721673367010615094243456984401873312810107945127223737886&'
WRITE (23,*) '126058165668053714396127888732527373890392890506865324138062796025930387727697&'
WRITE (23,*) '783792868409325365880733988457218746021005311483351323850047827169376218004904&'
WRITE (23,*) '795597959290591655470505777514308175112698985188408718564026035305583737832422&'
WRITE (23,*) '924185625644255022672155980274012617971928047139600689163828665277009752767069&'
WRITE (23,*) '777036439260224372841840883251848770472638440379530166905465937461619323840363&'
WRITE (23,*) '893131364327137688841026811219891275223056256756254701725086349765367288605966&'
WRITE (23,*) '752740868627407912856576996313789753034660616669804218267724560530660773899624&'
WRITE (23,*) '218340859882071864682623215080288286359746839654358856685503773131296587975810&'
WRITE (23,*) '501214916207656769950659715344763470320853215603674828608378656803073062657633&'
WRITE (23,*) '469774295634643716709397193060876963495328846833613038829431040800296873869117&'
WRITE (23,*) '066666146800015121143442256023874474325250769387077775193299942137277211258843&'
WRITE (23,*) '608715834835626961661980572526612206797540621062080649882918454395301529982092&'
WRITE (23,*) '503005498257043390553570168653120526495614857249257386206917403695213533732531&'
WRITE (23,*) '666345466588597286659451136441370331393672118569553952108458407244323835586063&'
WRITE (23,*) '106806964924851232632699514603596037297253198368423363904632136710116192821711&'
WRITE (23,*) '150282801604488058802382031981493096369596735832742024988245684941273860566491&'
WRITE (23,*) '352526706046234450549227581151709314921879592718001940968866986837037302200475&'
WRITE (23,*) '314338181092708030017205935530520700706072233999463990571311587099635777359027&'
WRITE (23,*) '196285061146514837526209565346713290025994397663114545902685898979115837093419&'
WRITE (23,*) '370441155121920117164880566945938131183843765620627846310490346293950029458341&'
WRITE (23,*) '164824114969758326011800731699437393506966295712410273239138741754923071862454&'
WRITE (23,*) '543222039552735295240245903805744502892246886285336542213815722131163288112052&'
WRITE (23,*) '146489805180092024719391710555390113943316681515828843687606961102505171007392&'
WRITE (23,*) '762385553386272553538830960671644662370922646809671254061869502143176211668140&'
WRITE (23,*) '097595281493907222601112681153108387317617323235263605838173151034595736538223&'
WRITE (23,*) '534992935822836851007810884634349983518404451704270189381994243410090575376257&'
WRITE (23,*) '767571118090088164183319201962623416288166521374717325477727783488774366518828&'
WRITE (23,*) '752156685719506371936565390389449366421764003121527870222366463635755503565576&'
WRITE (23,*) '948886549500270853923617105502131147413744106134445544192101336172996285694899&'
WRITE (23,*) '193369184729478580729156088510396781959429833186480756083679551496636448965592&'
WRITE (23,*) '948187851784038773326247051945050419847742014183947731202815886845707290544057&'
WRITE (23,*) '510601285258056594703046836344592652552137008068752009593453607316226118728173&'
WRITE (23,*) '928074623094685367823106097921599360019946237993434210687813497346959246469752&'
WRITE (23,*) '506246958616909178573976595199392993995567542714654910456860702099012606818704&'
WRITE (23,*) '984178079173924071945996323060254707901774527513186809982284730860766536866855&'
WRITE (23,*) '516467702911336827563107223346726113705490795365834538637196235856312618387156&'
WRITE (23,*) '774118738527722922594743373785695538456246801013905727871016512966636764451872&'
WRITE (23,*) '465653730402443684140814488732957847348490003019477888020460324660842875351848&'
WRITE (23,*) '364959195082888323206522128104190448047247949291342284951970022601310430062410&'
WRITE (23,*) '717971502793433263407995960531446053230488528972917659876016667811937932372453&'
WRITE (23,*) '857209607582277178483361613582612896226118129455927462767137794487586753657544&'
WRITE (23,*) '861407611931125958512655759734573015333642630767985443385761715333462325270572&'
WRITE (23,*) '005303988289499034259566232975782488735029259166825894456894655992658454762694&'
WRITE (23,*) '528780516501720674785417887982276806536650641910973434528878338621726156269582&'
WRITE (23,*) '654478205672987756426325321594294418039943217000090542650763095588465895171709&'
WRITE (23,*) '147607437136893319469090981904501290307099566226620303182649365733698419555776&'
WRITE (23,*) '963787624918852865686607600566025605445711337286840205574416030837052312242587&'
WRITE (23,*) '223438854123179481388550075689381124935386318635287083799845692619981794523364&'
WRITE (23,*) '087429591180747453419551420351726184200845509170845682368200897739455842679214&'
WRITE (23,*) '273477560879644279202708312150156406341341617166448069815483764491573900121217&'
WRITE (23,*) '041547872591998943825364950514771379399147205219529079396137621107238494290616&'
WRITE (23,*) '357604596231253506068537651423115349665683715116604220796394466621163255157729&'
WRITE (23,*) '070978473156278277598788136491951257483328793771571459091064841642678309949723&'
WRITE (23,*) '674420175862269402159407924480541255360431317992696739157542419296607312393763&'
WRITE (23,*) '542139230617876753958711436104089409966089471418340698362993675362621545247298&'
WRITE (23,*) '464213752891079884381306095552622720837518629837066787224430195793793786072107&'
WRITE (23,*) '254277289071732854874374355781966511716618330881129120245204048682200072344035&'
WRITE (23,*) '025448202834254187884653602591506445271657700044521097735585897622655484941621&'
WRITE (23,*) '714989532383421600114062950718490427789258552743035221396835679018076406042138&'
WRITE (23,*) '307308774460170842688272261177180842664333651780002171903449234264266292261456&'
WRITE (23,*) '004337383868335555343453004264818473989215627086095650629340405264943244261445&'
WRITE (23,*) '665921291225648893569655009154306426134252668472594914314239398845432486327461&'
WRITE (23,*) '842846655985332312210466259890141712103446084271616619001257195870793217569698&'
WRITE (23,*) '544013397622096749454185407118446433946990162698351607848924514058940946395267&'
WRITE (23,*) '807354579700307051163682519487701189764002827648414160587206184185297189154019&'
WRITE (23,*) '688253289309149665345753571427318482016384644832499037886069008072709327673127&'
WRITE (23,*) '581966563941148961716832980455139729506687604740915420428429993541025829113502&'
WRITE (23,*) '241690769431668574242522509026939034814856451303069925199590436384028429267412&'
WRITE (23,*) '573422447765584177886171737265462085498294498946787350929581652632072258992368&'
WRITE (23,*) '768457017823038096567883112289305809140572610865884845873101658151167533327674&'
WRITE (23,*) '887014829167419701512559782572707406431808601428149024146780472327597684269633&'
WRITE (23,*) '935773542930186739439716388611764209004068663398856841681003872389214483176070&'
WRITE (23,*) '116684503887212364367043314091155733280182977988736590916659612402021778558854&'
WRITE (23,*) '876176161989370794380056663364884365089144805571039765214696027662583599051987&'
WRITE (23,*) '042300179465536788567430285974600143785483237068701190078499404930918919181649&'
WRITE (23,*) '327259774030074879681484882342932023012128032327460392219687528340516906974194&'
WRITE (23,*) '257614673978110715464186273369091584973185011183960482533518748438923177292613&'
WRITE (23,*) '543024932562896371361977285456622924461644497284597867711574125670307871885109&'
WRITE (23,*) '336344480149675240618536569532074170533486782754827815415561966911055101472799&'
WRITE (23,*) '040386897220465550833170782394808785990501947563108984124144672821865459971596&'
WRITE (23,*) '639015641941751820935932616316888380132758752601460507676098392625726411120135&'
WRITE (23,*) '288591317848299475682472564885533357279772205543568126302535748216585414000805&'
WRITE (23,*) '314820697137262149755576051890481622376790414926742600071045922695314835188137&'
WRITE (23,*) '463887104273544767623577933993970632396604969145303273887874557905934937772320&'
WRITE (23,*) '142954803345000695256980935282887783710670585567749481373858630385762823040694&'
WRITE (23,*) '005665340584887527005308832459182183494318049834199639981458773435863115940570&'
WRITE (23,*) '443683515285383609442955964360676090221741896883548131643997437764158365242234&'
WRITE (23,*) '642619597390455450680695232850751868719449064767791886720306418630751053512149&'
WRITE (23,*) '851051207313846648717547518382979990189317751550639981016466414592102406838294&'
WRITE (23,*) '603208535554058147159273220677567669213664081505900806952540610628536408293276&'
WRITE (23,*) '621931939933861623836069111767785448236129326858199965239275488427435414402884&'
WRITE (23,*) '536455595124735546139403154952097397051896240157976832639450633230452192645049&'
WRITE (23,*) '651735466775699295718989690470902730288544945416699791992948038254980285946029&'
WRITE (23,*) '052763145580316514066229171223429375806143993484914362107993576737317948964252&'
WRITE (23,*) '488813720435579287511385856973381976083524423240466778020948399639946684833774&'
WRITE (23,*) '706725483618848273000648319163826022110555221246733323184463005504481849916996&'
WRITE (23,*) '622087746140216157021029603318588727333298779352570182393861244026868339555870&'
WRITE (23,*) '607758169954398469568540671174444932479519572159419645863736126915526457574786&'
WRITE (23,*) '985964242176592896862383506370433939811671397544736228625506803682664135541448&'
WRITE (23,*) '048997721373174119199970017293907303350869020922519124447393278376156321810842&'
WRITE (23,*) '898207706974138707053266117683698647741787180202729412982310888796831880854367&'
WRITE (23,*) '327806879771659111654224453806625861711729498038248879986504061563975629936962&'
WRITE (23,*) '809358189761491017145343556659542757064194408833816841111166200759787244137082&'
WRITE (23,*) '333917886114708228657531078536674695018462140736493917366254937783014074302668&'
WRITE (23,*) '422150335117736471853872324040421037907750266020114814935482228916663640782450&'
WRITE (23,*) '166815341213505278578539332606110249802273093636740213515386431693015267460536&'
WRITE (23,*) '064351732154701091440650878823636764236831187390937464232609021646365627553976&'
WRITE (23,*) '834019482932795750624399645272578624400375983422050808935129023122475970644105&'
WRITE (23,*) '678361870877172333555465482598906861201410107222465904008553798235253885171623&'
WRITE (23,*) '518256518482203125214950700378300411216212126052726059944320443056274522916128&'
WRITE (23,*) '891766814160639131235975350390320077529587392412476451850809163911459296071156&'
WRITE (23,*) '344204347133544720981178461451077872399140606290228276664309264900592249810291&'
WRITE (23,*) '068759434533858330391178747575977065953570979640012224092199031158229259667913&'
WRITE (23,*) '153991561438070129260780197022589662923368154312499412259460023399472228171056&'
WRITE (23,*) '603931877226800493833148980338548909468685130789292064242819174795866199944411&'
WRITE (23,*) '196208730498064385006852620258432842085582338566936649849720817046135376163584&'
WRITE (23,*) '015342840674118587581546514598270228676671855309311923340191286170613364873183&'
WRITE (23,*) '197560812569460089402953094429119590295968563923037689976327462283900735457144&'
WRITE (23,*) '596414108229285922239332836210192822937243590283003884445701383771632056518351&'
WRITE (23,*) '970100115722010956997890484964453434612129224964732356126321951155701565824427&'
WRITE (23,*) '661599326463155806672053127596948538057364208384918887095176052287817339462747&'
WRITE (23,*) '644656858900936266123311152910816041524100214195937349786431661556732702792109&'
WRITE (23,*) '593543055579732660554677963552005378304619540636971842916168582734122217145885&'
WRITE (23,*) '870814274090248185446421774876925093328785670674677381226752831653559245204578&'
WRITE (23,*) '070541352576903253522738963847495646255940378924925007624386893776475310102323&'
WRITE (23,*) '746733771474581625530698032499033676455430305274561512961214585944432150749051&'
WRITE (23,*) '491453950981001388737926379964873728396416897555132275962011838248650746985492&'
WRITE (23,*) '038097691932606437608743209385602815642849756549307909733854185583515789409814&'
WRITE (23,*) '007691892389063090542534883896831762904120212949167195811935791203162514344096&'
WRITE (23,*) '503132835216728021372415947344095498316138322505486708172221475138425166790445&'
WRITE (23,*) '416617303200820330902895488808516797258495813407132180533988828139346049850532&'
WRITE (23,*) '340472595097214331492586604248511405819579711564191458842833000525684776874305&'
WRITE (23,*) '916390494306871343118796189637475503362820939949343690321031976898112055595369&'
WRITE (23,*) '465424704173323895394046035325396758354395350516720261647961347790912327995264&'
WRITE (23,*) '929045151148307923369382166010702872651938143844844532639517394110131152502750&'
WRITE (23,*) '465749343063766541866128915264446926222884366299462732467958736383501937142786&'
WRITE (23,*) '471398054038215513463223702071533134887083174146591492406359493020921122052610&'
WRITE (23,*) '312390682941345696785958518393491382340884274312419099152870804332809132993078&'
WRITE (23,*) '936867127413922890033069995875921815297612482409116951587789964090352577345938&'
WRITE (23,*) '248232053055567238095022266790439614231852991989181065554412477204508510210071&'
WRITE (23,*) '522352342792531266930108270633942321762570076323139159349709946933241013908779&'
WRITE (23,*) '161651226804414809765618979735043151396066913258379033748620836695475083280318&'
WRITE (23,*) '786707751177525663963479259219733577949555498655214193398170268639987388347010&'
WRITE (23,*) '255262052312317215254062571636771270010760912281528326508984359568975961038372&'
WRITE (23,*) '157726831170734552250194121701541318793651818502020877326906133592182000762327&'
WRITE (23,*) '269503283827391243828198170871168108951187896746707073377869592565542713340052&'
WRITE (23,*) '326706040004348843432902760360498027862160749469654989210474443927871934536701&'
WRITE (23,*) '798673920803845633723311983855862638008516345597194441994344624761123844617615&'
WRITE (23,*) '736242015935078520825600604101556889899501732554337298073561699861101908472096&'
WRITE (23,*) '600708320280569917042590103876928658336557728758684250492690370934262028022399&'
WRITE (23,*) '861803400211320742198642917383679176232826444645756330336556777374808644109969&'
WRITE (23,*) '141827774253417010988435853189339175934511574023847292909015468559163792696196&'
WRITE (23,*) '841000676598399744972047287881831200233383298030567865480871476464512824264478&'
WRITE (23,*) '216644266616732096012564794514827125671326697067367144617795643752391742928503&'
WRITE (23,*) '987022583734069852309190464967260243411270345611114149835783901793499713790913&'
WRITE (23,*) '696706497637127248466613279908254305449295528594932793818341607827091326680865&'
WRITE (23,*) '655921102733746700132583428715240835661522165574998431236278287106649401564670&'
WRITE (23,*) '141943713823863454729606978693335973109537126499416282656463708490580151538205&'
WRITE (23,*) '338326511289504938566468752921135932220265681856418260827538790002407915892646&'
WRITE (23,*) '028490894922299966167437731347776134150965262448332709343898412056926145108857&'
WRITE (23,*) '812249139616912534202918139898683901335795857624435194008943955180554746554000&'
WRITE (23,*) '051766240202825944828833811886381749594284892013520090951007864941868256009273&'
WRITE (23,*) '977667585642598378587497776669563350170748579027248701370264203283965756348010&'
WRITE (23,*) '818356182372177082236423186591595883669487322411726504487268392328453010991677&'
WRITE (23,*) '518376831599821263237123854357312681202445175401852132663740538802901249728180&'
WRITE (23,*) '895021553100673598184430429105288459323064725590442355960551978839325930339572&'
WRITE (23,*) '934663055160430923785677229293537208416693134575284011873746854691620648991164&'
WRITE (23,*) '726909428982971065606801805807843600461866223562874591385185904416250663222249&'
WRITE (23,*) '561448724413813849763797102676020845531824111963927941069619465426480006761727&'
WRITE (23,*) '618115630063644321116224837379105623611358836334550102286170517890440570419577&'
WRITE (23,*) '859833348463317921904494652923021469259756566389965893747728751393377105569802&'
WRITE (23,*) '455757436190501772466214587592374418657530064998056688376964229825501195065837&'
WRITE (23,*) '843125232135309371235243969149662310110328243570065781487677299160941153954063&'
WRITE (23,*) '362752423712935549926713485031578238899567545287915578420483105749330060197958&'
WRITE (23,*) '207739558522807307048950936235550769837881926357141779338750216344391014187576&'
WRITE (23,*) '711938914416277109602859415809719913429313295145924373636456473035037374538503&'
WRITE (23,*) '489286113141638094752301745088784885645741275003353303416138096560043105860548&'
WRITE (23,*) '355773946625033230034341587814634602169235079216111013148948281895391028916816&'
WRITE (23,*) '328709309713184139815427678818067628650978085718262117003140003377301581536334&'
WRITE (23,*) '149093237034703637513354537634521050370995452942055232078817449370937677056009&'
WRITE (23,*) '306353645510913481627378204985657055608784211964039972344556458607689515569686&'
WRITE (23,*) '899384896439195225232309703301037277227710870564912966121061494072782442033414&'
WRITE (23,*) '057441446459968236966118878411656290355117839944070961772567164919790168195234&'
WRITE (23,*) '523807446299877664824873753313018142763910519234685081979001796519907050490865&'
WRITE (23,*) '237442841652776611425351538665162781316090964802801234493372427866930894827913&'
WRITE (23,*) '465443931965254154829494577875758599482099181824522449312077768250830768282335&'
WRITE (23,*) '001597040419199560509705364696473142448453825888112602753909548852639708652339&'
WRITE (23,*) '052941829691802357120545328231809270356491743371932080628731303589640570873779&'
WRITE (23,*) '967845174740515317401384878082881006046388936711640477755985481263907504747295&'
WRITE (23,*) '012609419990373721246201677030517790352952793168766305099837441859803498821239&'
WRITE (23,*) '340919805055103821539827677291373138006715339240126954586376422065097810852907&'
WRITE (23,*) '639079727841301764553247527073788764069366420012194745702358295481365781809867&'
WRITE (23,*) '944020220280822637957006755393575808086318932075864444206644691649334467698180&'
WRITE (23,*) '811716568665213389686173592450920801465312529777966137198695916451869432324246&'
WRITE (23,*) '404401672381978020728394418264502183131483366019384891972317817154372192103946&'
WRITE (23,*) '638473715630226701801343515930442853848941825678870721238520597263859224934763&'
WRITE (23,*) '623122188113706307506918260109689069251417142514218153491532129077723748506635&'
WRITE (23,*) '489170892850760234351768218355008829647410655814882049239533702270536705630750&'
WRITE (23,*) '317499788187009989251020178015601042277836283644323729779929935160925884515772&'
WRITE (23,*) '055232896978333126427671291093993103773425910592303277652667641874842441076564&'
WRITE (23,*) '447767097790392324958416348527735171981064673837142742974468992320406932506062&'
WRITE (23,*) '834468937543016787815320616009057693404906146176607094380110915443261929000745&'
WRITE (23,*) '209895959201159412324102274845482605404361871836330268992858623582145643879695'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3263
WRITE (KWSAVE,"(/' Check Log(2), Log(3), Log(5), Log(7), Log(67), Log(210).')")
M_B = 2
M_A = LOG(M_B)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '0.6931471805599453094172321214581765680755001343602552541206800094933936219696&'
WRITE (23,*) '947156058633269964186875420014810205706857336855202357581305570326707516350759&'
WRITE (23,*) '619307275708283714351903070386238916734711233501153644979552391204751726815749&'
WRITE (23,*) '320651555247341395258829504530070953263666426541042391578149520437404303855008&'
WRITE (23,*) '019441706416715186447128399681717845469570262716310645461502572074024816377733&'
WRITE (23,*) '896385506952606683411372738737229289564935470257626520988596932019650585547647&'
WRITE (23,*) '033067936544325476327449512504060694381471046899465062201677204245245296126879&'
WRITE (23,*) '465461931651746813926725041038025462596568691441928716082938031727143677826548&'
WRITE (23,*) '775664850856740776484514644399404614226031930967354025744460703080960850474866&'
WRITE (23,*) '385231381816767514386674766478908814371419854942315199735488037516586127535291&'
WRITE (23,*) '661000710535582498794147295092931138971559982056543928717000721808576102523688&'
WRITE (23,*) '921324497138932037843935308877482597017155910708823683627589842589185353024363&'
WRITE (23,*) '421436706118923678919237231467232172053401649256872747782344535347648114941864&'
WRITE (23,*) '238677677440606956265737960086707625719918473402265146283790488306203306114463&'
WRITE (23,*) '007371948900274364396500258093651944304119115060809487930678651588709006052034&'
WRITE (23,*) '684297361938412896525565396860221941229242075743217574890977067526871158170511&'
WRITE (23,*) '370091589426654785959648906530584602586683829400228330053820740056770530467870&'
WRITE (23,*) '018416240441883323279838634900156312188956065055315127219939833203075140842609&'
WRITE (23,*) '147900126516824344389357247278820548627155274187724300248979454019618723398086&'
WRITE (23,*) '083166481149093066751933931289043164137068139777649817697486890388778999129650&'
WRITE (23,*) '361927071088926410523092478391737350122984242049956893599220660220465494151061&'
WRITE (23,*) '391878857442455775102068370308666194808964121868077902081815885800016881159730&'
WRITE (23,*) '561866761991873952007667192145922367206025395954365416553112951759899400560003&'
WRITE (23,*) '665135675690512459268257439464831683326249018038242408242314523061409638057007&'
WRITE (23,*) '025513877026817851630690255137032340538021450190153740295099422629957796474271&'
WRITE (23,*) '381573638017298739407042421799722669629799393127069357472404933865308797587216&'
WRITE (23,*) '996451294464918837711567016785988049818388967841349383140140731664727653276359&'
WRITE (23,*) '192335112333893387095132090592721854713289754707978913844454666761927028855334&'
WRITE (23,*) '234298993218037691549733402675467588732367783429161918104301160916952655478597&'
WRITE (23,*) '328917635455567428638774639871019124317542558883012067792102803412068797591430&'
WRITE (23,*) '812833072303008834947057924965910058600123415617574132724659430684354652111350&'
WRITE (23,*) '215443415399553818565227502214245664400062761833032064727257219751529082785684&'
WRITE (23,*) '213207959886389672771195522188190466039570097747065126195052789322960889314056&'
WRITE (23,*) '254334425523920620303439417773579455921259019925591148440242390125542590031295&'
WRITE (23,*) '370519220615064345837878730020354144217857580132364516607099143831450049858966&'
WRITE (23,*) '885772221486528821694181270488607589722032166631283783291567630749872985746389&'
WRITE (23,*) '282693735098407780493950049339987626475507031622161390348452994249172483734061&'
WRITE (23,*) '366226383493681116841670569252147513839306384553718626877973288955588716344297&'
WRITE (23,*) '562447553923663694888778238901749810273565524050518547730619440524232212559024&'
WRITE (23,*) '833082778888890596291197299545744156245124859268311260746797281638090250005655&'
WRITE (23,*) '999146128332543581114048482060640824224792403855764762350311003242597091425011&'
WRITE (23,*) '146155848306700125831821915347207474111940098355732728261442738213970704779562&'
WRITE (23,*) '596705790230338480617134555536855375810657497344479225111965461618278960100685&'
WRITE (23,*) '129653954796586637835224736245460935850360506784143911445231457780335917921127&'
WRITE (23,*) '955705055554514387888188153519485934467246429498640506265184244753956637833734&'
WRITE (23,*) '822075332944813064933603546101017746493267877167198612073968320123596077290246&'
WRITE (23,*) '830459403130563776313240108042028543590269450940307400149339507673160285028697&'
WRITE (23,*) '303187182399843352574354995608502566089783395564211494807339362607510238183314&'
WRITE (23,*) '110047089039501343302974134748405406158775396888381540769801776730369991074924&'
WRITE (23,*) '697847843128430364112892028012272563468391623354787727340063958657179819069358&'
WRITE (23,*) '127387034335313189050383845616444442927969063837969092441303965600987663584627&'
WRITE (23,*) '766076053486974908593811939309251791198855527765356660762439356877194233166642&'
WRITE (23,*) '838200744816307865229235659826586275918747520875091447609016973569357231824249&'
WRITE (23,*) '919475494431631463392270743244590302482544412490359409900711377326310998077723&'
WRITE (23,*) '937579092667787226299567773759125268754691760395501473633737461645076457771598&'
WRITE (23,*) '146610758399303043231349496586482284678495247540297968900151098424340816722641&'
WRITE (23,*) '053465175318895709341462658913980173123676248874585502699619246678052425882378&'
WRITE (23,*) '995907144185753559519019313826275593500184826081076906494067924435885831503526&'
WRITE (23,*) '017045009346714087384727895167845415252267023696905468698446072109821774736606&'
WRITE (23,*) '547523242089063817688335653308345429052023662173681689021810091859270116416256&'
WRITE (23,*) '337109210919193811088408371995494139528087438476593315164645244837143495547071&'
WRITE (23,*) '767478644667777773262400599442803883005052063960254487221940100482456835584914&'
WRITE (23,*) '116372021650148290488954105485988582139146739280127960783765798030190197895831&'
WRITE (23,*) '298445842350551628047138457098367143179598497983384936643051357439778464080283&'
WRITE (23,*) '944996492836177201217529719601115189233475664664487214704005952700208247971196&'
WRITE (23,*) '291259570791322875250242252752285663130430511219493771542940710492247147978154&'
WRITE (23,*) '532985068822892694882234218141773477912289705930385167864412351277321379947051&'
WRITE (23,*) '313086561526091767421412897899794277108410495559054929958460312928956410723379&'
WRITE (23,*) '347221982629602465778859855649153542526276936457817157687505627695951940614769&'
WRITE (23,*) '513362135896621103672390186183449100847056023240885740736498064913350497727229&'
WRITE (23,*) '854121559922564905903204165800777130365484448790985802916806772298738484805391&'
WRITE (23,*) '437126882845158996289290464953606976491322649729017581046490396601249026809144&'
WRITE (23,*) '226696306532240532793180520138990302506701645946145093278991874975058845950892&'
WRITE (23,*) '812313146535841156454786288876711792759444189103227033972699410782620949066939&'
WRITE (23,*) '193233649528840398410534174131030284298298384597274509689153505229806232440923&'
WRITE (23,*) '138110578435654734098675193838607282407897523799065221536828449641519520436143&'
WRITE (23,*) '002340641177671720819470742812470616078679139714257561026877325672566518779398&'
WRITE (23,*) '869543561247252503824110532837942494962425075385985566130187632566463726695281&'
WRITE (23,*) '899182447028336064458337646946313432313914423530118060852644531774177829165319&'
WRITE (23,*) '868877107483800215964071937546885362724120722736141210013984094390772718393471&'
WRITE (23,*) '792022895741896562095677977039547595272233827891909436958956141581883760856034&'
WRITE (23,*) '834063384906401173599284897189611655350881207229167416716902882811061704372980&'
WRITE (23,*) '788755174869275740035755306007315351924334950734050193793931810588767452835236&'
WRITE (23,*) '416527690371651749224459625244061326021533148024272969622677771345064205355151&'
WRITE (23,*) '024831061088767266294511910945817001717135117299890025904644763066359724199051&'
WRITE (23,*) '847024911088680124694191549654441175995933753867861532885105055485957519052829&'
WRITE (23,*) '926745974805776695003496600239248911757605776389825650559728570971462382136461&'
WRITE (23,*) '281575699631424743375953147095068089204461516870319405483113785049768421845778&'
WRITE (23,*) '096360358356776814229804015130588032213887006143666466195154562642826797900580&'
WRITE (23,*) '907023312944256272924492983069495929158131775714230468246948685772631408192667&'
WRITE (23,*) '492977253974375636520310755620276511754740767284532831999750648553715678521340&'
WRITE (23,*) '479205266153502615115035640625189174989835252957607118611897031987583795086582&'
WRITE (23,*) '124471448554809890971322784110436163215054456189256415686480097687527172793631&'
WRITE (23,*) '662356769343050705400960785297576973347816339786503563447596083113058918741088&'
WRITE (23,*) '775476498966140767093540099289679033005197129229294655908813155093792311652676&'
WRITE (23,*) '248200974255320501351088304034115018668628172784448518320999893113810480114847&'
WRITE (23,*) '364338261550474827000102727871555379607626977726233061428597322037017716488013&'
WRITE (23,*) '935906731651593131207225660010057306787815875968237327432664863152551632539069&'
WRITE (23,*) '522055152460415473672664715829719759100176329246755391947924412596855986918431&'
WRITE (23,*) '266716876066114774212493131547577111029905275698849479218285429200771991138110&'
WRITE (23,*) '640201310850296702223726371927432520508605883939945814143535946600955513703685&'
WRITE (23,*) '151439534425132251623274481769284748335160181431483775772910265977050216375513&'
WRITE (23,*) '317616320906962102363852706627337362690153696255073610884241576308151549058618&'
WRITE (23,*) '960450223864851723710305700902066826458514960037828134831228854708597775562195&'
WRITE (23,*) '752286969914671954540310816696269690296896222715552668123003336549928427924612&'
WRITE (23,*) '250395570999614692971694339351544508557516142866963351826393901192551987712707&'
WRITE (23,*) '669409200410842997382985072562990345850433584478193617497687963688481517014603&'
WRITE (23,*) '841493189458567310955889799384166616697431842151088678182747274771922062439778&'
WRITE (23,*) '066084664630977888195315596103595567520455859572036591635522582959536734037782&'
WRITE (23,*) '112409893988073073541836213121088375170380368236163604481832644531771086739357&'
WRITE (23,*) '751041914220906966917822647476248726919802612861083744865233044185807437406799&'
WRITE (23,*) '924659359146430681924558555771836314041797245925837265876930872766629910804504&'
WRITE (23,*) '348591495996962501941052691904827629968903003602357636424254397670564582540996&'
WRITE (23,*) '414041450994670345387743125702655292199608428211070672039110526250561980914926&'
WRITE (23,*) '429443191308362902026158372172207479904166903500594072814160493965365572734122&'
WRITE (23,*) '339332806103370037021008211534192227293534916762079885625851679806479158586942&'
WRITE (23,*) '391146178726357859291357726649656033071530623284906061534893403415083718713352&'
WRITE (23,*) '615870286424651827290435568456552106161725177136625005254799445985467661817786&'
WRITE (23,*) '025877803806030984445445231764300573378558790455136113162544138851136958094835&'
WRITE (23,*) '849584914934421251105356131748993037427322843117221670118781585253525367038010&'
WRITE (23,*) '852035298366282616347129789683306531521000247432193921670599073133403022837905&'
WRITE (23,*) '315374833325886025968671733006730262612955255637933976817300485239406795549141&'
WRITE (23,*) '449465881533293253950529298238146676292254117063142342669344856493368632531418&'
WRITE (23,*) '747139643415905283733805759990776658169381718971757458617472391097384196997646&'
WRITE (23,*) '199589679391854451098059585787249716421848244964174409657751106908793193517216&'
WRITE (23,*) '376221168703906403811218433433897183542006078817356825697886748930465585244588&'
WRITE (23,*) '375921264841779920836375927805215882886594444347071772120467466371740330707609&'
WRITE (23,*) '189137396956143477741839440991803548117653335878130833510705646029925695615913&'
WRITE (23,*) '401856601359655560624421004911821699526092256929050668007880472190104275769399&'
WRITE (23,*) '728857134943322807769849868922798926091978863997413490189574945776099003240778&'
WRITE (23,*) '006385645141861828349003795405822520235575551835106442974343192288203124712092&'
WRITE (23,*) '616672910059842425584688410737461252455480446810934156766289024463281824281667&'
WRITE (23,*) '751184466668387823392709575081432194066411901596540674182811601761878924361886&'
WRITE (23,*) '894263257092445908782154769142255960623010878593423021975662573657944763015485&'
WRITE (23,*) '513301075928450951148704833843039530904701607204487468436180565560131594900674&'
WRITE (23,*) '700028960122816580763957025938567028500857842913017993255346003026897124008215&'
WRITE (23,*) '372023295239510561612930218011086117806018705258023174799663311973159164227394&'
WRITE (23,*) '841457146006097721028175934997957626572830726924318064900431093352977471930292&'
WRITE (23,*) '569559289495918975229282504936734700072201870074852517098129533228990355643489&'
WRITE (23,*) '282628242232057765900906768264520455193008656009268487634941672172576245498392&'
WRITE (23,*) '407482176816497950651016496723435321271361477358100054703859727717522533474044&'
WRITE (23,*) '249181355078831786228920823407840877579510977437116659105850764539512808885418&'
WRITE (23,*) '022379717921945595784992041975424078230570210176927234282010614401413727798996&'
WRITE (23,*) '550879570794358959247496352560292741940328341730785362188088484884799858368585&'
WRITE (23,*) '337653864695945882672064068254838713940288325003451919161457260171375712977479&'
WRITE (23,*) '435196876679368319244207888906419429844415672325841374317637258025122604023769&'
WRITE (23,*) '343179405756465733037696140228131154458232717946132934232405660541738351556403&'
WRITE (23,*) '914350759765683127548780879337234275773964980299053868070184720497233498754739&'
WRITE (23,*) '340050533341342018905605212118300171227373591923255203966692629440419692461864&'
WRITE (23,*) '806559658635288700740509857416169814414722985619578650467769499339468429459869&'
WRITE (23,*) '106118001009042268417154368150887488240992364668208089623232784652772211168408&'
WRITE (23,*) '287961422245525960470524628437332840413975391008488717787008112139990501571208&'
WRITE (23,*) '280239163476825573196776728313491684598803977575948199678642710110156272292748&'
WRITE (23,*) '732594889442671553838722227514802964942565556051884833321343658624931151921363&'
WRITE (23,*) '915359415642413254753582033416070833779730918726398256508185286720245988893164&'
WRITE (23,*) '249212530407153426697072877570175804894613052403378088812972108852604371672274&'
WRITE (23,*) '967332353434642467120451903645790546924095235594038258781454763009236599377894&'
WRITE (23,*) '412438658640316333822515478766272608083042113492131163014656656320074508321431&'
WRITE (23,*) '381965210841370168986972635800970990044851495896303448419575981412854012310025&'
WRITE (23,*) '933759297634281315332791919047911211651153793224396272984317551311793589979853&'
WRITE (23,*) '693269565212094191537325792386496150810656167157629833046992088363312424889758&'
WRITE (23,*) '525953688090251145094432756591875081992544654411784477740288025906346075632310&'
WRITE (23,*) '858426359523457417012715892220587058899637637700201493553990253400623191011562&'
WRITE (23,*) '528723490697031663038643406091912041616889152649702438145299217404069064338640&'
WRITE (23,*) '559104931198053653342195008311499067586544440545526765576180764743373734064815&'
WRITE (23,*) '235781279478780956494237019281071623324416630911647165798208522239041063104215&'
WRITE (23,*) '698032582804964253399466616672746040254355480868315362056923400100423986025698&'
WRITE (23,*) '467250021124138680228087893332985646757172111567270640693544228725331084446397&'
WRITE (23,*) '104974574059697743620202440233273612136610625085166691808445362008089431816852&'
WRITE (23,*) '479359277006042538251416630259933877186540095290348691984922362267860461826523&'
WRITE (23,*) '305506533662724242441599040006264429245027117749751058800901102369308452550080&'
WRITE (23,*) '211544364427280158034662741766977570165341861124949007018306143765679783472419&'
WRITE (23,*) '453887027732527900748672865957868021017973871377362988158466334928962783513688&'
WRITE (23,*) '345611583327020534023438300223066913124184305891183389197339745779270739534707&'
WRITE (23,*) '126617952861559133100593695296878122473471579181576543740246461624335699859076&'
WRITE (23,*) '753805517136646893108143543774283925562105977372172810726742898104273804152580&'
WRITE (23,*) '081773133784859429235960604583596487232303931417919480615333084075258421225607&'
WRITE (23,*) '767479765644924882294350828226147663841867094048278801509469765315263015187266&'
WRITE (23,*) '437879038301847531225325420919317880966099568182573525240553808977936943311802&'
WRITE (23,*) '588814056976010202324216404096374046464376918304630891475066889343894084702565&'
WRITE (23,*) '935263806825509811469960411623414634018408838321947545604618104422960857833092&'
WRITE (23,*) '306851490272393723761954136292093920175118228051530692405081825542630944007267&'
WRITE (23,*) '416954698029023078900860453460826581214148446478797525613747654053978734198146&'
WRITE (23,*) '860216965561755497250023505993275248957407954232317530750092603476619972768070&'
WRITE (23,*) '032047533370473467328439804039405716913529858762866701036116715506898942833637&'
WRITE (23,*) '141140418216923040188689178737550545168916737470686006980000282449782273663432&'
WRITE (23,*) '552805797701120201107883715162750513241064466983899916686377154539622990883951&'
WRITE (23,*) '271522926030593920003955823121075102290068158630782863974779164036905708369743&'
WRITE (23,*) '129569566940164985010306936406846624101034391769743705076068231298226004325971&'
WRITE (23,*) '317084295352276808221024703939416253606037544035026060229112082081025023581821&'
WRITE (23,*) '129987736015934782065781276743622627826835724196830736602751972162951889534395&'
WRITE (23,*) '917126744281802593685272867478484936755156101581954743960006449859992186273618&'
WRITE (23,*) '785817726127631336301327815132881873412871642373064699995041163514096205237165&'
WRITE (23,*) '911935270250308690354160085082691930707276856721456533228130168939431818566797&'
WRITE (23,*) '033938345851290322041618163125740038906357505769659102091267340545301143049444&'
WRITE (23,*) '614104858846561912054552111606392843100583387285194766872975902790920278412314&'
WRITE (23,*) '457252155664691604989082199110139757624706042071130634370008155159995551253456&'
WRITE (23,*) '920247658332824051856025433417188975510224802014995161645411507938197123181463&'
WRITE (23,*) '963702452885601353041672957625871641247056324166759160152642145622488747003540&'
WRITE (23,*) '092591100005865867318249233360718312357637050214018122389271887844122136288575&'
WRITE (23,*) '168652193703146873591117127044078390618531174915462959689817446390557606621449&'
WRITE (23,*) '420329170926217376784883044883211654785912424632159264242645517191882136591919&'
WRITE (23,*) '900377208242856696453471768051000099749458163392820899417845951685120001619506&'
WRITE (23,*) '777574719957593746204451088185986562215766412598200226570198460052565084324939&'
WRITE (23,*) '180046663499825296554670789247803018398097474759584883543366554421452824192750&'
WRITE (23,*) '124080998884672818618586164065627792571353909525264631905379913198376247313068&'
WRITE (23,*) '947524083131834089163840272767273267098315937965928168271143427380826180019787&'
WRITE (23,*) '884600049552677941945098336467275015242943702968036743337553496485766934520879&'
WRITE (23,*) '771145765334677566709638315282133033209889522508981407459378944577345158259447&'
WRITE (23,*) '515688368522256284007761327503621781030812333068818583391347164473216749381088&'
WRITE (23,*) '666691597844715443529110164548463574609091489248612816466537904545591507913147&'
WRITE (23,*) '761892139930495393239749330876048423130834623902651461567414703580782553246566&'
WRITE (23,*) '486434874911307854563828698991865076045255838092772245367152839530633413563356&'
WRITE (23,*) '542310979716459960960007619351564079754200264687866504315750108385392281759274&'
WRITE (23,*) '900929804050787604887604628973293899407529218395937228165492494944500019534700&'
WRITE (23,*) '761278803198692038093973991194107767525346926500939428975102843414749825151872&'
WRITE (23,*) '946421918487665158967372771274297341998019946019438696838255263005087356912247&'
WRITE (23,*) '641192393079988022858184940197806297464094954612478287966829561928690339627912&'
WRITE (23,*) '574967886785655042109319397366941380547810583011047010435230462764167893031910&'
WRITE (23,*) '207359846336243287303993154709590172820488710333204481925112905655964161311788&'
WRITE (23,*) '378634299697909994274941351385737158433151895234591262273735109075028134152218&'
WRITE (23,*) '302688728907775366751152294121468330309518152884439224524998553016047205803522&'
WRITE (23,*) '460998929568993257235646487973064080220024856707292221773724911976210468641629&'
WRITE (23,*) '521543244142051646155484468613792478959226650854773002664364187074726857942282&'
WRITE (23,*) '935751850073370936752589886275958415717755784139040719310806922047312226677190&'
WRITE (23,*) '620165318855393019570054661874711652912138755169988027430015934323446098000676&'
WRITE (23,*) '400623843311760284184391128104303937479510931875446903800771950686147901864503&'
WRITE (23,*) '363056387831731184990877565044863458724625931590482674513307154046623042446124&'
WRITE (23,*) '272439904600215209964195068037794626189992065951873798058407264947939827589080&'
WRITE (23,*) '610898665326393664941582799186756935414618363260233108770326987139698120407653&'
WRITE (23,*) '859957379413882787345639285609402277258216672336686576695886036246235122928615&'
WRITE (23,*) '412051509045380792266925458691896396232072034476855179352351288772388243509337&'
WRITE (23,*) '000754944664093389634034755051661406302699453047835611035199340946104642461025&'
WRITE (23,*) '824111820379394639578957121668490888559732460031177437969435909771616396216117&'
WRITE (23,*) '755188044260634338239018031526955238118867765850725491463280737814169323131469&'
WRITE (23,*) '109444413937664846470379004840831805788393454869589311180786268676096704068766&'
WRITE (23,*) '305023415418310566608471857543757426265983635139073767185709006978698842294398&'
WRITE (23,*) '120281764925956354017847038834654121912245309961274037942967060213091432022068&'
WRITE (23,*) '614361477897473674427567693258339857090020844536950201722460980736775091201696&'
WRITE (23,*) '482074144206900588581719036435890430564406003653468590067233453880358720372724&'
WRITE (23,*) '097476778174618964820860428368910069677322537717172160299780147208048636577509&'
WRITE (23,*) '665348544549598262014635961572716389345014441492589540835574327007328970026796&'
WRITE (23,*) '851865802043388098019472204460535896808575027859112962945895986707529487554872&'
WRITE (23,*) '235838935015908422997545797018527177956789446793534815737471015864869972913691&'
WRITE (23,*) '572090259416475756389132512233708259586838313298999281228892760606078478127710&'
WRITE (23,*) '891145352839610116212636161688431253109210709186283497912255076635165999593169&'
WRITE (23,*) '704977711977406971288722245125223223809106822929666346914169055128202110715779&'
WRITE (23,*) '569167560822156369398784196518905798504343303702754344619686372330942805815233&'
WRITE (23,*) '930222808443506855274130809379037598213658647503762684939516823532922411168920&'
WRITE (23,*) '434261864850031034553080867963692228656723068230485076186919914410898023337277&'
WRITE (23,*) '956720903640144511111030957406334462771411114006130763032289021515791529050163&'
WRITE (23,*) '165573831884562233671273602181606394491261104358122549777977198552819948058457&'
WRITE (23,*) '838182549975440860697587927338329384262981250614639994817940997240072869868911&'
WRITE (23,*) '959391225257870072184440647375024269589787634968994668737325254644539065775853&'
WRITE (23,*) '861158772880656847118345375383620387665431658137988905944684874821918506088949&'
WRITE (23,*) '374057984196397697758541669020632215525498569993267223022378991719308474629769&'
WRITE (23,*) '012506235521362020143037786353965565176471344675829919255719245594297291688229'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3264
M_B = 210
M_A = LOG(M_B)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '5.3471075307174686805185894350500696418856767760333836162274123845426467656480&'
WRITE (23,*) '307148972714584912019141229995073140952552875012819486911134208680473350299598&'
WRITE (23,*) '759938944456132108314054329426790615328446410493306148410216100155673570446624&'
WRITE (23,*) '949689221931990308910554350186810265492926596135273618307471108831156136086824&'
WRITE (23,*) '797160007936597929410664834955387113963548474566930592007540118798913177786496&'
WRITE (23,*) '039125662746398050678220767788319996787197487073826205036235318427814765931139&'
WRITE (23,*) '394039619044397484568889920939594262377936851857423397335114669801462283244000&'
WRITE (23,*) '999701031510390640962586127325978728993498571548644260069976648382677928238460&'
WRITE (23,*) '597615336857746767338199962152387599684256535649397273530686830180968014792871&'
WRITE (23,*) '160963214619660048655871515771203314220510574017864638506138136542303951557722&'
WRITE (23,*) '442053924608246827279527147948373343589666596845406316375070544200835901425341&'
WRITE (23,*) '818395215561263134034238011854448395881597825460836617286096885955472042012596&'
WRITE (23,*) '578754994469834231372042944798072269779458383701266766499447583432069287529536&'
WRITE (23,*) '200179476602214146557020795648663925301213053812155645778710900479618814635873&'
WRITE (23,*) '532415926861487009547019528647166990952348298302817197606437657199880674077442&'
WRITE (23,*) '748057372110622123520003548264232662981836861917767878186268042092381481836467&'
WRITE (23,*) '015219159911947960525971523552501924273459347635291675881814675826887462005049&'
WRITE (23,*) '215110588283277414905978580998920255838396918365249686677831400945045156644611&'
WRITE (23,*) '012523381205698982967361671687439618977738794618623117790432027547181861593343&'
WRITE (23,*) '703427920040602516417396420897466037015963210871104639487638335054071018054778&'
WRITE (23,*) '395523198071002205188341979522601480197498465626485154911718405192883150463134&'
WRITE (23,*) '571514989709113309383668666923415532191782849487251137577532187837982454362930&'
WRITE (23,*) '773061003836201513743527353666896553054915378957691183941568067093354386969933&'
WRITE (23,*) '886578087140250587369691295113596563996385728714102034325502854729338097343876&'
WRITE (23,*) '616032468021337031266889530945519605890835789845713114488851026388110271769915&'
WRITE (23,*) '937235697176957909346060593961592980745311171679725241332250406390314829648117&'
WRITE (23,*) '230862099453767017019288615819478422880023635732478780658425644657083843495524&'
WRITE (23,*) '955461790866497992906123454606231050915288062405943399509867556556156972959752&'
WRITE (23,*) '640903861385324659163690746330953844623495200040837712910105810185029265853697&'
WRITE (23,*) '746071719059065916112009063724841892129959997070586842054466054651060330744121&'
WRITE (23,*) '003161470188482389833398656569249045562692828777681021404118550759758672192094&'
WRITE (23,*) '746174547151516733011604431958177196186317929405269060073655003779188927042962&'
WRITE (23,*) '253639026708675849584393894975796070242872367005948646169894801759937995234448&'
WRITE (23,*) '329819906556077590789193675238840423827318414289301567410277401371097668148077&'
WRITE (23,*) '179697399222153343370825959635286344021677768301991714701702295775368625903461&'
WRITE (23,*) '621640486463586461910481002512527870092431408414069791711502440248478885405088&'
WRITE (23,*) '875749151455833825387934831137699459084137814357069498886215276518451739796797&'
WRITE (23,*) '598844392305356054490857085863861001281660463321400234300413271461046325347593&'
WRITE (23,*) '540207090238020861728281537872408747807263236337275484667859467576407646598431&'
WRITE (23,*) '829535294895087132663643727262384641975253107897443246652212909079817525378944&'
WRITE (23,*) '584838347654841204033180901289124696459989118696243768873790880319943708034610&'
WRITE (23,*) '927429043348886621326308254588534718864319597446244937841292890814716339291639&'
WRITE (23,*) '423746823222946980030162436866968411149283536312941485809555753678817961966876&'
WRITE (23,*) '133467715143887024611084476919490066272716737951260302253108012697641025812874&'
WRITE (23,*) '605963792185864066110230785091287623030139326601051985600532572974724718695990&'
WRITE (23,*) '067229379524689075686982728789117415434365154435526709044237664942880946163818&'
WRITE (23,*) '471845838613734809548056029563259155392731493035057935345243005548993550227077&'
WRITE (23,*) '706488272873024409739310548595366789487180551603134067586921964806184562916142&'
WRITE (23,*) '769252121705389588544566597431524876834585743201249656197268352195574225397362&'
WRITE (23,*) '913176864091967885982209381149386358140324626505253250754423632696076747286033&'
WRITE (23,*) '115380724368929907879953447635625108362067582708236114838282729891705563121030&'
WRITE (23,*) '815064349930475064539622444200557943709122494717645402312387894707931482893514&'
WRITE (23,*) '639371918991450294428555573783858067831990037501460488077694764369574172639754&'
WRITE (23,*) '472828989086763319559557308256991783063916662357770468880360075729827341453023&'
WRITE (23,*) '080331477621556842396451757764323647319852364567451024275006049958439502679798&'
WRITE (23,*) '312244893612762134296774818666825912204779627269838252581157947346034227797642&'
WRITE (23,*) '215240647229214741727605013072966809935412883940765705740320917840695187947676&'
WRITE (23,*) '951839938794125960946869435869913034458776841094979797477940400548931421205974&'
WRITE (23,*) '492887085893288387357630820894269195370093156017368672357311794137876453577617&'
WRITE (23,*) '616102935897543807348825758399277502137921392988675807232767944040186497186948&'
WRITE (23,*) '736625959486156896402349297847280508173410549304611760249005013052357132622113&'
WRITE (23,*) '130277324125294187344369193452451206955279256138476798869270578791334957460122&'
WRITE (23,*) '789826854004312315802202783912395656486696662394611166584652247442384399265085&'
WRITE (23,*) '724242010186654849732716352809509893199369472000851492041342603571926908916109&'
WRITE (23,*) '420812443847963976046009800277325233633119871311735720385266840774645103160391&'
WRITE (23,*) '428057912373652963499816267517217343098823201310685722371166550284893692966294&'
WRITE (23,*) '355337785233923799089805925077003021951063983805636329418340104204982434241324&'
WRITE (23,*) '004194810773456395608540502314877333467473081302185683716540544871526171742831&'
WRITE (23,*) '910219742395362804171402667165598633864576760699860470224528810221735876138415&'
WRITE (23,*) '280126947205465367777166629326253211337381133881806027527429096443520505812608&'
WRITE (23,*) '118159933629941445845319588234880091892479558419072458655844389920414240496699&'
WRITE (23,*) '496480478946167255226957997545460718529382214825336734033937643298078198859627&'
WRITE (23,*) '233288596280916012270332757946801214432836830170877773518549024303389448239832&'
WRITE (23,*) '435308768458448796471069090866032118494771656273096374807162878803395715244516&'
WRITE (23,*) '003912474658278933053729457611486916400369754655069750912170229271733600135742&'
WRITE (23,*) '979896710865641509792060783332724128673874679462009763415077252312784149315895&'
WRITE (23,*) '165606598773945587310999797347245745019917679549340140492975832185933614791257&'
WRITE (23,*) '320353071232331196208708762878647897907936171544480609889348913735295160055605&'
WRITE (23,*) '094314204929873277883725221720484614501824136338539685836756501983727492484453&'
WRITE (23,*) '369182604480644806618751997560139873084895437288376251418538326773299303395890&'
WRITE (23,*) '750060639322764533079457987193321813346115833929500669914979066909499822288982&'
WRITE (23,*) '122838421024139624528464466135041784918985811594084678846367874384614146808510&'
WRITE (23,*) '372267696348577714408616375408448559656747241171950005303137480413896506524746&'
WRITE (23,*) '137379213578027065437577099142354247482931746805184124833841617397991065109627&'
WRITE (23,*) '731162526205485885378335140728662572414027927994537877462702867518528466495870&'
WRITE (23,*) '719754447641672101228030152997797221808723913013353821710885709767955624926747&'
WRITE (23,*) '761891948248675666889441375453840432183113795045840781907605792619152724519135&'
WRITE (23,*) '283787512404246897562210442854577397150488385458451388994731519116194915545485&'
WRITE (23,*) '488587120074467009915947625709965694189747636857842288148602154137229217476765&'
WRITE (23,*) '768170147831549524370170205098640339242013886322013725401724369019644591686403&'
WRITE (23,*) '929650536353272072833146093383380368973853333991010043029304461280886816785572&'
WRITE (23,*) '909352923815353073854071980948189689124787013909847625370627206846777186620261&'
WRITE (23,*) '407340546636502405034779637755851747198619190961218341869458298941846177887862&'
WRITE (23,*) '988867264539538152764060622930302524085303515515044909802144272168096212263925&'
WRITE (23,*) '249159526699494976654265594601729566394081179652281572240869454246104075378661&'
WRITE (23,*) '088953392714084658072452859815204748734601712264172071415904555186384640815047&'
WRITE (23,*) '875081943013083985542398605586141559020470983584689762287058142094069547175134&'
WRITE (23,*) '375026501044801978118638546237017371850324399265400849395117948704023980591639&'
WRITE (23,*) '837410114958871175452468895660872687020943025694723018986588855770819797081383&'
WRITE (23,*) '748924786240887974820156177649432235554529508140430366051118026996680303559548&'
WRITE (23,*) '546978300522161411588370025735020672749969375531580461004442074754291832724247&'
WRITE (23,*) '510359915825235330151719430758253393394700573472704260684506291220460824767241&'
WRITE (23,*) '578874856066065914223618828040994336333356157217995177601768960184550715264533&'
WRITE (23,*) '214513706936987653666002954279758220637367885553080533665943524031234106894287&'
WRITE (23,*) '566898332561283422644339890047615402750076427135922226915098612006760050288842&'
WRITE (23,*) '579874043710081395838392841161843368811204870945490617092282518248113493603923&'
WRITE (23,*) '180754156168653911304199464960664305467487522301602402601911862682082013951949&'
WRITE (23,*) '533853023564936407161906796050432481184073888509397950096071551141411068352268&'
WRITE (23,*) '116618577707422173670205473995257503098025884540930868066626473128666306685966&'
WRITE (23,*) '898613615669614752442186563275034992200059373800611316082008798883377493596799&'
WRITE (23,*) '932246951830600559710602624445172678221728200261964958853748262926900354453060&'
WRITE (23,*) '483397137769265604978636876957756380090650869601710387318938730026017082804258&'
WRITE (23,*) '418539482698373357004614087954113269680713075307719229669006257777552692742220&'
WRITE (23,*) '663443869979995668291921621461821955112717126834162255366562991820409810421159&'
WRITE (23,*) '991227445394346466334328097508301579886736139460038182218501983464812393314737&'
WRITE (23,*) '280097185248201510578530880158660764991069110835500715374961731912219410605175&'
WRITE (23,*) '035305902864684278899782809779596634672613106373540856087074548428881288511720&'
WRITE (23,*) '921616675345894930062163695687633704577597378431689125876055897319072607015644&'
WRITE (23,*) '252974994511948910815393087240716567828049093613658133003820904927362700629154&'
WRITE (23,*) '851372641591703653177743044764713301191499173986857474679367292220938748307417&'
WRITE (23,*) '266135407198156240919435873179220363805132665076573859650213136608631752792115&'
WRITE (23,*) '974261193902478868055002155312959709759625071731569242417847099469416112649732&'
WRITE (23,*) '782237897499104831662268338897529194931257167034362412949053115187376299798773&'
WRITE (23,*) '123312274739753184181713606011451610825028740106546531862933315578884178397209&'
WRITE (23,*) '344797854065696254193880320250830393820828143598514410161542301956339869411758&'
WRITE (23,*) '025834059235471060512198683763249245229776138508607797653425532873165976792168&'
WRITE (23,*) '665571624433425287169354033054251149972297393946955971599274774305704909186439&'
WRITE (23,*) '330756401271815676535330709307295162882090989307779427430277628434343572029380&'
WRITE (23,*) '096517768213149694713584735787715656227878605945719328798277358331607262543193&'
WRITE (23,*) '883584009833226682482118129988539716829631262778352852373760814858023241898269&'
WRITE (23,*) '911415193978655330829848731862844199770510729615449684962375224976283380754728&'
WRITE (23,*) '042973511506428524300445675964134185293699369015188238624721907300818584227374&'
WRITE (23,*) '777088125253455589231202401885928832455397604937681186281072457908235704490463&'
WRITE (23,*) '755259518688352472597470108144709968883396036692410095507875206820222317448689&'
WRITE (23,*) '394119768719462085851793086568425291989991433699161597810498514363701248938252&'
WRITE (23,*) '391796802960373831897728074075335554434059383459478690556840615216334519921328&'
WRITE (23,*) '847462782201938825235040503553403271587650342030084774675990571109712136804600&'
WRITE (23,*) '490048389193729648347889389315283528202685476139102773481485110936805030668536&'
WRITE (23,*) '195177735989051209162223631220052129679335721725535815566360618539165745869711&'
WRITE (23,*) '704886099695131188293219682923965483061092237415228418659905906219227592065892&'
WRITE (23,*) '992452573446424266010864096253326630676245374788209316366963279982025006846157&'
WRITE (23,*) '618930025044614098534267122518124707888224799530597844556640334554434294553269&'
WRITE (23,*) '952127551033916434417740200227758903175610758794397929245339252987141176652898&'
WRITE (23,*) '817384620704082863976888695111277689749761401839864444411455805360400541333158&'
WRITE (23,*) '941733140420613198842024981149360771661214236145092499352959832883333395731868&'
WRITE (23,*) '669245571175828281142671073797751968542650533059210781271523793377425653363204&'
WRITE (23,*) '905981733176763296263962691600680926815728131164864762036845106509989441971241&'
WRITE (23,*) '779457332665051137213150877648081898044435203694071889951113481017998239039440&'
WRITE (23,*) '286738543343289754968046651033380616040155678033091579635301104515953792336577&'
WRITE (23,*) '822964030943587254157277614805834355996803749603968952832118792967700889870693&'
WRITE (23,*) '018661862258240319610180478264792375118287973207818376914806329813521323680744&'
WRITE (23,*) '416856152251387784739573493643444537103045001592388295484453557990955686977775&'
WRITE (23,*) '710556964521851917070756551228876797823796292341177153452664031084369693854260&'
WRITE (23,*) '499640662081834940714346344266809738560530256797756478103247520051612537292985&'
WRITE (23,*) '259608693987743916025731539510088033116561507894488895128945775979456919579952&'
WRITE (23,*) '378869811272689265743763052899065498427879170577895892579920468496464019380100&'
WRITE (23,*) '870018533226751157307574831252117281607432732008955420266435797483527996569375&'
WRITE (23,*) '007930899835501809829035459490068201562612284926590873334005390007391493066247&'
WRITE (23,*) '848948382170596039441601236103271986908121164118465972829687017550833344102043&'
WRITE (23,*) '546144647329334245524384998288665082763573680050303765936242131063242207105532&'
WRITE (23,*) '043872874228480164947773560598713537642130363854648270717923123560136316829250&'
WRITE (23,*) '826620963840675088863262369691723291923461560733314301771688685523444598439963&'
WRITE (23,*) '627308744997649888559184611023374100227245908337127778431849033892938356317292&'
WRITE (23,*) '991623987117253261487225980139146922594974353540551522144569828658274214785395&'
WRITE (23,*) '625944373184350824969334837658616869130707069402373370141529810786756690803236&'
WRITE (23,*) '836405497316895937628979977465771229083180944417211542632360649641006410644685&'
WRITE (23,*) '316614568719485321640427770901423967181422838804532864088585216249450964722172&'
WRITE (23,*) '972828680848126959353580400461745101013216684661966504128323716897350424535496&'
WRITE (23,*) '934790749561896596840521950232058932133428598317677483113143581048593147761446&'
WRITE (23,*) '149949068811789158186472909589212170397912070820662362779681164178406666371219&'
WRITE (23,*) '267728091141817774129897654527928548833077805443268935271440089114880349761855&'
WRITE (23,*) '344546350300223272036153047033775362433283270726576658437986609696961218729797&'
WRITE (23,*) '661359738925217842893083452417618564146881018156290873235910882124964944262657&'
WRITE (23,*) '880504037515993707248524946179392725390677697330150886525253015648129541087975&'
WRITE (23,*) '637050436929188714887047112174338199131092487160612810221726545710547786548809&'
WRITE (23,*) '962091566933945463585198619355062220101415144013564330532689782380256144365732&'
WRITE (23,*) '542596249242989787645692230895696602698048107257433539731593199260195582308662&'
WRITE (23,*) '168711805024694012176363411592802095640924796576282591633168518210460788993464&'
WRITE (23,*) '986619085241088132861520209149380840356661205155888825493271126326641617266593&'
WRITE (23,*) '227171525629830252089394647242335316083877024621014676322447434429721309759102&'
WRITE (23,*) '655403863800038690464794467763990283227896767573449531079554152158402533987760&'
WRITE (23,*) '251698945342056604657422447437106976889327630844386693725090350845657032979292&'
WRITE (23,*) '752766537509082585440366832527891386580178015257183898564970128491297222854891&'
WRITE (23,*) '240037322759437108002377561658278728372357394790903608815708280093766914100141&'
WRITE (23,*) '002966863283815874803145083394817833041840778180876000142283337695728912751839&'
WRITE (23,*) '442940732055606221572066659099561979816586076708392331112734321710563038064958&'
WRITE (23,*) '005116246574857201376153524093387680806478583679300528971980699911741287605953&'
WRITE (23,*) '586470409072882776356204822328609652193626414073064510894462672614932722760777&'
WRITE (23,*) '026282940971996547002981021066598540204657328890627323543486231798263301056279&'
WRITE (23,*) '760442020972201453593211921881552072457634111027443671290307386065386485310478&'
WRITE (23,*) '454272621574562273671112317781694901946451701347432652533982585429347879354032&'
WRITE (23,*) '463295310439579931360566137726876710718118338252331369932772474471610416540169&'
WRITE (23,*) '310964440986229165100924217852698831497086244996049353293820900598735378488439&'
WRITE (23,*) '899783384488524590197592144011233172477294339689209038988429342344600707778602&'
WRITE (23,*) '556437178763267172298820986593990064979660833084303671939010013639628059346739&'
WRITE (23,*) '272978465227561504883291553386258385251111386974501172319971778784306412718304&'
WRITE (23,*) '230787346600468505744036205267034477875661284618566981602429835530190062657617&'
WRITE (23,*) '893775108955979920599340771432750175834353343936569251820817515538688752281365&'
WRITE (23,*) '929818449311278473996565728782979536668069936342493572289772739010342601447410&'
WRITE (23,*) '605869881100394943664149115737611732735493252485004222156935646767555446037179&'
WRITE (23,*) '373991908144049565022397821137104979124265281823939797233480023155812714387433&'
WRITE (23,*) '437826939263033542364579238984243702882095160974720858902610398165043527382504&'
WRITE (23,*) '889251011580419326408433569515330479577868933934530839955319715487156792902032&'
WRITE (23,*) '727827293149986284232674408471423750899345879196065208641381382844625962376385&'
WRITE (23,*) '752143462156157933657823317104764641146293741217233188594728419208034732224497&'
WRITE (23,*) '421993053241476528704532337549446666452608229114250349795533318220065785532565&'
WRITE (23,*) '256527694171526134604625068839690254357377790395941005907854134711688101522738&'
WRITE (23,*) '824636866811997748590427397824271548717154830014098962052712394958829156006583&'
WRITE (23,*) '462520806675055782430003138113384918248006727452776587345042318343856595893072&'
WRITE (23,*) '069732562143987525123320073483890058300447227493789494870095933185921225857327&'
WRITE (23,*) '329675766745181903032127636682834450068051515366316500965308100641724033466058&'
WRITE (23,*) '290389805801169265583310713452332139384444892498129915904293606000533408095266&'
WRITE (23,*) '190866754656748758304161948165291305731945889512811333432111222074799417935739&'
WRITE (23,*) '385488851464679484022730964201951991916116117060390689313842367462001811911616&'
WRITE (23,*) '266446311007005740477803600615401560172008362974723299908843769559420604893084&'
WRITE (23,*) '994925745245151086996742503864116092149332171508890993418165134672954779047797&'
WRITE (23,*) '312441835554323643510641920417446706909852629948519064412047591663508776731974&'
WRITE (23,*) '841960820068143355313950000464087561985935467236159204729106634348951401306411&'
WRITE (23,*) '089639167320204271128561425637063556038660641315435901618367367232688368339120&'
WRITE (23,*) '518979184004091948436755520893788815074949141183940417728248767438565621858793&'
WRITE (23,*) '398967999203848819703258362622996432591662033512544045458219769464179291113592&'
WRITE (23,*) '233963572704006491972837292830811303038219241655995992840619905791953065930198&'
WRITE (23,*) '451432967153004897346036504514287830579831178703604189297190847901533849240206&'
WRITE (23,*) '963009865645286581025787798620710513271123106992710378105963507136174698568760&'
WRITE (23,*) '973095891316223328936134460762974086677137325108258817452822752959631891360763&'
WRITE (23,*) '246161226023600250511930952768192570938782215656186128652581923410875888342754&'
WRITE (23,*) '710787070572506881728569362203429885569546346205841130036268366950812015033445&'
WRITE (23,*) '356351181283027018159686895537196513488681945474782349756022398257454205963940&'
WRITE (23,*) '527474063473790142381127638304278935320097767944530803011089968810039642343052&'
WRITE (23,*) '117425689710418362522924368173065514474149452408427483475999015701613747782368&'
WRITE (23,*) '150717588234938107837386424084208834296717080460171683052915949036453805021703&'
WRITE (23,*) '586228221029608660518435161829099356452114209094758222582018707150214340986405&'
WRITE (23,*) '858346559110073384159778185760749582013683181941295674200970942279694869022001&'
WRITE (23,*) '275694331775471988873122804511185850830227961156564689940870796949270643149699&'
WRITE (23,*) '171697198601818650704484660941765509857244159116494814297934660663655903570001&'
WRITE (23,*) '473536588224825420044431337073377316980182026586711997977693529928500110947512&'
WRITE (23,*) '272836905460247329893300239961308146089678150875160100412500245088878992293740&'
WRITE (23,*) '444970692001831597638971355011297964793210525497580049428539268735436748722946&'
WRITE (23,*) '232919867573432336642260524646785559467499011795630083127619155801355350643281&'
WRITE (23,*) '383859696657316664413867041068332782978349335949092903300396465972009560462447&'
WRITE (23,*) '577084913603971969239039566092185332474414254262710219526866175932012971323430&'
WRITE (23,*) '701728455783859958561320705548991783415580299275905668753080447029777360449834&'
WRITE (23,*) '557406396431951800958254601216174172705834270080087363780398539366668172639010&'
WRITE (23,*) '202020347623612313245147784131540867852595201591460672397586315372949687271187&'
WRITE (23,*) '947754733553550159351414923623879996199188352943468600106083884243935493314231&'
WRITE (23,*) '458726966711561545813899843821512290729631910827515148964377351753976503811947&'
WRITE (23,*) '968532680285836415796266159001114140366861978684916756741292793405832407111118&'
WRITE (23,*) '958892472333799798985431451305105565223117195824793293716762028501652339484686&'
WRITE (23,*) '176795741054180069311231602138548195118956816979287997166964118093697652549868&'
WRITE (23,*) '915794062144110030599836468390535327611765574867690892273387735272328724762982&'
WRITE (23,*) '195584290831726601694582880754550161280931351833110137764688196157795934574776&'
WRITE (23,*) '472670519547735341825563448251799197878267887758206272824961259882012661112299&'
WRITE (23,*) '409707312396884014289059163918229496098018109493398793061867969428125510987880&'
WRITE (23,*) '430246379388793226040760522544153773667465348798096174626917130731544240269091&'
WRITE (23,*) '763961212807453710657187058929920708608282076619428670173097313859268419535696&'
WRITE (23,*) '160227171558128186070158143138245013185510360438488072510453261852981762917577&'
WRITE (23,*) '852958849243105504939842781266735657083637868562868788223735589132576522987025'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3265
M_B = 67
M_A = LOG(M_B)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '4.2046926193909660596700719963637227505669329032218953371377841307752685055280&'
WRITE (23,*) '868966389141878210254845339621912646600141969872064833275363688318077549180423&'
WRITE (23,*) '833135353639633338607736598023369194616957994910670921835088374205631569702104&'
WRITE (23,*) '358914331157007226886464474373656176214845992009851946284677305918702829202891&'
WRITE (23,*) '587981463071481407004769056385986018759955189605803163735275369520247911693958&'
WRITE (23,*) '420203399565906858637138827152686132122287278775933821406297965541145433104617&'
WRITE (23,*) '816637659618924286357945221874082953891331077189072883147228053928626243068463&'
WRITE (23,*) '751150700981375033085587433224001356505707472275148023338666373339507366848258&'
WRITE (23,*) '942635919412049541570833988069380683758495676003588550866448101409393872237756&'
WRITE (23,*) '089931953775200664653415303256465584526040470958356690747210035981372337060744&'
WRITE (23,*) '765060569578645670044475769213965913580599108582213924911903825908479988561460&'
WRITE (23,*) '973058364674291254263018791247383461565120982798207553025489908566503658436736&'
WRITE (23,*) '396751446252376955968623813035107349889603760884216395464490736003143092644676&'
WRITE (23,*) '508050014056094108868521651310062230845534400430063486018564715503508834293386&'
WRITE (23,*) '362013094386762027495938006197919206284878972702931666365420670775692022491671&'
WRITE (23,*) '354687712217490877192095178492037569374977448697369349259912277046532873487142&'
WRITE (23,*) '765496327501889220539490973199663499102902888726654831174204656205959944299574&'
WRITE (23,*) '171742270091615739874596960764041766945296737563273546638983139703386801428369&'
WRITE (23,*) '920013632454996068708249633308257998211143077845865065481727146846850960573604&'
WRITE (23,*) '554019429985301561544559666204320929699260091316148043288810448211605079668853&'
WRITE (23,*) '657736701700412997795450185346026506336936271030893204403113117318102498733604&'
WRITE (23,*) '358844232314097626277683553367776737085732243645370035952309106168921184374302&'
WRITE (23,*) '597063069279988452303053016746125222605275135852719318203101601939568855145004&'
WRITE (23,*) '278216920238047489236326963620374836725833728006770703568480039515111973487716&'
WRITE (23,*) '721805652875486777176279272443044649089656022613115920052228710004852331000732&'
WRITE (23,*) '808537871951817585283392307171403785937309572441187692671508006296885419017599&'
WRITE (23,*) '246279993035162587430078420893839214055664268663052218146045125362370494812544&'
WRITE (23,*) '882100366940859088035352318798237185435723811165815170417436643309474388746781&'
WRITE (23,*) '967113478959958118543159329105759896621380327297195736943783011683594508978931&'
WRITE (23,*) '904152848776521219871774981152666371051810476619911346958584554695480200682990&'
WRITE (23,*) '925349975127165939391044505361866832944198062600799468016261021866674288852979&'
WRITE (23,*) '629238492698837436344184563830976952189291476093598295068180165981702652094614&'
WRITE (23,*) '481115947654744086977436123804440330798540682382566383689445071055232814977000&'
WRITE (23,*) '884926338941520326266647287630447144957050785346548064350993608044448450908086&'
WRITE (23,*) '265114907409513271059612797228322252249035113641344463379009562590720580913525&'
WRITE (23,*) '495434094633528344782782577384556067232204361522033145186541061811691818087390&'
WRITE (23,*) '643869459486393332030360858237474075052416066006341016379286487950322077024836&'
WRITE (23,*) '682174392755532647243853459338339492615206889464617500273835662570179790223699&'
WRITE (23,*) '812651523732100690268192363527978532693949904911029496283744978688216599345306&'
WRITE (23,*) '298018122418694771169167104260888890169821804846498873631292707417618091457211&'
WRITE (23,*) '695897675539044308896377870390184994895283178320170313998683449486664809003757&'
WRITE (23,*) '603457131986491117722459297670594893283212324126613825677627336645113049473188&'
WRITE (23,*) '397342624576287124142091478319366172217821270867095442000963817897130415849032&'
WRITE (23,*) '458413233445359582702270902651679013198596033842548844704399659809267717280882&'
WRITE (23,*) '704277203930755818470018812235785980997621433829554741035480556426500055710461&'
WRITE (23,*) '644739859897191603272454332963606474795032879659613050195724113518356280211494&'
WRITE (23,*) '953300799688102496232334620757514645761239757039353218309154256029108546073693&'
WRITE (23,*) '739140004313974080685296145717456372795171822356639700760630302002035711727444&'
WRITE (23,*) '094211053757178216090499232244918305900940886955891270507721498344381980874984&'
WRITE (23,*) '520831861111543583610154279901531107685572945243186968045743237506789820665111&'
WRITE (23,*) '096077433183105874138291103722697542443786081716442089183756108631611970587637&'
WRITE (23,*) '785890920273656328622165139439399150882356107114639799507209199763292426282061&'
WRITE (23,*) '399146878941674003563203263544504810826757116320971125442269809744395656618178&'
WRITE (23,*) '395239071387625724393927560185077897136133679707383066944167881846614065087638&'
WRITE (23,*) '936193965454689339144883186188481028721038582013278615481157730354235410178143&'
WRITE (23,*) '197731889918053086676187062782390673040535897695597897931898731354697060952917&'
WRITE (23,*) '781554433906490374381153380652693419241234647021785680983422758594607923331145&'
WRITE (23,*) '461093003532419397301566594999412220935084096301760246125853350987526608325585&'
WRITE (23,*) '960516021539961590379011913359705497487528265416944281309112205436743702235283&'
WRITE (23,*) '079110068007460115207351873099741453202446232045946749401366034287247709082130&'
WRITE (23,*) '796442617696233924541122658557226098145838230384563543887063844164152385385984&'
WRITE (23,*) '571361359766141242546634748202413025557310909656205734148932896800836231414906&'
WRITE (23,*) '017108643284843300223010460605320412082212030649441492225163849631981305786767&'
WRITE (23,*) '286108481084232133653901624679675796201653059958996120911851922288426088712742&'
WRITE (23,*) '882046008568352438438185075536978248533100572835394146664210230104028380743021&'
WRITE (23,*) '306390095117651177287543883921739244037922423532344677427815810367362391060314&'
WRITE (23,*) '965932607379703425776557791230144358949836122431657452228383789078602351439547&'
WRITE (23,*) '590746821547883226979490619390297198413532723673637582844658443517940411989722&'
WRITE (23,*) '359971568904594174635827154249176388909663319400698224431381962659099698637433&'
WRITE (23,*) '830349277718918647910775108880675338790796928062623641961130855754932620153205&'
WRITE (23,*) '483047623374184685677677962702768417334215462164150467203744328795040589513224&'
WRITE (23,*) '570051886006980307733035839210291239474878310292695192068374232646894905962286&'
WRITE (23,*) '315273454160909253006299828452267416954763936032081790420848981112625859338617&'
WRITE (23,*) '846744189353424099189759550742545864740710722945606478022581220237140611846781&'
WRITE (23,*) '378310825627483373453893855335962034945669776103059804488292994369568739421037&'
WRITE (23,*) '085296525186280238112454795740485779540543713452962021236051975717954720467543&'
WRITE (23,*) '187411255716942394962782829143547116905728758366007214612842571932937685316208&'
WRITE (23,*) '780929350103382415497786773141717647552280798677357156904022475216411612500128&'
WRITE (23,*) '541907348080178369974075456081929800563016101577078048701705520504367951382878&'
WRITE (23,*) '431464175744535313066162971524447715525930797458812085297703735563874421808143&'
WRITE (23,*) '824231360578434026565886226942942833435718310670222245645672549359286510932615&'
WRITE (23,*) '372676215657433381293441347104448604031995896780053742592507039400394523423854&'
WRITE (23,*) '381556173259519120810345981548261177254685886661771469336387491020902794274855&'
WRITE (23,*) '237638175722846040262868975750312534798635406604454676811030023032391268528899&'
WRITE (23,*) '663550623710441474054368971434517900978482768875771355631930781177912033310071&'
WRITE (23,*) '205611270673422775152990059935731309410821621307599215111934871390210271648344&'
WRITE (23,*) '708485233650016455711363858978482898616336172408803080255034210740840550629197&'
WRITE (23,*) '527685798763904495359905780470870651634407875318436783575929580487752967501823&'
WRITE (23,*) '577006594751046655758223496917745986625405844520849013495455167597114618679286&'
WRITE (23,*) '285378125913760397373568089498879552417485915991698643595876521992040264031505&'
WRITE (23,*) '603085559059532409101854392341085558350322544005549440727138474594872870649225&'
WRITE (23,*) '874774839687492883905180218529216090690806948649203479881104988415779617505933&'
WRITE (23,*) '833800989073664122940415747349744733267553282291802424864218836781136985826302&'
WRITE (23,*) '026034014944468033697376985704682713175989062675845402021225107523148010936597&'
WRITE (23,*) '632214780669920581818227425796490964481601910740249363441336135598119367077641&'
WRITE (23,*) '091253297343345307331543779045951132921694325076873025462543209628572503179163&'
WRITE (23,*) '574110652808711141549657823494332077147313150255490897814044752827683511868816&'
WRITE (23,*) '683211447902498441996530692033559756452545701020447718024213063675085118429116&'
WRITE (23,*) '245843930755104890823794015171646982739401217233606697140937299720324945691490&'
WRITE (23,*) '064003893143876414987548488752002801194973339519092159100466787856685682899286&'
WRITE (23,*) '774588411752252779102418945348080721418597801927430470604961675562034850731257&'
WRITE (23,*) '728384239582109055853643430359998182506783829145450839425876292412590362744811&'
WRITE (23,*) '192891395966930178370500803545828025834465023713687505622292820555499623388119&'
WRITE (23,*) '314094428695477750119309118059224062798078169045678480534567727768201167909097&'
WRITE (23,*) '876958535951041609718065787972415763495153564936877281633081797892119096260896&'
WRITE (23,*) '535145701699419099128640584918433607996627490472859643856818743788877170853666&'
WRITE (23,*) '108356027406929685417576056615093930579519418329487609954263921962204722209881&'
WRITE (23,*) '656554909243548450242482359374606359549899836842934079415704340950135155357860&'
WRITE (23,*) '280138084248909780057904915059200447548595249019070848055913472772465218418262&'
WRITE (23,*) '185375986224479509209858753173753223160257515837868310067768680113657883180858&'
WRITE (23,*) '349962137677637916869201227994496456583380540391088974331062175747583098872402&'
WRITE (23,*) '514628098295056056692908362688069521789931781333581876043311494143103656412486&'
WRITE (23,*) '479241757378894980453009681235100451191942318723104973942912260727678921658295&'
WRITE (23,*) '425744983004131005361570258121006302232838543982115039514523126899540958525676&'
WRITE (23,*) '317851431535861868818829486082591466325529145089425743409012414691205939140563&'
WRITE (23,*) '437659291754111073851127240482602609947038888686516781775297739141848460814905&'
WRITE (23,*) '565376557241852551999082078526576888895627954445588473085994725269731985821952&'
WRITE (23,*) '752288299705186551921564654871887520426375529055440938603480651236777191212228&'
WRITE (23,*) '729891989006632697722676789283053458532909219346742862782215771179833489598309&'
WRITE (23,*) '170001556227506676114596007094973546070689793732719898117883067718798209659646&'
WRITE (23,*) '864892650000990526305491232105188430279594354499654585721743391684189104345788&'
WRITE (23,*) '695257561533462430847468457536628811250227247032364751248775684018791383707996&'
WRITE (23,*) '405594046743914431640510566976871253746299462738279316516238798072034943964561&'
WRITE (23,*) '770416062056875633577506512079666649998298236242995346672471539892329035446522&'
WRITE (23,*) '938401251080050397539653488664581012973580729124168470564792350969340707235135&'
WRITE (23,*) '061666436213198193029640467097493652656254986417337357119555816021225510701047&'
WRITE (23,*) '338370366912330746363386612030429920410782621744780661159829214216368118972968&'
WRITE (23,*) '586005919608113285636476863415700518553956844732477506685896177990458982424045&'
WRITE (23,*) '368482820608088263377153917163197544269621412198277096737670352555085993558965&'
WRITE (23,*) '682733591239584118633353939216701105237783939083508786012430298565736516120590&'
WRITE (23,*) '440249515520755202422188650527865548085284449296722718794524910029481305317740&'
WRITE (23,*) '893916523032934961951821036672575749244782249139141843806736477339415707500102&'
WRITE (23,*) '999555115422445236154494870794377652835285887062855191786898481080239600143358&'
WRITE (23,*) '221730572471918006422396022939206630993656184665013474209346643100888375067613&'
WRITE (23,*) '408299272105819674803020978320287176671271532478188021684394009308995197424920&'
WRITE (23,*) '018961993897677381224895588813592877067239139741629154360307929091936801964503&'
WRITE (23,*) '416381146521396827266263823470749284755390246368348077113514074305776068575084&'
WRITE (23,*) '324363202443132738253957938712541144427995675297653783896617597449252883364314&'
WRITE (23,*) '270900449255066620801611036028244386840297034802504861321224315545259486063130&'
WRITE (23,*) '809854682246084182854485549539238059331109484053681261377375615674064970551733&'
WRITE (23,*) '771934974200576586948108382447926970864534232669953757524878405015828197318333&'
WRITE (23,*) '875871291283844958168013431351979970704768803851445855260017344413326224617282&'
WRITE (23,*) '796133858012800917982533656137134916765682977771574772179552003596485659526341&'
WRITE (23,*) '431312898634113264086452088864939018075785225185631533980393260324372539407308&'
WRITE (23,*) '906234557448189898058962628734709380493229329402278230784662444361054659052727&'
WRITE (23,*) '993225196378387197285560229036731041767334896255385547642652863350666789333192&'
WRITE (23,*) '728267234259905602762950717427511958755752374386953436229761342337643552073646&'
WRITE (23,*) '450319413244355557256441509628277275387050031562006515465711844736655969666010&'
WRITE (23,*) '073478206209288328284118533263543363053124296538153195435958575565383486393193&'
WRITE (23,*) '929928258498762138364572123643075553190916948393444493321731346732081338291374&'
WRITE (23,*) '002168083086099384723927133175139794778980974929745458331340346253875193789286&'
WRITE (23,*) '826461790086433443326316768138319140166799265613086616131862463660539167762139&'
WRITE (23,*) '985527211047699136296130129222029755285179406375766320122166224268643836285722&'
WRITE (23,*) '820517266826833705414062245782455907518332705545335710074222316187574346899507&'
WRITE (23,*) '560454236573473141849599809965802580570906278518284896308694852300221648688606&'
WRITE (23,*) '282569655190411140779593567449223685215814823714862770714191968878986987731427&'
WRITE (23,*) '061806594278716748214207602223456215067619429196938836257859247367545762785284&'
WRITE (23,*) '553974680261711563520204420595168336543233636489787302644804700151094605974620&'
WRITE (23,*) '627637480004770657053343881302350192395322753974933734321289746139396911538639&'
WRITE (23,*) '758527368448964422312733977119843776951899254936243722548995394845170596312300&'
WRITE (23,*) '460164603065091355590648636500968012695421430648665682091808147191006018516888&'
WRITE (23,*) '007170210581851643858994030624478251308058657532918085492724427561463464546637&'
WRITE (23,*) '510458322849149231121111655970877052344330094135321754989367077541629921209014&'
WRITE (23,*) '838624393677462635030080265104077286264700626370312751491105846784113962110937&'
WRITE (23,*) '473451488901762576495056884971248864522407503158763070957412415695136402136626&'
WRITE (23,*) '085038026244957495405848712909227176398433176584629214846709656917167919813078&'
WRITE (23,*) '032180629359847109862555441332371713842638032257837342635153900502775954016623&'
WRITE (23,*) '275872503106658601420786393015877918176857815542195817107009471654187596590497&'
WRITE (23,*) '556023520238086604144876298656183087312061816670850332161290510502820995940577&'
WRITE (23,*) '855192047954138416963188905324074471031672544103634439950244679729197724685279&'
WRITE (23,*) '340407247084936830126620122033690156487834900881670839324759334522758503475674&'
WRITE (23,*) '374506056321300678511647977950102258966743142762342818646025018086651800668294&'
WRITE (23,*) '309805875085991157547449706494500801362305055376262766651076399908391526093872&'
WRITE (23,*) '668275350593701516472809565911738967907271742613652240279294810324331673384018&'
WRITE (23,*) '430551817848222998920874496571560430855218042995230221407846832920774076501881&'
WRITE (23,*) '439436355660174316341344064349206716720899369374409248262034334863772028870871&'
WRITE (23,*) '124073457130678539901409393160815790455840145147192872800532792560452584548379&'
WRITE (23,*) '354025816739845772942443660741478775166660460113334673450727789366509592669241&'
WRITE (23,*) '106120286619624583211735214046932366522262249532743303253000460702725568941672&'
WRITE (23,*) '978755611932137881497078124195106147908344495728665918215514372063643085478525&'
WRITE (23,*) '536151225535216673595768412631400483283517787868694131425862286352347244077958&'
WRITE (23,*) '026744730659709295722949421356408225301744290481499717103067984116431312562548&'
WRITE (23,*) '532233004572300419157948348406493410738130046369974635507451267368782256753548&'
WRITE (23,*) '830838248560598227234078718708124605468435628123324158126125353276680730153092&'
WRITE (23,*) '856958574118627481472240787181180646937539863138490012038068754757997415851085&'
WRITE (23,*) '925036086100567034753573575322995349332837711214993223816162687796350349518999&'
WRITE (23,*) '234844602002688179709238667132492177854195281420034640604613589582926157823999&'
WRITE (23,*) '192939533463709138181601874933621515939780408637814467789832927480804680498512&'
WRITE (23,*) '227247391738019960141101178874898104293942257061375850790904867712645382103190&'
WRITE (23,*) '841381799367554628079732431972828723978993451090608031201155714040071639311271&'
WRITE (23,*) '842821246239840175904722330854315719170954976102780842767116845258759403911298&'
WRITE (23,*) '645470527056473383630249655697987702104815424378729589485112884630828135921023&'
WRITE (23,*) '705600557651662016110405142253425878084735783057819061183716386282033602390958&'
WRITE (23,*) '336853380754477331110433841888282272253948479989370514945217340738099710072413&'
WRITE (23,*) '719913765477771627502687942895558987416597300030235527822097457431928028587193&'
WRITE (23,*) '631102672911579037414653372093862120283071515060972658815414308702531526062969&'
WRITE (23,*) '742521195532360193046591406921880865887051806056557797772794581406137991787139&'
WRITE (23,*) '956978550530890803516856001980234397465635739325374090133054204439892388659246&'
WRITE (23,*) '979058260332065621424260850451214951782153112704966243574660347614361472909788&'
WRITE (23,*) '441887605258893925343019148582430294425602564765258572942930391218136320242807&'
WRITE (23,*) '013835124561170935255295176132568987721115013464036821625004118680608957608039&'
WRITE (23,*) '628421217630531772475799219037269131331824637615146439595831356495463084231252&'
WRITE (23,*) '393951978669879650543783808935694749102929820724014406637576947674255101203905&'
WRITE (23,*) '332549304801545678904266941727600233723012757399138452724986951355772210793664&'
WRITE (23,*) '794535091910682866884895825917659296226147463771267715061628681303385512327693&'
WRITE (23,*) '783184408373358934393889257116333659963518682051501864936737291960746561197602&'
WRITE (23,*) '156521362469698606164386775811950224019906664334439826505455285682770575607598&'
WRITE (23,*) '056519954509036446203487448891028615548649320290178125059812300063657130107531&'
WRITE (23,*) '499126248478028029228776613647165032018899923668643498311603073205978158863004&'
WRITE (23,*) '033218226685741591881471094400925245312599832754798886146391714667896675857480&'
WRITE (23,*) '438952004196452571883254538556502170891272229146479614489731633608053814667400&'
WRITE (23,*) '043383847929810630895585960166054170758059374281521718737593263605202117275984&'
WRITE (23,*) '438436297004253619026647934543458558579249694086754028378151530261562397773678&'
WRITE (23,*) '893801653506107494495928693210827955246962258318817000057940173454309463915823&'
WRITE (23,*) '601712190125609083667042019024966092298313477915928716006904610929625928103706&'
WRITE (23,*) '864110172306862168002782798106617886323238459484373982866702987924482582882181&'
WRITE (23,*) '282709229918193246818487059129478224410350249336433677526065714199803650115892&'
WRITE (23,*) '754219030897547718500024717934714321497292839839654330215600836986442424579427&'
WRITE (23,*) '869822219480296137282808554130237487932697369182012651449035065223658010559950&'
WRITE (23,*) '002358702480814086518435346823713334757540708338604084347061003654803275935906&'
WRITE (23,*) '850305309483363462588147901241557175884894306320575440166849900089514465474088&'
WRITE (23,*) '891776334880466300924905501573551344452329143072038581358277311877542628954790&'
WRITE (23,*) '287977969056058152362028266998150135951275635394757629036730732556142251729266&'
WRITE (23,*) '293740231754405405934771647080454600838654186883759429521053009591803828295117&'
WRITE (23,*) '818477529191269463128596347932753639750744191432100411087158311854590814557646&'
WRITE (23,*) '411429133064684467236135906885701598041116260365326853957323995090656811789988&'
WRITE (23,*) '940586555467987472773093557241509568185047585253688741469386101110868980833513&'
WRITE (23,*) '749149726555401975610279707276081935294748938120697822382876024831269921384270&'
WRITE (23,*) '681413448460367032072724270368279769003980500992464916337895066121014456618493&'
WRITE (23,*) '025933903663041470342144504671574000017564716087662750134127161218251173325389&'
WRITE (23,*) '757250865559207489328920029133148889842210829855801898783449234155847609199114&'
WRITE (23,*) '888777985633800311906630312521855797406664750532306300033369455510820660299280&'
WRITE (23,*) '570253986791591933066540171682293622325608773503534685348103013114142809084661&'
WRITE (23,*) '644052511941724596135629908212140090831946672454979862758382107408967939030227&'
WRITE (23,*) '864181035378283953702690660807649359102126705797513056047279393444158242149701&'
WRITE (23,*) '035094310286863918332524024461358747963005506173197844116218010744525164875849&'
WRITE (23,*) '874834934751999182930715546627046436206883594322031010010017883489713969939925&'
WRITE (23,*) '840108889665797057424297840699393009040599164609190292439355269184774533289628&'
WRITE (23,*) '784265269372425952665453331398492927727547171214257820141972726873784536524647&'
WRITE (23,*) '289315422938877001958016643993444136888077225192647145971270174335115994503746&'
WRITE (23,*) '394224921184571769993125301167115471528802211666821179078166970503202574333943&'
WRITE (23,*) '558308596079552406817715058216766631201541960333919024488739533792531900573773&'
WRITE (23,*) '412737343507815693114569413408559767217397618912292076331376003144156268247155&'
WRITE (23,*) '657326408731335241830759997415762189581210136512368369942294649097896660018920&'
WRITE (23,*) '915478098797766047252484579057409890302128971855608319315709071820740990209727&'
WRITE (23,*) '967740733059425832484513961280405079834545157924275290138100739323792817575757&'
WRITE (23,*) '139431441222426598866002262245226904904653265490122918078571345637297901460157&'
WRITE (23,*) '346405708559369186403655495182476230190285080657218154056128011973130774949092&'
WRITE (23,*) '026595912706534397569832348146464344367334313343264907968090359221127661344009&'
WRITE (23,*) '446055387381849533557779849000267741704468600048140068836153530505873426485117&'
WRITE (23,*) '919748301498412224350555860150319819904641705596955299599597661253023814340739&'
WRITE (23,*) '652669200240363631304500397695457570446122497216725861599065571114311829210653&'
WRITE (23,*) '022731852524614365955774860298329031528227425374663255677801119172667202035135&'
WRITE (23,*) '361902435585753442595726382231277316220201599490821050438025868343831537360967&'
WRITE (23,*) '513718860516557344036402364443739380534732778877131270099031539920382803105766&'
WRITE (23,*) '011893185228729835989897316656283172654633218841167516200323199771846515972455&'
WRITE (23,*) '390478385224578123330531459882794695431178130398141406914562116603099959703515'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3266
WRITE (KWSAVE,"(/' Check integer factorial: 5987!')")
M_J = FACTORIAL(5987)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '208192927313311220490757655589384669106927918679356841667489099127409322369776&'
WRITE (23,*) '108170811372236867865213629766457747241009858484835093483305960638769362583770&'
WRITE (23,*) '566621358462398299769236882878587329421890825844184067509346016487626085365255&'
WRITE (23,*) '044016439899064215740667576001348257025872905991614037588462949304094492309649&'
WRITE (23,*) '405948159398591498533911222647046939906708776938239424442849762462382728144603&'
WRITE (23,*) '579025920053807737725727466108906485780740262895358992271083878407161082909466&'
WRITE (23,*) '716160433667377881675761096355367827155025621803637362285450061666280461690558&'
WRITE (23,*) '784838065397595912239685411721111890180063912482320037891342793785520233815130&'
WRITE (23,*) '631892709620858006215394415194541496895050993296013155373185552458973189991687&'
WRITE (23,*) '008280548507017100664796358721466366011130053766927112514123097275847479937286&'
WRITE (23,*) '925011673153522709653340306511424193210321033961125603941515829065167923041651&'
WRITE (23,*) '937057433265633507223894477590860175603486192861910942723783181505133978973200&'
WRITE (23,*) '322235882670239897466971518885641604474548881378362888880112859267618077384125&'
WRITE (23,*) '462656269221172054412101098163794528749565956592099808283319190576489745057467&'
WRITE (23,*) '415962342954034863650778977982804215216766196921576117906670310615337819245377&'
WRITE (23,*) '401943497560509839370895309779974541456503092756464314200833363636708151694353&'
WRITE (23,*) '412982511976329645136216217418774448716731496090568013705880744050677965361829&'
WRITE (23,*) '331206139344319503458684159817234613375216511607316772124985043087500124534415&'
WRITE (23,*) '896869707683467647751375158508916243738246357761648630167391893378795850503424&'
WRITE (23,*) '942264888422101317824395474924569191547909863940955337266939098154327671576980&'
WRITE (23,*) '264900910614597127235164109424401620748744414174878263175106971075403768218802&'
WRITE (23,*) '569347749015340212317621061797901045839641033955233054731717326760158869423623&'
WRITE (23,*) '945653352585371770362577107509774807838676722866760531902451883197843692431002&'
WRITE (23,*) '935153306841999664957034061910095986811953900577244417051660599752038346361820&'
WRITE (23,*) '269400417137380019280324706950416442262968792090546950481075361838203035846407&'
WRITE (23,*) '188572419899367457729769762293304678298897434334131821848123239081167557055746&'
WRITE (23,*) '965287231056700059818747936111255222257149960304044966265801398346707073898343&'
WRITE (23,*) '714445331833013883065115258748250169930571346343018962152366571159508040583975&'
WRITE (23,*) '136794965346324658932551750463223946252673228050622552781958953956139004747117&'
WRITE (23,*) '744770404270965814330639826945462143313668399305587088259735871873465593543038&'
WRITE (23,*) '689808892644114753221528550449697239528790714256370864263081132547745467248601&'
WRITE (23,*) '206845118391520586742666781369542270664173849057414283483307625860416220718762&'
WRITE (23,*) '758981481212186434400213534574208521163392222021082437997991241294081212431356&'
WRITE (23,*) '242756280290842156565213853793225556261438142264726639578859677341156810274171&'
WRITE (23,*) '763044908201640561388897266856794100865950512483552578847137010800298497013187&'
WRITE (23,*) '884696205523159731239646790816136831481807362031080528644788073742956172188284&'
WRITE (23,*) '844524533612973295133621090431555968624916171014366464759443644434542824949878&'
WRITE (23,*) '908892207825910710836407643881294210905262999079354660879744082518417741335574&'
WRITE (23,*) '314718181367744483447620506460547466056632998169591496029334449114097614836991&'
WRITE (23,*) '609207738445013719616183984328596284817537375093143411160211461338403094559262&'
WRITE (23,*) '807446086318549421738258837371491660334283370006659915917075294122843819581209&'
WRITE (23,*) '295818501634280581382531637074756207121238072499978268020833760801707062510824&'
WRITE (23,*) '635894810887800443203109022676894081492304122452090027595153388884158403063957&'
WRITE (23,*) '353386843631546180726821578816801518043072096757883421704571840655466643186317&'
WRITE (23,*) '993001299166259937666512290883374388217922888663023634509883671195384322014266&'
WRITE (23,*) '167088406888440135096016410083842968007918295577776374042275912319740263586609&'
WRITE (23,*) '266725737142370144503261572155972453463917766715786971709202479138474906809341&'
WRITE (23,*) '968805516864533006984920262389185369762142245527383224937728761054214950799211&'
WRITE (23,*) '299789139170154326071501265670006199980954086106822361677147116737763898511625&'
WRITE (23,*) '882069838114438120553749877807451345428553969485393965445141804335204338751821&'
WRITE (23,*) '190238984094180688978489640642787102284383303078177059545226204415327498446225&'
WRITE (23,*) '494181435766355226542346880980039296758348042882686353542562034807232841665122&'
WRITE (23,*) '225451886995208362755389154572256049687501635203974134205575750173093200217196&'
WRITE (23,*) '650243486745773639840294671580443365851758109231436990783950789828851192147319&'
WRITE (23,*) '548586388914913488916027299996382565290272474440744182787796912165867648640055&'
WRITE (23,*) '016221143963827992277727938569957903796386675029850471752434094255353826039059&'
WRITE (23,*) '059263683952798030083720018426632897384963076781966358138477621733289293915499&'
WRITE (23,*) '793663940843209110772605298040769100139953221825201267997712593878444341034230&'
WRITE (23,*) '782108764215129728814594410707715997251073258770153118660404024467673850656524&'
WRITE (23,*) '931396911831689543070369892291992594892313892035024381908346888883821225414410&'
WRITE (23,*) '029409794696181581449434685973318417453268545361612397953552388445022523300347&'
WRITE (23,*) '774103966484959262454075548229068584652605582842099248147064588983267634627245&'
WRITE (23,*) '285770580180612953258760488477010064385176048902372329354889599466306197271256&'
WRITE (23,*) '180223256278028948777635106726380665274075287646529452422164323013480902121808&'
WRITE (23,*) '355798563522821695903796630838879385914802157666845139198219756424185177351071&'
WRITE (23,*) '617096465170949677165106164357040581915424752581930931947752216086669421070023&'
WRITE (23,*) '848943521444988472728184582770485008532248737379661028818297498601083774792978&'
WRITE (23,*) '915030896779132866337167134822864338869911817909343442560778166335675249398583&'
WRITE (23,*) '844272693054776878150103097394993295014593259655490077735892683394474987018497&'
WRITE (23,*) '676531540310024979475656409879334481384247615529461343131158000724526084292904&'
WRITE (23,*) '027386963554505627263694842136234089023100708509890447222248539216409804957392&'
WRITE (23,*) '359952942936090010802629959395700445733234300303835287590107562110204614195661&'
WRITE (23,*) '425248380765903400113176531010312850566200123702779930191860573161664711816412&'
WRITE (23,*) '623851434984083028500004775053023181068601119319603548578579267241487382865300&'
WRITE (23,*) '450255145221470724137860689723124864359242105855939445240302049742659382064648&'
WRITE (23,*) '248375070176018183142122437731842620349427061713562772213203565775179129686400&'
WRITE (23,*) '029067646198860017637138820412761152297332667742536596877069727465532410723736&'
WRITE (23,*) '806950050918396779914809089217325178877570429308013864748312694119048618661799&'
WRITE (23,*) '334596387106342416356705235337582019571757823516151775042802318391336051676205&'
WRITE (23,*) '194208974519567818697879987657755106894208982972774951964419868902418007323703&'
WRITE (23,*) '267134934863482966629861359837148339860180905324314379186170457215003727252484&'
WRITE (23,*) '892260363139549363285419557205680998139167614464448267969898245438356191937298&'
WRITE (23,*) '141436491813821297295683305826502549459188508896304451136118193403565580265823&'
WRITE (23,*) '379456775073868318324501856979270592461750915942996150055122458544630158771814&'
WRITE (23,*) '752867398767804897250106306988849300342164576107063014780302962321443056181494&'
WRITE (23,*) '836720652181743148116291818857111797064491306470701463422568015380992227593747&'
WRITE (23,*) '679000925987269892644743708678534781715633469072503753329723125443162273618303&'
WRITE (23,*) '550210086343784078009952477084539003288837236063477361521761951944008408758739&'
WRITE (23,*) '112406047733291238727713872983373996388586527715053062292874426803209476680497&'
WRITE (23,*) '557230597233778739093017959291536860696699487358478581263300634821556452463374&'
WRITE (23,*) '744656695286316404389227545218831396621228091669954961719217073261758608637806&'
WRITE (23,*) '735770497678164006659587609983020533725666881400466293902620022471389308072634&'
WRITE (23,*) '098659230067286847675132563254272191155216519285770712432701535368669077893266&'
WRITE (23,*) '729662136391274759651869406209943426082506856835746896634952316361972545450534&'
WRITE (23,*) '900629738304718170690925667677932711622769945017682790655673950284251479766181&'
WRITE (23,*) '758560026993193879569052337944109895003860571321488657525626007087585908465274&'
WRITE (23,*) '412182260225171268890526394768334127219657180367615980845587557641971495024735&'
WRITE (23,*) '364054342221695369614174666794864071364860932711084413137647487287952252084209&'
WRITE (23,*) '695043320972023865392757824351062627044264295643368895957236150752687587820446&'
WRITE (23,*) '738907077502525851500249118041108498985754352420143681331979805837593369294041&'
WRITE (23,*) '142545209150329603007895732359317709420790603296119166443039070279587492778068&'
WRITE (23,*) '724191513577838716454786707252089601339023438204997881445363588885656508642439&'
WRITE (23,*) '910321214502822323745067813070915822916517442244501158291588682538315577086844&'
WRITE (23,*) '909579502644102315301863086068818660805730548399833419181688603012856211567411&'
WRITE (23,*) '039301750715543574856261850297084822621380376961104893143055114021824953212011&'
WRITE (23,*) '040615778249527598642818469757481904469584157309247985579860585931302883253655&'
WRITE (23,*) '115524313324160506640661576797738192770584425591210723255616625447872733496346&'
WRITE (23,*) '123117976721896526233643956835406534792817856046871314353365552971507335065287&'
WRITE (23,*) '908072484922807334906098980639704620818844966761265223160288317380174979363264&'
WRITE (23,*) '249904258434101286821636787253133342504867260697919372393709160172351611970139&'
WRITE (23,*) '321399572523058931541023846240146668056120881761344676379631607180410055206194&'
WRITE (23,*) '205953143924613658067234140720076167337237565139618616923720948615248937979789&'
WRITE (23,*) '572508674089314667968306871071818663071361531997755237067395632583852378017872&'
WRITE (23,*) '435221973864985381455336983491460358611509852803254789556655944955876567196763&'
WRITE (23,*) '724071401826406341230882278222607777506372187127171494736631488650126553027438&'
WRITE (23,*) '085718807346079698111794608170712436948885747820743624286630803234139842471448&'
WRITE (23,*) '248417722936518818759764315903062927617278459194740174115191889880338193532252&'
WRITE (23,*) '749472358787706089602781401095122714004812463461082959818404399757865757226407&'
WRITE (23,*) '202800702396623544027936261733836339748435935835576459430156078742675905845476&'
WRITE (23,*) '041484452368827821067511980714605398318819802057156566403648444114407872252872&'
WRITE (23,*) '468052839982246648364030273138153690649455331979876975977013363830174204205972&'
WRITE (23,*) '339299300490205273488509600327366685538438652573646363370901707570429571376042&'
WRITE (23,*) '290422394853820580626352335166881183829684447650720394963812096366548943326834&'
WRITE (23,*) '743656792715316311841105329840732692653695457438268071098850577724741374522808&'
WRITE (23,*) '062317600730862094565846214038590642215173028078227341939136227576580092420509&'
WRITE (23,*) '012046175852107053104153903492016554861874486182989682269332320333284961551007&'
WRITE (23,*) '187194740557463289643246100041791426733875402390792618280659447801501736306365&'
WRITE (23,*) '757328074728488421670438860407045975183909355893747160045283889494065866123411&'
WRITE (23,*) '417047068032384104951789107523103531744536374134060557018819202447292350682045&'
WRITE (23,*) '927788615649205724980748062288462143957078190383373598914564258528979438388045&'
WRITE (23,*) '558043154214592424081554489152460034571213609308288316117305185452774662158975&'
WRITE (23,*) '681938551375252705412203149473295603974779962766806601659417895000859760513905&'
WRITE (23,*) '175426335974434987213261164102088964887064942813275793035656462993644172367307&'
WRITE (23,*) '944960203284375352979144359559619064302329684500766341698815792172946895973326&'
WRITE (23,*) '549387814775379031810107421109722805620262502044288084799659453243903296252142&'
WRITE (23,*) '880485054061011062824542847660117094902126224259693958528397939766285012735837&'
WRITE (23,*) '124398434607192288199061176669047537087135679907368644424294634244529922131536&'
WRITE (23,*) '039381564052393787223381343598410894688045388689015053054395938532739553502754&'
WRITE (23,*) '305337791008943735999108784300413402148451468490151238021731862315253500747284&'
WRITE (23,*) '606459432803345412667510681878208426181576299140508605228096307858914194564920&'
WRITE (23,*) '471909133983476572012574716861424841070789085066727353302423397986649620600831&'
WRITE (23,*) '757446216859102601436863945293022224643688860195200819510587819270220494769626&'
WRITE (23,*) '182510946743119170100147203426503168249343255512216850955158419812077963086758&'
WRITE (23,*) '825505786931776614817651738211964816733579826062267810955855592538222385265757&'
WRITE (23,*) '052965521546477954556725687407123965495983931429387436130747597532142327585203&'
WRITE (23,*) '521339125962885901198105763280948122227212479284175512324322782883002590507398&'
WRITE (23,*) '404560339769395473512494961574723100979864892196967139231731211114163758589855&'
WRITE (23,*) '322396028369285654796143357269786533849098307464814385324228841275142819249328&'
WRITE (23,*) '164867648441855122628577489505762728811269316611789172074565422573612349276571&'
WRITE (23,*) '390960938533517246228492344294326358887560064620674152696939142975534084918454&'
WRITE (23,*) '173177885412667358449868488457127404758226997551426250602278738494749616504447&'
WRITE (23,*) '585002741696926134416458075164693724461153718648552891289529271301459535616155&'
WRITE (23,*) '591767781157116631077355482953211385336690547986182033565953540656130214777928&'
WRITE (23,*) '803773376023096028821082362600354724851813134330193060698621244200556043615068&'
WRITE (23,*) '008161086493387751759787941025241260291837243830192395722682577422995792068380&'
WRITE (23,*) '357617361595047554819864131501562921430592619447679570784932997203491052260366&'
WRITE (23,*) '035146665048569781852950190488602323925785410577892646672715845499445138218260&'
WRITE (23,*) '172371476570506046954719870313447769244838998120537040847400283139459828059952&'
WRITE (23,*) '773742400395556313344298622504803669515651791136039302631484026018247973489601&'
WRITE (23,*) '452323835580501315756875300067303870692413903536661580599218136288299986284294&'
WRITE (23,*) '088686610019564996922897878684679125984251416651658343988792061041321447592566&'
WRITE (23,*) '391571198904009956773883141837821409284875557992762266837541808836025242044794&'
WRITE (23,*) '827044219330555035103433822788437185736436241874146916860951053390718392586537&'
WRITE (23,*) '971691750447750985563287364401713582873539410492508298713854643068205368853637&'
WRITE (23,*) '704955060057052260518801271274843675339998201677973195037637780690641304924081&'
WRITE (23,*) '398421518524036015518226349186024501497209562941629053700458342707355128560824&'
WRITE (23,*) '039682464298099848650117160032934665894287630720026161276382227064304053488262&'
WRITE (23,*) '016137686950807857233084194355722073787300677070873722419766316793792392559145&'
WRITE (23,*) '104917571006340988847163668640790521031598759387627491027438956869251014468866&'
WRITE (23,*) '291443164032436900408546054679339240635247398048867014737207760467295198418231&'
WRITE (23,*) '055289741553189569992876152916101389604712375423312864489278749565522942941932&'
WRITE (23,*) '635875642453703800010291995063252389373020573153719280420799680099670399216031&'
WRITE (23,*) '282551241688878717952363501410948950529116940612760292077455985929502889108010&'
WRITE (23,*) '503499587155720623695947325571934940008888268705644618317963131109137003964659&'
WRITE (23,*) '702793560131996555828380288569909335595604865192125915430680146158406136438686&'
WRITE (23,*) '660254953894007927055332270315957504822786601004158373336292891119596045608405&'
WRITE (23,*) '885132206513874183645318099027683302579329695512435239347505008288016433308866&'
WRITE (23,*) '346714195929701825553889512104983907316580093659503102613099560687578578146053&'
WRITE (23,*) '290616072799435748578703728901599336719906652749173669051535652226085028262764&'
WRITE (23,*) '727785631885164809110424500456758930244541041926548170167777797407538040592106&'
WRITE (23,*) '408255027339046070942068102421444168825935357904196667920339116504622014098716&'
WRITE (23,*) '120380671658541676668795780648852723157001748244107052106810339149294208258896&'
WRITE (23,*) '088382022328777010071347307584350628238923866035689286090399316689689772484377&'
WRITE (23,*) '939896433347018965491999188774630287691022942754022691115967165453682225334671&'
WRITE (23,*) '135496682971260676669889521855359794222321636613356390327143221431118185563782&'
WRITE (23,*) '235358684976441010455425956888871170327361473683062598299113454587405766971143&'
WRITE (23,*) '317234972582078608162888515359197077088070367185279149882470676487835384714031&'
WRITE (23,*) '610690684858225735518512682418941591773291696493986927771991886557923716057437&'
WRITE (23,*) '584082224949671165510241365063498192405616599077697729331556998847656723821612&'
WRITE (23,*) '283123439037914468664685694193015478333715079949590525237557370009353443081050&'
WRITE (23,*) '828092410049807864108559988805873963874810161425579996535309676197726346686777&'
WRITE (23,*) '573746911331752637190500223672476806575639392275510337818914350883366529438488&'
WRITE (23,*) '558774549064916350425611748283373254702239152204070120652817061761239353528457&'
WRITE (23,*) '531959915645578085330174067555760826511822417052420643224238523960484887691427&'
WRITE (23,*) '686048133892432967581158107834833663985871887878689730971041901027828921604853&'
WRITE (23,*) '256563107458936471030997125860530574421016947253724193889931541862883968779794&'
WRITE (23,*) '536150728373390564038087588485795023097470249404617997487360324822193250147331&'
WRITE (23,*) '044088356377489894865972441037491900966541735115636662281445721661254012327998&'
WRITE (23,*) '963094481744053846426263937053642377811400884883098658414377966874293835459172&'
WRITE (23,*) '979399074786070989584088828957105812428091120992423597313287643141833158804625&'
WRITE (23,*) '961355353405890396509064524252975102157481482138953359985725371055306117237048&'
WRITE (23,*) '477480823665445255940909413368351772555903036281048068572485228027426363979883&'
WRITE (23,*) '902110900781414315684645752628020590956693815116522633267710307797937930678150&'
WRITE (23,*) '423253751547230063340572219799576400152559053095188902296959293516765466415874&'
WRITE (23,*) '619238741777011034859844010227144981884087205628777869434859859136842916127309&'
WRITE (23,*) '312478538512520876960880251431308209750719442282160496768325996867199567763739&'
WRITE (23,*) '467720921198844138254822673326620245393852332542488852987387191747767143360300&'
WRITE (23,*) '840021238788572046552057649465186166911920194626459645008404891218527764781384&'
WRITE (23,*) '154440959033373896009077053277739662780909418958818510143323346556447509444962&'
WRITE (23,*) '189454904486344187902037881163258279516939840549173466560467560110490659849707&'
WRITE (23,*) '844228347151128126024659067526064968589230462372723571442344335126464257851061&'
WRITE (23,*) '866245891624273497049432045391237415685569384624185000862049537718594735147999&'
WRITE (23,*) '704894476663334819401808136249865723379904323205825049683993882664417902084966&'
WRITE (23,*) '454734196610719363692768227627187071131775625452676725503621557015031207780490&'
WRITE (23,*) '806708795495870184358967349361593564010801394301442869521577605567363767591818&'
WRITE (23,*) '782719395813170479087137384690415332745338301464130782933278424203413293267823&'
WRITE (23,*) '876157045004489233684494901213602660351793685048274074490334789195564706076214&'
WRITE (23,*) '281897768325298795601108797908431470374504701012307700995565404476704153449099&'
WRITE (23,*) '737468003239471895931073717441747109210640925728276142761843372425473435588775&'
WRITE (23,*) '920930732636539169788763176439506500984302856126082733943372002477613055485011&'
WRITE (23,*) '152972839030592662652370765955466213555266461055619084940770749022488454449155&'
WRITE (23,*) '443041996261076390898333456371277362856535477802097467614565761933699427829835&'
WRITE (23,*) '655142055954314485969003873768990997640315550119236135039949223217252769345086&'
WRITE (23,*) '177422435162121507699372372122770786645869198945063823270556038328557276006652&'
WRITE (23,*) '195618485514435986509610069142418428547244410483168825254986510399407722981191&'
WRITE (23,*) '936355019935074050916991747605764086835315188167615937800414090416073378941094&'
WRITE (23,*) '462178611227812713016153886150663249618263480354946313686807662152631229009374&'
WRITE (23,*) '845605774664985488052072077989293899737928361243041350868269990462039172726311&'
WRITE (23,*) '778173197856502815266295512015784469409513841234775427724822438942611699285500&'
WRITE (23,*) '140846444445805553063671642987605212078070337068206039588687491411686477996481&'
WRITE (23,*) '868560525671434971392704362777819279792925442872119919434712744293627520235373&'
WRITE (23,*) '833478687268302522818076272844342825468644595296674456722506331868680802514395&'
WRITE (23,*) '761449604341589457883011925087737549991630260093565415463326499685728768517934&'
WRITE (23,*) '593283957532712403735050761446326553653119010689274465168025975634933014661146&'
WRITE (23,*) '055607413829968956901754256505857654096421365862001633379248734783736342723570&'
WRITE (23,*) '208448980613969657212995401669307964639814460434639940889663435902018092189402&'
WRITE (23,*) '071420332789255396467429858138979688359616017127529836458904426585863968489735&'
WRITE (23,*) '970085327316527014701187563721074933760000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '000000000000000000000000000000000000000000000000000000000000000000000000000000&'
WRITE (23,*) '0000000000000000000000000000000000000000000000000'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL IM_READ(23,M_K)
CLOSE(23)
IF (.NOT.(M_J == M_K)) THEN
CALL ERRPRT_IM(' FACT ',M_J,'M_J',M_K,'M_K')
ENDIF
NCASE = 3267
WRITE (KWSAVE,"(/' Check Euler''s constant.')")
CALL FM_EULER(M_A)
OPEN (23,FILE='TEMPFM')
WRITE (23,*) '0.5772156649015328606065120900824024310421593359399235988057672348848677267776&'
WRITE (23,*) '646709369470632917467495146314472498070824809605040144865428362241739976449235&'
WRITE (23,*) '362535003337429373377376739427925952582470949160087352039481656708532331517766&'
WRITE (23,*) '115286211995015079847937450857057400299213547861466940296043254215190587755352&'
WRITE (23,*) '673313992540129674205137541395491116851028079842348775872050384310939973613725&'
WRITE (23,*) '530608893312676001724795378367592713515772261027349291394079843010341777177808&'
WRITE (23,*) '815495706610750101619166334015227893586796549725203621287922655595366962817638&'
WRITE (23,*) '879272680132431010476505963703947394957638906572967929601009015125195950922243&'
WRITE (23,*) '501409349871228247949747195646976318506676129063811051824197444867836380861749&'
WRITE (23,*) '455169892792301877391072945781554316005002182844096053772434203285478367015177&'
WRITE (23,*) '394398700302370339518328690001558193988042707411542227819716523011073565833967&'
WRITE (23,*) '348717650491941812300040654693142999297779569303100503086303418569803231083691&'
WRITE (23,*) '640025892970890985486825777364288253954925873629596133298574739302373438847070&'
WRITE (23,*) '370284412920166417850248733379080562754998434590761643167103146710722370021810&'
WRITE (23,*) '745044418664759134803669025532458625442225345181387912434573501361297782278288&'
WRITE (23,*) '148945909863846006293169471887149587525492366493520473243641097268276160877595&'
WRITE (23,*) '088095126208404544477992299157248292516251278427659657083214610298214617951957&'
WRITE (23,*) '959095922704208989627971255363217948873764210660607065982561990102880756125199&'
WRITE (23,*) '137511678217643619057058440783573501580056077457934213144988500786415171615194&'
WRITE (23,*) '565706170432450750081687052307890937046143066848179164968425491504967243121837&'
WRITE (23,*) '838753564894950868454102340601622508515583867234944187880440940770106883795111&'
WRITE (23,*) '307872023426395226920971608856908382511378712836820491178925944784861991185293&'
WRITE (23,*) '910293099059255266917274468920443869711147174571574573203935209122316085086827&'
WRITE (23,*) '558890109451681181016874975470969366671210206304827165895049327314860874940207&'
WRITE (23,*) '006742590918248759621373842311442653135029230317517225722162832488381124589574&'
WRITE (23,*) '386239870375766285513033143929995401853134141586212788648076110030152119657800&'
WRITE (23,*) '681177737635016818389733896639868957932991456388644310370608078174489957958324&'
WRITE (23,*) '579418962026049841043922507860460362527726022919682995860988339013787171422691&'
WRITE (23,*) '788381952984456079160519727973604759102510995779133515791772251502549293246325&'
WRITE (23,*) '028747677948421584050759929040185576459901862692677643726605711768133655908815&'
WRITE (23,*) '548107470000623363725288949554636971433012007913085552639595497823023144039149&'
WRITE (23,*) '740494746825947320846185246058776694882879530104063491722921858008706770690427&'
WRITE (23,*) '926743284446968514971825678095841654491851457533196406331199373821573450874988&'
WRITE (23,*) '325560888873528019019155089688554682592454445277281730573010806061770113637731&'
WRITE (23,*) '824629246600812771621018677446849595142817901451119489342288344825307531187018&'
WRITE (23,*) '609761224623176749775564124619838564014841235871772495542248201615176579940806&'
WRITE (23,*) '296834242890572594739269638633838743805471319676429268372490760875073785283702&'
WRITE (23,*) '304686503490512034227217436689792848629729088926789777032624623912261888765300&'
WRITE (23,*) '577862743606094443603928097708133836934235508583941126709218734414512187803276&'
WRITE (23,*) '150509478055466300586845563152454605315113252818891079231491311032344302450933&'
WRITE (23,*) '450003076558648742229717700331784539150566940159988492916091140029486902088485&'
WRITE (23,*) '381697009551566347055445221764035862939828658131238701325358800625686626926997&'
WRITE (23,*) '767737730683226900916085104515002261071802554659284938949277595897540761559933&'
WRITE (23,*) '782648241979506418681437881718508854080367996314239540091964388750078900000627&'
WRITE (23,*) '997942809886372992591977765040409922037940427616817837156686530669398309165243&'
WRITE (23,*) '227059553041766736640116792959012930537449718308004275848635083808042466735093&'
WRITE (23,*) '559832324116969214860649892763624432958854873789701489713343538448002890466650&'
WRITE (23,*) '902845376896223983048814062730540879591189670574938544324786914808533770264067&'
WRITE (23,*) '758081275458731117636478787430739206642011251352727499617545053085582356683068&'
WRITE (23,*) '322917676677041035231535032510124656386156706449847132695969330167866138333333&'
WRITE (23,*) '441657900605867497103646895174569597181553764078377650184278345991842015995431&'
WRITE (23,*) '449047725552306147670165993416390660912054005322158902091340802782251533852899&'
WRITE (23,*) '511665452245869185993671220132150144801424230986254604488672569343148870491593&'
WRITE (23,*) '044640189164502022405495386291847586293077889350643771596606909604681243702305&'
WRITE (23,*) '465703160679992587166675247219409777980186362625633582526279422393254860132693&'
WRITE (23,*) '530701388937436923842878938512764740856548650281563067740442203064403756826309&'
WRITE (23,*) '102917514572234441050369317711452170888907446416048688701083862311426128441425&'
WRITE (23,*) '960956370400619200579335034155242624026206465693543061258526583452192121497771&'
WRITE (23,*) '878069586608516334922104836737994592594340379560002192785418379417760203365594&'
WRITE (23,*) '673078879838084816314678241492354649148876683368407492893865281863048589820354&'
WRITE (23,*) '818624383848175997635849075180791480634943916284705482200754945348986133827235&'
WRITE (23,*) '730922190030740096800337666844932505567654937530318112516410552492384077645149&'
WRITE (23,*) '842395762012781552322944928854557853820248918942441857095919558208100071578384&'
WRITE (23,*) '039627479985817880888865716830699436060735990421068511427913169699596792300828&'
WRITE (23,*) '988156097538338059109360341252998656790389568795673455083362907823862638563490&'
WRITE (23,*) '747319275278740166557531190111543470018186256971261120126852923129937161403906&'
WRITE (23,*) '965112224816615082353643982396620532633322248505191593682690715004315589871802&'
WRITE (23,*) '783353845448309107249498057880961717996337167036554180041464667538719586948483&'
WRITE (23,*) '331543583330641935929487420951478832347748481418149776871694413640056645156936&'
WRITE (23,*) '116524161555734141935424721373067468333849054426626038372788217552709930958141&'
WRITE (23,*) '026136979500786465876771608630804460749802801576962675913897794772214337515470&'
WRITE (23,*) '829345879123898433055067223474969984942486706721502569273529585065869588997486&'
WRITE (23,*) '535562186958043997125168976654169862653862891977542187721939605817001104236414&'
WRITE (23,*) '158780810386172101557551923711160049880682291618097732421958328974869227183979&'
WRITE (23,*) '190467716542668138893379296036815457939611339621922245430151580631743708405608&'
WRITE (23,*) '536416031384982969518566952612822123716939368130321296561939718710207098007948&'
WRITE (23,*) '833910197535104307441823448833331796978277332091143324514305086573457500687391&'
WRITE (23,*) '475470777577559918467118308583660159437193718449039061770232536567977596744475&'
WRITE (23,*) '747511584195746700997345002454428406585024508585646392791246119879093693072019&'
WRITE (23,*) '804029303603738838430742162821201635386466226097198958436799430572030149638050&'
WRITE (23,*) '832232365825557724534237187737439818333306454662906993311125973721950274646899&'
WRITE (23,*) '065457155440303917835419756434315739034883866750542742161831050060550464223545&'
WRITE (23,*) '708427393549359051762717479299472398908632970101905610107742690926475235740304&'
WRITE (23,*) '630159243442464900834188630859320685522507790910195858895314328799817570981916&'
WRITE (23,*) '829315940453005632543314488517357302698256937253469964013440871580108145287865&'
WRITE (23,*) '790408663637945071108505104241797691911292615132010316363498086606948624407800&'
WRITE (23,*) '668400671696221463718114777268341846646364242734053003138077349611998146861768&'
WRITE (23,*) '585463120816316479893796426373835661893831371098328956490521148813402974238886&'
WRITE (23,*) '863154313297876579912545424333856347200268129048994955042698088213026726358153&'
WRITE (23,*) '248067538790323057421040330149788786752377860705468861472100992632942510887801&'
WRITE (23,*) '970284117922402591091466584809257857192786282147667074087863519714256292427867&'
WRITE (23,*) '028407703241437569931883243331559002433304769111009247979118006286202213707800&'
WRITE (23,*) '621725732904735994398883139279927969397063567628116694054128859081982023838277&'
WRITE (23,*) '035483496879734048888293016736770941584654400954862465146101353913496855912040&'
WRITE (23,*) '236361872150992980651905861682815302875042754525860533196343259577747881343723&'
WRITE (23,*) '939499124380614375449859068607518563142725525564259396701498041425981823785257&'
WRITE (23,*) '682943639596562438852065654807103884546394453770191784571874101186223227802525&'
WRITE (23,*) '194362657438242256093567692582387749116073775945140144703190224153559112506138&'
WRITE (23,*) '178297421264982641618724606313340891926702359795802365841631755679233566210123&'
WRITE (23,*) '133584549459059006998420067226025116774384736482438571540714626594564239112717&'
WRITE (23,*) '078030637141692638644010057131095896063264963755295676936468941051795200061645&'
WRITE (23,*) '202188435340473018243930514881984593076296404445687762416528716207276731860632&'
WRITE (23,*) '540801428874571198657307471701886603687970364770854852871670003622928528837468&'
WRITE (23,*) '246605881411754047446061676354303739923756596593696708792316774468569310838210&'
WRITE (23,*) '783048315919643002144125970228906320317410114936648095290301171633453191792293&'
WRITE (23,*) '924242877283787234956992923213609223494722645824375509451533552011761289751733&'
WRITE (23,*) '951371782933287158609438662701179184155458726489825139255594379519731786744876&'
WRITE (23,*) '992532617942338129994127939860264424519600605436818664670986594436593015437629&'
WRITE (23,*) '148697959769499653352721002002096791043948254724411334224487005463765684086676&'
WRITE (23,*) '215337362746159120547008629057169825735370523976123123841256434941178949861582&'
WRITE (23,*) '859702097109703919635216812258224756271951938272828520914718237534365525402074&'
WRITE (23,*) '620306673047695247009441381456178282666319613967359367257264603388494642489472&'
WRITE (23,*) '448978481596715306153846712236987128231978476931105716623637326207595971180401&'
WRITE (23,*) '514389623170601958570982381392466613527913695637655904861676205129740998314965&'
WRITE (23,*) '597860253410129454399867288300624408440186181511750687088764671609799292017769&'
WRITE (23,*) '624963301575829259618849485872002292248060628812177873383145882551293953651088&'
WRITE (23,*) '191865120044923154983947731473578688973142047310945381464822632102331079439597&'
WRITE (23,*) '462852354129575191063558792300195618131294612030157576340159785681751749842377&'
WRITE (23,*) '882447375398247457599686770740854557432942402678193848220354096210606072192499&'
WRITE (23,*) '082510485400318496319986322156908909761405310716511312932685349852440286448293&'
WRITE (23,*) '470591608586995981988903959955918110764134466588145254256588153545028884739975&'
WRITE (23,*) '324327809021522569521844145298650835512983980226238264974881811581525034599749&'
WRITE (23,*) '915966400983201452007048035556858997309981503104192238508974537327612947171268&'
WRITE (23,*) '165308867005472886577922467017826594827260972290347157414031669731070505078296&'
WRITE (23,*) '108260728704291260823119741510147357847810107279711242797602848141151633886896&'
WRITE (23,*) '907867175772593815247961237899990366617560358821813254675634483091487296266937&'
WRITE (23,*) '219885027001882981730170249442140631726519713950622108276450718166391043668329&'
WRITE (23,*) '566380730719454321125505362089678323031085171481149285889936287064887558438913&'
WRITE (23,*) '004718684679858165552159013925603206137642715628011897109611400239130393406061&'
WRITE (23,*) '778482110221716599265959682958890544989648574041220474973542564671840236504679&'
WRITE (23,*) '058274859069504735553531183835808965288615889417441621988680423034924389581497&'
WRITE (23,*) '367222749518112714534386974992432421386841484837577033108761767133199442634988&'
WRITE (23,*) '067216670298371723057130497256381988443653998194797022327543291144443346325211&'
WRITE (23,*) '479318846497359469448480951734770940726109149351051855043188851638018002426817&'
WRITE (23,*) '631726458957788146589473162199135421797069639295912560383804858583156727254184&'
WRITE (23,*) '614699660351900767011178230527999831318698072478216817338984691249055791086706&'
WRITE (23,*) '543025629380810948236091118296066894973819763151051538493517552397192853567163&'
WRITE (23,*) '929421336526958049103950351840242187193546181447795970030349815957972043067775&'
WRITE (23,*) '949449017231423798597476267707800898011891852222929262329729280631476481001191&'
WRITE (23,*) '709993531769730894226374020100709335066622785533772217649569429513342217056106&'
WRITE (23,*) '818127569614044749582903928608574573882919365080522428612221275463635105136722&'
WRITE (23,*) '125822455750771093554824186440818218680657808079971951770947419767773212482371&'
WRITE (23,*) '462384395487937267559991170281970607563576664101281350099008705335620052336929&'
WRITE (23,*) '605429509254541973523808772616447265372230756826505484509679771899200854891347&'
WRITE (23,*) '407396416049412403555326815724626902383938518718802550684925766238748405876020&'
WRITE (23,*) '851568226963759595051924724151133516339979157222400961087839275225882213091370&'
WRITE (23,*) '903982536026810267141924576566175774597781406877480392728811583817563119477376&'
WRITE (23,*) '560766005726467895297998458098623666372886042022108157462248075344471068266824&'
WRITE (23,*) '531314678301397955654694465699247988477387250964676238903679415569294589007614&'
WRITE (23,*) '520078868536367858812639918959157620043217199636790269882911241353800382628031&'
WRITE (23,*) '504030039749014353600724971492214479643758821649852142913915384273409266056541&'
WRITE (23,*) '107859009804754850156339629411006873227088580389209386660266980006473728247820&'
WRITE (23,*) '412411924173296188763380556482765634362806022434826427529444866804709558214825&'
WRITE (23,*) '898644301688129938538646305603236099773123960870297542270948386187482590661232&'
WRITE (23,*) '366079611083208760971785785180155014858213269995803166919175521428507208991557&'
WRITE (23,*) '973107600924829378301641820294128632633196317883190107426009661616474339415471&'
WRITE (23,*) '030452836546064071934824026808748051413868316974125030020258370651319696179081&'
WRITE (23,*) '369146457636041823285423301773883904534574963531243187897269622438904054033903&'
WRITE (23,*) '930695288493580577776125643371595108950240899889318570203178001328019977794593&'
WRITE (23,*) '112299552308849338750171861541860364176739567649056361598862243672529569480619&'
WRITE (23,*) '860769068359724589424106760646984439397076406175503565002783992173562868396180&'
WRITE (23,*) '408416369119211501155776948685790892247148784553154768257495726062378798014970&'
WRITE (23,*) '674722354640498210776685941396850724508514339018888173055536931601670653909391&'
WRITE (23,*) '147432099334808976720016884417834298884047712670483576935230068082754128375435&'
WRITE (23,*) '298573553305079730500671205240128955776236713842811694763519207699037189430380&'
WRITE (23,*) '421637143802026011066653481795022365479391717883965714656447437420668688735833&'
WRITE (23,*) '199794916377430780910427849896848696069341450462136485237707090145221902946818&'
WRITE (23,*) '311010595459003456379294809886301499826854423185500878779723024949554868090170&'
WRITE (23,*) '869765483115615727622011473376443991501418567990740030037672560243741388601826&'
WRITE (23,*) '281147310254695189478557853136583469555201409821287525639689263918589808251623&'
WRITE (23,*) '672406477391949008501946281722380965739629579093560206866658498934080063406550&'
WRITE (23,*) '151569717814639965693033183297518341636408758073086869433770130534755350707380&'
WRITE (23,*) '020376787971498937491328559989959320285516202248353523430625004541942497456865&'
WRITE (23,*) '778335976416571951895508961376615965441761125924395577874399029062767715978507&'
WRITE (23,*) '442098881964333593223667348339760214243656682296563386296436643098365790502774&'
WRITE (23,*) '285832937625151304198649989323990826721085251452196664337691929124568307902046&'
WRITE (23,*) '470010977589386585361988541587230955225029384153983145045682582096197806356420&'
WRITE (23,*) '181696020159418540250108519917441232044359433255386748664893693067885295996446&'
WRITE (23,*) '411284996056526523608267398981987117548774096939187531617946083678898022608124&'
WRITE (23,*) '243451095995683868000861799310710702963881404939122157400395481875578592231612&'
WRITE (23,*) '347211869630335055311470859923358857870092118413269800255255090914405930908481&'
WRITE (23,*) '794362042114949380046192562880723163672053591440491539434916323056090234305842&'
WRITE (23,*) '614623231050272805681774732302381641835569442688787291214590816281953094501986&'
WRITE (23,*) '409863370515188369936872272321282157944261169325925809723735145616982473133038&'
WRITE (23,*) '449504125366090515653245082721603019799449338076471234957921342281621907187438&'
WRITE (23,*) '982273420860284547721067207147698855269401438807380939380447076779481368156589&'
WRITE (23,*) '979836824234592607151527012698013442837469806766707490882190684706656355638799&'
WRITE (23,*) '359394664554943503374933857236685434578996655138620231507027267757724874814428&'
WRITE (23,*) '656726218414717327824758420816863433272118986038485407155294280379121637347471&'
WRITE (23,*) '936253784989052234713087189766479256257843028853236672296655170902166052301629&'
WRITE (23,*) '604631841408378121554450028034243481767926749392803737422980180930297227420558&'
WRITE (23,*) '605636539630767988666531730859657836792800653373388435733282136257948107214101&'
WRITE (23,*) '357247663300376702160644195881497280925381097173048360551680297767033857116116&'
WRITE (23,*) '357379272718506957483089854178653252203055843287505365707323768783953667065658&'
WRITE (23,*) '437121236819406886880231979265992422636388891128946904020211309092652904440351&'
WRITE (23,*) '671955889025854535659075663621170642493005981169439653653000144607137778634507&'
WRITE (23,*) '024526291332390666480426744971657826737998617420258785900760957770282302951206&'
WRITE (23,*) '237905849685457912549874939226631042431063861271724775671888206473836211757291&'
WRITE (23,*) '386292342992075533360415148279052758645438463230548508211645489614370321105816&'
WRITE (23,*) '670690716753966996934705195697280161875865631829671638983350351999223587550643&'
WRITE (23,*) '365991933505457989978608901505691307864991295551560150591485570072085121222373&'
WRITE (23,*) '236014829228808109284917467104680822796780585462274257119190623519018115588393&'
WRITE (23,*) '345809208500598433454718414838467454498821236404336570772816563345556993128430&'
WRITE (23,*) '168439806410112142410172335173914167718694538752598955737558076015062413471621&'
WRITE (23,*) '879486188514037219800257284665274012966090357021714218690744586133555262852721&'
WRITE (23,*) '004928008676550637747720269084028344949010122695083701756739211016793619482227&'
WRITE (23,*) '306720274306421780338238561826407424166928738279267332182425122527934919765754&'
WRITE (23,*) '711531551031634008053058046746537060153116304457968994220233747303997471922794&'
WRITE (23,*) '003485294439798836062196756011376955344900290024024766289973138926494018209775&'
WRITE (23,*) '659983756480868171771938495956267874842649927085898056023839576676355282259603&'
WRITE (23,*) '730617278148818971888525879460802162212302900333066081809609261473615609593812&'
WRITE (23,*) '495792099944332415715748435104309619443553104254164916150289163284962356216928&'
WRITE (23,*) '143506284521178498824447386722841590379761915945316220998795682371803445674030&'
WRITE (23,*) '205195447517707341107016209602431880273442501110931202686260491782619764142699&'
WRITE (23,*) '123581121547165646328751248460328348231831183388165574952139985583172509595157&'
WRITE (23,*) '114270972014718925357842172497868084030478532500889477825864371755409272827907&'
WRITE (23,*) '786291461022255692919118741093445711640604764244783372979191609099671348650369&'
WRITE (23,*) '891907164877141693948979715071347989764226742472488001601457843724122588168725&'
WRITE (23,*) '662867207556056080845809124475575399539202446038358048033016635885864076236100&'
WRITE (23,*) '234692493675465229634852537782175369431534440276447989299965780928807123536205&'
WRITE (23,*) '907264232945997659234107216070073076305285418376991220386746561836015704671719&'
WRITE (23,*) '210545042441773862426597277779250350012237790656702275487885514586457500655796&'
WRITE (23,*) '627710051636942224073411689875106230992824775791335828597651448351261981775097&'
WRITE (23,*) '704575491595470911890587001593033665622878593998189397253298307857455743323876&'
WRITE (23,*) '578688278148434471425670317140801964359152062797845818216638904943399788731962&'
WRITE (23,*) '333405088019153747402899737786376277973981946818654707520833775154607122766209&'
WRITE (23,*) '612012482868387783933936440442782068506261914356541498500010734952891114529756&'
WRITE (23,*) '858980757532959507852642061978983153186570253543099992874226189595508675364040&'
WRITE (23,*) '599011288097144208657332837485797078071728398566307075896422598408685914316316&'
WRITE (23,*) '830398891767220213151081541145684358224418564049489352457351707077957434714677&'
WRITE (23,*) '391247158445765030667521484834867088194248376291849313419349270595714069404438&'
WRITE (23,*) '486656004290010870496422475223966370378207910323813580916738394030225549027013&'
WRITE (23,*) '603667925374100930351030294215350078423122193692113100735500517782125590180090&'
WRITE (23,*) '189758948956829260500710914352846117016413348182531505768041478914156878481607&'
WRITE (23,*) '411041638172952172486516562327433593364645281269048385080416744148816596892929&'
WRITE (23,*) '875001176525062039199253202442499856370131521043205763859751596997775878901931&'
WRITE (23,*) '926539550759620343899982502799237669772902105521254539340286474838417913238066&'
WRITE (23,*) '059141093459934876325848519929228497193995693507177967072960203848722923747150&'
WRITE (23,*) '140765786176771174408993400136927244191829685628245251748657902025770716583029&'
WRITE (23,*) '853935066095540571663241126551724249990048205178938683547936966320669422958161&'
WRITE (23,*) '050604030359040585662069577605945095219129191030265043557212878090927377825447&'
WRITE (23,*) '774936343833336869500567523795175838116365257896893692420348314819899318157675&'
WRITE (23,*) '946355987268370152972934539763387953396724843649699089955400295299155639991980&'
WRITE (23,*) '112120122549591864509868990864535156475738679125209082331563857113259205813346&'
WRITE (23,*) '296947083781078034213628498976780208971112282678269879210194898987156698008106&'
WRITE (23,*) '644103527258123408056472309443396903625043297746420126313561341596502344991504&'
WRITE (23,*) '774765705366125271942124563888861222355681773755420281393716401245093417134864&'
WRITE (23,*) '892413424025308305228370342108957865874423495212421782595144749299841486632259&'
WRITE (23,*) '803631830199223228460657603350268704051453889331851491821591049538380090344644&'
WRITE (23,*) '366461890550030988563519195908340991033630840858917972058451512280615234348179&'
WRITE (23,*) '186431604127199959142745423756327774842886188566400617380143873060743003207612&'
WRITE (23,*) '908374637945275566050281666845830942463782581492320884105122265910609450782637&'
WRITE (23,*) '708741962262301154596674127758538084202376673890516535970284295957833210637009&'
WRITE (23,*) '259510159501234954389796041202325093036274908630148653907389582417952735284745&'
WRITE (23,*) '357623120911584953750113473887485428833766873879809220392358890917600334360517&'
WRITE (23,*) '341557950146917634324918300878337410688289348393687392767473010467425661695257&'
WRITE (23,*) '652600452515616639412091874988944234340527682082201941031378698318477369742325'
WRITE (23,*) ' '
CLOSE(23)
OPEN (23,FILE='TEMPFM')
CALL FM_READ(23,M_D)
CLOSE(23)
MFM3 = ABS(M_A - M_D)
CALL FM_ST2M(' 1.0E-20000 ',MFM4)
IF (.NOT.(MFM3 <= MFM4)) THEN
CALL PRTERR(KWSAVE)
ENDIF
NCASE = 3268
CALL FMSET(30000)
M_A = TO_FM(31) / 41
M_B = TO_FM(37) / 47
M_C = M_A / M_B
M_D = M_C * 1517 - 1457
IF (.NOT.(ABS(M_D) <= TO_FM(' 1e-30000 '))) THEN
CALL PRTERR(KWSAVE)
ENDIF
KW = KWSAVE
RETURN
END SUBROUTINE TEST116
END MODULE TEST_H
PROGRAM TEST
USE TEST_VARS
USE TEST_A
USE TEST_B
USE TEST_C
USE TEST_D
USE TEST_E
USE TEST_F
USE TEST_G
USE TEST_H
IMPLICIT NONE
! Write output to the standard FM output (unit KW, defined in subroutine FMSET),
! and also to the file TestFM.out.
KLOG = 18
OPEN (KLOG,FILE='TestFM.out')
KWSAVE = KW
KW = KLOG
! Set precision to give at least 50 significant digits and initialize the FM package.
! This call also checks many of the initialization values used in module FMVALS
! (file FMSAVE.f95). Set KW = KLOG for this call so that any messages concerning these
! values will appear in file TestFM.out.
CALL FM_SET(50)
KW = KWSAVE
! Write output for testing error messages to the file FMERRMSG.OUT.
OPEN (22,FILE='FMERRMSG.OUT')
WRITE (22,*) ' '
WRITE (22,*) ' This file is produced by the TestFM program while testing'
WRITE (22,*) ' error messages and trace output options.'
WRITE (22,*) ' '
KW = 22
CALL FPVARS
KW = KWSAVE
CALL CPU_TIME(TIME1)
! Initialize some of the test variables.
J2 = 131
R2 = 241.21
D2 = 391.61D0
C2 = ( 411.11D0 , 421.21D0 )
CD2 = ( 431.11D0 , 441.21D0 )
CALL FM_ST2M('581.21',MFM1)
CALL FM_ST2M('-572.42',MFM2)
CALL IM_ST2M('661',MIM1)
CALL IM_ST2M('-602',MIM2)
CALL ZM_ST2M('731.51 + 711.41 i',MZM1)
CALL ZM_ST2M('-762.12 - 792.42 i',MZM2)
! NERROR is the number of errors found.
NERROR = 0
! Test input and output conversion.
CALL TEST1
! Test add and subtract.
CALL TEST2
! Test multiply, divide and square root.
CALL TEST3
! Test stored constants.
CALL TEST4
! Test exponentials.
CALL TEST5
! Test logarithms.
CALL TEST6
! Test trigonometric functions.
CALL TEST7
! Test inverse trigonometric functions.
CALL TEST8
! Test hyperbolic functions.
CALL TEST9
! Test integer input and output conversion.
CALL TEST10
! Test integer add and subtract.
CALL TEST11
! Test integer multiply and divide.
CALL TEST12
! Test conversions between FM and IM format.
CALL TEST13
! Test integer power and GCD functions.
CALL TEST14
! Test integer modular functions.
CALL TEST15
! Test complex input and output conversion.
CALL TEST16
! Test complex add and subtract.
CALL TEST17
! Test complex multiply, divide and square root.
CALL TEST18
! Test complex exponentials.
CALL TEST19
! Test complex logarithms.
CALL TEST20
! Test complex trigonometric functions.
CALL TEST21
! Test complex inverse trigonometric functions.
CALL TEST22
! Test complex hyperbolic functions.
CALL TEST23
! Test the derived type = interface.
CALL TEST24
! Test the derived type == interface.
CALL TEST25
! Test the derived type /= interface.
CALL TEST26
! Test the derived type > interface.
CALL TEST27
! Test the derived type >= interface.
CALL TEST28
! Test the derived type < interface.
CALL TEST29
! Test the derived type <= interface.
CALL TEST30
! Test the derived type + interface.
CALL TEST31
! Test the derived type - interface.
CALL TEST32
! Test the derived type * interface.
CALL TEST33
! Test the derived type / interface.
CALL TEST34
! Test the derived type ** interface.
CALL TEST35
! Test the derived type functions ABS, ..., CEILING interface.
CALL TEST36
! Test the derived type functions CMPLX, ..., EXPONENT interface.
CALL TEST37
! Test the derived type functions FLOOR, ..., MIN interface.
CALL TEST38
! Test the derived type functions MINEXPONENT, ..., RRSPACING interface.
CALL TEST39
! Test the derived type functions SCALE, ..., TINY interface.
CALL TEST40
! Test the derived type functions TO_FM, TO_IM, TO_ZM, ..., TO_DPZ interface.
CALL TEST41
! Test the derived type functions ADDI, ..., Z2M interface.
CALL TEST42
! Test Bernoulli numbers, Pochhammer's function, Euler's constant.
CALL TEST43
! Test Gamma, Factorial, Log(Gamma), Beta, Binomial.
CALL TEST44
! Test Incomplete Gamma, Incomplete Beta.
CALL TEST45
! Test Polygamma, Psi.
CALL TEST46
! Test the different rounding modes.
CALL TEST47
CALL TEST48
CALL TEST49
CALL TEST50
CALL TEST51
CALL TEST52
! Test special cases and error cases.
CALL TEST53
! Test packed array routines and error messages.
CALL TEST54
CALL TEST55
CALL TEST56
CALL TEST57
CALL TEST58
CALL TEST59
CALL TEST60
! Test special functions Bessel J, ..., Sine integral
CALL TEST61
! Test derived-type array equal assignments.
CALL TEST62
CALL TEST63
CALL TEST64
CALL TEST65
CALL TEST66
CALL TEST67
! Test derived-type array addition operations.
CALL TEST68
CALL TEST69
CALL TEST70
CALL TEST71
CALL TEST72
CALL TEST73
CALL TEST74
CALL TEST75
CALL TEST76
CALL TEST77
CALL TEST78
CALL TEST79
! Test derived-type array subtraction operations.
CALL TEST80
CALL TEST81
CALL TEST82
CALL TEST83
CALL TEST84
CALL TEST85
CALL TEST86
CALL TEST87
CALL TEST88
CALL TEST89
CALL TEST90
CALL TEST91
! Test derived-type array multiplication operations.
CALL TEST92
CALL TEST93
CALL TEST94
CALL TEST95
CALL TEST96
CALL TEST97
CALL TEST98
CALL TEST99
CALL TEST100
CALL TEST101
CALL TEST102
CALL TEST103
! Test derived-type array division operations.
CALL TEST104
CALL TEST105
CALL TEST106
CALL TEST107
CALL TEST108
CALL TEST109
CALL TEST110
CALL TEST111
CALL TEST112
CALL TEST113
CALL TEST114
CALL TEST115
! Test higher precision operations.
CALL TEST116
! End of tests.
CALL CPU_TIME(TIME2)
IF (NERROR == 0) THEN
WRITE (KW, "(///1X,I5,' cases tested. No errors were found.'/)" ) NCASE
WRITE (KLOG, "(///1X,I5,' cases tested. No errors were found.'/)" ) NCASE
ELSE IF (NERROR == 1) THEN
WRITE (KW, "(///1X,I5,' cases tested. 1 error was found.'/)" ) NCASE
WRITE (KLOG, "(///1X,I5,' cases tested. 1 error was found.'/)" ) NCASE
ELSE
WRITE (KW, "(///1X,I5,' cases tested.',I4,' errors were found.'/)" ) NCASE,NERROR
WRITE (KLOG, "(///1X,I5,' cases tested.',I4,' errors were found.'/)" ) NCASE,NERROR
ENDIF
IF (NERROR >= 1) THEN
KWSAVE = KW
KW = KLOG
! Write some of the variables in module FMVALS.
CALL FPVARS
KW = KWSAVE
ENDIF
WRITE (KW,*) ' '
WRITE (KW,"(F10.2,A)") TIME2-TIME1,' Seconds for TestFM.'
WRITE (KW,*) ' '
WRITE (KLOG,*) ' '
WRITE (KLOG,"(F10.2,A)") TIME2-TIME1,' Seconds for TestFM.'
WRITE (KLOG,*) ' '
WRITE (KW,*)' End of run.'
STOP
END PROGRAM TEST
SUBROUTINE ERRPRTFM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)
! Print error messages for testing of real (FM) routines.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using FMST2M.
! M3 is ABS(M1-M2), and ERRPRT is called if this is too big.
! NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine
! correspond to M1,M2,M3.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
INTEGER :: M1,M2,M3
CHARACTER(2) :: NAME1,NAME2,NAME3
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so FMPRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL FMPRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL FMPRINT(M2)
WRITE (KLOG,"(1X,A,' =')") NAME3
CALL FMPRINT(M3)
KW = KWSAVE
RETURN
END SUBROUTINE ERRPRTFM
SUBROUTINE ERRPRTIM(NROUT,M1,NAME1,M2,NAME2)
! Print error messages for testing of integer (IM) routines.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using IMST2M.
! NAME1,NAME2 are strings identifying which variables in the calling routine correspond to M1,M2.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
INTEGER :: M1,M2
CHARACTER(2) :: NAME1,NAME2
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so IMPRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL IMPRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL IMPRINT(M2)
KW = KWSAVE
END SUBROUTINE ERRPRTIM
SUBROUTINE ERRPRTZM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)
! Print error messages.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using ZMST2M.
! M3 is ABS(M1-M2), and ERRPRTZM is called if this is too big.
! NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
! to M1,M2,M3.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
INTEGER :: M1(2),M2(2),M3(2)
CHARACTER(2) :: NAME1,NAME2,NAME3
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The routine',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so ZMPRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL ZMPRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL ZMPRINT(M2)
WRITE (KLOG,"(1X,A,' =')") NAME3
CALL ZMPRINT(M3)
KW = KWSAVE
END SUBROUTINE ERRPRTZM
SUBROUTINE ERRPRT_FM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)
! Print error messages for testing of TYPE (FM) interface routines.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using FMST2M.
! M3 is ABS(M1-M2), and ERRPRT_FM is called if this is too big.
! NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
! to M1,M2,M3.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
TYPE (FM) :: M1, M2, M3
CHARACTER(3) :: NAME1,NAME2,NAME3
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so FM_PRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL FM_PRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL FM_PRINT(M2)
WRITE (KLOG,"(1X,A,' =')") NAME3
CALL FM_PRINT(M3)
KW = KWSAVE
END SUBROUTINE ERRPRT_FM
SUBROUTINE ERRPRT_IM(NROUT,M1,NAME1,M2,NAME2)
! Print error messages for testing of TYPE (IM) interface routines.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using IMST2M.
! NAME1,NAME2 are strings identifying which variables in the calling routine correspond to M1,M2.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
TYPE (IM) :: M1, M2
CHARACTER(3) :: NAME1,NAME2
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so IM_PRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL IM_PRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL IM_PRINT(M2)
KW = KWSAVE
END SUBROUTINE ERRPRT_IM
SUBROUTINE ERRPRT_ZM(NROUT,M1,NAME1,M2,NAME2,M3,NAME3)
! Print error messages for testing of TYPE (ZM) interface routines.
! M1 is the value to be tested, as computed by the routine named NROUT.
! M2 is the reference value, usually converted using ZMST2M.
! M3 is ABS(M1-M2), and ERRPRT_ZM is called if this is too big.
! NAME1,NAME2,NAME3 are strings identifying which variables in the calling routine correspond
! to M1,M2,M3.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
TYPE (ZM) :: M1, M2, M3
CHARACTER(3) :: NAME1,NAME2,NAME3
CHARACTER(6) :: NROUT
NERROR = NERROR + 1
WRITE (KW, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
WRITE (KLOG, &
"(//' Error in case',I5,'. The interface',' being tested was ',A6)" &
) NCASE,NROUT
! Temporarily change KW to KLOG so ZM_PRINT will write to the log file.
KWSAVE = KW
KW = KLOG
WRITE (KLOG,"(1X,A,' =')") NAME1
CALL ZM_PRINT(M1)
WRITE (KLOG,"(1X,A,' =')") NAME2
CALL ZM_PRINT(M2)
WRITE (KLOG,"(1X,A,' =')") NAME3
CALL ZM_PRINT(M3)
KW = KWSAVE
END SUBROUTINE ERRPRT_ZM
SUBROUTINE ERRPRT_STR(STRING1,STRING2)
! Print error messages for testing of output formatting routines.
! STRING1 is the output string, formatted by FM_FORM
! STRING2 is the reference string to be compared to STRING1.
USE FMVALS
USE FMZM
USE TEST_VARS
IMPLICIT NONE
CHARACTER(80) :: STRING1, STRING2
NERROR = NERROR + 1
WRITE (KW,*) ' Error in case ',NCASE,' during input/output testing.'
WRITE (KLOG,*) ' Error in case ',NCASE,' during input/output testing.'
WRITE (KLOG,*) ' STRING1 = ',TRIM(STRING1)
WRITE (KLOG,*) ' STRING2 = ',TRIM(STRING2)
END SUBROUTINE ERRPRT_STR
SUBROUTINE PRTERR(KW2)
USE TEST_VARS
IMPLICIT NONE
INTEGER :: KW2
WRITE (KW2,*) ' Error in case ',NCASE
WRITE (KLOG,*) ' '
WRITE (KLOG,*) ' Error in case ',NCASE
NERROR = NERROR + 1
END SUBROUTINE PRTERR
c4science · Help