!  Test version 1.4 of FM_parallel.f95, the thread-safe version of the FM package, using CoArrays.

      PROGRAM TEST
      USE FMVALS_PARALLEL
      USE FMZM_PARALLEL
      IMPLICIT NONE

    INTERFACE
      FUNCTION Z_TEST_FUNCTION(XI,NI,QX)     RESULT (RETURN_VALUE)
      USE FMVALS_PARALLEL
      IMPLICIT NONE
      TYPE (MULTI) :: XI(2)
      INTEGER :: NI
      TYPE (MULTI), DIMENSION(2) :: RETURN_VALUE
      TYPE(FM_SETTINGS) :: QX
      END FUNCTION Z_TEST_FUNCTION
    END INTERFACE
      INTEGER, PARAMETER :: N_VALS = 10, MAX_CASE = 500
      INTEGER :: L, N_ERRORS, SKIP, SKIP_CHECK(30)
      DOUBLE PRECISION :: TIME1, TIME2
      CHARACTER(8) :: FILE_NUMBER
      CHARACTER(25) :: FILE_NAME
      CHARACTER(251) :: LINE1, LINE2
      LOGICAL :: CHK_FILE_EXISTS
      TYPE(FM), EXTERNAL :: FM_FPRIME
      TYPE(ZM), EXTERNAL :: ZM_FPRIME
      TYPE(MULTI), EXTERNAL :: F_TEST_FUNCTION
      EXTERNAL :: FM_RK14_F

!             Declare the coarray variables.

      TYPE (FM) :: X1[*], X2[*], R[*], X_VALS(2*N_VALS)[*],            &
                   A(5,5)[*], B(5)[*], X(5)[*], DET[*], AINV(5,5)[*],  &
                   AX[*], BX[*], TOL[*], XVAL[*], FVAL[*], S(3)[*], S1(3)[*]
      TYPE (IM) :: I1[*]
      TYPE (ZM) :: Z1[*], Z2[*], Z3[*], ZA(5,5)[*], ZB(5)[*], ZX(5)[*], ZDET[*], ZAINV(5,5)[*],  &
                   LIST_OF_ROOTS(8)[*]
      INTEGER :: I[*], N_CASE[*], J[*], K[*], N_FOUND[*], N_ORDER[*], N_FUNCTION[*]
      DOUBLE PRECISION :: RM[*], RAN(4*N_VALS*MAX_CASE)[*]

!             The first section is not run in parallel.

if (this_image() .eq. 1) then
      CALL CLOCK_TIME(TIME1)
endif

sync all

!             Test each operation at 2*N_VALS different arguments.

      X1 = TO_FM('0.001234')
      X2 = TO_FM('987.6')
      R = (X2/X1) ** (TO_FM(1)/(N_VALS-1))
      CALL FM_FORM('ES60.50',R,LINE1)
      R = TO_FM(TRIM(LINE1))
      X_VALS(1) = X1
      DO J = 2, N_VALS
         X_VALS(J) = R * X_VALS(J-1)
         CALL FM_FORM('ES60.50',X_VALS(J),LINE1)
         X_VALS(J) = TO_FM(TRIM(LINE1))
      ENDDO
      DO J = 1, N_VALS
         X_VALS(J+N_VALS) = -X_VALS(J)
      ENDDO

      RM = 2.0D0**31 - 1
      RAN(1) = RM / 3
      DO J = 2, 4*N_VALS*MAX_CASE
         RAN(J) = MOD( 314159.0D0 * RAN(J-1) , RM )
      ENDDO
      RAN = RAN/RM
      RAN = RAN*(2*N_VALS) + 1

sync all

!             Run the test cases in parallel.

      DO I = this_image(), 2*N_VALS, num_images()

         IF (I == this_image()) THEN
             WRITE(FILE_NUMBER,"(I8)") this_image()
             FILE_NAME = TRIM( 'TestFM_parallel' // ADJUSTL(FILE_NUMBER) ) // '.out'
             OPEN(30+this_image(),FILE=TRIM(FILE_NAME))
         ENDIF

         N_CASE = 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = X_VALS(J) + X_VALS(K)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 2
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = X_VALS(J) - X_VALS(K)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 3
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = X_VALS(J) * X_VALS(K)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 4
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = X_VALS(J) / X_VALS(K)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 5
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = X_VALS(J) ** X_VALS(K)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 6
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = SQRT(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 7
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = (X_VALS(I)) ** 2
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 8
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SIN(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 9
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = COS(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 10
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = TAN(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 11
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1.0,1.0,J,K)
         X1 = ASIN(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 12
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1.0,1.0,J,K)
         X1 = ACOS(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 13
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ATAN(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 14
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SINH(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 15
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = COSH(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 16
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = TANH(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 17
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ASINH(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 18
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,1.0,1001.0,J,K)
         X1 = ACOSH(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 19
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1.0,1.0,J,K)
         X1 = ATANH(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 20
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP(X_VALS(I))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 21
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = LOG(X_VALS(J))
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 22
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP(X_VALS(I)) + TO_FM(2)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 23
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM('2.1') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 24
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM('2.2D0') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 25
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM('2.3') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 26
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM(TO_ZM('2.4+2.5i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 27
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM(TO_ZM('2.5D0+2.6D0i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 28
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM((X_VALS(I))/10) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 29
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM(TO_IM(2)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 30
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_FM(TO_ZM('2.01+2.01i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 31
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP(X_VALS(I)) + TO_IM(2)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 32
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(2.1) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 33
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(2.2D0) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 34
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM('2.3') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 35
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(TO_ZM('2.4+2.5i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 36
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(TO_ZM('2.5D0+2.6D0i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 37
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM((X_VALS(I))/10) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 38
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(TO_IM(2)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 39
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP( (X_VALS(I)) + TO_IM(TO_ZM('2.01+2.01i')) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 40
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = INT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 41
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = NINT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 42
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FLOOR( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 43
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = CEILING( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 44
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MOD( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 45
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MOD( TO_IM(X_VALS(J)) + 12345678 , TO_IM(X_VALS(K)) + 1234 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 46
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = GCD( TO_IM(X_VALS(J)) + 12345678 , TO_IM(X_VALS(K)) + 1234 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 47
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FACTORIAL( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 48
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = GAMMA( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 49
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = GAMMA( (X_VALS(I)) + 1 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 50
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = LOG_GAMMA( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 51
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BINOMIAL( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 52
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_EULER(X1)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 53
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BERNOULLI( TO_INT(ABS(X_VALS(I))) + 12 + I )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 54
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BETA( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 55
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = PSI( (X_VALS(J)) + TO_FM('0.12345') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 56
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = POLYGAMMA( I , (X_VALS(J)) + TO_FM('0.12345') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 57
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = POCHHAMMER( (X_VALS(J)) + TO_FM('0.12345') , I )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 58
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = INCOMPLETE_GAMMA1( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 59
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = INCOMPLETE_GAMMA2( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 60
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BESSEL_J( I , (X_VALS(I)) + TO_FM('0.12345') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 61
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = BESSEL_Y( I , (X_VALS(J)) + TO_FM('0.12345') )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 62
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BESSEL_J0( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 63
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = BESSEL_J1( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 64
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = BESSEL_Y0( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 65
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = BESSEL_Y1( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 66
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = COS_INTEGRAL( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 67
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = COSH_INTEGRAL( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 68
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ERF( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 69
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ERFC( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 70
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ERFC_SCALED( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 71
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXP_INTEGRAL_EI( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 72
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = EXP_INTEGRAL_EN( I , (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 73
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FRESNEL_C( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 74
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FRESNEL_S( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 75
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X2 = TO_FM(I) / (2*N_VALS+1)
         X1 = INCOMPLETE_BETA( X2, X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 76
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = LOG_ERFC( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 77
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = LOG_INTEGRAL( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 78
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SIN_INTEGRAL( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 79
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SINH_INTEGRAL( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 80
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) == X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 81
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) /= X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 82
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) < X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 83
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) <= X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 84
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) > X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 85
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (X_VALS(J) >= X_VALS(K)) THEN
             X1 = X_VALS(J)
         ELSE
             X1 = X_VALS(K)
         ENDIF
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 86
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J)) + TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 87
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J)) - TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 88
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J)) * TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 89
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J)) / TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 90
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) == TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 91
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) /= TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 92
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) <= TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 93
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) < TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 94
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) >= TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 95
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         IF (TO_IM(TO_FM('1.0D+41')*X_VALS(J)) > TO_IM(TO_FM('1.0D+43')*X_VALS(K))) THEN
             I1 = TO_IM(TO_FM('1.0D+41')*X_VALS(J))
         ELSE
             I1 = TO_IM(TO_FM('1.0D+43')*X_VALS(K))
         ENDIF
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 96
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = ABS(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 97
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = BINOMIAL(TO_IM(100),TO_IM(50))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 98
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = CEILING(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 99
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = DIGITS(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 100
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = DIM(TO_IM(TO_FM('1.0D+41')*X_VALS(J)),TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 101
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = FACTORIAL(TO_IM(50))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 102
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = FLOOR(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 103
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = GCD(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 104
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = INT(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 105
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = MAX(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 106
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = MIN(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 107
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = MOD(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 108
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = MODULO(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 109
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = MULTIPLY_MOD(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)) ,  &
              TO_IM('1234567'))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 110
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = NINT(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 111
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = POWER_MOD(ABS(TO_IM(TO_FM('1.0D+41')*X_VALS(J))) ,  &
                        ABS(TO_IM(TO_FM('1.0D+43')*X_VALS(K))) , TO_IM('1234567'))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 112
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = RADIX(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 113
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = RANGE(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 114
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = SIGN(TO_IM(TO_FM('1.0D+41')*X_VALS(J)) , TO_IM(TO_FM('1.0D+43')*X_VALS(K)))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 115
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         I1 = TINY(TO_IM(TO_FM('1.0D+41')*(X_VALS(I))))
         CALL OUTPUT_IM(I,N_CASE,I1)

         N_CASE = 116
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ABS( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 117
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = AINT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 118
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ANINT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 119
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = ATAN2( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 120
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = CEILING( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 121
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = DBLE( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 122
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = DIGITS( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 123
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = DIM( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 124
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = DINT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 125
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EPSILON( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 126
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = EXPONENT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 127
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FLOOR( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 128
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = FRACTION( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 129
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = HUGE( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 130
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = HYPOT( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 131
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = INT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 132
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,0.0,1001.0,J,K)
         X1 = LOG10( (X_VALS(J)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 133
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MAX( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 134
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MIN( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 135
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MAXEXPONENT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 136
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MINEXPONENT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 137
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = MODULO( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 138
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = NEAREST( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 139
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = NINT( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 140
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = PRECISION( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 141
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = RADIX( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 142
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = RANGE( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 143
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = RRSPACING( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 144
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SCALE( (X_VALS(I)) , 4 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 145
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SIGN( X_VALS(J) , X_VALS(K) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 146
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         X1 = SPACING( (X_VALS(I)) )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 147
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_COSH_SINH( (X_VALS(I)) , X1 , X2 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 148
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_COSH_SINH( (X_VALS(I)) , X1 , X2 )
         CALL OUTPUT(I,N_CASE,X2)

         N_CASE = 149
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_COS_SIN( (X_VALS(I)) , X1 , X2 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 150
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_COS_SIN( (X_VALS(I)) , X1 , X2 )
         CALL OUTPUT(I,N_CASE,X2)

         N_CASE = 151
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         CALL FM_ULP( (X_VALS(I)) , X1 )
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 152
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         N_CASE = N_CASE + 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z3 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = Z2 + Z3
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 154
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         N_CASE = N_CASE + 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z3 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = Z2 - Z3
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 156
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         N_CASE = N_CASE + 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z3 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = Z2 * Z3
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 158
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         N_CASE = N_CASE + 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z3 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = Z2 / Z3
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 160
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         N_CASE = N_CASE + 1
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z3 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = Z2 ** Z3
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 162
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ABS(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 164
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ACOS(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 166
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ACOSH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 168
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = AINT(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 170
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ASIN(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 172
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ASINH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 174
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ATAN(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 176
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ATANH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 178
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = CEILING(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 180
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = CONJG(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 182
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = COS(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 184
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = COSH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 186
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = DBLE(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 188
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = DIGITS(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 190
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = DINT(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 192
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ERF(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 194
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ERFC(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 196
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = ERFC_SCALED(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 198
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = EXP(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 200
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = FACTORIAL(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 202
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = FLOOR(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 204
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = FRACTION(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 206
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = GAMMA(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 208
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = HUGE(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 210
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = INT(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 212
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = LOG(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 214
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = LOG10(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 216
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = LOG_GAMMA(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 218
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = NINT(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 220
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = PRECISION(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 222
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = RADIX(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 224
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = RANGE(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 226
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = REAL(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 228
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = SCALE(Z2,I)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 230
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = SIN(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 232
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = SINH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 234
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = SQRT(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 236
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = TAN(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 238
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = TANH(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 240
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         Z1 = TINY(Z2)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 242
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         CALL ZM_COSH_SINH(Z2,Z1,Z3)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE,REAL(Z3))
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 246
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         CALL ZM_COS_SIN(Z2,Z1,Z3)
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE-1,REAL(Z1))
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE,REAL(Z3))
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE,AIMAG(Z1))

         N_CASE = 250
         CALL ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,-1001.0,1001.0,J,K)
         Z2 = CMPLX( X_VALS(J) , X_VALS(K) )
         CALL ZM_ARG(Z2,X1)
         CALL OUTPUT(I,N_CASE,X1)

         N_CASE = 251
         DO J = 1, 5
            DO K = 1, 5
               A(J,K) = TAN(TO_FM(J*K)) + EXP(TO_FM(J-K))*LOG(TO_FM('1.2')*(J+K)) +  &
                        TO_FM(I*100)/N_CASE
            ENDDO
            B(J) = J
         ENDDO
         CALL FM_LIN_SOLVE(A,X,B,5,DET)
         DO J = 1, 5
            CALL OUTPUT(I,N_CASE,X(J))
            N_CASE = N_CASE + 1
         ENDDO

         N_CASE = 256
         CALL OUTPUT(I,N_CASE,DET)

         N_CASE = 257
         CALL FM_INVERSE(A,5,AINV,DET)
         DO J = 1, 5
            DO K = 1, 5
               CALL OUTPUT(I,N_CASE,AINV(J,K))
               N_CASE = N_CASE + 1
            ENDDO
         ENDDO

         N_CASE = 282
         AX = 0
         BX = 2
         TOL = TO_FM('1.0E-25')
         CALL FM_FIND_MIN(1,AX,BX,TOL,XVAL,FVAL,F_TEST_FUNCTION,1,0,6)
         CALL OUTPUT(I,N_CASE,XVAL)
         N_CASE = 283
         CALL OUTPUT(I,N_CASE,FVAL)

         N_CASE = 284
         AX = TO_FM(I)/4
         BX = FM_FPRIME(MOD(I,6),AX,F_TEST_FUNCTION,1)
         CALL OUTPUT(I,N_CASE,BX)

         N_CASE = 285
         AX = TO_FM(I)/4
         BX = AX + 1
         TOL = TO_FM('1.0E-40')
         CALL FM_INTEGRATE(F_TEST_FUNCTION,1,AX,BX,TOL,FVAL,0,6)
         CALL OUTPUT(I,N_CASE,FVAL)

         N_CASE = 286
         N_ORDER = 2
         N_FUNCTION = 1
         AX = TO_FM(I)/4
         BX = AX + TO_FM(1)/4
         S(1) = 1
         S(2) = -1
         TOL = TO_FM(' 1.0e-30 ')
         CALL FM_RK14(AX,BX,N_ORDER,FM_RK14_F,N_FUNCTION,S,TOL,S1)
         CALL OUTPUT(I,N_CASE,S1(1))
         N_CASE = N_CASE + 1
         CALL OUTPUT(I,N_CASE,S1(2))

         N_CASE = 288
         AX = TO_FM(-3) + TO_FM(I-1)/2
         BX = AX + 1.0E-3
         CALL FM_SECANT(AX,BX,F_TEST_FUNCTION,2,XVAL,0,6)
         CALL OUTPUT(I,N_CASE,XVAL)

         N_CASE = 289
         DO J = 1, 5
            DO K = 1, 5
               ZA(J,K) = CMPLX(TAN(TO_FM(J*K)) + EXP(TO_FM(J-K))*LOG(TO_FM('1.2')*(J+K)) +  &
                                   TO_FM(I*100)/N_CASE ,                                    &
                               TAN(TO_FM(J*K)) + EXP(TO_FM(J-K))*LOG(TO_FM('2.3')*(J+K)) +  &
                                   TO_FM(I*100)/N_CASE                                      &
                              )
            ENDDO
            ZB(J) = J
         ENDDO
         CALL ZM_LIN_SOLVE(ZA,ZX,ZB,5,ZDET)
         DO J = 1, 5
            CALL OUTPUT(I,N_CASE,REAL(ZX(J)))
            N_CASE = N_CASE + 1
            CALL OUTPUT(I,N_CASE,AIMAG(ZX(J)))
            N_CASE = N_CASE + 1
         ENDDO

         N_CASE = 299
         CALL OUTPUT(I,N_CASE,REAL(ZDET))
         N_CASE = 300
         CALL OUTPUT(I,N_CASE,AIMAG(ZDET))

         N_CASE = 301
         CALL ZM_INVERSE(ZA,5,ZAINV,ZDET)
         DO J = 1, 5
            DO K = 1, 5
               CALL OUTPUT(I,N_CASE,REAL(ZAINV(J,K)))
               N_CASE = N_CASE + 1
               CALL OUTPUT(I,N_CASE,AIMAG(ZAINV(J,K)))
               N_CASE = N_CASE + 1
            ENDDO
         ENDDO

         N_CASE = 351
         CALL OUTPUT(I,N_CASE,REAL(ZDET))
         N_CASE = 352
         CALL OUTPUT(I,N_CASE,AIMAG(ZDET))

         N_CASE = 353
         Z1 = CMPLX(3*TO_FM(I)/4,6*TO_FM(I)/5)
         Z2 = ZM_FPRIME(MOD(I,4),Z1,Z_TEST_FUNCTION,1)
         CALL OUTPUT(I,N_CASE,REAL(Z2))
         N_CASE = 354
         CALL OUTPUT(I,N_CASE,AIMAG(Z2))

         N_CASE = 355
         Z1 = EXP(CMPLX(TO_FM(0),TO_FM(I))) * TO_FM('0.5') * TO_FM('1.05')**(I-1)
         Z2 = Z1 + CMPLX(TO_FM('0.001'),I*TO_FM('0.001'))
         CALL ZM_SECANT(Z1,Z2,Z_TEST_FUNCTION,1,Z3,0,6)
         CALL OUTPUT(I,N_CASE,REAL(Z3))
         N_CASE = 356
         CALL OUTPUT(I,N_CASE,AIMAG(Z3))

         N_CASE = 357
         CALL ZM_ROOTS(8,Z_TEST_FUNCTION,1,N_FOUND,LIST_OF_ROOTS,0,6)
         DO J = 1, N_FOUND-1
            DO K = 1, N_FOUND-J
               IF (ABS( ABS(LIST_OF_ROOTS(K)) - ABS(LIST_OF_ROOTS(K+1)) ) < 1.0D-50 .AND.  &
                   AIMAG(LIST_OF_ROOTS(K)) < 0) THEN
                   Z1 = LIST_OF_ROOTS(K)
                   LIST_OF_ROOTS(K) = LIST_OF_ROOTS(K+1)
                   LIST_OF_ROOTS(K+1) = Z1
               ELSE IF (ABS(LIST_OF_ROOTS(K)) < ABS(LIST_OF_ROOTS(K+1))) THEN
                   Z1 = LIST_OF_ROOTS(K)
                   LIST_OF_ROOTS(K) = LIST_OF_ROOTS(K+1)
                   LIST_OF_ROOTS(K+1) = Z1
               ENDIF
            ENDDO
         ENDDO
         DO J = 1, N_FOUND
            CALL OUTPUT(I,N_CASE,REAL(LIST_OF_ROOTS(J)))
            N_CASE = N_CASE + 1
            CALL OUTPUT(I,N_CASE,AIMAG(LIST_OF_ROOTS(J)))
            N_CASE = N_CASE + 1
         ENDDO

         N_CASE = 373
         AX = TO_FM('-2.11') + TO_FM(I-1)/3
         BX = AX + 1.0E-3
         CALL FM_SECANT(AX,BX,F_TEST_FUNCTION,3,XVAL,0,6)
         CALL OUTPUT(I,N_CASE,XVAL)

         N_CASE = 374
         Z1 = EXP(CMPLX(TO_FM(0),TO_FM(I))) * TO_FM('0.5') * TO_FM('1.05')**(I-1)
         Z2 = Z1 + CMPLX(TO_FM('0.001'),I*TO_FM('0.001'))
         CALL ZM_SECANT(Z1,Z2,Z_TEST_FUNCTION,2,Z3,0,6)
         CALL OUTPUT(I,N_CASE,REAL(Z3))
         N_CASE = 375
         CALL OUTPUT(I,N_CASE,AIMAG(Z3))

         N_CASE = 376
         CALL ZM_ROOTS(6,Z_TEST_FUNCTION,2,N_FOUND,LIST_OF_ROOTS,0,6)
         DO J = 1, N_FOUND-1
            DO K = 1, N_FOUND-J
               IF (ABS( ABS(LIST_OF_ROOTS(K)) - ABS(LIST_OF_ROOTS(K+1)) ) < 1.0D-50 .AND.  &
                   AIMAG(LIST_OF_ROOTS(K)) < 0) THEN
                   Z1 = LIST_OF_ROOTS(K)
                   LIST_OF_ROOTS(K) = LIST_OF_ROOTS(K+1)
                   LIST_OF_ROOTS(K+1) = Z1
               ELSE IF (ABS(LIST_OF_ROOTS(K)) > ABS(LIST_OF_ROOTS(K+1))) THEN
                   Z1 = LIST_OF_ROOTS(K)
                   LIST_OF_ROOTS(K) = LIST_OF_ROOTS(K+1)
                   LIST_OF_ROOTS(K+1) = Z1
               ENDIF
            ENDDO
         ENDDO
         DO J = 1, N_FOUND
            CALL OUTPUT(I,N_CASE,REAL(LIST_OF_ROOTS(J)))
            N_CASE = N_CASE + 1
            CALL OUTPUT(I,N_CASE,AIMAG(LIST_OF_ROOTS(J)))
            N_CASE = N_CASE + 1
         ENDDO
         N_CASE = N_CASE - 1

      ENDDO

      CLOSE(30+this_image())

sync all

if (this_image() .eq. 1) then
      CALL CLOCK_TIME(TIME2)
      WRITE (*,"(//F9.2,A)") TIME2-TIME1, ' seconds for the tests.'

!             Check the results against file TestFM_parallel.chk

      INQUIRE(FILE='TestFM_parallel.chk', EXIST=CHK_FILE_EXISTS)
      IF (.NOT. CHK_FILE_EXISTS) THEN
          WRITE (*,"(//A//)") ' Cannot check the results because file  TestFM_parallel.chk ' //  &
                              ' does not exist in this location.'
          STOP
      ENDIF

!             Some of the cases above test the FM functions for machine characteristics, such as
!             DIGITS, EXPONENT, FRACTION, ...
!             These might be different when this program runs on a different machine, so
!             don't call it an error if one of those cases differs from the chk file.

      SKIP_CHECK = [  99, 112, 113, 122, 125, 126, 128, 129, 135, 136, 140, 141, 142, 143, 144,  &
                     146, 151, 188, 204, 205, 208, 209, 220, 221, 222, 223, 224, 225, 228, 229 ]

      OPEN(21,FILE='TestFM_parallel.chk')
      DO I = 1, num_images()
         WRITE(FILE_NUMBER,"(I8)") I
         FILE_NAME = TRIM( 'TestFM_parallel' // ADJUSTL(FILE_NUMBER) ) // '.out'
         OPEN(30+I,FILE=TRIM(FILE_NAME))
      ENDDO

      IF (FM_SIGNIFICANT_DIGITS /= 50) THEN

      ENDIF

      N_ERRORS = 0
      I = 1
      DO K = 1, 2*N_VALS
         DO J = 1, N_CASE
            READ (21,"(A)") LINE1
            READ (30+I,"(A)") LINE2
            X1 = TO_FM(TRIM(LINE1(15:251)))
            X2 = TO_FM(TRIM(LINE2(15:251)))
            R = ABS(X1-X2)
            IF (J >= 355) THEN
                IF (ABS(X1) < 1.0D-50 .AND. ABS(X2) < 1.0D-50) R = 0
            ENDIF
            IF (R > 0) THEN
                IF (ABS(X2) > 0) THEN
                    R = R / ABS(X2)
                ELSE
                    R = R / ABS(X1)
                ENDIF
            ENDIF
            IF (R > 1.0D-50 .OR. IS_UNKNOWN(R)) THEN
                SKIP = 0
                DO L = 1, 30
                   IF (SKIP_CHECK(L) == J) THEN
                       SKIP = 1
                       EXIT
                   ENDIF
                ENDDO
                IF (SKIP == 1) CYCLE
                WRITE (*,"(/A)") ' The current result does not agree with file  TestFM_parallel.chk'
                WRITE (*,"(A,A)") ' chk:   ', TRIM(LINE1)
                WRITE (*,"(A,A)") ' out:   ', TRIM(LINE2)
                N_ERRORS = N_ERRORS + 1
            ENDIF
         ENDDO
         I = I + 1
         IF (I > num_images()) I = 1
      ENDDO
      WRITE (*,"(//I5,A,I6,A)") N_CASE*2*N_VALS, ' cases were tested using',  &
                                num_images(), ' threads.'
      IF (N_ERRORS == 0) THEN
          WRITE (*,"(//A//)") ' All results were ok.'
      ELSE
          WRITE (*,"(//I6,A//)") N_ERRORS, ' errors were found.'
      ENDIF
endif

      STOP
      END PROGRAM TEST

      SUBROUTINE OUTPUT(I,N_CASE,X1)
      USE FMVALS_PARALLEL
      USE FMZM_PARALLEL
      IMPLICIT NONE
      TYPE (FM) :: X1
      INTEGER :: I,N_CASE,JD
      CHARACTER(251)  :: ST1
      CHARACTER(20) :: FMT

      JD = 7*NDIG_USER

      WRITE (FMT,"(A,I6,'.',I6)") 'ES', JD+30, JD
      CALL FM_FORM(TRIM(FMT),X1,ST1)
      WRITE (* ,"(I4,I6,5X,A)") I,N_CASE,TRIM(ST1)
      WRITE (30+this_image(),"(I4,I6,5X,A)") I,N_CASE,TRIM(ST1)

      END SUBROUTINE OUTPUT

      SUBROUTINE OUTPUT_IM(I,N_CASE,I1)
      USE FMVALS_PARALLEL
      USE FMZM_PARALLEL
      IMPLICIT NONE
      TYPE (IM) :: I1
      INTEGER :: I,N_CASE,JD
      CHARACTER(251)  :: ST1
      CHARACTER(20) :: FMT
      IF (I1 == 0) THEN
          JD = 2
      ELSE
          JD = LOG10(ABS(TO_FM(I1))) + 2
      ENDIF
      WRITE (FMT,"(A,I6)") 'I', JD
      CALL IM_FORM(TRIM(FMT),I1,ST1)
      WRITE (* ,"(I4,I6,5X,A)") I,N_CASE,TRIM(ST1)
      WRITE (30+this_image(),"(I4,I6,5X,A)") I,N_CASE,TRIM(ST1)

      END SUBROUTINE OUTPUT_IM

      SUBROUTINE ARGS(I,N_CASE,MAX_CASE,N_VALS,X_VALS,RAN,X_MIN,X_MAX,J,K)
      USE FMZM_PARALLEL
      IMPLICIT NONE

!  Return J and K for the test program to use x_vals(j) and optionally x_vals(k)
!  as input for testing a function.

!  For functions with restricted domains, choose j,k so that x_min < x_vals(j) < x_max.

      INTEGER :: N_VALS
      TYPE (FM) :: X_VALS(2*N_VALS)
      REAL :: X_MIN,X_MAX
      INTEGER :: I, J, K, L, N_CASE, MAX_CASE
      DOUBLE PRECISION :: RAN(4*N_VALS*MAX_CASE)

      L = (I-1)*MAX_CASE + N_CASE
      J = RAN(L)
      K = RAN(L+2*N_VALS*MAX_CASE)

      DO WHILE (X_VALS(J) < X_MIN .OR. X_VALS(J) > X_MAX)
         J = J + 7
         IF (J > 2*N_VALS) J = J - 2*N_VALS
      ENDDO

      DO WHILE (X_VALS(K) < X_MIN .OR. X_VALS(K) > X_MAX)
         K = K + 7
         IF (K > 2*N_VALS) K = K - 2*N_VALS
      ENDDO

      END SUBROUTINE ARGS

      SUBROUTINE CLOCK_TIME(CLOCK_SECONDS)

!  Convert intrinsic function DATE_AND_TIME character output to a real second count.
!  It seems optimistic to worry about the century changing during the time interval
!  being measured, so that field is ignored.

!  Since not all months have the same number of days, using the average number of seconds/month
!  below may cause a wrong elapsed time to be computed if the start time and stop time calls
!  occur in different months.

!  DATE = "ccyymmdd"  for century, year, month, date

!  TIME = "hhmmss.sss"  for hour, minute, seconds

      IMPLICIT NONE
      DOUBLE PRECISION :: CLOCK_SECONDS
      CHARACTER( 8) :: DATE
      CHARACTER(10) :: TIME
      INTEGER :: FIELD(8)

      CALL DATE_AND_TIME(DATE,TIME)

      READ( DATE , "(4I2)" ) FIELD(1:4)
      READ( TIME , "(3I2,1X,I3)" ) FIELD(5:8)

      CLOCK_SECONDS = FIELD(2) * 3.15576D7 + FIELD(3) * 2.6298D6 + FIELD(4) * 8.64D4 +  &
                      FIELD(5) * 3.6D+3 + FIELD(6) * 60.0D0 + FIELD(7) + FIELD(8) / 1000.0D0

      END SUBROUTINE CLOCK_TIME

      FUNCTION F_TEST_FUNCTION(X,NF,SETTINGS)     RESULT (RETURN_VALUE)

!  Many of the routines from FM_Sample_Routines.f95 need to call a function defined in the
!  user's program.  That function defines the model to be fitted, the function to be minimized,
!  integrated, etc.

!  Because these user functions are called from a lower-level FM routine, they use FMVALS_PARALLEL
!  and not FMZM.  They need a SETTINGS variable added to their argument list and they
!  need to do their calculations using calls to the low-level FM routines.

      USE FMVALS_PARALLEL
      IMPLICIT NONE

      INTEGER :: NF
      TYPE (MULTI) :: RETURN_VALUE, X
      TYPE (MULTI) :: T1, T2
      TYPE (FM_SETTINGS) :: SETTINGS

      IF (NF == 1) THEN
          CALL FMGAM(X,RETURN_VALUE,SETTINGS)
      ELSE IF (NF == 2) THEN

!               5.3136 + 15.678 x - 7.83 x^2 - 3.2 x^3 + x^4

          T1 = X
          CALL FMST2M('3.2',T2,SETTINGS)
          CALL FMSUB_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMST2M('7.83',T2,SETTINGS)
          CALL FMSUB_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMST2M('15.678',T2,SETTINGS)
          CALL FMADD_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMST2M('5.3136',T2,SETTINGS)
          CALL FMADD(T1,T2,RETURN_VALUE,SETTINGS)
      ELSE IF (NF == 3) THEN

!             32 - 120 x + 100 x^2 + 90 x^3 - 135 x^4 + 27 x^5

!             Triple root at x = 2/3, simple roots at x = -1, 4.

          T1 = X
          CALL FMMPYI_R1(T1,27,SETTINGS)
          CALL FMI2M(-135,T2,SETTINGS)
          CALL FMADD_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMI2M(90,T2,SETTINGS)
          CALL FMADD_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMI2M(100,T2,SETTINGS)
          CALL FMADD_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMI2M(-120,T2,SETTINGS)
          CALL FMADD_R1(T1,T2,SETTINGS)
          CALL FMMPY_R1(T1,X,SETTINGS)

          CALL FMI2M(32,T2,SETTINGS)
          CALL FMADD(T1,T2,RETURN_VALUE,SETTINGS)
      ELSE
          CALL FMI2M(0,RETURN_VALUE,SETTINGS)
      ENDIF

      END FUNCTION F_TEST_FUNCTION

      FUNCTION Z_TEST_FUNCTION(X,NF,SETTINGS)     RESULT (RETURN_VALUE)

!  This function is used by the complex type(zm) routines from FM_Sample_Routines.f95.
!  Like F_TEST_FUNCTION, it uses type(multi) arguments and results, and must be coded
!  using low-level calls.

      USE FMVALS_PARALLEL
      IMPLICIT NONE

      INTEGER :: NF
      TYPE (MULTI), DIMENSION(2) :: RETURN_VALUE, X
      TYPE (MULTI), DIMENSION(2) :: T1, T2
      TYPE (FM_SETTINGS) :: SETTINGS

      IF (NF == 1) THEN

!             x**8 - 3*x**5 + 2*x - 1

          CALL ZMIPWR(X,8,T1,SETTINGS)
          CALL ZMIPWR(X,5,T2,SETTINGS)
          CALL ZMMPYI_R1(T2,3,SETTINGS)
          CALL ZMSUB_R1(T1,T2,SETTINGS)
          CALL ZMMPYI(X,2,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMI2M(1,T2,SETTINGS)
          CALL ZMSUB(T1,T2,RETURN_VALUE,SETTINGS)
      ELSE IF (NF == 2) THEN

!             x**6 - x**5 - 5*x**4 - 19*x**3 - 28*x**2 - 28*x - 16

!             This function has 2 double roots, which forces the root-finder to evaluate
!             derivatives.  That causes precision to be raised.

!             The parallel version of FM has a fixed upper limit on precision, so using
!             zmipwr as in the function above can cause the root-finder to fail.

!             Using Horner's rule below avoids the zmipwr call and can sometimes avoid
!             exceeding the precision limit.

!             Double roots at -1/2 +- sqrt(3)/2 i, simple roots at -1, 4.

          CALL ZMEQ(X,T1,SETTINGS)
          CALL ZMI2M(-1,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMMPY_R1(T1,X,SETTINGS)
          CALL ZMI2M(-5,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMMPY_R1(T1,X,SETTINGS)
          CALL ZMI2M(-19,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMMPY_R1(T1,X,SETTINGS)
          CALL ZMI2M(-28,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMMPY_R1(T1,X,SETTINGS)
          CALL ZMI2M(-28,T2,SETTINGS)
          CALL ZMADD_R1(T1,T2,SETTINGS)
          CALL ZMMPY_R1(T1,X,SETTINGS)
          CALL ZMI2M(-16,T2,SETTINGS)
          CALL ZMADD(T1,T2,RETURN_VALUE,SETTINGS)
      ELSE
          CALL ZMI2M(0,RETURN_VALUE,SETTINGS)
      ENDIF

      END FUNCTION Z_TEST_FUNCTION

      SUBROUTINE FM_RK14_F(N_ORDER, N_FUNCTION, X, S, RHS, SETTINGS)

!  Compute the right-hand-side function for the vector first-order differential equation
!  s' = f(x,s).

!  N_ORDER is the order of the differential equation.  After reducing the equation to
!          a first-order vector D.E., N_ORDER is the length of vectors S and RHS.
!          (N_ORDER is unused in this sample version)

!  RHS is returned as the right-hand-side vector function of the differential equation,
!  with S as the input vector:  RHS = F(X,S).

!  N_FUNCTION is the function to be evaluated, for cases where a program may solve
!             several different differential equations.

      USE FMVALS_PARALLEL
      IMPLICIT NONE

      INTEGER, PARAMETER :: MAXIMUM_ORDER = 3
      INTEGER :: N_ORDER, N_FUNCTION
      TYPE (MULTI) :: X, S(MAXIMUM_ORDER), RHS(MAXIMUM_ORDER)
      TYPE (MULTI) :: T1, T2, T3
      TYPE (FM_SETTINGS) :: SETTINGS

      IF (N_FUNCTION == 1) THEN

!             y'' = -y' + sin(x)*y - cos(x)

          RHS(1) = S(2)

!         RHS(2) = -S(2) + SIN(X)*S(1) - COS(X)

!             We can speed this up by computing sin(x) and cos(x) both at the same time.
!             FMCSSN is the low-level version of FM_COS_SIN.  FMCSSN needs type(multi)
!             arguments, while FM_COS_SIN needs type(fm).

          CALL FMCSSN(X,T1,T2,SETTINGS)

          CALL FMMPY(T2,S(1),T3,SETTINGS)
          CALL FMSUB(T3,T1,T2,SETTINGS)
          CALL FMSUB(T2,S(2),RHS(2),SETTINGS)
      ELSE
          RHS(1) = S(1)
          IF (N_ORDER >= 2) CALL FMI2M(0,S(2),SETTINGS)
          IF (N_ORDER >= 3) CALL FMI2M(0,S(3),SETTINGS)
      ENDIF

      END SUBROUTINE FM_RK14_F


!+ This file contains all the linear algebra routines FIDASIM uses
module eigensystem
  !+ A basic libary for calculating matrix eigen-decompositions and inverses
  implicit none
  !!Definition for the kind of the variables:
  integer , parameter   :: long      = kind(int(1))
  integer , parameter   :: float     = kind(1.e0)
  integer , parameter   :: double    = kind(1.d0)
  !! eigenvalue decomposition values
  real(double),parameter:: ONE=1.d0,TWO=2.d0,ZERO=0.d0
  real(double),parameter:: XMACH_EPS=2.22d-16
  integer , parameter   :: MAXIT=50
contains
  ! first subroutines for eigenvalue decomposition
  subroutine RSWAP(a,b)
    !+ Swaps values `a` and `b`
    real(double) :: a,b, t
    t=a; a=b; b=t
  end subroutine RSWAP
  subroutine balance(n,  mat, scal, low, high )
    !+Balances the matrix so that the rows with zero entries
    !+off the diagonal are isolated and the remaining columns and rows
    !+are resized to have one norm close to 1.
    integer, intent(in)  :: n
        !+ Dimension of `mat`
    real(double)         :: mat(0:n-1,0:n-1)
        !+ `n`x`n` scaled matrix
    real(double)         :: scal(0:n-1)
        !+ Contains isolated eigenvalue in the positions 0-`low` and `high`-`n`-1
        !+ its other components contain the scaling factors for transforming `mat`
    integer, intent(out) :: high
    integer, intent(out) :: low

    integer, parameter   :: basis = 2
    real(double)         :: b2, r, c, f, g, s
    integer              :: m, k, i, j, iter
    scal=0.d0
    b2 = basis * basis
    m = 0
    k = n - 1
    iter=1
    do while(iter==1)
       iter = 0
       do j = k, 0, -1
          r = ZERO
          do i = 0, k
             if (i.ne.j)  r = r + DABS(mat(j,i))
          enddo
          if (r == ZERO) then
             scal(k) = j
             if (j.ne.k) then
                do i = 0, k
                   call RSWAP(mat(i,j), mat(i,k))
                enddo
                do i = m, n-1
                   call RSWAP(mat(j,i), mat(k,i))
                enddo
             endif
             k=k-1
             iter = 1
          endif
       enddo !j loop
    enddo !while iter=1
    iter=1
    do while (iter==1)
       iter = 0
       do j = m, k
          c = ZERO
          do i = m, k
             if (i.ne.j)  c = c + DABS(mat(i,j))
          enddo
          if (c == ZERO) then
             scal(m) = j
             if (j.ne.m) then
                do i = 0, k
                   call RSWAP(mat(i,j), mat(i,m))
                enddo
                do i = m, n-1
                   call RSWAP(mat(j,i), mat(m,i))
                enddo
             endif
             m = m + 1
             iter = 1
          endif
       enddo !j loop
    enddo !while iter=1
    low = m
    high = k
    do i = m, k
       scal(i) = ONE
    enddo
    iter=1
    do while (iter==1)
       iter = 0
       do i = m, k
          c=ZERO; r=ZERO
          do j = m, k
             if (j.ne.i) then
                c = c + DABS(mat(j,i))
                r = r + DABS(mat(i,j))
             endif
          enddo
          g = r / basis
          f = ONE
          s = c + r
          do while (c < g)
             f = f * basis
             c = c * b2
          enddo
          g = r * basis
          do while (c >= g)
             f = f / basis
             c = c / b2
          enddo
          if ((c + r) / f < 0.95 * s) then
             g = ONE / f
             scal(i) = scal(i) * f
             iter = 1
             do j = m, n-1
                mat(i,j) = mat(i,j) * g
             enddo
             do j = 0, k
                mat(j,i) = mat(j,i) * f
             enddo
          endif
       enddo !i loop
    enddo !while iter=1
    return
  end subroutine balance
  subroutine balback(n, low, high, scal, eivec )
    !+  Reverses the balancing of balance for the eigenvectors
    integer,intent(in)         :: n
      !+ Dimension of matrix
    integer,intent(in)         :: low
      !+ First nonzero row
    integer,intent(in)         :: high
      !+ Last nonzero row
    real(double), intent(in)   ::  scal(0:n-1)
      !+ Scaling data from balance
    real(double), intent(inout):: eivec(0:n-1,0:n-1)
      !+ Input: n x n matrix of eigenvectors, as computed in qr2
      !+ Output: Non-normalized eigenvectors of the original matrix

    real(double) :: s
    integer      :: i,j,k
    do i = low, high
       s = scal(i)
       do j = 0, n-1
      eivec(i,j) = eivec(i,j) * s
       enddo
    enddo
    do i = low-1, 0, -1
       k = Int(scal(i))
       if (k.ne.i) then
          do j = 0, n-1
             call RSWAP(eivec(i,j), eivec(k,j))
          enddo
       endif
    enddo
    do i = high + 1, n-1
       k = Int(scal(i))
       if (k.ne.i) then
          do j = 0, n-1
             call RSWAP(eivec(i,j), eivec(k,j))
          enddo
       endif
    enddo
    return
  end subroutine balback
  subroutine elmhes(n, low, high, mat, perm )
    !+Transforms the matrix `mat` to upper Hessenberg form.
    integer,intent(in)   :: n
      !+Dimension of `mat`
    integer,intent(in)   :: low
      !+First nonzero row
    integer,intent(in)   :: high
      !+Last nonzero row
    real(double), intent(inout):: mat(0:n-1,0:n-1)
      !+Input: `n`x`n` matrix
      !+Output: Upper Hessenberg matrix; additional information on the tranformation
      !+is stored in the lower triangle
    integer,intent(out)  :: perm(0:n-1)
      !+Permutation vector for elmtrans

    integer              :: i, j, m
    real(double)         ::  x, y
    do m = low + 1, high-1
       i = m
       x = ZERO
       do j = m, high
          if (DABS(mat(j,m-1)) > DABS (x)) then
             x = mat(j,m-1)
             i = j
          endif
       enddo
       perm(m) = i
       if (i.ne.m) then
          do j = m - 1, n-1
             call RSWAP(mat(i,j), mat(m,j))
          enddo
          do j = 0, high
             call RSWAP(mat(j,i), mat(j,m))
          enddo
       endif
       if (x.ne.ZERO) then
          do i = m + 1, high
             y = mat(i,m-1)
             if (y.ne.ZERO) then
                y = y / x
                mat(i,m-1) = y
                do j = m, n-1
                   mat(i,j) = mat(i,j) - y * mat(m,j)
                enddo
                do j = 0, high
                   mat(j,m) = mat(j,m) + y * mat(j,i)
                enddo
             endif
          enddo !i loop
       endif !x <> ZERO
    enddo !m loop
  end subroutine elmhes
  Subroutine elmtrans(n, low, high, mat, perm, h  )
    !+  Elmtrans copies the Hessenberg matrix stored in `mat` to `h`
    integer,intent(in)         :: n
      !+ Dimension of mat
    integer,intent(in)         :: low
      !+ First nonzero row
    integer,intent(in)         :: high
      !+ Last nonzero row
    real(double), intent(in)   :: mat(0:n-1,0:n-1)
      !+ `n`x`n` input matrix
    integer,intent(in)         :: perm(0:n-1)
      !+ Permutation data from elmhes
    real(double),intent(out)   :: h(0:n-1,0:n-1)
      !+ Hessenberg matrix
    integer                    :: i, j, k
    do i = 0, n-1
       do k = 0, n-1
      h(i,k) = ZERO
       enddo
       h(i,i) = ONE
    enddo
    do i = high - 1, low+1, -1
       j = perm(i)
       do k = i + 1, high
      h(k,i) = mat(k,i-1)
       enddo
       if (i.ne.j) then
          do k = i, high
             h(i,k) = h(j,k)
             h(j,k) = ZERO
          enddo
          h(j,i) = ONE
       endif
    enddo
  end subroutine elmtrans
  subroutine Comdiv(ar, ai, br, bi, cr, ci, rc )
    !+ Performs complex division `c` = `a` / `b`
    real(double) ::  ar
      !+ Real part of numerator
    real(double) ::  ai
      !+ Imaginary part of numerator
    real(double) ::  br
      !+ Real part of denominator
    real(double) ::  bi
      !+ Imaginary part of denominator
    real(double) ::  cr
      !+ Real part of quotient
    real(double) ::  ci
      !+ Imaginary part of quotient
    integer      :: rc
      !+ return code

    real(double) :: tmp
    if (br == ZERO.AND.bi == ZERO) then
       rc = 1
       return
    endif
    if (dabs(br) > dabs(bi)) then
       tmp = bi / br
       br  = tmp * bi + br
       cr  = (ar + tmp * ai) / br
       ci  = (ai - tmp * ar) / br
    else
       tmp = br / bi
       bi  = tmp * br + bi
       cr  = (tmp * ar + ai) / bi
       ci  = (tmp * ai - ar) / bi
    endif
    rc = 0
  end subroutine Comdiv !Comdiv
  function comabs(ar,ai)
    !+ Calculates absolute value of a complex number `a`
    real(double) :: ar
      !+ Real part of `a`
    real(double) :: ai
      !+ Imaginary part of `a`
    real(double) :: comabs
      !+ Absolute value of `a`

    if (ar == ZERO.and.ai == ZERO) then
       Comabs = ZERO
       return
    endif
    ar = DABS(ar)
    ai = DABS(ai)
    if (ai > ar) then                                  !Switch  ai and ar
       call RSWAP(ai, ar)
    endif
    if (ai == ZERO) then
       Comabs = ar
    else
       Comabs = ar * DSQRT(ONE + ai / ar * ai / ar)
    endif
  end function comabs
  subroutine  hqrvec(n,     & !Dimension of matrix .......
       low,   & !first nonzero row .........
       high,  & !last nonzero row ..........
       h,     & !upper Hessenberg matrix ...
       wr,    & !Real parts of evalues .....
       wi,    & !Imaginary parts of evalues
       eivec, & !Eigenvectors ..............
       rc  )   !return code ...............
    !+Computes the eigenvectors for the eigenvalues found in hqr2
    !+
    !+###Input parameters
    !+   n     :   int n;  ( n > 0 )
    !+         :   Dimension of  mat and eivec, number of eigenvalues.
    !+
    !+   low   :   int low;
    !+
    !+   high  :   int high; see  balance
    !+
    !+   h     :   n x n upper Hessenberg matrix
    !+
    !+   wr    :   vector of size n;
    !+         :   Real parts of the n eigenvalues.
    !+
    !+   wi    :   vector of size n; Imaginary parts of the n eigenvalues.
    !+
    !+###Output parameter:
    !+   eivec :  n x n matrix, whose columns are the eigenvectors
    integer,intent(in)         :: n
    integer,intent(in)         :: high, low
    real(double), intent(in)   :: wr(0:n-1),wi(0:n-1)
    real(double), intent(out)  :: eivec(0:n-1,0:n-1)
    real(double)  :: h(0:n-1,0:n-1)
    integer :: rc
    integer :: i, j, m, k, na, l
    integer :: code, en
    real(double)  :: p, q, r, s, t, w, x, y, z, ra, sa, vr, vi, norm, temp

    r=ZERO; s=ZERO; z=ZERO; norm=ZERO
    do i = 0, n-1                               !find norm of h
       do j = i, n-1
          norm = norm + DABS(h(i,j))
       enddo
    enddo
    if (norm == ZERO) then
       rc = 1                                    !zero matrix
       return
    endif
    do en = n-1, 0, -1                          !transform back
       p = wr(en)
       q = wi(en)
       na = en - 1
       if (q == ZERO) then
          m = en
          h(en,en) = ONE
          do i = na, 0, -1
             w = h(i,i) - p
             r = h(i,en)
             do j = m, na
                r = r + h(i,j) * h(j,en)
             enddo
             if (wi(i) < ZERO) then
                z = w
                s = r
             else
                m = i
                if (wi(i) == ZERO) then
                   if (w.ne.ZERO) then
                      temp = w
                   else
                      temp=XMACH_EPS * norm
                   endif
                   h(i,en) = -r/temp
                else
                   !Solve the linear system:
                   !| w   x |  | h[i][en]   |   | -r |
                   !|       |  |            | = |    |
                   !| y   z |  | h[i+1][en] |   | -s |
                   x = h(i,i+1)
                   y = h(i+1,i)
                   q = (wr(i) - p)**2 + wi(i)**2
                   h(i,en) = (x * s - z * r) / q
                   t = h(i,en)
                   if (DABS(x) > DABS(z)) then
                      temp = (-r -w * t) / x
                   else
                      temp = (-s -y * t) / z
                   endif
                   h(i+1,en) = temp
                endif
             endif !wi[i] < 0
          enddo !i loop
       else if (q < ZERO) then
          m = na
          if (DABS(h(en,na)) > DABS(h(na,en))) then
             h(na,na) = - (h(en,en) - p) / h(en,na)
             h(na,en) = - q / h(en,na)
          else
             call Comdiv(-h(na,en),0.d0, h(na,na)-p, q, h(na,na), h(na,en),code)
          endif
          h(en,na) = ONE
          h(en,en) = ZERO
          do i = na - 1, 0, -1
             w = h(i,i) - p
             ra = h(i,en)
             sa = ZERO
             do j = m, na
                ra = ra + h(i,j) * h(j,na)
                sa = sa + h(i,j) * h(j,en)
             enddo
             if (wi(i) < ZERO) then
                z = w
                r = ra
                s = sa
             else
                m = i
                if (wi(i) == ZERO) then
                   call Comdiv(-ra, -sa, w, q, h(i,na), h(i,en),code)
                else
            !  solve complex linear system:
                   !| w+i*q     x | | h[i][na] + i*h[i][en]  |   | -ra+i*sa |
                   !|             | |                        | = |          |
            !|   y    z+i*q| | h[i+1][na]+i*h[i+1][en]|   | -r+i*s   |
                   x = h(i,i+1)
                   y = h(i+1,i)
                   vr = (wr(i) - p)**2 + wi(i)**2 - q*q
                   vi = TWO * q * (wr(i) - p)
                   if (vr == ZERO.AND.vi == ZERO) then
                      vr = XMACH_EPS * norm * (DABS(w) + DABS(q)  &
                           + DABS(x) + DABS(y) + DABS(z))
                   endif

                   call Comdiv (x*r-z*ra+q*sa,x*s-z*sa-q*ra &
                        ,vr,vi,h(i,na),h(i,en),code)
                   if (DABS(x) > DABS(z) + DABS(q)) then
                      h(i+1,na) = (-ra - w * h(i,na) + q * h(i,en)) / x
                      h(i+1,en) = (-sa - w * h(i,en) - q * h(i,na)) / x
                   else
                      call Comdiv (-r - y * h(i,na), -s - y * h(i,en) &
                           , z, q, h(i+1,na), h(i+1,en),code)
                   endif
                endif !wi[i] = 0
             endif !wi[i] < 0
          enddo !i loop
       endif !else if q < 0
    enddo !en loop
    do i = 0, n-1                        !Eigenvectors for the evalues for
       if (i < low.or.i > high) then      !rows < low  and rows  > high
          do k = i + 1, n-1
             eivec(i,k) = h(i,k)
          enddo
       endif
    enddo
    j = n-1
    do while (j>=low)
       if(j<=high)then
          m =j
       else
          j = high
       endif
       if(j < 0) exit
       if (wi(j) < ZERO) then
          l=j-1
          do i = low, high
             y=ZERO; z=ZERO
             do k = low, m
                y = y + eivec(i,k) * h(k,l)
                z = z + eivec(i,k) * h(k,j)
             enddo
             eivec(i,l) = y
             eivec(i,j) = z
          enddo
       else
          if (wi(j) == ZERO) then
             do i = low, high
                z = ZERO
                do k = low, m
                   z = z + eivec(i,k) * h(k,j)
                enddo
                eivec(i,j) = z
             enddo
          endif
       endif
       j = j - 1
    enddo !j loop
    rc = 0
  end subroutine hqrvec
  subroutine hqr2(n,    &  !Dimension of matrix .........
       low,  &  !first nonzero row ...........
       high, &  !last nonzero row ............
       h,    &  !Hessenberg matrix ...........
       wr,   &  !Real parts of eigenvalues ...
       wi,   &  !Imaginary parts of evalues ..
       eivec,&  !Matrix of eigenvectors ......
       cnt,  &  !Iteration counter ...........
       rc   )   !return code .................
    !+Computes the eigenvalues and (if vec = True) the eigenvectors
    !+of an  n * n upper Hessenberg matrix.
    !+
    !+###Input parameters
    !+   n     :  integer;  ( n > 0 )
    !+            Dimension of  h and eivec,
    !+            length of the real parts vector  wr and of the
    !+            imaginary parts vector  wi of the eigenvalues.
    !+
    !+   low   :  integer;
    !+
    !+   high  :  integer;  see balance
    !+
    !+   h     :  n x n matrix;
    !+            upper Hessenberg matrix as output of Elmhes
    !+            (destroyed in the process).
    !+###Output parameters
    !+   eivec :  n x n matrix;  (only if vec = 1)
    !+            Matrix, which for vec = 1 contains the
    !+            eigenvectors as follows:
    !+            For real eigebvalues the corresponding column
    !+            contains the corresponding eigenvactor, while for
    !+            complex eigenvalues the corresponding column contains
    !+            the real part of the eigenvactor with its imaginary
    !+            part is stored in the subsequent column of eivec.
    !+            The eigenvactor for the complex conjugate eigenvactor
    !+            is given by the complex conjugate eigenvactor.
    !+
    !+   wr    :  vector of size n;
    !+            Real part of the n eigenvalues.
    !+
    !+   wi    :  vector of size n;
    !+            Imaginary parts of the eigenvalues
    !+
    !+   cnt   :  Integer vector of size n;
    !+            vector of iterations used for each eigenvalue.
    !+            For a complex conjugate eigenvalue pair the second
    !+            entry is negative.
    integer,intent(in)          :: n
    integer,intent(in)          :: high, low
    real(double) ,intent(out)   :: h(0:n-1,0:n-1)
    real(double), intent(out)   :: wr(0:n-1),wi(0:n-1)
    real(double), intent(out)   :: eivec(0:n-1,0:n-1)
    integer,intent(out)         :: rc
    integer,intent(out)         :: cnt(0:n-1)
    integer :: en
    integer :: i, j, na, iter, l, ll, m, k
    real(double)  :: p, q, r, s, t, w, x, y, z
    real(double)  :: r_p,r_r,r_s,r_x,r_z

    p=ZERO; q=ZERO; r=ZERO
    do i = 0, n-1
       if (i < low.or.i > high) then
          wr(i) = h(i,i)
          wi(i) = ZERO
          cnt(i) = 0
       endif
    enddo
    en = high
    t = ZERO
    do while (en >= low)
       iter = 0
       na = en - 1
       do while(1<2)
          ll=999
          do l = en, low+1, -1                      !search for small
             !subdiagonal element
             if(DABS(h(l,l-1))<=XMACH_EPS*(DABS(h(l-1,l-1))+DABS(h(l,l))))then
                ll=l;      !save current index
                goto 10    !exit l loop
             endif
          enddo
10        if(ll.ne.999)then
             l=ll
      else
             l=0          !restore l
          endif
          x = h(en,en)
          if (l == en) then                         !found one evalue
             wr(en) = x + t
             h(en,en) = x + t
             wi(en) = ZERO
             cnt(en) = iter
             en = en - 1
             goto 15      !exit from loop while(True)
          endif
          y = h(na,na)
          w = h(en,na) * h(na,en)
          if (l == na) then                         !found two evalues
             p = (y - x) * 0.5d0
             q = p * p + w
             z = DSQRT(DABS(q))
             x = x + t
             h(en,en) = x + t
             h(na,na) = y + t
             cnt(en) = -iter
             cnt(na) = iter
             if (q >= ZERO) then                     !real eigenvalues
                if (p<ZERO) then
                   z=p-z
                else
                   z=p+z
                endif
                r_z = 1.0d0/z
                wr(na) = x + z
                wr(en) = x - w * r_z
                s = w - w * r_z
                wi(na) = ZERO
                wi(en) = ZERO
                x = h(en,na)
                r = DSQRT (x * x + z * z)
                r_r = 1.0d0/r
                p = x * r_r
                q = z * r_r
                do j = na, n-1
                   z = h(na,j)
                   h(na,j) = q * z + p * h(en,j)
                   h(en,j) = q * h(en,j) - p * z
                enddo
                do i = 0, en
                   z = h(i,na)
                   h(i,na) = q * z + p * h(i,en)
                   h(i,en) = q * h(i,en) - p * z
                enddo
                do i = low, high
                   z = eivec(i,na)
                   eivec(i,na) = q * z + p * eivec(i,en)
                   eivec(i,en) = q * eivec(i,en) - p * z
                enddo
             else                                  !pair of complex
                wr(na) = x + p
                wr(en) = x + p
                wi(na) =   z
                wi(en) = - z
             endif !if q>=ZERO
             en = en - 2
             goto 15                               !exit while(1<2)
          endif !if l = na
          if (iter >= MAXIT) then
             cnt(en) = MAXIT + 1
             rc = en
             write(*,*) ' stop at iter >= MAXIT.'
             return
          endif
          if (iter.ne.0.and.MOD(iter,10) == 0) then
             t = t + x
             do i = low, en
                h(i,i) = h(i,i) - x
             enddo
             s = DABS(h(en,na)) + DABS(h(na,en-2))
             x = 0.75d0 * s; y = x
             w = -0.4375d0 * s * s
          endif
          iter = iter + 1
          do m = en - 2, l, -1
             z = h(m,m)
             r = x - z
             s = y - z
             p = ( r * s - w ) / h(m+1,m) + h(m,m+1)
             q = h(m + 1,m + 1) - z - r - s
             r = h(m + 2,m + 1)
             s = DABS(p) + DABS(q) + DABS (r)
             r_s = 1.0d0/s
             p = p * r_s
             q = q * r_s
             r = r * r_s
             if (m == l)  goto 12
             if (DABS(h(m,m-1)) * (DABS(q) + DABS(r)) <= XMACH_EPS * DABS(p) &
                  * (DABS(h(m-1,m-1)) + DABS(z) + DABS(h(m+1,m+1)))) then
                goto 12                !exit m loop
             endif
          enddo
12        do i = m + 2, en
             h(i,i-2) = ZERO
          enddo
          do i = m + 3, en
             h(i,i-3) = ZERO
          enddo
          do k = m, na
             if(k.ne.m)then!double QR step, for rows l to en and columns m to en
                p = h(k,k-1)
                q = h(k+1,k-1)
                if (k.ne.na) then
                   r = h(k+2,k-1)
                else
                   r = ZERO
                endif
                x = DABS(p) + DABS(q) + DABS(r)
                if (x == ZERO) goto 30                  !next k
                r_x = 1.0d0/x
                p = p * r_x
                q = q * r_x
                r = r * r_x
             endif
             s = DSQRT(p * p + q * q + r * r)
             if (p < ZERO) s = -s
             r_s = 1.0d0/s
             if (k.ne.m) then
                h(k,k-1) = -s * x
             else if (l.ne.m) then
                h(k,k-1) = -h(k,k-1)
             endif
             p = p + s
             r_p = 1.0d0/p
             x = p * r_s
             y = q * r_s
             z = r * r_s
             q = q * r_p
             r = r * r_p
             do j = k, n-1                          !modify rows
                p = h(k,j) + q * h(k+1,j)
                if (k.ne.na) then
                   p = p + r * h(k+2,j)
                   h(k+2,j) = h(k+2,j) - p * z
                endif
                h(k+1,j) = h(k+1,j) - p * y
                h(k,j)   = h(k,j) - p * x
             enddo
             if (k+3 < en) then
                j=k+3
             else
                j=en
             endif
             do i = 0, j                            !modify columns
                p = x * h(i,k) + y * h(i,k+1)
                if (k.ne.na) then
                   p = p + z * h(i,k+2)
                   h(i,k+2) = h(i,k+2) - p * r
                endif
                h(i,k+1) = h(i,k+1) - p * q
                h(i,k)   = h(i,k) - p
             enddo
             do i = low, high
                p = x * eivec(i,k) + y * eivec(i,k+1)
                if (k.ne.na) then
                   p = p + z * eivec(i,k+2)
                   eivec(i,k+2) = eivec(i,k+2) - p * r
                endif
                eivec(i,k+1) = eivec(i,k+1) - p * q
                eivec(i,k)   = eivec(i,k) - p
             enddo
30           continue
          enddo !k loop
       enddo !while(1<2)
15  continue
    enddo !while en >= low                         All evalues found
    !transform evectors back
    call hqrvec (n, low, high, h, wr, wi, eivec,rc)
  end subroutine hqr2

  subroutine eigen (n, matrix, eigvec, eigval)
    !+The subroutine eigen  determines all eigenvalues and (if desired)
    !+all eigenvectors of a real square  n * n  matrix via the QR method
    !+in the version of Martin, Parlett, Peters, Reinsch and Wilkinson.
    !+
    !+###Literature
    !+1. Peters, Wilkinson: Eigenvectors of real and complex
    !+   matrices by LR and QR triangularisations,
    !+   Num. Math. 16, p.184-204, (1970); [PETE70]; contribution
    !+   II/15, p. 372 - 395 in [WILK71].
    !+2. Martin, Wilkinson: Similarity reductions of a general
    !+   matrix to Hessenberg form, Num. Math. 12, p. 349-368,(1968)
    !+   [MART 68]; contribution II,13, p. 339 - 358 in [WILK71].
    !+3. Parlett, Reinsch: Balancing a matrix for calculations of
    !+   eigenvalues and eigenvectors, Num. Math. 13, p. 293-304,
    !+   (1969); [PARL69]; contribution II/11, p.315 - 326 in
    !+   [WILK71].
    !+
    !+###Input parameters
    !+   n     :  integer; ( n > 0 )
    !+            size of matrix, number of eigenvalues
    !+
    !+   mat   :  n x n matrix;
    !+            input matrix
    !+
    !+###Output parameters
    !+   eivec :  n x n matrix;     (only if vec = 1)
    !+            matrix, if  vec = 1  that holds the eigenvectors
    !+            thus :
    !+            If the jth eigenvalue of the matrix is real then the
    !+            jth column is the corresponding real eigenvector;
    !+            if the jth eigenvalue is complex then the jth column
    !+            of eivec contains the real part of the eigenvector
    !+            while its imaginary part is in column j+1.
    !+            (the j+1st eigenvector is the complex conjugate
    !+            vector.)
    !+
    !+   valre :  vector of size n;
    !+            Real parts of the eigenvalues.
    !+
    !+   valim :  vector of size n;
    !+            Imaginary parts of the eigenvalues
    !+
    !+   cnt   :  Integer vector of size n;
    !+            vector containing the number of iterations for each
    !+            eigenvalue. (for a complex conjugate pair the second
    !+            entry is negative).
    integer      ,intent(in)                 :: n ! nlevels
    real(double) ,intent(in),dimension(n,n)  :: matrix
    real(double) ,intent(out),dimension(n,n) :: eigvec
    real(double) ,intent(out),dimension(n)   :: eigval
    real(double)     :: mat(0:n-1,0:n-1)
    real(double)     :: eivec(0:n-1,0:n-1)
    real(double)     :: valre(0:n-1) !real parts of eigenvalues
    real(double)     :: valim(0:n-1) !imaginary parts of eigenvalues
    integer          :: rc             !return code
    integer          :: cnt(0:n-1)   !Iteration counter
    integer          :: high, low
    real(double)     :: d(0:n-1), scale(0:n-1)
    integer          :: perm(0:n-1)

    cnt=0 ; d=0.d0
    mat(0:n-1,0:n-1)=matrix(1:n,1:n)
    !balance mat for nearly
    call balance(n, mat, scale, low, high)      !equal row and column
    !reduce mat to upper
    call elmhes(n, low, high, mat, perm)        !reduce mat to upper
    !Hessenberg form
    call elmtrans(n, low, high, mat, perm, eivec)
    !QR algorithm for eigenvalues and eigenvectors
    call hqr2(n, low, high, mat, valre, valim, eivec, cnt,rc)
    !reverse balancing to determine eigenvectors
    call balback(n, low, high, scale, eivec)
    if (rc.ne.0) then
      print*, 'matrix = '
      print*, matrix
      stop 'problem in eigen!'
    endif
    eigval(1:n)=valre(0:n-1)
    eigvec(1:n,1:n)=eivec(0:n-1,0:n-1)
  end subroutine eigen

  function outerprod(a,b)
    !+ Calculates outer product
    real(double), dimension(:), intent(IN)   :: a,b
    real(double), dimension(size(a),size(b)) :: outerprod
    outerprod = spread(a,dim=2,ncopies=size(b)) * &
         spread(b,dim=1,ncopies=size(a))
  end function outerprod
  subroutine swap(a,b)
    !+Swap arrays `a` and `b`
    real(double), dimension(:), intent(INOUT) :: a,b
    real(double), dimension(size(a))          :: dum
    dum=a
    a=b
    b=dum
  end subroutine swap
  subroutine ludcmp(a,indx,d)
    !+Calculates LU decomposition
    real(double), dimension(:,:),intent(INOUT):: a
    integer,dimension(:),  intent(OUT)        :: indx
    real(double),                intent(OUT)  :: d
    real(double), dimension(size(a,1))        :: vv
    integer,dimension(1)                      :: imaxloc
    integer :: j,n,imax
    n=size(indx)
    d=1.0
    vv=maxval(abs(a),dim=2)
    if(any(vv.eq.0.))stop 'singular matrix in ludcmp'
    vv=1.d0/vv
    do j=1,n
       imaxloc=maxloc(vv(j:n)*abs(a(j:n,j)))
       imax=(j-1)+imaxloc(1)
       if (j /= imax) then
          call swap(a(imax,:),a(j,:))
          d=-d
          vv(imax)=vv(j)
       endif
       indx(j)=imax
       if (a(j,j) == 0.0) a(j,j)=1.0d-20
       a(j+1:n,j)=a(j+1:n,j)/a(j,j)
       a(j+1:n,j+1:n)=a(j+1:n,j+1:n)-outerprod(a(j+1:n,j),a(j,j+1:n))
    enddo
  end subroutine ludcmp
  subroutine lubksb(a,indx,b)
    !+ Does LU back substitution
    real(double), dimension(:,:),intent(IN)   :: a
    integer,dimension(:),  intent(IN)         :: indx
    real(double), dimension(:),  intent(INOUT):: b
    integer       :: i,n,ii,ll
    real(double)  :: summ
    n=size(indx)
    ii=0
    do i=1,n
       ll=indx(i)
       summ=b(ll)
       b(ll)=b(i)
       if (ii /= 0) then
          summ=summ-dot_product(a(i,ii:i-1),b(ii:i-1))
       else if (summ /= 0.0) then
          ii=i
       endif
       b(i)=summ
    enddo
    do i=n,1,-1
       b(i) = (b(i)-dot_product(a(i,i+1:n),b(i+1:n)))/a(i,i)
    enddo
  end subroutine lubksb
  subroutine matinv(a, b)
    !+ Matrix inversion with LU-decomposition
    !====================================================
    real(double), dimension(:,:), intent(IN)             :: a
    real(double), dimension(:,:), intent(OUT)            :: b
    real(double), dimension(size(a,dim=1),size(a,dim=2)) :: ah, y
    integer                                              :: i, N
    integer, dimension(size(a,dim=1))                    :: indx
    real(double)                                         :: d
    N = size(a,dim=1)
    if (N /= size(a,dim=2)) stop 'SUB matinv: ludcmp matrix must be square!'
    ah = a
    y  = 0.
    do i = 1, N
       y(i,i) = 1.d0
    enddo
    call ludcmp(ah,indx,d)
    do i = 1, N
       call lubksb(ah,indx,y(:,i))
    enddo
    b = y
  end subroutine matinv

  subroutine linsolve(a,b,x)
   !+ Solve linear equations A * X = B
   real(double), dimension(:,:), intent(IN)  :: a ! assume a square
   real(double), dimension(:), intent(IN)    :: b ! assume size(b) == size(a,1)
   real(double), dimension(:), intent(OUT)   :: x ! assume size(x) == size(b)

#ifdef _USE_BLAS
   real(double), dimension(size(b),size(b)) :: lu
   integer, dimension(size(b)) :: ipiv
   integer :: n,info

   n = size(b)

   ! first factorize a
   lu(:,:) = a(:,:)
   call DGETRF(n,n,lu,n,ipiv,info)
   if (info /= 0) stop 'sub linsolve: DGETRF failed!'

   x(:) = b(:)
   call DGETRS('N',n,1,lu,n,ipiv,x,n,info)
   if (info /= 0) stop 'sub linsolve: DGETRS failed!'

#else
   real(double), dimension(size(b),size(b)) :: a_inv
   call matinv(a, a_inv)
   x = matmul(a_inv, b)!coeffs determined from states at t=0
#endif

  end subroutine linsolve

end module eigensystem