Homec4science
Diffusion COSOlver (llechot) Browse

cosolver/basis_transformation/FMlib/FMinterval/fm_interval.f95
df55999e752fllechot

Last Change
Raw File

fm_interval.f95
View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
MODULE FM_INTERVAL_ARITHMETIC_1
! FM_interval 1.3 David M. Smith Interval Arithmetic
! This module extends the definition of the basic Fortran arithmetic and function operations so
! they also apply to multiple precision intervals, using version 1.3 of FM.
! The multiple precision interval data type is called
! TYPE (FM_INTERVAL)
! Each FM interval consists of two endpoints, with each endpoint being a TYPE(FM) multiple
! precision number. The first of these endpoints defines the left endpoint of an interval,
! and the second defines the right endpoint of the interval.
! Most of the functions defined in this module are multiple precision interval versions of standard
! Fortran functions. In addition, there are functions for direct conversion, formatting, and some
! mathematical special functions.
! TO_FM_INTERVAL is a function for converting other types of numbers to type FM_INTERVAL.
! Like the TO_FM function in module FMZM, TO_FM_INTERVAL(3.12) converts the REAL constant
! to an FM interval, but it is accurate only to single precision. TO_FM_INTERVAL(3.12D0)
! agrees with 3.12 to double precision accuracy, and TO_FM_INTERVAL('3.12') or
! TO_FM_INTERVAL(312)/TO_FM_INTERVAL(100) agrees to full FM accuracy.
USE FMZM
! For all comparisons except == and /=, the order is not well defined if intervals overlap.
! In those cases, the midpoints of the intervals are compared.
TYPE FM_INTERVAL
INTEGER :: LEFT = -1
INTEGER :: RIGHT = -1
END TYPE
! Work variables for derived type operations.
TYPE (FM_INTERVAL), SAVE :: MTFM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: MUFM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: MVFM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: MWFM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M0FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M1FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M2FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M3FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M4FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M5FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M6FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M7FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M8FM_I = FM_INTERVAL(-3,-3)
TYPE (FM_INTERVAL), SAVE :: M9FM_I = FM_INTERVAL(-3,-3)
TYPE (FM), SAVE :: M_1 = FM(-3), M_2 = FM(-3), M_3 = FM(-3), M_4 = FM(-3), M_5 = FM(-3), &
M_6 = FM(-3), M_7 = FM(-3), M_8 = FM(-3), M_9 = FM(-3), M_10 = FM(-3), &
M_11 = FM(-3), M_12 = FM(-3), X_EDGE = FM(-3), Y_EDGE = FM(-3), &
XY_EDGE = FM(-3), F_LEFT = FM(-3), F_RIGHT = FM(-3)
TYPE (ZM), SAVE :: MZ_1 = ZM( (/ -3, -3 /) )
INTEGER, SAVE :: MTIM_I = -3
INTEGER, SAVE :: MTZM_I(2) = (/ -3, -3 /)
INTEGER, PARAMETER :: N_PREV = 10
INTEGER, SAVE :: NDIG_XY_EDGE,KXY_EDGE,K_ROUTINE_EDGE,KROUND_PREV(0:N_PREV-1), &
ROUTINE_PREV(0:N_PREV-1),NUM_PREV = 0
TYPE (FM), SAVE :: M1_PREV(0:N_PREV-1) = FM(-3), M2_PREV(0:N_PREV-1) = FM(-3), &
M3_PREV(0:N_PREV-1) = FM(-3)
INTERFACE TO_FM_INTERVAL
! Create an interval by giving both endpoints.
MODULE PROCEDURE INTERVAL_FM_I
MODULE PROCEDURE INTERVAL_FM_R
MODULE PROCEDURE INTERVAL_FM_D
MODULE PROCEDURE INTERVAL_FM_Z
MODULE PROCEDURE INTERVAL_FM_ZD
MODULE PROCEDURE INTERVAL_FM_FM
MODULE PROCEDURE INTERVAL_FM_IM
MODULE PROCEDURE INTERVAL_FM_ZM
MODULE PROCEDURE INTERVAL_FM_ST
! Convert single values to intervals with both endpoints the same.
MODULE PROCEDURE FM_INTERVAL_I
MODULE PROCEDURE FM_INTERVAL_R
MODULE PROCEDURE FM_INTERVAL_D
MODULE PROCEDURE FM_INTERVAL_Z
MODULE PROCEDURE FM_INTERVAL_ZD
MODULE PROCEDURE FM_INTERVAL_FM
MODULE PROCEDURE FM_INTERVAL_FMA
MODULE PROCEDURE FM_INTERVAL_IM
MODULE PROCEDURE FM_INTERVAL_ZM
MODULE PROCEDURE FM_INTERVAL_ST
MODULE PROCEDURE FM_INTERVAL_I1
MODULE PROCEDURE FM_INTERVAL_R1
MODULE PROCEDURE FM_INTERVAL_D1
MODULE PROCEDURE FM_INTERVAL_Z1
MODULE PROCEDURE FM_INTERVAL_ZD1
MODULE PROCEDURE FM_INTERVAL_FM1
MODULE PROCEDURE FM_INTERVAL_FMA1
MODULE PROCEDURE FM_INTERVAL_IM1
MODULE PROCEDURE FM_INTERVAL_ZM1
MODULE PROCEDURE FM_INTERVAL_ST1
MODULE PROCEDURE FM_INTERVAL_I2
MODULE PROCEDURE FM_INTERVAL_R2
MODULE PROCEDURE FM_INTERVAL_D2
MODULE PROCEDURE FM_INTERVAL_Z2
MODULE PROCEDURE FM_INTERVAL_ZD2
MODULE PROCEDURE FM_INTERVAL_FM2
MODULE PROCEDURE FM_INTERVAL_FMA2
MODULE PROCEDURE FM_INTERVAL_IM2
MODULE PROCEDURE FM_INTERVAL_ZM2
MODULE PROCEDURE FM_INTERVAL_ST2
END INTERFACE
! Return the left or right endpoint of an interval as a type (fm) number.
INTERFACE LEFT_ENDPOINT
MODULE PROCEDURE LEFT_ENDPOINT_INTERVAL_FM
END INTERFACE
INTERFACE RIGHT_ENDPOINT
MODULE PROCEDURE RIGHT_ENDPOINT_INTERVAL_FM
END INTERFACE
INTERFACE TO_FM
MODULE PROCEDURE FM_FM_INTERVAL
MODULE PROCEDURE FM_FM_INTERVAL1
MODULE PROCEDURE FM_FM_INTERVAL2
END INTERFACE
INTERFACE TO_IM
MODULE PROCEDURE IM_FM_INTERVAL
MODULE PROCEDURE IM_FM_INTERVAL1
MODULE PROCEDURE IM_FM_INTERVAL2
END INTERFACE
INTERFACE TO_ZM
MODULE PROCEDURE ZM_FM_INTERVAL
MODULE PROCEDURE ZM_FM_INTERVAL1
MODULE PROCEDURE ZM_FM_INTERVAL2
END INTERFACE
INTERFACE TO_INT
MODULE PROCEDURE FM_INTERVAL_2INT
MODULE PROCEDURE FM_INTERVAL_2INT1
MODULE PROCEDURE FM_INTERVAL_2INT2
END INTERFACE
INTERFACE TO_SP
MODULE PROCEDURE FM_INTERVAL_2SP
MODULE PROCEDURE FM_INTERVAL_2SP1
MODULE PROCEDURE FM_INTERVAL_2SP2
END INTERFACE
INTERFACE TO_DP
MODULE PROCEDURE FM_INTERVAL_2DP
MODULE PROCEDURE FM_INTERVAL_2DP1
MODULE PROCEDURE FM_INTERVAL_2DP2
END INTERFACE
INTERFACE TO_SPZ
MODULE PROCEDURE FM_INTERVAL_2SPZ
MODULE PROCEDURE FM_INTERVAL_2SPZ1
MODULE PROCEDURE FM_INTERVAL_2SPZ2
END INTERFACE
INTERFACE TO_DPZ
MODULE PROCEDURE FM_INTERVAL_2DPZ
MODULE PROCEDURE FM_INTERVAL_2DPZ1
MODULE PROCEDURE FM_INTERVAL_2DPZ2
END INTERFACE
INTERFACE IS_OVERFLOW
MODULE PROCEDURE FM_INTERVAL_IS_OVERFLOW
MODULE PROCEDURE FM_INTERVAL_IS_OVERFLOW1
MODULE PROCEDURE FM_INTERVAL_IS_OVERFLOW2
END INTERFACE
INTERFACE IS_UNDERFLOW
MODULE PROCEDURE FM_INTERVAL_IS_UNDERFLOW
MODULE PROCEDURE FM_INTERVAL_IS_UNDERFLOW1
MODULE PROCEDURE FM_INTERVAL_IS_UNDERFLOW2
END INTERFACE
INTERFACE IS_UNKNOWN
MODULE PROCEDURE FM_INTERVAL_IS_UNKNOWN
MODULE PROCEDURE FM_INTERVAL_IS_UNKNOWN1
MODULE PROCEDURE FM_INTERVAL_IS_UNKNOWN2
END INTERFACE
INTERFACE FMEQ_INDEX_INTERVAL
MODULE PROCEDURE FMEQ_INDEX_INTERVAL_FM0
MODULE PROCEDURE FMEQ_INDEX_INTERVAL_FM1
MODULE PROCEDURE FMEQ_INDEX_INTERVAL_FM2
END INTERFACE
INTERFACE FM_INTERVAL_UNDEF_INP
MODULE PROCEDURE FM_UNDEF_INP_INTERVAL_FM0
MODULE PROCEDURE FM_UNDEF_INP_INTERVAL_FM1
MODULE PROCEDURE FM_UNDEF_INP_INTERVAL_FM2
END INTERFACE
CONTAINS
! TO_FM_INTERVAL
FUNCTION FM_INTERVAL_I(IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_I
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMI2M_INTERVAL(IVAL,FM_INTERVAL_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_I
FUNCTION FM_INTERVAL_R(R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_R
REAL :: R
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M_INTERVAL(R,FM_INTERVAL_R)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_R
FUNCTION FM_INTERVAL_D(D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_D
DOUBLE PRECISION :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M_INTERVAL(D,FM_INTERVAL_D)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_D
FUNCTION FM_INTERVAL_Z(Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_Z
COMPLEX :: Z
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M_INTERVAL(REAL(Z),FM_INTERVAL_Z)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_Z
FUNCTION FM_INTERVAL_ZD(C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_ZD
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),FM_INTERVAL_ZD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZD
FUNCTION FM_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FM_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMMIN(MA%LEFT,MA%RIGHT,FM_INTERVAL_FM%LEFT)
CALL FMMAX(MA%LEFT,MA%RIGHT,FM_INTERVAL_FM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FM
FUNCTION FM_INTERVAL_FMA(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_FMA
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,FM_INTERVAL_FMA%LEFT)
CALL FMEQ(MA%MFM,FM_INTERVAL_FMA%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FMA
FUNCTION FM_INTERVAL_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_IM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,FM_INTERVAL_IM%LEFT)
CALL IMI2FM(MA%MIM,FM_INTERVAL_IM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IM
FUNCTION FM_INTERVAL_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL_INTERVAL(MA%MZM,FM_INTERVAL_ZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZM
FUNCTION FM_INTERVAL_ST(ST)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: FM_INTERVAL_ST
CHARACTER(*) :: ST
INTENT (IN) :: ST
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMST2M_INTERVAL(ST,FM_INTERVAL_ST)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ST
FUNCTION FM_INTERVAL_I1(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FM_INTERVAL_I1
INTEGER :: J,N
INTENT (IN) :: IVAL
FM_INTERVAL_I1%LEFT = -1
FM_INTERVAL_I1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),FM_INTERVAL_I1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_I1
FUNCTION FM_INTERVAL_R1(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FM_INTERVAL_R1
INTEGER :: J,N
INTENT (IN) :: R
FM_INTERVAL_R1%LEFT = -1
FM_INTERVAL_R1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),FM_INTERVAL_R1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_R1
FUNCTION FM_INTERVAL_D1(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FM_INTERVAL_D1
INTEGER :: J,N
INTENT (IN) :: D
FM_INTERVAL_D1%LEFT = -1
FM_INTERVAL_D1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),FM_INTERVAL_D1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_D1
FUNCTION FM_INTERVAL_Z1(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:) :: Z
TYPE (FM_INTERVAL), DIMENSION(SIZE(Z)) :: FM_INTERVAL_Z1
INTEGER :: J,N
INTENT (IN) :: Z
FM_INTERVAL_Z1%LEFT = -1
FM_INTERVAL_Z1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(Z)
DO J = 1, N
CALL FMSP2M_INTERVAL(REAL(Z(J)),FM_INTERVAL_Z1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_Z1
FUNCTION FM_INTERVAL_ZD1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (FM_INTERVAL), DIMENSION(SIZE(C)) :: FM_INTERVAL_ZD1
INTEGER :: J,N
INTENT (IN) :: C
FM_INTERVAL_ZD1%LEFT = -1
FM_INTERVAL_ZD1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
CALL FMDP2M_INTERVAL(REAL(C(J),KIND(0.0D0)),FM_INTERVAL_ZD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZD1
FUNCTION FM_INTERVAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FM_INTERVAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_INTERVAL_FM1%LEFT = -1
FM_INTERVAL_FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ_INTERVAL(MA(J),FM_INTERVAL_FM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FM1
FUNCTION FM_INTERVAL_FMA1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FM_INTERVAL_FMA1
INTEGER :: J,N
INTENT (IN) :: MA
FM_INTERVAL_FMA1%LEFT = -1
FM_INTERVAL_FMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ(MA(J)%MFM,FM_INTERVAL_FMA1(J)%LEFT)
CALL FMEQ(MA(J)%MFM,FM_INTERVAL_FMA1(J)%RIGHT)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FMA1
FUNCTION FM_INTERVAL_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FM_INTERVAL_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_INTERVAL_IM1%LEFT = -1
FM_INTERVAL_IM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,FM_INTERVAL_IM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IM1
FUNCTION FM_INTERVAL_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FM_INTERVAL_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_INTERVAL_ZM1%LEFT = -1
FM_INTERVAL_ZM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL_INTERVAL(MA(J)%MZM,FM_INTERVAL_ZM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZM1
FUNCTION FM_INTERVAL_ST1(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:) :: ST
TYPE (FM_INTERVAL), DIMENSION(SIZE(ST)) :: FM_INTERVAL_ST1
INTEGER :: J,N
INTENT (IN) :: ST
FM_INTERVAL_ST1%LEFT = -1
FM_INTERVAL_ST1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(ST)
DO J = 1, N
CALL FMST2M_INTERVAL(ST(J),FM_INTERVAL_ST1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ST1
FUNCTION FM_INTERVAL_I2(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FM_INTERVAL_I2
INTEGER :: J,K
INTENT (IN) :: IVAL
FM_INTERVAL_I2%LEFT = -1
FM_INTERVAL_I2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),FM_INTERVAL_I2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_I2
FUNCTION FM_INTERVAL_R2(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FM_INTERVAL_R2
INTEGER :: J,K
INTENT (IN) :: R
FM_INTERVAL_R2%LEFT = -1
FM_INTERVAL_R2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),FM_INTERVAL_R2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_R2
FUNCTION FM_INTERVAL_D2(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FM_INTERVAL_D2
INTEGER :: J,K
INTENT (IN) :: D
FM_INTERVAL_D2%LEFT = -1
FM_INTERVAL_D2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),FM_INTERVAL_D2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_D2
FUNCTION FM_INTERVAL_Z2(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:,:) :: Z
TYPE (FM_INTERVAL), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FM_INTERVAL_Z2
INTEGER :: J,K
INTENT (IN) :: Z
FM_INTERVAL_Z2%LEFT = -1
FM_INTERVAL_Z2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL FMSP2M_INTERVAL(REAL(Z(J,K)),FM_INTERVAL_Z2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_Z2
FUNCTION FM_INTERVAL_ZD2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (FM_INTERVAL), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FM_INTERVAL_ZD2
INTEGER :: J,K
INTENT (IN) :: C
FM_INTERVAL_ZD2%LEFT = -1
FM_INTERVAL_ZD2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMDP2M_INTERVAL(REAL(C(J,K),KIND(0.0D0)),FM_INTERVAL_ZD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZD2
FUNCTION FM_INTERVAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_INTERVAL_FM2%LEFT = -1
FM_INTERVAL_FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MA(J,K),FM_INTERVAL_FM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FM2
FUNCTION FM_INTERVAL_FMA2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_FMA2
INTEGER :: J,K
INTENT (IN) :: MA
FM_INTERVAL_FMA2%LEFT = -1
FM_INTERVAL_FMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MA(J,K)%MFM,FM_INTERVAL_FMA2(J,K)%LEFT)
CALL FMEQ(MA(J,K)%MFM,FM_INTERVAL_FMA2(J,K)%RIGHT)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_FMA2
FUNCTION FM_INTERVAL_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_INTERVAL_IM2%LEFT = -1
FM_INTERVAL_IM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,FM_INTERVAL_IM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IM2
FUNCTION FM_INTERVAL_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_INTERVAL_ZM2%LEFT = -1
FM_INTERVAL_ZM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMREAL_INTERVAL(MA(J,K)%MZM,FM_INTERVAL_ZM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ZM2
FUNCTION FM_INTERVAL_ST2(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:,:) :: ST
TYPE (FM_INTERVAL), DIMENSION(SIZE(ST,DIM=1),SIZE(ST,DIM=2)) :: FM_INTERVAL_ST2
INTEGER :: J,K
INTENT (IN) :: ST
FM_INTERVAL_ST2%LEFT = -1
FM_INTERVAL_ST2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(ST,DIM=1)
DO K = 1, SIZE(ST,DIM=2)
CALL FMST2M_INTERVAL(ST(J,K),FM_INTERVAL_ST2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_ST2
FUNCTION INTERVAL_FM_I(IVAL1,IVAL2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_I
INTEGER :: IVAL1,IVAL2,IV1,IV2
INTENT (IN) :: IVAL1,IVAL2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IV1 = MIN(IVAL1,IVAL2)
IV2 = MAX(IVAL1,IVAL2)
CALL FMI2M(IV1,INTERVAL_FM_I%LEFT)
CALL FMI2M(IV2,INTERVAL_FM_I%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_I
FUNCTION INTERVAL_FM_R(R1,R2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_R
REAL :: R1,R2,RV1,RV2
INTENT (IN) :: R1,R2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
RV1 = MIN(R1,R2)
RV2 = MAX(R1,R2)
CALL FMSP2M(RV1,INTERVAL_FM_R%LEFT)
CALL FMSP2M(RV2,INTERVAL_FM_R%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_R
FUNCTION INTERVAL_FM_D(D1,D2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_D
DOUBLE PRECISION :: D1,D2,DV1,DV2
INTENT (IN) :: D1,D2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DV1 = MIN(D1,D2)
DV2 = MAX(D1,D2)
CALL FMDP2M(DV1,INTERVAL_FM_D%LEFT)
CALL FMDP2M(DV2,INTERVAL_FM_D%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_D
FUNCTION INTERVAL_FM_Z(Z1,Z2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_Z
COMPLEX :: Z1,Z2
REAL :: RV1,RV2
INTENT (IN) :: Z1,Z2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
RV1 = MIN(REAL(Z1),REAL(Z2))
RV2 = MAX(REAL(Z1),REAL(Z2))
CALL FMSP2M(RV1,INTERVAL_FM_Z%LEFT)
CALL FMSP2M(RV2,INTERVAL_FM_Z%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_Z
FUNCTION INTERVAL_FM_ZD(C1,C2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_ZD
COMPLEX (KIND(0.0D0)) :: C1,C2
DOUBLE PRECISION :: DV1,DV2
INTENT (IN) :: C1,C2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DV1 = MIN(REAL(C1,KIND(0.0D0)),REAL(C2,KIND(0.0D0)))
DV2 = MAX(REAL(C1,KIND(0.0D0)),REAL(C2,KIND(0.0D0)))
CALL FMDP2M(DV1,INTERVAL_FM_ZD%LEFT)
CALL FMDP2M(DV2,INTERVAL_FM_ZD%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_ZD
FUNCTION INTERVAL_FM_FM(M1,M2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_FM
TYPE (FM) :: M1,M2
INTENT (IN) :: M1,M2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(M1)
CALL FM_UNDEF_INP(M2)
CALL FMMIN(M1%MFM,M2%MFM,MTFM)
CALL FMMAX(M1%MFM,M2%MFM,MUFM)
CALL FMEQ(MTFM,INTERVAL_FM_FM%LEFT)
CALL FMEQ(MUFM,INTERVAL_FM_FM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_FM
FUNCTION INTERVAL_FM_IM(M1,M2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_IM
TYPE (IM) :: M1,M2
INTENT (IN) :: M1,M2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(M1)
CALL FM_UNDEF_INP(M2)
CALL IMMIN(M1%MIM,M2%MIM,MTIM)
CALL IMMAX(M1%MIM,M2%MIM,MUIM)
CALL IMI2FM(MTIM,INTERVAL_FM_IM%LEFT)
CALL IMI2FM(MUIM,INTERVAL_FM_IM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_IM
FUNCTION INTERVAL_FM_ZM(M1,M2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_ZM
TYPE (ZM) :: M1,M2
INTENT (IN) :: M1,M2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(M1)
CALL FM_UNDEF_INP(M2)
CALL ZMREAL(M1%MZM,M1FM)
CALL ZMREAL(M2%MZM,M2FM)
CALL FMMIN(M1FM,M2FM,INTERVAL_FM_ZM%LEFT)
CALL FMMAX(M1FM,M2FM,INTERVAL_FM_ZM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_ZM
FUNCTION INTERVAL_FM_ST(S1,S2)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: INTERVAL_FM_ST
CHARACTER(*) :: S1,S2
INTENT (IN) :: S1,S2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMST2M(S1,M1FM)
CALL FMST2M(S2,M2FM)
CALL FMMIN(M1FM,M2FM,INTERVAL_FM_ST%LEFT)
CALL FMMAX(M1FM,M2FM,INTERVAL_FM_ST%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION INTERVAL_FM_ST
! LEFT_ENDPOINT
FUNCTION LEFT_ENDPOINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: LEFT_ENDPOINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ(MA%LEFT,LEFT_ENDPOINT_INTERVAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION LEFT_ENDPOINT_INTERVAL_FM
! RIGHT_ENDPOINT
FUNCTION RIGHT_ENDPOINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: RIGHT_ENDPOINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ(MA%RIGHT,RIGHT_ENDPOINT_INTERVAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION RIGHT_ENDPOINT_INTERVAL_FM
! TO_FM
FUNCTION FM_FM_INTERVAL(MA)
! When converting an interval to a non-interval value, use the midpoint.
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: FM_FM_INTERVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSUB(MA%RIGHT,MA%LEFT,MTFM)
CALL FMDIVI_R1(MTFM,2)
CALL FMADD(MA%LEFT,MTFM,FM_FM_INTERVAL%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM_INTERVAL
FUNCTION FM_FM_INTERVAL1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FM_FM_INTERVAL1
INTEGER :: J,N
INTENT (IN) :: MA
FM_FM_INTERVAL1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSUB(MA(J)%RIGHT,MA(J)%LEFT,MTFM)
CALL FMDIVI_R1(MTFM,2)
CALL FMADD(MA(J)%LEFT,MTFM,FM_FM_INTERVAL1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM_INTERVAL1
FUNCTION FM_FM_INTERVAL2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_FM_INTERVAL2
INTEGER :: J,K
INTENT (IN) :: MA
FM_FM_INTERVAL2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%RIGHT,MA(J,K)%LEFT,MTFM)
CALL FMDIVI_R1(MTFM,2)
CALL FMADD(MA(J,K)%LEFT,MTFM,FM_FM_INTERVAL2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM_INTERVAL2
! TO_IM
FUNCTION IM_FM_INTERVAL(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_FM_INTERVAL
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL IMFM2I_INTERVAL(MA,IM_FM_INTERVAL%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM_INTERVAL
FUNCTION IM_FM_INTERVAL1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: IM_FM_INTERVAL1
INTEGER :: J,N
INTENT (IN) :: MA
IM_FM_INTERVAL1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMFM2I_INTERVAL(MA(J),IM_FM_INTERVAL1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM_INTERVAL1
FUNCTION IM_FM_INTERVAL2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_FM_INTERVAL2
INTEGER :: J,K
INTENT (IN) :: MA
IM_FM_INTERVAL2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMFM2I_INTERVAL(MA(J,K),IM_FM_INTERVAL2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM_INTERVAL2
! TO_ZM
FUNCTION ZM_FM_INTERVAL(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_FM_INTERVAL
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(0,MUFM_I)
CALL ZMCMPX_INTERVAL(MA,MUFM_I,ZM_FM_INTERVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM_INTERVAL
FUNCTION ZM_FM_INTERVAL1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: ZM_FM_INTERVAL1
INTEGER :: J,N
INTENT (IN) :: MA
ZM_FM_INTERVAL1%MZM(1) = -1
ZM_FM_INTERVAL1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(0,MUFM_I)
DO J = 1, N
CALL ZMCMPX_INTERVAL(MA(J),MUFM_I,ZM_FM_INTERVAL1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM_INTERVAL1
FUNCTION ZM_FM_INTERVAL2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_FM_INTERVAL2
INTEGER :: J,K
INTENT (IN) :: MA
ZM_FM_INTERVAL2%MZM(1) = -1
ZM_FM_INTERVAL2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(0,MUFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX_INTERVAL(MA(J,K),MUFM_I,ZM_FM_INTERVAL2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM_INTERVAL2
! TO_INT
FUNCTION FM_INTERVAL_2INT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: FM_INTERVAL_2INT
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2I_INTERVAL(MA,FM_INTERVAL_2INT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2INT
FUNCTION FM_INTERVAL_2INT1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(SIZE(MA)) :: FM_INTERVAL_2INT1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2I_INTERVAL(MA(J),FM_INTERVAL_2INT1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2INT1
FUNCTION FM_INTERVAL_2INT2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_2INT2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2I_INTERVAL(MA(J,K),FM_INTERVAL_2INT2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2INT2
! TO_SP
FUNCTION FM_INTERVAL_2SP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL :: FM_INTERVAL_2SP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,FM_INTERVAL_2SP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SP
FUNCTION FM_INTERVAL_2SP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(SIZE(MA)) :: FM_INTERVAL_2SP1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2SP_INTERVAL(MA(J),FM_INTERVAL_2SP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SP1
FUNCTION FM_INTERVAL_2SP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_2SP2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2SP_INTERVAL(MA(J,K),FM_INTERVAL_2SP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SP2
! TO_DP
FUNCTION FM_INTERVAL_2DP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: FM_INTERVAL_2DP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,FM_INTERVAL_2DP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DP
FUNCTION FM_INTERVAL_2DP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA)) :: FM_INTERVAL_2DP1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2DP_INTERVAL(MA(J),FM_INTERVAL_2DP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DP1
FUNCTION FM_INTERVAL_2DP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_2DP2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2DP_INTERVAL(MA(J,K),FM_INTERVAL_2DP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DP2
! TO_SPZ
FUNCTION FM_INTERVAL_2SPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX FM_INTERVAL_2SPZ
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,R)
FM_INTERVAL_2SPZ = CMPLX( R , 0.0 )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SPZ
FUNCTION FM_INTERVAL_2SPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
COMPLEX, DIMENSION(SIZE(MA)) :: FM_INTERVAL_2SPZ1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2SP_INTERVAL(MA(J),R)
FM_INTERVAL_2SPZ1(J) = CMPLX( R , 0.0 )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SPZ1
FUNCTION FM_INTERVAL_2SPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_2SPZ2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2SP_INTERVAL(MA(J,K),R)
FM_INTERVAL_2SPZ2(J,K) = CMPLX( R , 0.0 )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2SPZ2
! TO_DPZ
FUNCTION FM_INTERVAL_2DPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: FM_INTERVAL_2DPZ
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,D)
FM_INTERVAL_2DPZ = CMPLX( D , 0.0D0 , KIND(0.0D0) )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DPZ
FUNCTION FM_INTERVAL_2DPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA)) :: FM_INTERVAL_2DPZ1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2DP_INTERVAL(MA(J),D)
FM_INTERVAL_2DPZ1(J) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DPZ1
FUNCTION FM_INTERVAL_2DPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_INTERVAL_2DPZ2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2DP_INTERVAL(MA(J,K),D)
FM_INTERVAL_2DPZ2(J,K) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_2DPZ2
! IS_OVERFLOW
FUNCTION FM_INTERVAL_IS_OVERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
LOGICAL :: FM_INTERVAL_IS_OVERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_OVERFLOW = .FALSE.
IF (MWK(START(MA%LEFT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW = .TRUE.
IF (MWK(START(MA%RIGHT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_OVERFLOW
FUNCTION FM_INTERVAL_IS_OVERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
LOGICAL :: FM_INTERVAL_IS_OVERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
FM_INTERVAL_IS_OVERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%LEFT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW1 = .TRUE.
IF (MWK(START(MA(J)%RIGHT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_OVERFLOW1
FUNCTION FM_INTERVAL_IS_OVERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
LOGICAL :: FM_INTERVAL_IS_OVERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_OVERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%LEFT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW2 = .TRUE.
IF (MWK(START(MA(J,K)%RIGHT)+2) == MEXPOV) FM_INTERVAL_IS_OVERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_OVERFLOW2
! IS_UNDERFLOW
FUNCTION FM_INTERVAL_IS_UNDERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
LOGICAL :: FM_INTERVAL_IS_UNDERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_UNDERFLOW = .FALSE.
IF (MWK(START(MA%LEFT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW = .TRUE.
IF (MWK(START(MA%RIGHT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNDERFLOW
! The integer versions are included for completeness, but type (im) numbers can't underflow.
FUNCTION FM_INTERVAL_IS_UNDERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
LOGICAL :: FM_INTERVAL_IS_UNDERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
FM_INTERVAL_IS_UNDERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%LEFT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW1 = .TRUE.
IF (MWK(START(MA(J)%RIGHT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNDERFLOW1
FUNCTION FM_INTERVAL_IS_UNDERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
LOGICAL :: FM_INTERVAL_IS_UNDERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_UNDERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%LEFT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW2 = .TRUE.
IF (MWK(START(MA(J,K)%RIGHT)+2) == MEXPUN) FM_INTERVAL_IS_UNDERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNDERFLOW2
! IS_UNKNOWN
FUNCTION FM_INTERVAL_IS_UNKNOWN(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
LOGICAL :: FM_INTERVAL_IS_UNKNOWN
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_UNKNOWN = .FALSE.
IF (MWK(START(MA%LEFT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN = .TRUE.
IF (MWK(START(MA%RIGHT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNKNOWN
FUNCTION FM_INTERVAL_IS_UNKNOWN1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
LOGICAL :: FM_INTERVAL_IS_UNKNOWN1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
FM_INTERVAL_IS_UNKNOWN1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%LEFT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN1 = .TRUE.
IF (MWK(START(MA(J)%RIGHT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNKNOWN1
FUNCTION FM_INTERVAL_IS_UNKNOWN2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
LOGICAL :: FM_INTERVAL_IS_UNKNOWN2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FM_INTERVAL_IS_UNKNOWN2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%LEFT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN2 = .TRUE.
IF (MWK(START(MA(J,K)%RIGHT)+2) == MUNKNO) FM_INTERVAL_IS_UNKNOWN2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_INTERVAL_IS_UNKNOWN2
SUBROUTINE FM_TO_FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSUB(MA%RIGHT,MA%LEFT,MTFM)
CALL FMDIVI_R1(MTFM,2)
CALL FMADD(MA%LEFT,MTFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_TO_FMA
! FMEQ_INDEX
! Check to see if the multiple precision number MA being defined is previously undefined
! and has a default index value of -1. If so, since it is a user variable and not a
! compiler-generated temporary number, change the index to -3 so that the variable is
! stored in the saved area in MWK and not treated as a temporary variable.
SUBROUTINE FMEQ_INDEX_INTERVAL_FM0(MA)
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
IF (MA%LEFT == -1) MA%LEFT = -3
IF (MA%RIGHT == -1) MA%RIGHT = -3
END SUBROUTINE FMEQ_INDEX_INTERVAL_FM0
SUBROUTINE FMEQ_INDEX_INTERVAL_FM1(MA)
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%LEFT == -1) MA(J)%LEFT = -3
IF (MA(J)%RIGHT == -1) MA(J)%RIGHT = -3
ENDDO
END SUBROUTINE FMEQ_INDEX_INTERVAL_FM1
SUBROUTINE FMEQ_INDEX_INTERVAL_FM2(MA)
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%LEFT == -1) MA(J,K)%LEFT = -3
IF (MA(J,K)%RIGHT == -1) MA(J,K)%RIGHT = -3
ENDDO
ENDDO
END SUBROUTINE FMEQ_INDEX_INTERVAL_FM2
SUBROUTINE FM_UNDEF_INP_INTERVAL_FM0(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
IF (MA%LEFT <= 0) CALL FM_INPUT_ERROR
IF (MA%LEFT > NUMBER_USED .AND. &
MA%LEFT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%LEFT > SIZE_OF_START) CALL FM_INPUT_ERROR
IF (MA%RIGHT <= 0) CALL FM_INPUT_ERROR
IF (MA%RIGHT > NUMBER_USED .AND. &
MA%RIGHT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%RIGHT > SIZE_OF_START) CALL FM_INPUT_ERROR
END SUBROUTINE FM_UNDEF_INP_INTERVAL_FM0
SUBROUTINE FM_UNDEF_INP_INTERVAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J
INTENT (IN) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%LEFT <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%LEFT > NUMBER_USED .AND. &
MA(J)%LEFT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%LEFT > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%RIGHT <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%RIGHT > NUMBER_USED .AND. &
MA(J)%RIGHT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%RIGHT > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
ENDDO
END SUBROUTINE FM_UNDEF_INP_INTERVAL_FM1
SUBROUTINE FM_UNDEF_INP_INTERVAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (IN) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%LEFT <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%LEFT > NUMBER_USED .AND. &
MA(J,K)%LEFT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%LEFT > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%RIGHT <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%RIGHT > NUMBER_USED .AND. &
MA(J,K)%RIGHT < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%RIGHT > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
ENDDO
ENDDO
END SUBROUTINE FM_UNDEF_INP_INTERVAL_FM2
SUBROUTINE FMABS_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) >= 0) THEN
CALL FMEQ(MA%LEFT,MB%LEFT)
CALL FMEQ(MA%RIGHT,MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) <= 0) THEN
CALL FMABS(MA%RIGHT,MB%LEFT)
CALL FMABS(MA%LEFT,MB%RIGHT)
ELSE
CALL FMI2M(0,MB%LEFT)
CALL FMABS(MA%LEFT,MTFM)
CALL FMMAX(MTFM,MA%RIGHT,MB%RIGHT)
ENDIF
110 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMABS_INTERVAL
SUBROUTINE FMADD_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
KROUND = -1
CALL FMADD(MA%LEFT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMADD(MA%RIGHT,MB%RIGHT,MC%RIGHT)
IF (MWK(START(MC%LEFT)+2) /= MUNKNO .AND. MWK(START(MC%RIGHT)+2) /= MUNKNO) THEN
IF (MWK(START(MA%LEFT)+2) == MEXPOV .AND. &
MWK(START(MA%LEFT)) > 0 .AND. MWK(START(MB%LEFT)) < 0) CALL FMBIG(MC%LEFT)
IF (MWK(START(MB%LEFT)+2) == MEXPOV .AND. &
MWK(START(MB%LEFT)) > 0 .AND. MWK(START(MA%LEFT)) < 0) CALL FMBIG(MC%LEFT)
IF (MWK(START(MA%RIGHT)+2) == MEXPOV .AND. &
MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%RIGHT)) > 0) THEN
CALL FMBIG(MC%RIGHT)
CALL FMMPYI_R1(MC%RIGHT,-1)
ENDIF
IF (MWK(START(MB%RIGHT)+2) == MEXPOV .AND. &
MWK(START(MB%RIGHT)) < 0 .AND. MWK(START(MA%RIGHT)) > 0) THEN
CALL FMBIG(MC%RIGHT)
CALL FMMPYI_R1(MC%RIGHT,-1)
ENDIF
ENDIF
IF (MWK(START(MC%LEFT)+2) == MUNKNO) THEN
KROUND = -1
IF (MWK(START(MA%LEFT)+2) == MEXPUN .AND. MWK(START(MB%LEFT)+2) == MEXPUN) THEN
IF (MWK(START(MA%LEFT)) > 0 .AND. MWK(START(MB%LEFT)) > 0) THEN
CALL FMST2M('UNDERFLOW',MC%LEFT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MB%LEFT)) < 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI(M_12%MFM,-2,MC%LEFT)
ELSE
CALL FMST2M('-UNDERFLOW',MC%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%LEFT)+2) == MEXPUN .AND. MWK(START(MB%LEFT)+2) > MEXPUN .AND. &
MWK(START(MB%LEFT)+2) < MEXPOV) THEN
IF (MWK(START(MA%LEFT)) > 0) THEN
CALL FMEQ(MB%LEFT,MC%LEFT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMSUB(MB%LEFT,M_12%MFM,MC%LEFT)
IF (MWK(START(MC%LEFT)+3) == 0) THEN
CALL FMDIVI(MB%LEFT,2,MC%LEFT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MB%LEFT)+2) == MEXPUN .AND. MWK(START(MA%LEFT)+2) > MEXPUN .AND. &
MWK(START(MA%LEFT)+2) < MEXPOV) THEN
IF (MWK(START(MB%LEFT)) > 0) THEN
CALL FMEQ(MA%LEFT,MC%LEFT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMSUB(MA%LEFT,M_12%MFM,MC%LEFT)
IF (MWK(START(MC%LEFT)+3) == 0) THEN
CALL FMDIVI(MA%LEFT,2,MC%LEFT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MA%LEFT)+2) == MEXPOV .AND. MWK(START(MB%LEFT)+2) == MEXPOV) THEN
CALL FMST2M('-OVERFLOW',MC%LEFT)
ENDIF
IF (MWK(START(MA%LEFT)+2) == MEXPOV .AND. MWK(START(MB%LEFT)+2) > MEXPUN .AND. &
MWK(START(MB%LEFT)+2) < MEXPOV) THEN
IF (MWK(START(MA%LEFT)) > 0) THEN
CALL FMBIG(M_11%MFM)
CALL FMULP(M_11%MFM,MC%LEFT)
ELSE
CALL FMST2M('-OVERFLOW',MC%LEFT)
ENDIF
ENDIF
IF (MWK(START(MB%LEFT)+2) == MEXPOV .AND. MWK(START(MA%LEFT)+2) > MEXPUN .AND. &
MWK(START(MA%LEFT)+2) < MEXPOV) THEN
IF (MWK(START(MB%LEFT)) > 0) THEN
CALL FMBIG(M_11%MFM)
CALL FMULP(M_11%MFM,MC%LEFT)
ELSE
CALL FMST2M('-OVERFLOW',MC%LEFT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
KROUND = 2
IF (MWK(START(MA%RIGHT)+2) == MEXPUN .AND. MWK(START(MB%RIGHT)+2) == MEXPUN) THEN
IF (MWK(START(MA%RIGHT)) > 0 .AND. MWK(START(MB%RIGHT)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI(M_12%MFM,2,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC%RIGHT)
ELSE
CALL FMST2M('+UNDERFLOW',MC%RIGHT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPUN .AND. MWK(START(MB%RIGHT)+2) > MEXPUN .AND. &
MWK(START(MB%RIGHT)+2) < MEXPOV) THEN
IF (MWK(START(MA%RIGHT)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMADD(MB%RIGHT,M_12%MFM,MC%RIGHT)
IF (MWK(START(MC%RIGHT)+3) == 0) THEN
CALL FMDIVI(MB%RIGHT,2,MC%RIGHT)
ENDIF
ELSE
CALL FMEQ(MB%RIGHT,MC%RIGHT)
ENDIF
ENDIF
IF (MWK(START(MB%RIGHT)+2) == MEXPUN .AND. MWK(START(MA%RIGHT)+2) > MEXPUN .AND. &
MWK(START(MA%RIGHT)+2) < MEXPOV) THEN
IF (MWK(START(MB%RIGHT)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMADD(MA%RIGHT,M_12%MFM,MC%RIGHT)
IF (MWK(START(MC%RIGHT)+3) == 0) THEN
CALL FMDIVI(MA%RIGHT,2,MC%RIGHT)
ENDIF
ELSE
CALL FMEQ(MA%RIGHT,MC%RIGHT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV .AND. MWK(START(MB%RIGHT)+2) == MEXPOV) THEN
CALL FMST2M('+OVERFLOW',MC%RIGHT)
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV .AND. MWK(START(MB%RIGHT)+2) > MEXPUN .AND. &
MWK(START(MB%RIGHT)+2) < MEXPOV) THEN
IF (MWK(START(MA%RIGHT)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE
CALL FMBIG(M_11%MFM)
CALL FMMPYI_R1(M_11%MFM,-1)
CALL FMULP(M_11%MFM,MC%RIGHT)
ENDIF
ENDIF
IF (MWK(START(MB%RIGHT)+2) == MEXPOV .AND. MWK(START(MA%RIGHT)+2) > MEXPUN .AND. &
MWK(START(MA%RIGHT)+2) < MEXPOV) THEN
IF (MWK(START(MB%RIGHT)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE
CALL FMBIG(M_11%MFM)
CALL FMMPYI_R1(M_11%MFM,-1)
CALL FMULP(M_11%MFM,MC%RIGHT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MC%LEFT)+2) == MUNKNO .OR. MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMADD_INTERVAL
SUBROUTINE FMADD_INTERVAL_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMADD_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMADD_INTERVAL_R1
SUBROUTINE FMADD_INTERVAL_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMADD_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMADD_INTERVAL_R2
FUNCTION FMCOMP_INTERVAL(MA,LREL,MB)
! When comparing intervals, the result could be invalid if the two intervals overlap.
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMCOMP_INTERVAL
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
CHARACTER(*) :: LREL
INTENT (IN) :: LREL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (LREL == '==' .OR. LREL == 'EQ' .OR. LREL == 'eq') THEN
FMCOMP_INTERVAL = FMCOMP(MA%LEFT,LREL,MB%LEFT) .AND. FMCOMP(MA%RIGHT,LREL,MB%RIGHT)
ELSE IF (LREL == '/=' .OR. LREL == 'NE' .OR. LREL == 'ne') THEN
FMCOMP_INTERVAL = FMCOMP(MA%LEFT,LREL,MB%LEFT) .OR. FMCOMP(MA%RIGHT,LREL,MB%RIGHT)
ELSE
FMCOMP_INTERVAL = FM_COMP(TO_FM(MA),LREL,TO_FM(MB))
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOMP_INTERVAL
SUBROUTINE FMDIV_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MB%LEFT)) <= 0 .AND. MWK(START(MB%RIGHT)) >= 0) THEN
CALL FMST2M('-OVERFLOW',MC%LEFT)
CALL FMST2M('+OVERFLOW',MC%RIGHT)
GO TO 110
ENDIF
KROUND = -1
IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
CALL FMDIV(MA%LEFT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%RIGHT,MB%LEFT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%LEFT,MB%RIGHT,MC%LEFT,MA%RIGHT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMDIV(MA%RIGHT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%LEFT,MB%LEFT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%RIGHT,MB%RIGHT,MC%LEFT,MA%LEFT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
MWK(START(MB%LEFT)) >= 0) THEN
CALL FMDIV(MA%LEFT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%RIGHT,MB%LEFT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%LEFT,MB%LEFT,MC%LEFT,MA%RIGHT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
MWK(START(MB%RIGHT)) < 0) THEN
CALL FMDIV(MA%RIGHT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%LEFT,MB%RIGHT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%RIGHT,MB%RIGHT,MC%LEFT,MA%LEFT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
CALL FMDIV(MA%LEFT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%RIGHT,MB%RIGHT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%LEFT,MB%LEFT,MC%LEFT,MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMDIV(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMDIV(MA%LEFT,MB%RIGHT,MC%RIGHT)
CALL FMDIV_INTERVAL_SPECIAL(MA%RIGHT,MB%LEFT,MC%LEFT,MA%LEFT,MB%RIGHT,MC%RIGHT)
ELSE
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
110 IF (MWK(START(MC%LEFT)+2) == MUNKNO .OR. MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDIV_INTERVAL
SUBROUTINE FMDIV_INTERVAL_SPECIAL(M1A,M1B,MC_LEFT,M2A,M2B,MC_RIGHT)
USE FMVALS
IMPLICIT NONE
INTEGER :: M1A,M1B,MC_LEFT,M2A,M2B,MC_RIGHT
INTENT (IN) :: M1A,M1B,M2A,M2B
INTENT (INOUT) :: MC_LEFT,MC_RIGHT
IF (MWK(START(MC_LEFT)+2) == MUNKNO) THEN
KROUND = -1
IF (MWK(START(M1A)+2) == MEXPUN .AND. MWK(START(M1B)+2) == MEXPUN) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPOV .AND. MWK(START(M1B)+2) == MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPUN .AND. MWK(START(M1B)+2) > MEXPUN .AND. &
MWK(START(M1B)+2) < MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMDIV(M_12%MFM,M1B,MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMDIV(M_12%MFM,M1B,MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1B)+2) == MEXPUN .AND. MWK(START(M1A)+2) > MEXPUN .AND. &
MWK(START(M1A)+2) < MEXPOV) THEN
IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ELSE IF (MWK(START(M1B)) < 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPOV .AND. MWK(START(M1B)+2) > MEXPUN .AND. &
MWK(START(M1B)+2) < MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMDIV(M_12%MFM,M1B,MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMDIV(M_12%MFM,M1B,MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1B)+2) == MEXPOV .AND. MWK(START(M1A)+2) > MEXPUN .AND. &
MWK(START(M1A)+2) < MEXPOV) THEN
IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1B)) < 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M_12%MFM,M1A,MC_LEFT)
ELSE IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) < 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M_12%MFM,M1A,MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MC_RIGHT)+2) == MUNKNO) THEN
KROUND = 2
IF (MWK(START(M2A)+2) == MEXPUN .AND. MWK(START(M2B)+2) == MEXPUN) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPOV .AND. MWK(START(M2B)+2) == MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPUN .AND. MWK(START(M2B)+2) > MEXPUN .AND. &
MWK(START(M2B)+2) < MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMDIV(M_12%MFM,M2B,MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMDIV(M_12%MFM,M2B,MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2B)+2) == MEXPUN .AND. MWK(START(M2A)+2) > MEXPUN .AND. &
MWK(START(M2A)+2) < MEXPOV) THEN
IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2B)) < 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) < 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPOV .AND. MWK(START(M2B)+2) > MEXPUN .AND. &
MWK(START(M2B)+2) < MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMDIV(M_12%MFM,M2B,MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMDIV(M_12%MFM,M2B,MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2B)+2) == MEXPOV .AND. MWK(START(M2A)+2) > MEXPUN .AND. &
MWK(START(M2A)+2) < MEXPOV) THEN
IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE IF (MWK(START(M2B)) < 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ENDIF
ENDIF
ENDIF
END SUBROUTINE FMDIV_INTERVAL_SPECIAL
SUBROUTINE FMDIV_INTERVAL_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDIV_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDIV_INTERVAL_R1
SUBROUTINE FMDIV_INTERVAL_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDIV_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDIV_INTERVAL_R2
SUBROUTINE FMDIVI_INTERVAL(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
INTENT (INOUT) :: MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
KROUND = -1
IF (MWK(START(MA%LEFT)) >= 0 .AND. IVAL >= 0) THEN
CALL FMDIVI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. IVAL < 0) THEN
CALL FMDIVI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%LEFT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
IVAL >= 0) THEN
CALL FMDIVI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
IVAL < 0) THEN
CALL FMDIVI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%LEFT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. IVAL >= 0) THEN
CALL FMDIVI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. IVAL < 0) THEN
CALL FMDIVI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMDIVI(MA%LEFT,IVAL,MB%RIGHT)
ELSE
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
ENDIF
IF (MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(IVAL,IVAL),M0FM_I)
CALL FMDIV_INTERVAL(MA,M0FM_I,MB)
ENDIF
IF (MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDIVI_INTERVAL
SUBROUTINE FMDIVI_INTERVAL_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDIVI_INTERVAL(MA,IVAL,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDIVI_INTERVAL_R1
SUBROUTINE FMDP2M_INTERVAL(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
DOUBLE PRECISION :: X
INTENT (IN) :: X
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FMDP2M(X,MA%LEFT)
KROUND = 2
CALL FMDP2M(X,MA%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDP2M_INTERVAL
SUBROUTINE FMEQ_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ(MA%LEFT,MB%LEFT)
CALL FMEQ(MA%RIGHT,MB%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL
SUBROUTINE FMEQU_INTERVAL(MA,MB,NDA,NDB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: KRSAVE,NCSAVE,NDA,NDB
INTENT (IN) :: MA,NDA,NDB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
NCSAVE = NCALL
NCALL = 1
KROUND = -1
CALL FMEQU(MA%LEFT,MB%LEFT,NDA,NDB)
KROUND = 2
CALL FMEQU(MA%RIGHT,MB%RIGHT,NDA,NDB)
KROUND = KRSAVE
NCALL = NCSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQU_INTERVAL
SUBROUTINE FMEQU_INTERVAL_R1(MA,NDA,NDB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: KRSAVE,NCSAVE,NDA,NDB
INTENT (IN) :: NDA,NDB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
NCSAVE = NCALL
NCALL = 1
KROUND = -1
CALL FMEQU_R1(MA%LEFT,NDA,NDB)
KROUND = 2
CALL FMEQU_R1(MA%RIGHT,NDA,NDB)
KROUND = KRSAVE
NCALL = NCSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQU_INTERVAL_R1
SUBROUTINE FMI2M_INTERVAL(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FMI2M(IVAL,MA%LEFT)
KROUND = 2
CALL FMI2M(IVAL,MA%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMI2M_INTERVAL
SUBROUTINE FMINT_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMINT(MA%LEFT,MB%LEFT)
CALL FMINT(MA%RIGHT,MB%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMINT_INTERVAL
SUBROUTINE FMM2DP_INTERVAL(MA,X)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
DOUBLE PRECISION :: X
INTENT (INOUT) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_M2DP(TO_FM(MA),X)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMM2DP_INTERVAL
SUBROUTINE FMM2I_INTERVAL(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_M2I(TO_FM(MA),IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMM2I_INTERVAL
SUBROUTINE FMM2SP_INTERVAL(MA,X)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
REAL :: X
INTENT (INOUT) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_M2SP(TO_FM(MA),X)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMM2SP_INTERVAL
SUBROUTINE FMMPY_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
KROUND = -1
IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
CALL FMMPY(MA%LEFT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%RIGHT,MB%RIGHT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%LEFT,MC%LEFT,MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%LEFT)) < 0 .AND. &
MWK(START(MB%RIGHT)) >= 0) THEN
CALL FMMPY(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%RIGHT,MB%RIGHT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%LEFT,MC%LEFT,MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMMPY(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%LEFT,MB%RIGHT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%LEFT,MC%LEFT,MA%LEFT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
MWK(START(MB%LEFT)) >= 0) THEN
CALL FMMPY(MA%LEFT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%RIGHT,MB%RIGHT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%RIGHT,MC%LEFT,MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
MWK(START(MB%LEFT)) < 0 .AND. MWK(START(MB%RIGHT)) >= 0) THEN
CALL FMMPY(MA%LEFT,MB%RIGHT,MTFM)
CALL FMMPY(MA%RIGHT,MB%LEFT,MUFM)
CALL FMI2M(0,MVFM)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%RIGHT,MTFM,MA%LEFT,MB%RIGHT,MVFM)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%LEFT,MUFM,MA%RIGHT,MB%LEFT,MVFM)
CALL FMMIN(MTFM,MUFM,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%LEFT,MB%LEFT,MTFM)
CALL FMMPY(MA%RIGHT,MB%RIGHT,MUFM)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%LEFT,MVFM,MA%LEFT,MB%LEFT,MTFM)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%RIGHT,MVFM,MA%RIGHT,MB%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,MC%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
MWK(START(MB%RIGHT)) < 0) THEN
CALL FMMPY(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%LEFT,MB%LEFT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%LEFT,MC%LEFT,MA%LEFT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
CALL FMMPY(MA%LEFT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%RIGHT,MB%LEFT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%RIGHT,MC%LEFT,MA%RIGHT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%LEFT)) < 0 .AND. &
MWK(START(MB%RIGHT)) >= 0) THEN
CALL FMMPY(MA%LEFT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%LEFT,MB%LEFT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%LEFT,MB%RIGHT,MC%LEFT,MA%LEFT,MB%LEFT,MC%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMMPY(MA%RIGHT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMMPY(MA%LEFT,MB%LEFT,MC%RIGHT)
CALL FMMPY_INTERVAL_SPECIAL(MA%RIGHT,MB%RIGHT,MC%LEFT,MA%LEFT,MB%LEFT,MC%RIGHT)
ELSE
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
IF (MWK(START(MC%LEFT)+2) == MUNKNO .OR. MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMPY_INTERVAL
SUBROUTINE FMMPY_INTERVAL_SPECIAL(M1A,M1B,MC_LEFT,M2A,M2B,MC_RIGHT)
USE FMVALS
IMPLICIT NONE
INTEGER :: M1A,M1B,MC_LEFT,M2A,M2B,MC_RIGHT
INTENT (IN) :: M1A,M1B,M2A,M2B
INTENT (INOUT) :: MC_LEFT,MC_RIGHT
IF (MWK(START(MC_LEFT)+2) == MUNKNO) THEN
KROUND = -1
IF (MWK(START(M1A)+2) == MEXPUN .AND. MWK(START(M1B)+2) == MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPOV .AND. MWK(START(M1B)+2) == MEXPUN) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPUN .AND. MWK(START(M1B)+2) > MEXPUN .AND. &
MWK(START(M1B)+2) < MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M_12%MFM,M1B,MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M_12%MFM,M1B,MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1B)+2) == MEXPUN .AND. MWK(START(M1A)+2) > MEXPUN .AND. &
MWK(START(M1A)+2) < MEXPOV) THEN
IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1B)) < 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ELSE IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) < 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1A)+2) == MEXPOV .AND. MWK(START(M1B)+2) > MEXPUN .AND. &
MWK(START(M1B)+2) < MEXPOV) THEN
IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M_12%MFM,M1B,MC_LEFT)
ELSE IF (MWK(START(M1A)) < 0 .AND. MWK(START(M1B)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1A)) > 0 .AND. MWK(START(M1B)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M_12%MFM,M1B,MC_LEFT)
ENDIF
ENDIF
IF (MWK(START(M1B)+2) == MEXPOV .AND. MWK(START(M1A)+2) > MEXPUN .AND. &
MWK(START(M1A)+2) < MEXPOV) THEN
IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ELSE IF (MWK(START(M1B)) < 0 .AND. MWK(START(M1A)) > 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE IF (MWK(START(M1B)) > 0 .AND. MWK(START(M1A)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC_LEFT)
ELSE
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M1A,M_12%MFM,MC_LEFT)
ENDIF
ENDIF
ENDIF
IF (MWK(START(MC_RIGHT)+2) == MUNKNO) THEN
KROUND = 2
IF (MWK(START(M2A)+2) == MEXPUN .AND. MWK(START(M2B)+2) == MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPOV .AND. MWK(START(M2B)+2) == MEXPUN) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPUN .AND. MWK(START(M2B)+2) > MEXPUN .AND. &
MWK(START(M2B)+2) < MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M_12%MFM,M2B,MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M_12%MFM,M2B,MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2B)+2) == MEXPUN .AND. MWK(START(M2A)+2) > MEXPUN .AND. &
MWK(START(M2A)+2) < MEXPOV) THEN
IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMTINY(M_12%MFM)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE IF (MWK(START(M2B)) < 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) < 0) THEN
CALL FMST2M('-UNDERFLOW',MC_RIGHT)
ELSE
CALL FMTINY(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2A)+2) == MEXPOV .AND. MWK(START(M2B)+2) > MEXPUN .AND. &
MWK(START(M2B)+2) < MEXPOV) THEN
IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2A)) < 0 .AND. MWK(START(M2B)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M_12%MFM,M2B,MC_RIGHT)
ELSE IF (MWK(START(M2A)) > 0 .AND. MWK(START(M2B)) < 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M_12%MFM,M2B,MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
IF (MWK(START(M2B)+2) == MEXPOV .AND. MWK(START(M2A)+2) > MEXPUN .AND. &
MWK(START(M2A)+2) < MEXPOV) THEN
IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ELSE IF (MWK(START(M2B)) < 0 .AND. MWK(START(M2A)) > 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPYI_R1(M_12%MFM,-1)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE IF (MWK(START(M2B)) > 0 .AND. MWK(START(M2A)) < 0) THEN
CALL FMBIG(M_12%MFM)
CALL FMMPY(M2A,M_12%MFM,MC_RIGHT)
ELSE
CALL FMST2M('+OVERFLOW',MC_RIGHT)
ENDIF
ENDIF
ENDIF
END SUBROUTINE FMMPY_INTERVAL_SPECIAL
SUBROUTINE FMMPY_INTERVAL_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMMPY_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMPY_INTERVAL_R1
SUBROUTINE FMMPY_INTERVAL_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMMPY_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMPY_INTERVAL_R2
SUBROUTINE FMMPYI_INTERVAL(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
INTENT (INOUT) :: MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
KROUND = -1
IF (MWK(START(MA%LEFT)) >= 0 .AND. IVAL >= 0) THEN
CALL FMMPYI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. IVAL < 0) THEN
CALL FMMPYI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%LEFT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
IVAL >= 0) THEN
CALL FMMPYI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0 .AND. &
IVAL < 0) THEN
CALL FMMPYI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%LEFT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. IVAL >= 0) THEN
CALL FMMPYI(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%RIGHT,IVAL,MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0 .AND. IVAL < 0) THEN
CALL FMMPYI(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMMPYI(MA%LEFT,IVAL,MB%RIGHT)
ELSE
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
ENDIF
IF (MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(IVAL,IVAL),M0FM_I)
CALL FMMPY_INTERVAL(MA,M0FM_I,MB)
ENDIF
IF (MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMPYI_INTERVAL
SUBROUTINE FMMPYI_INTERVAL_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMMPYI_INTERVAL(MA,IVAL,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMPYI_INTERVAL_R1
SUBROUTINE FMSP2M_INTERVAL(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
REAL :: X
INTENT (IN) :: X
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FMSP2M(X,MA%LEFT)
KROUND = 2
CALL FMSP2M(X,MA%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSP2M_INTERVAL
SUBROUTINE FMSQRT_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMI2M(0,MB%LEFT)
CALL FMI2M(0,MB%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) < 0 .OR. MWK(START(MA%LEFT)+3) == 0) THEN
CALL FMI2M(0,MB%LEFT)
ELSE
IF (MWK(START(MA%LEFT)+2) == MEXPOV) THEN
CALL FMBIG(M_12%MFM)
KROUND = -1
CALL FMSQRT(M_12%MFM,MB%LEFT)
ELSE IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
CALL FMST2M('+UNDERFLOW',MB%LEFT)
ELSE
KROUND = -1
CALL FMSQRT(MA%LEFT,MB%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMST2M('+OVERFLOW',MB%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
CALL FMBIG(M_12%MFM)
KROUND = 2
CALL FMRPWR(M_12%MFM,-1,2,MB%RIGHT)
ELSE
KROUND = 2
CALL FMSQRT(MA%RIGHT,MB%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSQRT_INTERVAL
SUBROUTINE FMSQRT_INTERVAL_R1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSQRT_INTERVAL(MA,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSQRT_INTERVAL_R1
SUBROUTINE FMST2M_INTERVAL(STRING,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FMST2M(STRING,MA%LEFT)
KROUND = 2
CALL FMST2M(STRING,MA%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMST2M_INTERVAL
SUBROUTINE FMSUB_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
KROUND = -1
CALL FMSUB(MA%LEFT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMSUB(MA%RIGHT,MB%LEFT,MC%RIGHT)
IF (MWK(START(MC%LEFT)+2) /= MUNKNO .AND. MWK(START(MC%RIGHT)+2) /= MUNKNO) THEN
IF (MWK(START(MA%LEFT)+2) == MEXPOV .AND. &
MWK(START(MA%LEFT)) > 0 .AND. MWK(START(MB%LEFT)) > 0) CALL FMBIG(MC%LEFT)
IF (MWK(START(MB%LEFT)+2) == MEXPOV .AND. &
MWK(START(MB%LEFT)) > 0 .AND. MWK(START(MA%LEFT)) > 0) THEN
CALL FMBIG(MC%RIGHT)
CALL FMMPYI_R1(MC%RIGHT,-1)
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV .AND. &
MWK(START(MA%RIGHT)) < 0 .AND. MWK(START(MB%RIGHT)) < 0) THEN
CALL FMBIG(MC%RIGHT)
CALL FMMPYI_R1(MC%RIGHT,-1)
ENDIF
IF (MWK(START(MB%RIGHT)+2) == MEXPOV .AND. &
MWK(START(MB%RIGHT)) < 0 .AND. MWK(START(MA%RIGHT)) < 0) CALL FMBIG(MC%LEFT)
ENDIF
IF (MWK(START(MC%LEFT)+2) == MUNKNO .OR. MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(-RIGHT_ENDPOINT(MB),-LEFT_ENDPOINT(MB)),M0FM_I)
CALL FMADD_INTERVAL(MA,M0FM_I,MC)
ENDIF
IF (MWK(START(MC%LEFT)+2) == MUNKNO .OR. MWK(START(MC%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSUB_INTERVAL
SUBROUTINE FMSUB_INTERVAL_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSUB_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSUB_INTERVAL_R1
SUBROUTINE FMSUB_INTERVAL_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSUB_INTERVAL(MA,MB,MWFM_I)
CALL FMEQ_INTERVAL(MWFM_I,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSUB_INTERVAL_R2
SUBROUTINE FMULP_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMULP(MA%LEFT,MB%LEFT)
CALL FMULP(MA%RIGHT,MB%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMULP_INTERVAL
SUBROUTINE IMFM2I_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
INTEGER :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_TO_FMA(MA,M_1)
CALL IMFM2I(M_1%MFM,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IMFM2I_INTERVAL
SUBROUTINE IMI2FM_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
INTENT (IN) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (INOUT) :: MB
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL IMI2FM(MA,MB%LEFT)
KROUND = 2
CALL IMI2FM(MA,MB%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IMI2FM_INTERVAL
SUBROUTINE ZMCMPX_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TYPE (ZM) :: MC
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZM_CMPX(TO_FM(MA),TO_FM(MB),MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZMCMPX_INTERVAL
SUBROUTINE ZMREAL_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
INTEGER :: MA(2)
INTENT (IN) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZMREAL(MA,MB%LEFT)
CALL ZMREAL(MA,MB%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZMREAL_INTERVAL
SUBROUTINE FM_INTERVAL_F_FM(FM_F,MA,MB)
! General interval evaluation for a special function of one FM variable:
! CALL FM_F(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: I,KRSAVE,L
EXTERNAL :: FM_F
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1))))) GO TO 110
CALL FMST2M(' OVERFLOW',M_4%MFM)
CALL FMST2M('-OVERFLOW',M_5%MFM)
DO I = 1, 9
CALL FMSUB(MA%RIGHT,MA%LEFT,M1FM)
CALL FMMPYI_R1(M1FM,I)
CALL FMDIVI_R1(M1FM,10)
CALL FMADD(MA%LEFT,M1FM,M_1%MFM)
CALL FM_F(M_1%MFM,MVFM)
IF (FMCOMP(MVFM,'<',M_4%MFM)) THEN
CALL FMEQ(MVFM,M_4%MFM)
ENDIF
IF (FMCOMP(MVFM,'>',M_5%MFM)) THEN
CALL FMEQ(MVFM,M_5%MFM)
ENDIF
ENDDO
CALL FM_F(MA%LEFT,M1FM)
CALL FM_F(MA%RIGHT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FM_F(M_3%MFM,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FM_F(M_3%MFM,M_2%MFM)
IF ( (FMCOMP(M_4%MFM,'<',M1FM) .AND. FMCOMP(M_4%MFM,'<',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,FM_F)
KROUND = -1
CALL FM_F(M_1%MFM,MB%LEFT)
IF (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)), &
SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,FM_F)
KROUND = 2
CALL FM_F(M_1%MFM,MB%RIGHT)
ELSE
KROUND = 2
CALL FM_F(MA%LEFT,M_4%MFM)
CALL FM_F(MA%RIGHT,M_5%MFM)
IF (FMCOMP(M_4%MFM,'>',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%RIGHT)
ELSE
CALL FMEQ(M_5%MFM,MB%RIGHT)
ENDIF
ENDIF
GO TO 120
ELSE IF ( (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,FM_F)
KROUND = 2
CALL FM_F(M_1%MFM,MB%RIGHT)
KROUND = -1
CALL FM_F(MA%LEFT,M_4%MFM)
CALL FM_F(MA%RIGHT,M_5%MFM)
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%LEFT)
ELSE
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
GO TO 120
ENDIF
110 KROUND = -1
CALL FM_F(MA%LEFT,M_4%MFM)
CALL FM_F(MA%RIGHT,M_5%MFM)
CALL FMEQ(M_4%MFM,MB%LEFT)
IF (FMCOMP(MB%LEFT,'>',M_5%MFM)) THEN
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
L = 1
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
L = 2
ENDIF
KROUND = 2
IF (L == 1) THEN
CALL FM_F(MA%LEFT,MB%RIGHT)
ELSE IF (L == 2) THEN
CALL FM_F(MA%RIGHT,MB%RIGHT)
ENDIF
120 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_F_FM
SUBROUTINE FM_FIND_EXTREME_POINT(MIN_OR_MAX,AX,BX,TOL,XVAL,FVAL,F)
! MIN_OR_MAX having value 1 means minimize the function, otherwise maximize.
! AX, BX define the endpoints of an interval in which the search takes place.
! TOL is the tolerance for the minimum. Usually TOL should be no less than
! sqrt(epsilon(ax)), meaning the x-coordinate XVAL of the extreme point will
! be accurate to only about half the digits carried. The y-coordinate FVAL
! should be accurate to nearly full precision.
! This happens because the typical graph is nearly parabolic near the minimum,
! and within sqrt(epsilon(ax)) of the minimum all the function values are
! essentially identical at the current precision.
! XVAL is returned as the value of X that minimizes (or maximizes) function F(X).
! It is a relative extreme point, and may not be the global extreme point if the
! function has more than one extremum on the interval.
! FVAL is returned as the function value at XVAL.
! F(X,Y) is a subroutine where X is the input and Y is the output of the function to be
! minimized.
! The method used is a combination of golden section search and successive parabolic interpolation.
! Convergence is never much slower than that for a fibonacci search. If f has a continuous second
! derivative which is positive at the minimum (which is not at ax or bx), then convergence is
! superlinear, and usually of the order of about 1.324....
! The function f is never evaluated at two points closer together than eps*abs(FVAL)+(tol/3),
! where eps is approximately the square root of the relative machine precision. If f is a
! unimodal function and the computed values of f are always unimodal when separated by at least
! eps*abs(x)+(tol/3), then FVAL approximates the abscissa of the global minimum of f on the
! interval ax,bx with an error less than 3*eps*abs(FVAL)+tol. If f is not unimodal, then FVAL
! may approximate a local, but perhaps non-global, minimum to the same accuracy.
! This routine is a slightly modified translation of function FVAL from netlib, which was adapted
! from the algol 60 procedure localmin given by Richard Brent in Algorithms For Minimization
! Without Derivatives, Prentice-Hall (1973).
USE FMVALS
IMPLICIT NONE
INTEGER :: MINV,MIN_OR_MAX,NDSAVE
TYPE (FM) :: AX,BX,TOL,XVAL,FVAL
EXTERNAL :: F
TYPE (FM), SAVE :: A, B, C, D, E, EPS, XM, P, Q, R, T2, U, V, W, FU, FV, FW, FX, X, TOL1, TOL3
CALL FM_ENTER_USER_ROUTINE
NDSAVE = NDIG
NDIG = MAX(NDIG+NGRD52,2)
MINV = 1
IF (MIN_OR_MAX /= 1) MINV = -1
IF (AX < BX) THEN
CALL FM_EQU(AX,A,NDSAVE,NDIG)
CALL FM_EQU(BX,B,NDSAVE,NDIG)
ELSE
CALL FM_EQU(AX,B,NDSAVE,NDIG)
CALL FM_EQU(BX,A,NDSAVE,NDIG)
ENDIF
! C is the squared inverse of the golden ratio.
C = (3-SQRT(TO_FM('5.0D0')))/2
! EPS is approximately the square root of the relative machine precision.
EPS = EPSILON(A)
TOL1 = EPS + 1
EPS = SQRT(EPS)
V = A + C*(B-A)
W = V
X = V
E = 0
FX = 0
CALL F(X%MFM,FX%MFM)
FX = FX*MINV
FV = FX
FW = FX
TOL3 = 0
CALL FM_EQU(TOL,TOL3,NDSAVE,NDIG)
TOL3 = TOL3/3
! The main loop starts here.
110 XM = A + (B-A)/2
TOL1 = EPS*ABS(X) + TOL3
T2 = 2*TOL1
! Check the stopping criterion.
IF (ABS(X-XM) <= (T2-(B-A)/2)) GO TO 160
P = 0
Q = 0
R = 0
IF (ABS(E) > TOL1) THEN
R = (X-W)*(FX-FV) ! Fit a parabola.
Q = (X-V)*(FX-FW)
P = (X-V)*Q-(X-W)*R
Q = 2*(Q-R)
IF (Q > 0) THEN
P = -P
ELSE
Q = -Q
ENDIF
R = E
E = D
ENDIF
IF ((ABS(P) >= ABS(Q*R/2)) .OR. (P <= Q*(A-X)) .OR. (P >= Q*(B-X))) GO TO 120
! Make a parabolic-interpolation step.
D = P/Q
U = X + D
! f must not be evaluated too close to ax or bx.
IF (((U-A) >= T2) .AND. ((B-U) >= T2)) GO TO 130
D = TOL1
IF (X >= XM) D = -D
GO TO 130
! Make a golden-section step.
120 IF (X < XM) THEN
E = B - X
ELSE
E = A - X
ENDIF
D = C*E
! f must not be evaluated too close to x.
130 IF (ABS(D) >= TOL1) THEN
U = X + D
ELSE
IF (D > 0) THEN
U = X + TOL1
ELSE
U = X - TOL1
ENDIF
ENDIF
FU = 0
CALL F(U%MFM,FU%MFM)
FU = FU*MINV
! update a, b, v, w, and x.
IF (FX <= FU) THEN
IF (U < X) THEN
A = U
ELSE
B = U
ENDIF
ENDIF
IF (FU > FX) GO TO 140
IF (U < X) THEN
B = X
ELSE
A = X
ENDIF
V = W
FV = FW
W = X
FW = FX
X = U
FX = FU
GO TO 110
140 IF ((FU > FW) .AND. (W /= X)) GO TO 150
V = W
FV = FW
W = U
FW = FU
GO TO 110
150 IF ((FU > FV) .AND. (V /= X) .AND. (V /= W)) GO TO 110
V = U
FV = FU
GO TO 110
! end of main loop
160 CALL FM_EQU(X,XVAL,NDIG,NDSAVE)
CALL FM_EQU(FX*MINV,FVAL,NDIG,NDSAVE)
NDIG = NDSAVE
CALL FM_EXIT_USER_ROUTINE
END SUBROUTINE FM_FIND_EXTREME_POINT
SUBROUTINE FM_INTERVAL_F_IFM(FM_F,N,MA,MB)
! General interval evaluation for a special function of one FM variable:
! CALL FM_F(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: I,KRSAVE,L,N
EXTERNAL :: FM_F
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1))))) GO TO 110
CALL FMST2M(' OVERFLOW',M_4%MFM)
CALL FMST2M('-OVERFLOW',M_5%MFM)
DO I = 1, 9
CALL FMSUB(MA%RIGHT,MA%LEFT,M1FM)
CALL FMMPYI_R1(M1FM,I)
CALL FMDIVI_R1(M1FM,10)
CALL FMADD(MA%LEFT,M1FM,M_1%MFM)
CALL FM_F(N,M_1%MFM,MVFM)
IF (FMCOMP(MVFM,'<',M_4%MFM)) THEN
CALL FMEQ(MVFM,M_4%MFM)
ENDIF
IF (FMCOMP(MVFM,'>',M_5%MFM)) THEN
CALL FMEQ(MVFM,M_5%MFM)
ENDIF
ENDDO
CALL FM_F(N,MA%LEFT,M1FM)
CALL FM_F(N,MA%RIGHT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FM_F(N,M_3%MFM,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FM_F(N,M_3%MFM,M_2%MFM)
IF ( (FMCOMP(M_4%MFM,'<',M1FM) .AND. FMCOMP(M_4%MFM,'<',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT_IFM(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = -1
CALL FM_F(N,M_1%MFM,MB%LEFT)
IF (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT_IFM(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)), &
SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = 2
CALL FM_F(N,M_1%MFM,MB%RIGHT)
ELSE
KROUND = 2
CALL FM_F(N,MA%LEFT,M_4%MFM)
CALL FM_F(N,MA%RIGHT,M_5%MFM)
IF (FMCOMP(M_4%MFM,'>',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%RIGHT)
ELSE
CALL FMEQ(M_5%MFM,MB%RIGHT)
ENDIF
ENDIF
GO TO 120
ELSE IF ( (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT_IFM(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = 2
CALL FM_F(N,M_1%MFM,MB%RIGHT)
KROUND = -1
CALL FM_F(N,MA%LEFT,M_4%MFM)
CALL FM_F(N,MA%RIGHT,M_5%MFM)
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%LEFT)
ELSE
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
GO TO 120
ENDIF
110 KROUND = -1
CALL FM_F(N,MA%LEFT,M_4%MFM)
CALL FM_F(N,MA%RIGHT,M_5%MFM)
CALL FMEQ(M_4%MFM,MB%LEFT)
IF (FMCOMP(MB%LEFT,'>',M_5%MFM)) THEN
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
L = 1
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
L = 2
ENDIF
KROUND = 2
IF (L == 1) THEN
CALL FM_F(N,MA%LEFT,MB%RIGHT)
ELSE IF (L == 2) THEN
CALL FM_F(N,MA%RIGHT,MB%RIGHT)
ENDIF
120 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_F_IFM
SUBROUTINE FM_FIND_EXTREME_POINT_IFM(MIN_OR_MAX,AX,BX,TOL,XVAL,FVAL,N,F)
! Same routine as FM_FIND_EXTREME_POINT, except the function includes an integer argument: F(N,X)
USE FMVALS
IMPLICIT NONE
INTEGER :: MINV,MIN_OR_MAX,N,NDSAVE
TYPE (FM) :: AX,BX,TOL,XVAL,FVAL
EXTERNAL :: F
TYPE (FM), SAVE :: A, B, C, D, E, EPS, XM, P, Q, R, T2, U, V, W, FU, FV, FW, FX, X, TOL1, TOL3
CALL FM_ENTER_USER_ROUTINE
NDSAVE = NDIG
NDIG = MAX(NDIG+NGRD52,2)
MINV = 1
IF (MIN_OR_MAX /= 1) MINV = -1
IF (AX < BX) THEN
CALL FM_EQU(AX,A,NDSAVE,NDIG)
CALL FM_EQU(BX,B,NDSAVE,NDIG)
ELSE
CALL FM_EQU(AX,B,NDSAVE,NDIG)
CALL FM_EQU(BX,A,NDSAVE,NDIG)
ENDIF
! C is the squared inverse of the golden ratio.
C = (3-SQRT(TO_FM('5.0D0')))/2
! EPS is approximately the square root of the relative machine precision.
EPS = EPSILON(A)
TOL1 = EPS + 1
EPS = SQRT(EPS)
V = A + C*(B-A)
W = V
X = V
E = 0
FX = 0
CALL F(N,X%MFM,FX%MFM)
FX = FX*MINV
FV = FX
FW = FX
TOL3 = 0
CALL FM_EQU(TOL,TOL3,NDSAVE,NDIG)
TOL3 = TOL3/3
! The main loop starts here.
110 XM = A + (B-A)/2
TOL1 = EPS*ABS(X) + TOL3
T2 = 2*TOL1
! Check the stopping criterion.
IF (ABS(X-XM) <= (T2-(B-A)/2)) GO TO 160
P = 0
Q = 0
R = 0
IF (ABS(E) > TOL1) THEN
R = (X-W)*(FX-FV) ! Fit a parabola.
Q = (X-V)*(FX-FW)
P = (X-V)*Q-(X-W)*R
Q = 2*(Q-R)
IF (Q > 0) THEN
P = -P
ELSE
Q = -Q
ENDIF
R = E
E = D
ENDIF
IF ((ABS(P) >= ABS(Q*R/2)) .OR. (P <= Q*(A-X)) .OR. (P >= Q*(B-X))) GO TO 120
! Make a parabolic-interpolation step.
D = P/Q
U = X + D
! f must not be evaluated too close to ax or bx.
IF (((U-A) >= T2) .AND. ((B-U) >= T2)) GO TO 130
D = TOL1
IF (X >= XM) D = -D
GO TO 130
! Make a golden-section step.
120 IF (X < XM) THEN
E = B - X
ELSE
E = A - X
ENDIF
D = C*E
! f must not be evaluated too close to x.
130 IF (ABS(D) >= TOL1) THEN
U = X + D
ELSE
IF (D > 0) THEN
U = X + TOL1
ELSE
U = X - TOL1
ENDIF
ENDIF
FU = 0
CALL F(N,U%MFM,FU%MFM)
FU = FU*MINV
! update a, b, v, w, and x.
IF (FX <= FU) THEN
IF (U < X) THEN
A = U
ELSE
B = U
ENDIF
ENDIF
IF (FU > FX) GO TO 140
IF (U < X) THEN
B = X
ELSE
A = X
ENDIF
V = W
FV = FW
W = X
FW = FX
X = U
FX = FU
GO TO 110
140 IF ((FU > FW) .AND. (W /= X)) GO TO 150
V = W
FV = FW
W = U
FW = FU
GO TO 110
150 IF ((FU > FV) .AND. (V /= X) .AND. (V /= W)) GO TO 110
V = U
FV = FU
GO TO 110
! end of main loop
160 CALL FM_EQU(X,XVAL,NDIG,NDSAVE)
CALL FM_EQU(FX*MINV,FVAL,NDIG,NDSAVE)
NDIG = NDSAVE
CALL FM_EXIT_USER_ROUTINE
END SUBROUTINE FM_FIND_EXTREME_POINT_IFM
SUBROUTINE FM_INTERVAL_F_FMI(FM_F,MA,N,MB)
! General interval evaluation for a special function of one FM variable:
! CALL FM_F(MA,N,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: I,KRSAVE,L,N
EXTERNAL :: FM_F
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1))))) GO TO 110
CALL FMST2M(' OVERFLOW',M_4%MFM)
CALL FMST2M('-OVERFLOW',M_5%MFM)
DO I = 1, 9
CALL FMSUB(MA%RIGHT,MA%LEFT,M1FM)
CALL FMMPYI_R1(M1FM,I)
CALL FMDIVI_R1(M1FM,10)
CALL FMADD(MA%LEFT,M1FM,M_1%MFM)
CALL FM_F(M_1%MFM,N,MVFM)
IF (FMCOMP(MVFM,'<',M_4%MFM)) THEN
CALL FMEQ(MVFM,M_4%MFM)
ENDIF
IF (FMCOMP(MVFM,'>',M_5%MFM)) THEN
CALL FMEQ(MVFM,M_5%MFM)
ENDIF
ENDDO
CALL FM_F(MA%LEFT,N,M1FM)
CALL FM_F(MA%RIGHT,N,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FM_F(M_3%MFM,N,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FM_F(M_3%MFM,N,M_2%MFM)
IF ( (FMCOMP(M_4%MFM,'<',M1FM) .AND. FMCOMP(M_4%MFM,'<',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT_FMI(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = -1
CALL FM_F(M_1%MFM,N,MB%LEFT)
IF (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT_FMI(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)), &
SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = 2
CALL FM_F(M_1%MFM,N,MB%RIGHT)
ELSE
KROUND = 2
CALL FM_F(MA%LEFT,N,M_4%MFM)
CALL FM_F(MA%RIGHT,N,M_5%MFM)
IF (FMCOMP(M_4%MFM,'>',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%RIGHT)
ELSE
CALL FMEQ(M_5%MFM,MB%RIGHT)
ENDIF
ENDIF
GO TO 120
ELSE IF ( (FMCOMP(M_5%MFM,'>',M1FM) .AND. FMCOMP(M_5%MFM,'>',M2FM)) .OR. &
(FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) ) THEN
CALL FM_FIND_EXTREME_POINT_FMI(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,N,FM_F)
KROUND = 2
CALL FM_F(M_1%MFM,N,MB%RIGHT)
KROUND = -1
CALL FM_F(MA%LEFT,N,M_4%MFM)
CALL FM_F(MA%RIGHT,N,M_5%MFM)
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
CALL FMEQ(M_4%MFM,MB%LEFT)
ELSE
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
GO TO 120
ENDIF
110 KROUND = -1
CALL FM_F(MA%LEFT,N,M_4%MFM)
CALL FM_F(MA%RIGHT,N,M_5%MFM)
CALL FMEQ(M_4%MFM,MB%LEFT)
IF (FMCOMP(MB%LEFT,'>',M_5%MFM)) THEN
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
L = 1
IF (FMCOMP(M_4%MFM,'<',M_5%MFM)) THEN
L = 2
ENDIF
KROUND = 2
IF (L == 1) THEN
CALL FM_F(MA%LEFT,N,MB%RIGHT)
ELSE IF (L == 2) THEN
CALL FM_F(MA%RIGHT,N,MB%RIGHT)
ENDIF
120 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_F_FMI
SUBROUTINE FM_FIND_EXTREME_POINT_FMI(MIN_OR_MAX,AX,BX,TOL,XVAL,FVAL,N,F)
! Same routine as FM_FIND_EXTREME_POINT, except the function includes an integer argument: F(X,N)
USE FMVALS
IMPLICIT NONE
INTEGER :: MINV,MIN_OR_MAX,N,NDSAVE
TYPE (FM) :: AX,BX,TOL,XVAL,FVAL
EXTERNAL :: F
TYPE (FM), SAVE :: A, B, C, D, E, EPS, XM, P, Q, R, T2, U, V, W, FU, FV, FW, FX, X, TOL1, TOL3
CALL FM_ENTER_USER_ROUTINE
NDSAVE = NDIG
NDIG = MAX(NDIG+NGRD52,2)
MINV = 1
IF (MIN_OR_MAX /= 1) MINV = -1
IF (AX < BX) THEN
CALL FM_EQU(AX,A,NDSAVE,NDIG)
CALL FM_EQU(BX,B,NDSAVE,NDIG)
ELSE
CALL FM_EQU(AX,B,NDSAVE,NDIG)
CALL FM_EQU(BX,A,NDSAVE,NDIG)
ENDIF
! C is the squared inverse of the golden ratio.
C = (3-SQRT(TO_FM('5.0D0')))/2
! EPS is approximately the square root of the relative machine precision.
EPS = EPSILON(A)
TOL1 = EPS + 1
EPS = SQRT(EPS)
V = A + C*(B-A)
W = V
X = V
E = 0
FX = 0
CALL F(X%MFM,N,FX%MFM)
FX = FX*MINV
FV = FX
FW = FX
TOL3 = 0
CALL FM_EQU(TOL,TOL3,NDSAVE,NDIG)
TOL3 = TOL3/3
! The main loop starts here.
110 XM = A + (B-A)/2
TOL1 = EPS*ABS(X) + TOL3
T2 = 2*TOL1
! Check the stopping criterion.
IF (ABS(X-XM) <= (T2-(B-A)/2)) GO TO 160
P = 0
Q = 0
R = 0
IF (ABS(E) > TOL1) THEN
R = (X-W)*(FX-FV) ! Fit a parabola.
Q = (X-V)*(FX-FW)
P = (X-V)*Q-(X-W)*R
Q = 2*(Q-R)
IF (Q > 0) THEN
P = -P
ELSE
Q = -Q
ENDIF
R = E
E = D
ENDIF
IF ((ABS(P) >= ABS(Q*R/2)) .OR. (P <= Q*(A-X)) .OR. (P >= Q*(B-X))) GO TO 120
! Make a parabolic-interpolation step.
D = P/Q
U = X + D
! f must not be evaluated too close to ax or bx.
IF (((U-A) >= T2) .AND. ((B-U) >= T2)) GO TO 130
D = TOL1
IF (X >= XM) D = -D
GO TO 130
! Make a golden-section step.
120 IF (X < XM) THEN
E = B - X
ELSE
E = A - X
ENDIF
D = C*E
! f must not be evaluated too close to x.
130 IF (ABS(D) >= TOL1) THEN
U = X + D
ELSE
IF (D > 0) THEN
U = X + TOL1
ELSE
U = X - TOL1
ENDIF
ENDIF
FU = 0
CALL F(U%MFM,N,FU%MFM)
FU = FU*MINV
! update a, b, v, w, and x.
IF (FX <= FU) THEN
IF (U < X) THEN
A = U
ELSE
B = U
ENDIF
ENDIF
IF (FU > FX) GO TO 140
IF (U < X) THEN
B = X
ELSE
A = X
ENDIF
V = W
FV = FW
W = X
FW = FX
X = U
FX = FU
GO TO 110
140 IF ((FU > FW) .AND. (W /= X)) GO TO 150
V = W
FV = FW
W = U
FW = FU
GO TO 110
150 IF ((FU > FV) .AND. (V /= X) .AND. (V /= W)) GO TO 110
V = U
FV = FU
GO TO 110
! end of main loop
160 CALL FM_EQU(X,XVAL,NDIG,NDSAVE)
CALL FM_EQU(FX*MINV,FVAL,NDIG,NDSAVE)
NDIG = NDSAVE
CALL FM_EXIT_USER_ROUTINE
END SUBROUTINE FM_FIND_EXTREME_POINT_FMI
SUBROUTINE FMEDGE_INTERVAL_FM(MA,MB,LEFT,RIGHT)
! Check for extreme function values on the edges of the rectangle MA x MB.
! K_ROUTINE_EDGE identifies the function being evaluated.
! The output interval is [ LEFT , RIGHT ].
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: J,LEFT,RIGHT
INTENT (IN) :: MA,MB
INTENT (INOUT) :: LEFT,RIGHT
TYPE (FM), SAVE :: DF1 = FM(-3),DF2 = FM(-3),F = FM(-3),FMAX = FM(-3),FMIN = FM(-3), &
LAST_M_1 = FM(-3),M_1A = FM(-3),M_1B = FM(-3),X0 = FM(-3), &
X = FM(-3),Y0 = FM(-3),Y = FM(-3)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),F)
ELSE IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),F)
ENDIF
CALL FM_EQ(F,FMIN)
CALL FM_EQ(F,FMAX)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),F)
ELSE IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),F)
ENDIF
CALL FM_EQ(MIN( FMIN , F ),FMIN)
CALL FM_EQ(MAX( FMAX , F ),FMAX)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),F)
ELSE IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),F)
ENDIF
CALL FM_EQ(MIN( FMIN , F ),FMIN)
CALL FM_EQ(MAX( FMAX , F ),FMAX)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),F)
ELSE IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),F)
ENDIF
CALL FM_EQ(MIN( FMIN , F ),FMIN)
CALL FM_EQ(MAX( FMAX , F ),FMAX)
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1)))) .AND. &
ABS(RIGHT_ENDPOINT(MB)-LEFT_ENDPOINT(MB)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MB)),SPACING(LEFT_ENDPOINT(MB))) / &
(100*SQRT(EPSILON(TO_FM(1))))) GO TO 110
IF (K_ROUTINE_EDGE == 1) THEN
IF (LEFT_ENDPOINT(MA) + LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MA)+LEFT_ENDPOINT(MB))-LEFT_ENDPOINT(MB),M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)+LEFT_ENDPOINT(MB))-LEFT_ENDPOINT(MB),M_1)
IF (M_1+LEFT_ENDPOINT(MB) > 0) THEN
CALL FM_EQ(-LEFT_ENDPOINT(MB),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,LEFT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(X,X0)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MA)/10 + J*RIGHT_ENDPOINT(MA)/10,X)
CALL FM_EQ(LEFT_ENDPOINT(MB),Y)
CALL FM_EQ(BETA(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,X)-POLYGAMMA(0,X+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,X)-POLYGAMMA(0,X+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(1,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(2,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
IF (LEFT_ENDPOINT(MA) - LEFT_ENDPOINT(MB) > -1) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING( LEFT_ENDPOINT(MA) - LEFT_ENDPOINT(MB) ),M_1)
IF (M_1 < 0) THEN
CALL FM_EQ(LEFT_ENDPOINT(MB) + M_1,M_1)
ELSE
CALL FM_EQ(TO_FM('+OVERFLOW'),M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,LEFT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR( RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MB) ),M_1)
IF (M_1 < 0) THEN
CALL FM_EQ(LEFT_ENDPOINT(MB) + M_1,M_1)
IF (M_1 > RIGHT_ENDPOINT(MA)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1)
ELSE
CALL FM_EQ(LEFT_ENDPOINT(MB) - 1,M_1)
IF (M_1 > RIGHT_ENDPOINT(MA)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,LEFT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,LEFT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(X,X0)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MA)/10 + J*RIGHT_ENDPOINT(MA)/10,X)
CALL FM_EQ(LEFT_ENDPOINT(MB),Y)
CALL FM_EQ(BINOMIAL(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,1+X)-POLYGAMMA(0,1+X-Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,1+X)-POLYGAMMA(0,1+X-Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(1,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(2,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 1) THEN
IF (LEFT_ENDPOINT(MA) + LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MA)+RIGHT_ENDPOINT(MB))-RIGHT_ENDPOINT(MB),M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)+RIGHT_ENDPOINT(MB))-RIGHT_ENDPOINT(MB),M_1)
IF (M_1+RIGHT_ENDPOINT(MB) > 0) THEN
CALL FM_EQ(-RIGHT_ENDPOINT(MB),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(X,X0)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MA)/10 + J*RIGHT_ENDPOINT(MA)/10,X)
CALL FM_EQ(RIGHT_ENDPOINT(MB),Y)
CALL FM_EQ(BETA(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,X)-POLYGAMMA(0,X+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,X)-POLYGAMMA(0,X+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(1,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(2,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
IF (LEFT_ENDPOINT(MA) - RIGHT_ENDPOINT(MB) > -1) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING( LEFT_ENDPOINT(MA) - RIGHT_ENDPOINT(MB) ),M_1)
IF (M_1 < 0) THEN
CALL FM_EQ(RIGHT_ENDPOINT(MB) + M_1,M_1)
ELSE
CALL FM_EQ(TO_FM('+OVERFLOW'),M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1-1,M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR( RIGHT_ENDPOINT(MA) - RIGHT_ENDPOINT(MB) ),M_1)
IF (M_1 < 0) THEN
CALL FM_EQ(RIGHT_ENDPOINT(MB) + M_1,M_1)
IF (M_1 > RIGHT_ENDPOINT(MA)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1)
ELSE
CALL FM_EQ(RIGHT_ENDPOINT(MB) - 1,M_1)
IF (M_1 > RIGHT_ENDPOINT(MA)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMEDGE_HORIZONTAL(M_1,M_1+1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_HORIZONTAL(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(X,X0)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MA)/10 + J*RIGHT_ENDPOINT(MA)/10,X)
CALL FM_EQ(RIGHT_ENDPOINT(MB),Y)
CALL FM_EQ(BINOMIAL(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,1+X)-POLYGAMMA(0,1+X-Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,1+X)-POLYGAMMA(0,1+X-Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(1,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(Y,Y_EDGE)
CALL FM_FIND_EXTREME_POINT(2,X0,X,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 1) THEN
IF (LEFT_ENDPOINT(MA) + LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MB)+LEFT_ENDPOINT(MA))-LEFT_ENDPOINT(MA),M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),M_1,FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1-1,M_1,FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1-1,M_1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MB)+LEFT_ENDPOINT(MA))-LEFT_ENDPOINT(MA),M_1)
IF (M_1+LEFT_ENDPOINT(MA) > 0) THEN
CALL FM_EQ(-LEFT_ENDPOINT(MA),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,M_1+1,FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,M_1+1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(Y,Y0)
CALL FM_EQ(LEFT_ENDPOINT(MA),X)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MB)/10 + J*RIGHT_ENDPOINT(MB)/10,Y)
CALL FM_EQ(BETA(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,Y)-POLYGAMMA(0,X+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,Y)-POLYGAMMA(0,X+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(1,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(2,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
IF (LEFT_ENDPOINT(MB) > -1 .AND. LEFT_ENDPOINT(MA) - RIGHT_ENDPOINT(MB) > -1) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(FLOOR( LEFT_ENDPOINT(MA) - LEFT_ENDPOINT(MB) ),M_1A)
IF (M_1A < 0) THEN
CALL FM_EQ(LEFT_ENDPOINT(MA) - M_1A,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1A)
ELSE
CALL FM_EQ(LEFT_ENDPOINT(MA) + 1,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1A)
ENDIF
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MB)),M_1B)
IF (M_1B == LEFT_ENDPOINT(MB)) THEN
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1B > -0.5) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1B)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A+1,M_1A)
ELSE
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LAST_M_1,M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A+1,M_1A)
ELSE
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LAST_M_1,M_1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR( RIGHT_ENDPOINT(MB) - LEFT_ENDPOINT(MA) ),M_1A)
IF (M_1A > 0) THEN
CALL FM_EQ(LEFT_ENDPOINT(MA) + M_1A,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1A)
ELSE
CALL FM_EQ(TO_FM('-OVERFLOW'),M_1A)
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MB)),M_1B)
IF (M_1B == RIGHT_ENDPOINT(MB)) THEN
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1B > -0.5) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1B)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A-1,M_1A)
ELSE
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,LAST_M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A-1,M_1A)
ELSE
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),M_1,LAST_M_1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(Y,Y0)
CALL FM_EQ(LEFT_ENDPOINT(MA),X)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MB)/10 + J*RIGHT_ENDPOINT(MB)/10,Y)
CALL FM_EQ(BINOMIAL(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,1+X-Y)-POLYGAMMA(0,1+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,1+X-Y)-POLYGAMMA(0,1+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(1,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(2,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 1) THEN
IF (LEFT_ENDPOINT(MA) + LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MB)+RIGHT_ENDPOINT(MA))-RIGHT_ENDPOINT(MA),M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),M_1,FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1-1,M_1,FMIN,FMAX)
CALL FM_EQ(M_1+1,M_1)
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1-1,M_1,FMIN,FMAX)
ENDIF
ELSE
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB), &
RIGHT_ENDPOINT(MB),FMIN,FMAX)
ENDIF
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MB)+RIGHT_ENDPOINT(MA))-RIGHT_ENDPOINT(MA),M_1)
IF (M_1+RIGHT_ENDPOINT(MA) > 0) THEN
CALL FM_EQ(-RIGHT_ENDPOINT(MA),M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,M_1+1,FMIN,FMAX)
CALL FM_EQ(M_1-1,M_1)
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,M_1+1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(Y,Y0)
CALL FM_EQ(RIGHT_ENDPOINT(MA),X)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MB)/10 + J*RIGHT_ENDPOINT(MB)/10,Y)
CALL FM_EQ(BETA(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,Y)-POLYGAMMA(0,X+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,Y)-POLYGAMMA(0,X+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(1,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(2,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
IF (LEFT_ENDPOINT(MB) > -1 .AND. RIGHT_ENDPOINT(MA) - RIGHT_ENDPOINT(MB) > -1) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ELSE
CALL FM_EQ(FLOOR( RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MB) ),M_1A)
IF (M_1A < 0) THEN
CALL FM_EQ(RIGHT_ENDPOINT(MA) - M_1A,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1A)
ELSE
CALL FM_EQ(RIGHT_ENDPOINT(MA) + 1,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1A)
ENDIF
CALL FM_EQ(CEILING(LEFT_ENDPOINT(MB)),M_1B)
IF (M_1B == LEFT_ENDPOINT(MB)) THEN
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1B > -0.5) CALL FM_EQ(TO_FM('+OVERFLOW'),M_1B)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A+1,M_1A)
ELSE
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LAST_M_1,M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A+1,M_1A)
ELSE
CALL FM_EQ(M_1B+1,M_1B)
ENDIF
IF (M_1A < M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 <= RIGHT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LAST_M_1,M_1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
CALL FM_EQ(FLOOR( RIGHT_ENDPOINT(MB) - RIGHT_ENDPOINT(MA) ),M_1A)
IF (M_1A > 0) THEN
CALL FM_EQ(RIGHT_ENDPOINT(MA) + M_1A,M_1A)
IF (M_1A > RIGHT_ENDPOINT(MB)) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1A)
ELSE
CALL FM_EQ(TO_FM('-OVERFLOW'),M_1A)
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MB)),M_1B)
IF (M_1B == RIGHT_ENDPOINT(MB)) THEN
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1B > -0.5) CALL FM_EQ(TO_FM('-OVERFLOW'),M_1B)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,RIGHT_ENDPOINT(MB),FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A-1,M_1A)
ELSE
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,LAST_M_1,FMIN,FMAX)
CALL FM_EQ(M_1,LAST_M_1)
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A-1,M_1A)
ELSE
CALL FM_EQ(M_1B-1,M_1B)
ENDIF
IF (M_1A > M_1B) THEN
CALL FM_EQ(M_1A,M_1)
ELSE
CALL FM_EQ(M_1B,M_1)
ENDIF
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),M_1,LAST_M_1,FMIN,FMAX)
ENDIF
ENDIF
ELSE
CALL FMEDGE_VERTICAL(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB),RIGHT_ENDPOINT(MB), &
FMIN,FMAX)
ENDIF
DO J = 0, 10
IF (J > 0) CALL FM_EQ(Y,Y0)
CALL FM_EQ(RIGHT_ENDPOINT(MA),X)
CALL FM_EQ((10-J)*LEFT_ENDPOINT(MB)/10 + J*RIGHT_ENDPOINT(MB)/10,Y)
CALL FM_EQ(BINOMIAL(X,Y),F)
IF (J == 0) THEN
CALL FM_EQ(F*(POLYGAMMA(0,1+X-Y)-POLYGAMMA(0,1+Y)),DF2)
CYCLE
ELSE
CALL FM_EQ(DF2,DF1)
CALL FM_EQ(F*(POLYGAMMA(0,1+X-Y)-POLYGAMMA(0,1+Y)),DF2)
ENDIF
IF (DF1 < 0 .AND. DF2 > 0 .AND. KROUND == -1) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(1,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
IF (DF1 > 0 .AND. DF2 < 0 .AND. KROUND == 2) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(X,X_EDGE)
CALL FM_FIND_EXTREME_POINT(2,Y0,Y,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ENDDO
ENDIF
ENDIF
110 CALL FMEQ(FMIN%MFM,LEFT)
CALL FMEQ(FMAX%MFM,RIGHT)
END SUBROUTINE FMEDGE_INTERVAL_FM
SUBROUTINE FMEDGE_HORIZONTAL(MA1,MA2,MB,FMIN,FMAX)
! Check for extreme function values on the horizontal edge of the rectangle MA x MB.
! K_ROUTINE_EDGE identifies the function being evaluated.
! Any new extreme values are used to update FMIN and FMAX.
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA1,MA2,MB,FMAX,FMIN
INTENT (IN) :: MB,MA1,MA2
INTENT (INOUT) :: FMAX,FMIN
TYPE (FM), SAVE :: F = FM(-3),FMIN0 = FM(-3),FMAX0 = FM(-3),X = FM(-3)
INTEGER :: J
DO J = 0, N_PREV-1
IF (K_ROUTINE_EDGE == ROUTINE_PREV(J) .AND. KROUND == KROUND_PREV(J)) THEN
IF (MA1 == M1_PREV(J) .AND. MA2 == M2_PREV(J) .AND. MB == M3_PREV(J)) THEN
RETURN
ENDIF
ENDIF
ENDDO
NUM_PREV = MOD(NUM_PREV+1,N_PREV)
ROUTINE_PREV(NUM_PREV) = K_ROUTINE_EDGE
KROUND_PREV(NUM_PREV) = KROUND
CALL FM_EQ(MA1,M1_PREV(NUM_PREV))
CALL FM_EQ(MA2,M2_PREV(NUM_PREV))
CALL FM_EQ(MB,M3_PREV(NUM_PREV))
CALL FM_EQ(FMIN,FMIN0)
CALL FM_EQ(FMAX,FMAX0)
CALL FM_EQ(TO_FM('+OVERFLOW'),FMIN)
CALL FM_EQ(TO_FM('-OVERFLOW'),FMAX)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(MA1,MB),M_2)
CALL FM_EQ(MA1+MAX(SPACING(MA1),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_3)
IF (M_3 > MA1 .AND. M_3 < MA2) THEN
CALL FM_EQ(BETA(M_3,MB),M_3)
ELSE
CALL FM_EQ(M_2,M_3)
ENDIF
CALL FM_EQ(BETA(MA2,MB),M_5)
CALL FM_EQ(MA2-MAX(SPACING(MA2),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_4)
IF (M_4 > MA1 .AND. M_4 < MA2) THEN
CALL FM_EQ(BETA(M_4,MB),M_4)
ELSE
CALL FM_EQ(M_5,M_4)
ENDIF
CALL FM_EQ(MIN(FMIN,M_2,M_3,M_4,M_5),FMIN)
CALL FM_EQ(MAX(FMAX,M_2,M_3,M_4,M_5),FMAX)
IF (M_3-M_2 > 0 .AND. M_5-M_4 < 0) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MB,Y_EDGE)
IF (KROUND == 2) THEN
CALL FM_FIND_EXTREME_POINT(2,MA1,MA2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ELSE IF (M_3-M_2 < 0 .AND. M_5-M_4 > 0) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MB,Y_EDGE)
IF (KROUND == -1) THEN
CALL FM_FIND_EXTREME_POINT(1,MA1,MA2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2 .AND. MB == 0) THEN
FMIN = 1
FMAX = 1
ELSE IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(MA1,MB),M_2)
CALL FM_EQ(MA1+MAX(SPACING(MA1),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_3)
IF (M_3 > MA1 .AND. M_3 < MA2) THEN
CALL FM_EQ(BINOMIAL(M_3,MB),M_3)
ELSE
CALL FM_EQ(M_2,M_3)
ENDIF
CALL FM_EQ(BINOMIAL(MA2,MB),M_5)
CALL FM_EQ(MA2-MAX(SPACING(MA2),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_4)
IF (M_4 > MA1 .AND. M_4 < MA2) THEN
CALL FM_EQ(BINOMIAL(M_4,MB),M_4)
ELSE
CALL FM_EQ(M_5,M_4)
ENDIF
CALL FM_EQ(MIN(FMIN,M_2,M_3,M_4,M_5),FMIN)
CALL FM_EQ(MAX(FMAX,M_2,M_3,M_4,M_5),FMAX)
IF (M_3-M_2 > 0 .AND. M_5-M_4 < 0) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MB,Y_EDGE)
IF (KROUND == 2) THEN
CALL FM_FIND_EXTREME_POINT(2,MA1,MA2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ELSE IF (M_3-M_2 < 0 .AND. M_5-M_4 > 0) THEN
KXY_EDGE = 1
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MB,Y_EDGE)
IF (KROUND == -1) THEN
CALL FM_FIND_EXTREME_POINT(1,MA1,MA2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
ENDIF
ENDIF
CALL FM_EQ(MIN(FMIN0,FMIN),FMIN)
CALL FM_EQ(MAX(FMAX0,FMAX),FMAX)
END SUBROUTINE FMEDGE_HORIZONTAL
SUBROUTINE FMEDGE_VERTICAL(MA,MB1,MB2,FMIN,FMAX)
! Check for extreme function values on the vertical edge of the rectangle MA x MB.
! K_ROUTINE_EDGE identifies the function being evaluated.
! Any new extreme values are used to update FMIN and FMAX.
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB1,MB2,FMAX,FMIN
INTENT (IN) :: MA,MB1,MB2
INTENT (INOUT) :: FMAX,FMIN
TYPE (FM), SAVE :: F = FM(-3),FMIN0 = FM(-3),FMAX0 = FM(-3),X = FM(-3)
INTEGER :: J
DO J = 0, N_PREV-1
IF (K_ROUTINE_EDGE == ROUTINE_PREV(J) .AND. KROUND == KROUND_PREV(J)) THEN
IF (MA == M1_PREV(J) .AND. MB1 == M2_PREV(J) .AND. MB2 == M3_PREV(J)) THEN
RETURN
ENDIF
ENDIF
ENDDO
NUM_PREV = MOD(NUM_PREV+1,N_PREV)
ROUTINE_PREV(NUM_PREV) = K_ROUTINE_EDGE
KROUND_PREV(NUM_PREV) = KROUND
CALL FM_EQ(MA,M1_PREV(NUM_PREV))
CALL FM_EQ(MB1,M2_PREV(NUM_PREV))
CALL FM_EQ(MB2,M3_PREV(NUM_PREV))
CALL FM_EQ(FMIN,FMIN0)
CALL FM_EQ(FMAX,FMAX0)
CALL FM_EQ(TO_FM('+OVERFLOW'),FMIN)
CALL FM_EQ(TO_FM('-OVERFLOW'),FMAX)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FM_EQ(BETA(MA,MB1),M_2)
CALL FM_EQ(MB1+MAX(SPACING(MB1),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_3)
IF (M_3 > MB1 .AND. M_3 < MB2) THEN
CALL FM_EQ(BETA(MA,M_3),M_3)
ELSE
CALL FM_EQ(M_2,M_3)
ENDIF
CALL FM_EQ(BETA(MA,MB2),M_5)
CALL FM_EQ(MB2-MAX(SPACING(MB2),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_4)
IF (M_4 > MB1 .AND. M_4 < MB2) THEN
CALL FM_EQ(BETA(MA,M_4),M_4)
ELSE
CALL FM_EQ(M_5,M_4)
ENDIF
CALL FM_EQ(MIN(FMIN,M_2,M_3,M_4,M_5),FMIN)
CALL FM_EQ(MAX(FMAX,M_2,M_3,M_4,M_5),FMAX)
IF (M_3-M_2 > 0 .AND. M_5-M_4 < 0) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MA,X_EDGE)
IF (KROUND == 2) THEN
CALL FM_FIND_EXTREME_POINT(2,MB1,MB2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ELSE IF (M_3-M_2 < 0 .AND. M_5-M_4 > 0) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MA,X_EDGE)
IF (KROUND == -1) THEN
CALL FM_FIND_EXTREME_POINT(1,MB1,MB2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
ENDIF
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
CALL FM_EQ(BINOMIAL(MA,MB1),M_2)
CALL FM_EQ(MB1+MAX(SPACING(MB1),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_3)
IF (M_3 > MB1 .AND. M_3 < MB2) THEN
CALL FM_EQ(BINOMIAL(MA,M_3),M_3)
ELSE
CALL FM_EQ(M_2,M_3)
ENDIF
CALL FM_EQ(BINOMIAL(MA,MB2),M_5)
CALL FM_EQ(MB2-MAX(SPACING(MB2),EPSILON(TO_FM(1)))/(100*SQRT(EPSILON(TO_FM(1)))),M_4)
IF (M_4 > MB1 .AND. M_4 < MB2) THEN
CALL FM_EQ(BINOMIAL(MA,M_4),M_4)
ELSE
CALL FM_EQ(M_5,M_4)
ENDIF
CALL FM_EQ(MIN(FMIN,M_2,M_3,M_4,M_5),FMIN)
CALL FM_EQ(MAX(FMAX,M_2,M_3,M_4,M_5),FMAX)
IF (M_3-M_2 > 0 .AND. M_5-M_4 < 0) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MA,X_EDGE)
IF (KROUND == 2) THEN
CALL FM_FIND_EXTREME_POINT(2,MB1,MB2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MAX(F,FMAX),FMAX)
ENDIF
ELSE IF (M_3-M_2 < 0 .AND. M_5-M_4 > 0) THEN
KXY_EDGE = 2
NDIG_XY_EDGE = NDIG
CALL FM_EQ(MA,X_EDGE)
IF (KROUND == -1) THEN
CALL FM_FIND_EXTREME_POINT(1,MB1,MB2,SQRT(EPSILON(TO_FM(1))),X,F,F_EDGE)
CALL FM_EQ(MIN(F,FMIN),FMIN)
ENDIF
ENDIF
ENDIF
CALL FM_EQ(MIN(FMIN0,FMIN),FMIN)
CALL FM_EQ(MAX(FMAX0,FMAX),FMAX)
END SUBROUTINE FMEDGE_VERTICAL
SUBROUTINE F_EDGE(X1,Y1)
USE FMVALS
USE FMZM
IMPLICIT NONE
INTEGER :: X1,Y1
TYPE (FM), SAVE :: X = FM(-3),Y = FM(-3)
IF (K_ROUTINE_EDGE == 1) THEN
CALL FMEQ(X1,X%MFM)
IF (KXY_EDGE == 1) THEN
CALL FM_EQU(Y_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(BETA(X,XY_EDGE),Y)
ELSE IF (KXY_EDGE == 2) THEN
CALL FM_EQU(X_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(BETA(XY_EDGE,X),Y)
ENDIF
CALL FMEQ(Y%MFM,Y1)
ENDIF
IF (K_ROUTINE_EDGE == 2) THEN
CALL FMEQ(X1,X%MFM)
IF (KXY_EDGE == 1) THEN
CALL FM_EQU(Y_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(BINOMIAL(X,XY_EDGE),Y)
ELSE IF (KXY_EDGE == 2) THEN
CALL FM_EQU(X_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(BINOMIAL(XY_EDGE,X),Y)
ENDIF
CALL FMEQ(Y%MFM,Y1)
ENDIF
IF (K_ROUTINE_EDGE == 3) THEN
CALL FMEQ(X1,X%MFM)
CALL FM_EQU(Y_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(INCOMPLETE_GAMMA1(X,XY_EDGE),Y)
CALL FMEQ(Y%MFM,Y1)
ENDIF
IF (K_ROUTINE_EDGE == 4) THEN
CALL FMEQ(X1,X%MFM)
CALL FM_EQU(Y_EDGE,XY_EDGE,NDIG_XY_EDGE,NDIG)
CALL FM_EQ(INCOMPLETE_GAMMA2(X,XY_EDGE),Y)
CALL FMEQ(Y%MFM,Y1)
ENDIF
END SUBROUTINE F_EDGE
SUBROUTINE FM_INTERVAL_F_FMFM(FM_F,MA,MB,MC)
! General interval evaluation for a special function of two FM variables:
! CALL FM_F(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KRSAVE,L
EXTERNAL :: FM_F
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FM_F(MA%LEFT,MB%LEFT,MTFM)
CALL FM_F(MA%RIGHT,MB%LEFT,MUFM)
CALL FM_F(MA%LEFT,MB%RIGHT,M1FM)
CALL FM_F(MA%RIGHT,MB%RIGHT,M2FM)
CALL FMEQ(MTFM,MC%LEFT)
IF (FMCOMP(MC%LEFT,'>',MUFM)) THEN
CALL FMEQ(MUFM,MC%LEFT)
ENDIF
IF (FMCOMP(MC%LEFT,'>',M1FM)) THEN
CALL FMEQ(M1FM,MC%LEFT)
ENDIF
IF (FMCOMP(MC%LEFT,'>',M2FM)) THEN
CALL FMEQ(M2FM,MC%LEFT)
ENDIF
L = 1
CALL FMEQ(MTFM,MC%RIGHT)
IF (FMCOMP(MC%RIGHT,'<',MUFM)) THEN
L = 2
CALL FMEQ(MUFM,MC%RIGHT)
ENDIF
IF (FMCOMP(MC%RIGHT,'<',M1FM)) THEN
L = 3
CALL FMEQ(M1FM,MC%RIGHT)
ENDIF
IF (FMCOMP(MC%RIGHT,'<',M2FM)) THEN
L = 4
ENDIF
KROUND = 2
IF (L == 1) THEN
CALL FM_F(MA%LEFT,MB%LEFT,MC%RIGHT)
ELSE IF (L == 2) THEN
CALL FM_F(MA%RIGHT,MB%LEFT,MC%RIGHT)
ELSE IF (L == 3) THEN
CALL FM_F(MA%LEFT,MB%RIGHT,MC%RIGHT)
ELSE
CALL FM_F(MA%RIGHT,MB%RIGHT,MC%RIGHT)
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_F_FMFM
SUBROUTINE FM_INTERVAL_F_FMFMFM(FM_F,MA,MB,MC,MD)
! General interval evaluation for a special function of three FM variables:
! CALL FM_F(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
INTEGER :: KRSAVE,L
EXTERNAL :: FM_F
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FM_F(MA%LEFT,MB%LEFT,MC%LEFT,MTZM(1))
CALL FM_F(MA%RIGHT,MB%LEFT,MC%LEFT,MTZM(2))
CALL FM_F(MA%LEFT,MB%RIGHT,MC%LEFT,MUZM(1))
CALL FM_F(MA%RIGHT,MB%RIGHT,MC%LEFT,MUZM(2))
CALL FM_F(MA%LEFT,MB%LEFT,MC%RIGHT,M1ZM(1))
CALL FM_F(MA%RIGHT,MB%LEFT,MC%RIGHT,M1ZM(2))
CALL FM_F(MA%LEFT,MB%RIGHT,MC%RIGHT,M2ZM(1))
CALL FM_F(MA%RIGHT,MB%RIGHT,MC%RIGHT,M2ZM(2))
CALL FMEQ(MTZM(1),MD%LEFT)
IF (FMCOMP(MD%LEFT,'>',MTZM(2))) THEN
CALL FMEQ(MTZM(2),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',MUZM(1))) THEN
CALL FMEQ(MUZM(1),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',MUZM(2))) THEN
CALL FMEQ(MUZM(2),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',M1ZM(1))) THEN
CALL FMEQ(M1ZM(1),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',M1ZM(2))) THEN
CALL FMEQ(M1ZM(2),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',M2ZM(1))) THEN
CALL FMEQ(M2ZM(1),MD%LEFT)
ENDIF
IF (FMCOMP(MD%LEFT,'>',M2ZM(2))) THEN
CALL FMEQ(M2ZM(2),MD%LEFT)
ENDIF
L = 1
CALL FMEQ(MTZM(1),MD%RIGHT)
IF (FMCOMP(MD%RIGHT,'<',MTZM(2))) THEN
L = 2
CALL FMEQ(MTZM(2),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',MUZM(1))) THEN
L = 3
CALL FMEQ(MUZM(1),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',MUZM(2))) THEN
L = 4
CALL FMEQ(MUZM(2),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',M1ZM(1))) THEN
L = 5
CALL FMEQ(M1ZM(1),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',M1ZM(2))) THEN
L = 6
CALL FMEQ(M1ZM(2),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',M2ZM(1))) THEN
L = 7
CALL FMEQ(M2ZM(1),MD%RIGHT)
ENDIF
IF (FMCOMP(MD%RIGHT,'<',M2ZM(2))) THEN
L = 8
CALL FMEQ(M2ZM(2),MD%RIGHT)
ENDIF
KROUND = 2
IF (L == 1) THEN
CALL FM_F(MA%LEFT,MB%LEFT,MC%LEFT,MD%RIGHT)
ELSE IF (L == 2) THEN
CALL FM_F(MA%RIGHT,MB%LEFT,MC%LEFT,MD%RIGHT)
ELSE IF (L == 3) THEN
CALL FM_F(MA%LEFT,MB%RIGHT,MC%LEFT,MD%RIGHT)
ELSE IF (L == 4) THEN
CALL FM_F(MA%RIGHT,MB%RIGHT,MC%LEFT,MD%RIGHT)
ELSE IF (L == 5) THEN
CALL FM_F(MA%LEFT,MB%LEFT,MC%RIGHT,MD%RIGHT)
ELSE IF (L == 6) THEN
CALL FM_F(MA%RIGHT,MB%LEFT,MC%RIGHT,MD%RIGHT)
ELSE IF (L == 7) THEN
CALL FM_F(MA%LEFT,MB%RIGHT,MC%RIGHT,MD%RIGHT)
ELSE
CALL FM_F(MA%RIGHT,MB%RIGHT,MC%RIGHT,MD%RIGHT)
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_F_FMFMFM
END MODULE FM_INTERVAL_ARITHMETIC_1
MODULE FM_INTERVAL_ARITHMETIC_2
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE FMEQ_INTERVAL_IFM
MODULE PROCEDURE FMEQ_INTERVAL_RFM
MODULE PROCEDURE FMEQ_INTERVAL_DFM
MODULE PROCEDURE FMEQ_INTERVAL_ZFM
MODULE PROCEDURE FMEQ_INTERVAL_CFM
MODULE PROCEDURE FMEQ_INTERVAL_FMI
MODULE PROCEDURE FMEQ_INTERVAL_FMR
MODULE PROCEDURE FMEQ_INTERVAL_FMD
MODULE PROCEDURE FMEQ_INTERVAL_FMZ
MODULE PROCEDURE FMEQ_INTERVAL_FMC
MODULE PROCEDURE FMEQ_INTERVAL_FMFM
MODULE PROCEDURE FMEQ_INTERVAL_FMFMA
MODULE PROCEDURE FMEQ_INTERVAL_FMAFM
MODULE PROCEDURE FMEQ_INTERVAL_FMIM
MODULE PROCEDURE FMEQ_INTERVAL_FMZM
MODULE PROCEDURE FMEQ_INTERVAL_IMFM
MODULE PROCEDURE FMEQ_INTERVAL_ZMFM
MODULE PROCEDURE FMEQ_INTERVAL_FM1I
MODULE PROCEDURE FMEQ_INTERVAL_FM1R
MODULE PROCEDURE FMEQ_INTERVAL_FM1D
MODULE PROCEDURE FMEQ_INTERVAL_FM1Z
MODULE PROCEDURE FMEQ_INTERVAL_FM1C
MODULE PROCEDURE FMEQ_INTERVAL_I1FM
MODULE PROCEDURE FMEQ_INTERVAL_R1FM
MODULE PROCEDURE FMEQ_INTERVAL_D1FM
MODULE PROCEDURE FMEQ_INTERVAL_Z1FM
MODULE PROCEDURE FMEQ_INTERVAL_C1FM
MODULE PROCEDURE FMEQ_INTERVAL_FM1FM
MODULE PROCEDURE FMEQ_INTERVAL_FM1FMA
MODULE PROCEDURE FMEQ_INTERVAL_FMA1FM
MODULE PROCEDURE FMEQ_INTERVAL_FM1IM
MODULE PROCEDURE FMEQ_INTERVAL_FM1ZM
MODULE PROCEDURE FMEQ_INTERVAL_IM1FM
MODULE PROCEDURE FMEQ_INTERVAL_ZM1FM
MODULE PROCEDURE FMEQ_INTERVAL_FM1I1
MODULE PROCEDURE FMEQ_INTERVAL_FM1R1
MODULE PROCEDURE FMEQ_INTERVAL_FM1D1
MODULE PROCEDURE FMEQ_INTERVAL_FM1Z1
MODULE PROCEDURE FMEQ_INTERVAL_FM1C1
MODULE PROCEDURE FMEQ_INTERVAL_I1FM1
MODULE PROCEDURE FMEQ_INTERVAL_R1FM1
MODULE PROCEDURE FMEQ_INTERVAL_D1FM1
MODULE PROCEDURE FMEQ_INTERVAL_Z1FM1
MODULE PROCEDURE FMEQ_INTERVAL_C1FM1
MODULE PROCEDURE FMEQ_INTERVAL_FM1FM1
MODULE PROCEDURE FMEQ_INTERVAL_FM1FMA1
MODULE PROCEDURE FMEQ_INTERVAL_FMA1FM1
MODULE PROCEDURE FMEQ_INTERVAL_FM1IM1
MODULE PROCEDURE FMEQ_INTERVAL_FM1ZM1
MODULE PROCEDURE FMEQ_INTERVAL_IM1FM1
MODULE PROCEDURE FMEQ_INTERVAL_ZM1FM1
MODULE PROCEDURE FMEQ_INTERVAL_FM2I
MODULE PROCEDURE FMEQ_INTERVAL_FM2R
MODULE PROCEDURE FMEQ_INTERVAL_FM2D
MODULE PROCEDURE FMEQ_INTERVAL_FM2Z
MODULE PROCEDURE FMEQ_INTERVAL_FM2C
MODULE PROCEDURE FMEQ_INTERVAL_I2FM
MODULE PROCEDURE FMEQ_INTERVAL_R2FM
MODULE PROCEDURE FMEQ_INTERVAL_D2FM
MODULE PROCEDURE FMEQ_INTERVAL_Z2FM
MODULE PROCEDURE FMEQ_INTERVAL_C2FM
MODULE PROCEDURE FMEQ_INTERVAL_FM2FM
MODULE PROCEDURE FMEQ_INTERVAL_FM2FMA
MODULE PROCEDURE FMEQ_INTERVAL_FMA2FM
MODULE PROCEDURE FMEQ_INTERVAL_FM2IM
MODULE PROCEDURE FMEQ_INTERVAL_FM2ZM
MODULE PROCEDURE FMEQ_INTERVAL_IM2FM
MODULE PROCEDURE FMEQ_INTERVAL_ZM2FM
MODULE PROCEDURE FMEQ_INTERVAL_FM2I2
MODULE PROCEDURE FMEQ_INTERVAL_FM2R2
MODULE PROCEDURE FMEQ_INTERVAL_FM2D2
MODULE PROCEDURE FMEQ_INTERVAL_FM2Z2
MODULE PROCEDURE FMEQ_INTERVAL_FM2C2
MODULE PROCEDURE FMEQ_INTERVAL_I2FM2
MODULE PROCEDURE FMEQ_INTERVAL_R2FM2
MODULE PROCEDURE FMEQ_INTERVAL_D2FM2
MODULE PROCEDURE FMEQ_INTERVAL_Z2FM2
MODULE PROCEDURE FMEQ_INTERVAL_C2FM2
MODULE PROCEDURE FMEQ_INTERVAL_FM2FM2
MODULE PROCEDURE FMEQ_INTERVAL_FM2FMA2
MODULE PROCEDURE FMEQ_INTERVAL_FMA2FM2
MODULE PROCEDURE FMEQ_INTERVAL_FM2IM2
MODULE PROCEDURE FMEQ_INTERVAL_FM2ZM2
MODULE PROCEDURE FMEQ_INTERVAL_IM2FM2
MODULE PROCEDURE FMEQ_INTERVAL_ZM2FM2
END INTERFACE
INTERFACE OPERATOR (==)
MODULE PROCEDURE FMLEQ_INTERVAL_IFM
MODULE PROCEDURE FMLEQ_INTERVAL_RFM
MODULE PROCEDURE FMLEQ_INTERVAL_DFM
MODULE PROCEDURE FMLEQ_INTERVAL_ZFM
MODULE PROCEDURE FMLEQ_INTERVAL_CFM
MODULE PROCEDURE FMLEQ_INTERVAL_FMI
MODULE PROCEDURE FMLEQ_INTERVAL_FMR
MODULE PROCEDURE FMLEQ_INTERVAL_FMD
MODULE PROCEDURE FMLEQ_INTERVAL_FMZ
MODULE PROCEDURE FMLEQ_INTERVAL_FMC
MODULE PROCEDURE FMLEQ_INTERVAL_FMFM
MODULE PROCEDURE FMLEQ_INTERVAL_FMFMA
MODULE PROCEDURE FMLEQ_INTERVAL_FMAFM
MODULE PROCEDURE FMLEQ_INTERVAL_FMIM
MODULE PROCEDURE FMLEQ_INTERVAL_FMZM
MODULE PROCEDURE FMLEQ_INTERVAL_IMFM
MODULE PROCEDURE FMLEQ_INTERVAL_ZMFM
END INTERFACE
! These routines are called to let the FMEQ_ subroutines know that a function subprogram has been
! called in the user's program. That means temporary FM, IM, or ZM variables created by this
! interface should not be discarded until the user's function ends and one of the FMEQ_ routines
! is called elsewhere in the user's program.
INTERFACE FM_ENTER_USER_FUNCTION
MODULE PROCEDURE FM_ENTER_FUNCTION_INTERVAL_FM
MODULE PROCEDURE FM_ENTER_FUNCTION_INTERVAL_FM1
MODULE PROCEDURE FM_ENTER_FUNCTION_INTERVAL_FM2
END INTERFACE
INTERFACE FM_EXIT_USER_FUNCTION
MODULE PROCEDURE FM_EXIT_FUNCTION_INTERVAL_FM
MODULE PROCEDURE FM_EXIT_FUNCTION_INTERVAL_FM1
MODULE PROCEDURE FM_EXIT_FUNCTION_INTERVAL_FM2
END INTERFACE
CONTAINS
SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: F_NAME
IN_USER_FUNCTION = .TRUE.
CALL FMDEFINE_INTERVAL(F_NAME)
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
TEMPV(NUMBER_USED-1) = -2
TEMPV(NUMBER_USED) = -2
END SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM
SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: F_NAME
INTEGER :: J
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME)
F_NAME(J)%LEFT = -1
F_NAME(J)%RIGHT = -1
CALL FMDEFINE_INTERVAL(F_NAME(J))
TEMPV(NUMBER_USED-1) = -2
TEMPV(NUMBER_USED) = -2
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM1
SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: F_NAME
INTEGER :: J,K
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME,DIM=1)
DO K = 1, SIZE(F_NAME,DIM=2)
F_NAME(J,K)%LEFT = -1
F_NAME(J,K)%RIGHT = -1
CALL FMDEFINE_INTERVAL(F_NAME(J,K))
TEMPV(NUMBER_USED-1) = -2
TEMPV(NUMBER_USED) = -2
ENDDO
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_FUNCTION_INTERVAL_FM2
! The exit routines for functions record the fact that a user function has finished,
! and also check to see if the multiple precision value associated with the function name
! has been moved during the function.
SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: F_NAME
INTEGER :: J,K,NEW_K
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
IF (F_NAME%LEFT > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1 .OR. &
F_NAME%RIGHT > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
IF (F_NAME%LEFT < F_NAME%RIGHT) THEN
J = F_NAME%LEFT
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%LEFT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 1
SIZE_OF(F_NAME%LEFT) = SIZE_OF(J)
START(F_NAME%LEFT) = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1)
J = F_NAME%RIGHT
F_NAME%RIGHT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%RIGHT) = SIZE_OF(J)
START(F_NAME%RIGHT) = NEW_K + 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1, NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ELSE
J = F_NAME%RIGHT
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%RIGHT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 1
SIZE_OF(F_NAME%RIGHT) = SIZE_OF(J)
START(F_NAME%RIGHT) = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1)
J = F_NAME%LEFT
F_NAME%LEFT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%LEFT) = SIZE_OF(J)
START(F_NAME%LEFT) = NEW_K + 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1, NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ENDIF
ENDIF
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) = -1
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) = -1
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM
SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: F_NAME
INTEGER :: J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO J = 1, SIZE(F_NAME)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%LEFT)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%LEFT)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%RIGHT)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%RIGHT)
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+2*SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%LEFT)
DO K = 1, SIZE_OF(F_NAME(J)%LEFT)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%LEFT)+K-1)
ENDDO
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%RIGHT)
DO K = 1, SIZE_OF(F_NAME(J)%RIGHT)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%RIGHT)+K-1)
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 2*SIZE(F_NAME)
DO J = 1, SIZE(F_NAME)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%LEFT) = -1
F_NAME(J)%LEFT = NPT
TEMPV(F_NAME(J)%LEFT) = -1
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%RIGHT) = -1
F_NAME(J)%RIGHT = NPT
TEMPV(F_NAME(J)%RIGHT) = -1
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO J = 1, SIZE(F_NAME)
TEMPV(F_NAME(J)%LEFT) = -1
TEMPV(F_NAME(J)%RIGHT) = -1
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM1
SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: F_NAME
INTEGER :: I,J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%LEFT)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%LEFT)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%RIGHT)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%RIGHT)
ENDDO
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+2*SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%LEFT)
DO K = 1, SIZE_OF(F_NAME(I,J)%LEFT)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%LEFT)+K-1)
ENDDO
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%RIGHT)
DO K = 1, SIZE_OF(F_NAME(I,J)%RIGHT)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%RIGHT)+K-1)
ENDDO
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 2*SIZE(F_NAME)
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%LEFT) = -1
F_NAME(I,J)%LEFT = NPT
TEMPV(F_NAME(I,J)%LEFT) = -1
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%RIGHT) = -1
F_NAME(I,J)%RIGHT = NPT
TEMPV(F_NAME(I,J)%RIGHT) = -1
ENDDO
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
TEMPV(F_NAME(I,J)%LEFT) = -1
TEMPV(F_NAME(I,J)%RIGHT) = -1
ENDDO
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_FUNCTION_INTERVAL_FM2
SUBROUTINE FMDEFINE_INTERVAL(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDEFINE(MA%LEFT)
CALL FMDEFINE(MA%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMDEFINE_INTERVAL
SUBROUTINE FMEQ_INTERVAL_TEMP
! Check to see if the last few FM numbers are temporaries.
! If so, re-set NUMBER_USED so that space in MWK can be re-claimed.
USE FMVALS
IMPLICIT NONE
INTEGER :: J,K,L
IF (USER_FUNCTION_LEVEL == 0) THEN
L = 1
ELSE
L = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) + 1
ENDIF
K = NUMBER_USED
DO J = K, L, -1
IF (TEMPV(J) == -1 .OR. TEMPV(J) <= -6) THEN
NUMBER_USED = NUMBER_USED - 1
TEMPV(J) = -2
ELSE
EXIT
ENDIF
ENDDO
END SUBROUTINE FMEQ_INTERVAL_TEMP
! =
SUBROUTINE FMEQ_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2I_INTERVAL(MA,IVAL)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IFM
SUBROUTINE FMEQ_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,R)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_RFM
SUBROUTINE FMEQ_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,D)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_DFM
SUBROUTINE FMEQ_INTERVAL_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
REAL :: R
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,R)
Z = CMPLX( R , 0.0 )
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZFM
SUBROUTINE FMEQ_INTERVAL_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,D)
C = CMPLX( D , 0.0D0 , KIND(0.0D0) )
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_CFM
SUBROUTINE FMEQ_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMI2M_INTERVAL(IVAL,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMI
SUBROUTINE FMEQ_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSP2M_INTERVAL(R,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMR
SUBROUTINE FMEQ_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDP2M_INTERVAL(D,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMD
SUBROUTINE FMEQ_INTERVAL_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
R = REAL(Z)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSP2M_INTERVAL(R,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMZ
SUBROUTINE FMEQ_INTERVAL_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
D = REAL(C,KIND(0.0D0))
CALL FMDP2M_INTERVAL(D,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMC
SUBROUTINE FMEQ_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INTERVAL(MB,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMFM
SUBROUTINE FMEQ_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ(MB%MFM,MA%LEFT)
CALL FMEQ(MB%MFM,MA%RIGHT)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMFMA
SUBROUTINE FMEQ_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FM_TO_FMA(MB,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMAFM
SUBROUTINE FMEQ_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMIM
SUBROUTINE FMEQ_INTERVAL_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (ZM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MB%MZM,MA)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMZM
SUBROUTINE FMEQ_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMFM2I_INTERVAL(MB,MA%MIM)
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IMFM
SUBROUTINE FMEQ_INTERVAL_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INTERVAL(MB,MTFM_I)
CALL FMI2M_INTERVAL(0,MUFM_I)
CALL ZMCMPX_INTERVAL(MTFM_I,MUFM_I,MA)
IF (TEMPV(MA%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA%MZM(1)) = -2
TEMPV(MA%MZM(2)) = -2
ENDIF
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZMFM
! Array equal assignments for FM.
! (1) rank 1 = rank 0
SUBROUTINE FMEQ_INTERVAL_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: IVAL,J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1I
SUBROUTINE FMEQ_INTERVAL_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1R
SUBROUTINE FMEQ_INTERVAL_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1D
SUBROUTINE FMEQ_INTERVAL_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1Z
SUBROUTINE FMEQ_INTERVAL_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1C
SUBROUTINE FMEQ_INTERVAL_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,K,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
CALL FMM2I_INTERVAL(MA,K)
DO J = 1, N
IVAL(J) = K
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_I1FM
SUBROUTINE FMEQ_INTERVAL_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
CALL FMM2SP_INTERVAL(MA,R2)
DO J = 1, N
R(J) = R2
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_R1FM
SUBROUTINE FMEQ_INTERVAL_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
CALL FMM2DP_INTERVAL(MA,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_D1FM
SUBROUTINE FMEQ_INTERVAL_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMM2SP_INTERVAL(MA,R2)
DO J = 1, N
Z(J) = R2
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_Z1FM
SUBROUTINE FMEQ_INTERVAL_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(C)
CALL FMM2DP_INTERVAL(MA,D2)
DO J = 1, N
C(J) = D2
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_C1FM
SUBROUTINE FMEQ_INTERVAL_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMEQ_INTERVAL(MB,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1FM
SUBROUTINE FMEQ_INTERVAL_FM1FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ(MB%MFM,MA(J)%LEFT)
CALL FMEQ(MB%MFM,MA(J)%RIGHT)
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1FMA
SUBROUTINE FMEQ_INTERVAL_FMA1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FM_TO_FMA(MB,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMA1FM
SUBROUTINE FMEQ_INTERVAL_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1IM
SUBROUTINE FMEQ_INTERVAL_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL ZMREAL_INTERVAL(MB%MZM,MTFM_I)
DO J = 1, N
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1ZM
SUBROUTINE FMEQ_INTERVAL_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMFM2I_INTERVAL(MB,MTIM)
DO J = 1, N
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IM1FM
SUBROUTINE FMEQ_INTERVAL_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M_INTERVAL(0,MTFM_I)
CALL ZMCMPX_INTERVAL(MB,MTFM_I,MZ_1)
DO J = 1, N
CALL ZMEQ(MZ_1%MZM,MA(J)%MZM)
IF (TEMPV(MA(J)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J)%MZM(1)) = -2
TEMPV(MA(J)%MZM(2)) = -2
ENDIF
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZM1FM
! (2) rank 1 = rank 1
SUBROUTINE FMEQ_INTERVAL_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1I1
SUBROUTINE FMEQ_INTERVAL_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1R1
SUBROUTINE FMEQ_INTERVAL_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1D1
SUBROUTINE FMEQ_INTERVAL_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(REAL(Z(J)),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1Z1
SUBROUTINE FMEQ_INTERVAL_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(REAL(C(J),KIND(0.0D0)),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1C1
SUBROUTINE FMEQ_INTERVAL_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(IVAL)
IVAL(J) = IUNKNO
ENDDO
GO TO 10
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMM2I_INTERVAL(MA(J),IVAL(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_I1FM1
SUBROUTINE FMEQ_INTERVAL_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(R)
R(J) = RUNKNO
ENDDO
GO TO 10
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMM2SP_INTERVAL(MA(J),R(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_R1FM1
SUBROUTINE FMEQ_INTERVAL_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(D)
D(J) = RUNKNO
ENDDO
GO TO 10
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMM2DP_INTERVAL(MA(J),D(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_D1FM1
SUBROUTINE FMEQ_INTERVAL_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(Z)
Z(J) = CMPLX(RUNKNO,RUNKNO)
ENDDO
GO TO 10
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL FMM2SP_INTERVAL(MA(J),R)
Z(J) = CMPLX(R,0.0)
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_Z1FM1
SUBROUTINE FMEQ_INTERVAL_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(C)
D = RUNKNO
C(J) = CMPLX(D,D , KIND(0.0D0))
ENDDO
GO TO 10
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMM2DP_INTERVAL(MA(J),D)
C(J) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_C1FM1
SUBROUTINE FMEQ_INTERVAL_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMEQ_INTERVAL(MB(J),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1FM1
SUBROUTINE FMEQ_INTERVAL_FM1FMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMEQ(MB(J)%MFM,MA(J)%LEFT)
CALL FMEQ(MB(J)%MFM,MA(J)%RIGHT)
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1FMA1
SUBROUTINE FMEQ_INTERVAL_FMA1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA)
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FM_TO_FMA(MB(J),MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMA1FM1
SUBROUTINE FMEQ_INTERVAL_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1IM1
SUBROUTINE FMEQ_INTERVAL_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA)
CALL FMEQ_INTERVAL(MTFM_I,MA(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL_INTERVAL(MB(J)%MZM,MA(J))
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM1ZM1
SUBROUTINE FMEQ_INTERVAL_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL IMST2M(' UNKNOWN ',MTIM)
DO J = 1, SIZE(MA)
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMFM2I_INTERVAL(MB(J),MA(J)%MIM)
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IM1FM1
SUBROUTINE FMEQ_INTERVAL_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',MTZM_I)
DO J = 1, SIZE(MA)
CALL ZMEQ(MTZM_I,MA(J)%MZM)
IF (TEMPV(MA(J)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J)%MZM(1)) = -2
TEMPV(MA(J)%MZM(2)) = -2
ENDIF
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO J = 1, N
CALL ZMCMPX_INTERVAL(MB(J),MTFM_I,MA(J))
IF (TEMPV(MA(J)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J)%MZM(1)) = -2
TEMPV(MA(J)%MZM(2)) = -2
ENDIF
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZM1FM1
! (3) rank 2 = rank 0
SUBROUTINE FMEQ_INTERVAL_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: IVAL,J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2I
SUBROUTINE FMEQ_INTERVAL_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2R
SUBROUTINE FMEQ_INTERVAL_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2D
SUBROUTINE FMEQ_INTERVAL_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2Z
SUBROUTINE FMEQ_INTERVAL_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2C
SUBROUTINE FMEQ_INTERVAL_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K,L
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2I_INTERVAL(MA,L)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = L
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_I2FM
SUBROUTINE FMEQ_INTERVAL_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,R2)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_R2FM
SUBROUTINE FMEQ_INTERVAL_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,D2)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
D(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_D2FM
SUBROUTINE FMEQ_INTERVAL_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2SP_INTERVAL(MA,R2)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_Z2FM
SUBROUTINE FMEQ_INTERVAL_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMM2DP_INTERVAL(MA,D2)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
C(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_C2FM
SUBROUTINE FMEQ_INTERVAL_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INTERVAL(MB,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2FM
SUBROUTINE FMEQ_INTERVAL_FM2FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MB%MFM,MA(J,K)%LEFT)
CALL FMEQ(MB%MFM,MA(J,K)%RIGHT)
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2FMA
SUBROUTINE FMEQ_INTERVAL_FMA2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FM_TO_FMA(MB,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMA2FM
SUBROUTINE FMEQ_INTERVAL_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2IM
SUBROUTINE FMEQ_INTERVAL_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MB%MZM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2ZM
SUBROUTINE FMEQ_INTERVAL_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMFM2I_INTERVAL(MB,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(MTIM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IM2FM
SUBROUTINE FMEQ_INTERVAL_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMI2M_INTERVAL(0,MTFM_I)
CALL ZMCMPX_INTERVAL(MB,MTFM_I,MZ_1)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MZ_1%MZM,MA(J,K)%MZM)
IF (TEMPV(MA(J,K)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J,K)%MZM(1)) = -2
TEMPV(MA(J,K)%MZM(2)) = -2
ENDIF
ENDDO
ENDDO
CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZM2FM
! (4) rank 2 = rank 2
SUBROUTINE FMEQ_INTERVAL_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2I2
SUBROUTINE FMEQ_INTERVAL_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2R2
SUBROUTINE FMEQ_INTERVAL_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2D2
SUBROUTINE FMEQ_INTERVAL_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(REAL(Z(J,K)),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2Z2
SUBROUTINE FMEQ_INTERVAL_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(REAL(C(J,K),KIND(0.0D0)),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2C2
SUBROUTINE FMEQ_INTERVAL_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = IUNKNO
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2I_INTERVAL(MA(J,K),IVAL(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_I2FM2
SUBROUTINE FMEQ_INTERVAL_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = RUNKNO
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2SP_INTERVAL(MA(J,K),R(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_R2FM2
SUBROUTINE FMEQ_INTERVAL_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
D(J,K) = RUNKNO
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2DP_INTERVAL(MA(J,K),D(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_D2FM2
SUBROUTINE FMEQ_INTERVAL_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = CMPLX(RUNKNO,RUNKNO)
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2SP_INTERVAL(MA(J,K),R)
Z(J,K) = CMPLX(R,0.0)
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_Z2FM2
SUBROUTINE FMEQ_INTERVAL_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
D = RUNKNO
C(J,K) = CMPLX(D,D , KIND(0.0D0))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2DP_INTERVAL(MA(J,K),D)
C(J,K) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_C2FM2
SUBROUTINE FMEQ_INTERVAL_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MB(J,K),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2FM2
SUBROUTINE FMEQ_INTERVAL_FM2FMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MB(J,K)%MFM,MA(J,K)%LEFT)
CALL FMEQ(MB(J,K)%MFM,MA(J,K)%RIGHT)
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2FMA2
SUBROUTINE FMEQ_INTERVAL_FMA2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MTFM,MA(J,K)%MFM)
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FM_TO_FMA(MB(J,K),MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FMA2FM2
SUBROUTINE FMEQ_INTERVAL_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2IM2
SUBROUTINE FMEQ_INTERVAL_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M_INTERVAL(' UNKNOWN ',MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MTFM_I,MA(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMREAL_INTERVAL(MB(J,K)%MZM,MA(J,K))
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_FM2ZM2
SUBROUTINE FMEQ_INTERVAL_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL IMST2M(' UNKNOWN ',MTIM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(MTIM_I,MA(J,K)%MIM)
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMFM2I_INTERVAL(MB(J,K),MA(J,K)%MIM)
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_IM2FM2
SUBROUTINE FMEQ_INTERVAL_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',MTZM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MTZM_I,MA(J,K)%MZM)
IF (TEMPV(MA(J,K)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J,K)%MZM(1)) = -2
TEMPV(MA(J,K)%MZM(2)) = -2
ENDIF
ENDDO
ENDDO
GO TO 10
ENDIF
CALL FMI2M_INTERVAL(0,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX_INTERVAL(MB(J,K),MTFM_I,MA(J,K))
IF (TEMPV(MA(J,K)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J,K)%MZM(1)) = -2
TEMPV(MA(J,K)%MZM(2)) = -2
ENDIF
ENDDO
ENDDO
10 CALL FMEQ_INTERVAL_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_INTERVAL_ZM2FM2
! ==
FUNCTION FMLEQ_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLEQ_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'EQ',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_IFM
FUNCTION FMLEQ_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLEQ_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'EQ',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_RFM
FUNCTION FMLEQ_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLEQ_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'EQ',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_DFM
FUNCTION FMLEQ_INTERVAL_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_ZFM,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
L1 = FMCOMP_INTERVAL(MTFM_I,'EQ',MA)
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_INTERVAL_ZFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_ZFM
FUNCTION FMLEQ_INTERVAL_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_CFM,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
L1 = FMCOMP_INTERVAL(MTFM_I,'EQ',MA)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_INTERVAL_CFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_CFM
FUNCTION FMLEQ_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLEQ_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMI
FUNCTION FMLEQ_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLEQ_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMR
FUNCTION FMLEQ_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLEQ_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMD
FUNCTION FMLEQ_INTERVAL_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMZ,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_INTERVAL_FMZ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMZ
FUNCTION FMLEQ_INTERVAL_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMC,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_INTERVAL_FMC = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMC
FUNCTION FMLEQ_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLEQ_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'EQ',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMFM
FUNCTION FMLEQ_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLEQ_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'EQ',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMFMA
FUNCTION FMLEQ_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLEQ_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'EQ',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMAFM
FUNCTION FMLEQ_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT_INTERVAL(MA,MTFM_I)
IF (FMCOMP_INTERVAL(MA,'EQ',MTFM_I)) THEN
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLEQ_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
ELSE
FMLEQ_INTERVAL_FMIM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMIM
FUNCTION FMLEQ_INTERVAL_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_FMZM,L1,L2
TYPE (FM_INTERVAL) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MB%MZM,MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'EQ',MTFM_I)
L2 = .TRUE.
IF (MWK(START(MB%MZM(2))+3) /= 0) L2 = .FALSE.
FMLEQ_INTERVAL_FMZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_FMZM
FUNCTION FMLEQ_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMINT_INTERVAL(MB,MTFM_I)
IF (FMCOMP_INTERVAL(MB,'EQ',MTFM_I)) THEN
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLEQ_INTERVAL_IMFM = FMCOMP_INTERVAL(MB,'EQ',MTFM_I)
ELSE
FMLEQ_INTERVAL_IMFM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_IMFM
FUNCTION FMLEQ_INTERVAL_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_INTERVAL_ZMFM,L1,L2
TYPE (FM_INTERVAL) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MA%MZM,MTFM_I)
L1 = FMCOMP_INTERVAL(MB,'EQ',MTFM_I)
L2 = .TRUE.
IF (MWK(START(MA%MZM(2))+3) /= 0) L2 = .FALSE.
FMLEQ_INTERVAL_ZMFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_INTERVAL_ZMFM
END MODULE FM_INTERVAL_ARITHMETIC_2
MODULE FM_INTERVAL_ARITHMETIC_3
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (/=)
MODULE PROCEDURE FMLNE_INTERVAL_IFM
MODULE PROCEDURE FMLNE_INTERVAL_RFM
MODULE PROCEDURE FMLNE_INTERVAL_DFM
MODULE PROCEDURE FMLNE_INTERVAL_ZFM
MODULE PROCEDURE FMLNE_INTERVAL_CFM
MODULE PROCEDURE FMLNE_INTERVAL_FMI
MODULE PROCEDURE FMLNE_INTERVAL_FMR
MODULE PROCEDURE FMLNE_INTERVAL_FMD
MODULE PROCEDURE FMLNE_INTERVAL_FMZ
MODULE PROCEDURE FMLNE_INTERVAL_FMC
MODULE PROCEDURE FMLNE_INTERVAL_FMFM
MODULE PROCEDURE FMLNE_INTERVAL_FMFMA
MODULE PROCEDURE FMLNE_INTERVAL_FMAFM
MODULE PROCEDURE FMLNE_INTERVAL_FMIM
MODULE PROCEDURE FMLNE_INTERVAL_FMZM
MODULE PROCEDURE FMLNE_INTERVAL_IMFM
MODULE PROCEDURE FMLNE_INTERVAL_ZMFM
END INTERFACE
INTERFACE OPERATOR (>)
MODULE PROCEDURE FMLGT_INTERVAL_IFM
MODULE PROCEDURE FMLGT_INTERVAL_RFM
MODULE PROCEDURE FMLGT_INTERVAL_DFM
MODULE PROCEDURE FMLGT_INTERVAL_FMI
MODULE PROCEDURE FMLGT_INTERVAL_FMR
MODULE PROCEDURE FMLGT_INTERVAL_FMD
MODULE PROCEDURE FMLGT_INTERVAL_FMFM
MODULE PROCEDURE FMLGT_INTERVAL_FMFMA
MODULE PROCEDURE FMLGT_INTERVAL_FMAFM
MODULE PROCEDURE FMLGT_INTERVAL_FMIM
MODULE PROCEDURE FMLGT_INTERVAL_IMFM
END INTERFACE
INTERFACE OPERATOR (>=)
MODULE PROCEDURE FMLGE_INTERVAL_IFM
MODULE PROCEDURE FMLGE_INTERVAL_RFM
MODULE PROCEDURE FMLGE_INTERVAL_DFM
MODULE PROCEDURE FMLGE_INTERVAL_FMI
MODULE PROCEDURE FMLGE_INTERVAL_FMR
MODULE PROCEDURE FMLGE_INTERVAL_FMD
MODULE PROCEDURE FMLGE_INTERVAL_FMFM
MODULE PROCEDURE FMLGE_INTERVAL_FMFMA
MODULE PROCEDURE FMLGE_INTERVAL_FMAFM
MODULE PROCEDURE FMLGE_INTERVAL_FMIM
MODULE PROCEDURE FMLGE_INTERVAL_IMFM
END INTERFACE
INTERFACE OPERATOR (<)
MODULE PROCEDURE FMLLT_INTERVAL_IFM
MODULE PROCEDURE FMLLT_INTERVAL_RFM
MODULE PROCEDURE FMLLT_INTERVAL_DFM
MODULE PROCEDURE FMLLT_INTERVAL_FMI
MODULE PROCEDURE FMLLT_INTERVAL_FMR
MODULE PROCEDURE FMLLT_INTERVAL_FMD
MODULE PROCEDURE FMLLT_INTERVAL_FMFM
MODULE PROCEDURE FMLLT_INTERVAL_FMFMA
MODULE PROCEDURE FMLLT_INTERVAL_FMAFM
MODULE PROCEDURE FMLLT_INTERVAL_FMIM
MODULE PROCEDURE FMLLT_INTERVAL_IMFM
END INTERFACE
INTERFACE OPERATOR (<=)
MODULE PROCEDURE FMLLE_INTERVAL_IFM
MODULE PROCEDURE FMLLE_INTERVAL_RFM
MODULE PROCEDURE FMLLE_INTERVAL_DFM
MODULE PROCEDURE FMLLE_INTERVAL_FMI
MODULE PROCEDURE FMLLE_INTERVAL_FMR
MODULE PROCEDURE FMLLE_INTERVAL_FMD
MODULE PROCEDURE FMLLE_INTERVAL_FMFM
MODULE PROCEDURE FMLLE_INTERVAL_FMFMA
MODULE PROCEDURE FMLLE_INTERVAL_FMAFM
MODULE PROCEDURE FMLLE_INTERVAL_FMIM
MODULE PROCEDURE FMLLE_INTERVAL_IMFM
END INTERFACE
CONTAINS
! /=
FUNCTION FMLNE_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLNE_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'NE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_IFM
FUNCTION FMLNE_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLNE_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'NE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_RFM
FUNCTION FMLNE_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLNE_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'NE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_DFM
FUNCTION FMLNE_INTERVAL_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_ZFM,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
L1 = FMCOMP_INTERVAL(MTFM_I,'NE',MA)
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_INTERVAL_ZFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_ZFM
FUNCTION FMLNE_INTERVAL_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_CFM,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
L1 = FMCOMP_INTERVAL(MTFM_I,'NE',MA)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_INTERVAL_CFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_CFM
FUNCTION FMLNE_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLNE_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMI
FUNCTION FMLNE_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLNE_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMR
FUNCTION FMLNE_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLNE_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMD
FUNCTION FMLNE_INTERVAL_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMZ,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(REAL(Z),MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_INTERVAL_FMZ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMZ
FUNCTION FMLNE_INTERVAL_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMC,L1,L2
TYPE (FM_INTERVAL) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(REAL(C,KIND(0.0D0)),MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_INTERVAL_FMC = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMC
FUNCTION FMLNE_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLNE_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'NE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMFM
FUNCTION FMLNE_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLNE_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'NE',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMFMA
FUNCTION FMLNE_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLNE_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'NE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMAFM
FUNCTION FMLNE_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT_INTERVAL(MA,MTFM_I)
IF (FMCOMP_INTERVAL(MA,'EQ',MTFM_I)) THEN
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLNE_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
ELSE
FMLNE_INTERVAL_FMIM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMIM
FUNCTION FMLNE_INTERVAL_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_FMZM,L1,L2
TYPE (FM_INTERVAL) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MB%MZM,MTFM_I)
L1 = FMCOMP_INTERVAL(MA,'NE',MTFM_I)
L2 = .FALSE.
IF (MWK(START(MB%MZM(2))+3) /= 0) L2 = .TRUE.
FMLNE_INTERVAL_FMZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_FMZM
FUNCTION FMLNE_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMINT_INTERVAL(MB,MTFM_I)
IF (FMCOMP_INTERVAL(MB,'EQ',MTFM_I)) THEN
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLNE_INTERVAL_IMFM = FMCOMP_INTERVAL(MB,'NE',MTFM_I)
ELSE
FMLNE_INTERVAL_IMFM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_IMFM
FUNCTION FMLNE_INTERVAL_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_INTERVAL_ZMFM,L1,L2
TYPE (FM_INTERVAL) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL ZMREAL_INTERVAL(MA%MZM,MTFM_I)
L1 = FMCOMP_INTERVAL(MB,'NE',MTFM_I)
L2 = .FALSE.
IF (MWK(START(MA%MZM(2))+3) /= 0) L2 = .TRUE.
FMLNE_INTERVAL_ZMFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_INTERVAL_ZMFM
! >
FUNCTION FMLGT_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLGT_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'GT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_IFM
FUNCTION FMLGT_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLGT_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'GT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_RFM
FUNCTION FMLGT_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLGT_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'GT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_DFM
FUNCTION FMLGT_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLGT_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'GT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMI
FUNCTION FMLGT_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLGT_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'GT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMR
FUNCTION FMLGT_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLGT_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'GT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMD
FUNCTION FMLGT_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLGT_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'GT',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMFM
FUNCTION FMLGT_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGT_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'GT',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMFMA
FUNCTION FMLGT_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLGT_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'GT',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMAFM
FUNCTION FMLGT_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLGT_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'GT',MTFM_I)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_FMIM
FUNCTION FMLGT_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLGT_INTERVAL_IMFM = FMCOMP_INTERVAL(MTFM_I,'GT',MB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_INTERVAL_IMFM
! >=
FUNCTION FMLGE_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLGE_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'GE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_IFM
FUNCTION FMLGE_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLGE_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'GE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_RFM
FUNCTION FMLGE_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLGE_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'GE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_DFM
FUNCTION FMLGE_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLGE_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'GE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMI
FUNCTION FMLGE_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLGE_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'GE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMR
FUNCTION FMLGE_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLGE_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'GE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMD
FUNCTION FMLGE_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLGE_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'GE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMFM
FUNCTION FMLGE_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGE_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'GE',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMFMA
FUNCTION FMLGE_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLGE_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'GE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMAFM
FUNCTION FMLGE_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLGE_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'GE',MTFM_I)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_FMIM
FUNCTION FMLGE_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLGE_INTERVAL_IMFM = FMCOMP_INTERVAL(MTFM_I,'GE',MB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_INTERVAL_IMFM
! <
FUNCTION FMLLT_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLLT_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'LT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_IFM
FUNCTION FMLLT_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLLT_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'LT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_RFM
FUNCTION FMLLT_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLLT_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'LT',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_DFM
FUNCTION FMLLT_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLLT_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'LT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMI
FUNCTION FMLLT_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLLT_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'LT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMR
FUNCTION FMLLT_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLLT_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'LT',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMD
FUNCTION FMLLT_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLLT_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'LT',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMFM
FUNCTION FMLLT_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLT_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'LT',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMFMA
FUNCTION FMLLT_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLLT_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'LT',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMAFM
FUNCTION FMLLT_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLLT_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'LT',MTFM_I)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_FMIM
FUNCTION FMLLT_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLLT_INTERVAL_IMFM = FMCOMP_INTERVAL(MTFM_I,'LT',MB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_INTERVAL_IMFM
! <=
FUNCTION FMLLE_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_IFM
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLLE_INTERVAL_IFM = FMCOMP_INTERVAL(MTFM_I,'LE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_IFM
FUNCTION FMLLE_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_RFM
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLLE_INTERVAL_RFM = FMCOMP_INTERVAL(MTFM_I,'LE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_RFM
FUNCTION FMLLE_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_DFM
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLLE_INTERVAL_DFM = FMCOMP_INTERVAL(MTFM_I,'LE',MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_DFM
FUNCTION FMLLE_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMI
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
FMLLE_INTERVAL_FMI = FMCOMP_INTERVAL(MA,'LE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMI
FUNCTION FMLLE_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMR
TYPE (FM_INTERVAL) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
FMLLE_INTERVAL_FMR = FMCOMP_INTERVAL(MA,'LE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMR
FUNCTION FMLLE_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMD
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
FMLLE_INTERVAL_FMD = FMCOMP_INTERVAL(MA,'LE',MTFM_I)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMD
FUNCTION FMLLE_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMFM
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLLE_INTERVAL_FMFM = FMCOMP_INTERVAL(MA,'LE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMFM
FUNCTION FMLLE_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMFMA
TYPE (FM_INTERVAL) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLE_INTERVAL_FMFMA = FMCOMP_INTERVAL(MA,'LE',TO_FM_INTERVAL(MB))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMFMA
FUNCTION FMLLE_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMAFM
TYPE (FM) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
FMLLE_INTERVAL_FMAFM = FMCOMP_INTERVAL(TO_FM_INTERVAL(MA),'LE',MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMAFM
FUNCTION FMLLE_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_FMIM
TYPE (FM_INTERVAL) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
FMLLE_INTERVAL_FMIM = FMCOMP_INTERVAL(MA,'LE',MTFM_I)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_FMIM
FUNCTION FMLLE_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_INTERVAL_IMFM
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
FMLLE_INTERVAL_IMFM = FMCOMP_INTERVAL(MTFM_I,'LE',MB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_INTERVAL_IMFM
END MODULE FM_INTERVAL_ARITHMETIC_3
MODULE FM_INTERVAL_ARITHMETIC_4
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (+)
MODULE PROCEDURE FMADD_INTERVAL_IFM
MODULE PROCEDURE FMADD_INTERVAL_RFM
MODULE PROCEDURE FMADD_INTERVAL_DFM
MODULE PROCEDURE FMADD_INTERVAL_FMI
MODULE PROCEDURE FMADD_INTERVAL_FMR
MODULE PROCEDURE FMADD_INTERVAL_FMD
MODULE PROCEDURE FMADD_INTERVAL_FMFM
MODULE PROCEDURE FMADD_INTERVAL_FMFMA
MODULE PROCEDURE FMADD_INTERVAL_FMAFM
MODULE PROCEDURE FMADD_INTERVAL_FMIM
MODULE PROCEDURE FMADD_INTERVAL_IMFM
MODULE PROCEDURE FMADD_INTERVAL_FM
MODULE PROCEDURE FMADD_INTERVAL_IFM1
MODULE PROCEDURE FMADD_INTERVAL_RFM1
MODULE PROCEDURE FMADD_INTERVAL_DFM1
MODULE PROCEDURE FMADD_INTERVAL_FMI1
MODULE PROCEDURE FMADD_INTERVAL_FMR1
MODULE PROCEDURE FMADD_INTERVAL_FMD1
MODULE PROCEDURE FMADD_INTERVAL_FMFM1
MODULE PROCEDURE FMADD_INTERVAL_FMFMA1
MODULE PROCEDURE FMADD_INTERVAL_FMAFM1
MODULE PROCEDURE FMADD_INTERVAL_IMFM1
MODULE PROCEDURE FMADD_INTERVAL_FMIM1
MODULE PROCEDURE FMADD_INTERVAL_FM1I
MODULE PROCEDURE FMADD_INTERVAL_FM1R
MODULE PROCEDURE FMADD_INTERVAL_FM1D
MODULE PROCEDURE FMADD_INTERVAL_I1FM
MODULE PROCEDURE FMADD_INTERVAL_R1FM
MODULE PROCEDURE FMADD_INTERVAL_D1FM
MODULE PROCEDURE FMADD_INTERVAL_FM1FM
MODULE PROCEDURE FMADD_INTERVAL_FM1FMA
MODULE PROCEDURE FMADD_INTERVAL_FMA1FM
MODULE PROCEDURE FMADD_INTERVAL_FM1IM
MODULE PROCEDURE FMADD_INTERVAL_IM1FM
MODULE PROCEDURE FMADD_INTERVAL_I1FM1
MODULE PROCEDURE FMADD_INTERVAL_R1FM1
MODULE PROCEDURE FMADD_INTERVAL_D1FM1
MODULE PROCEDURE FMADD_INTERVAL_FM1I1
MODULE PROCEDURE FMADD_INTERVAL_FM1R1
MODULE PROCEDURE FMADD_INTERVAL_FM1D1
MODULE PROCEDURE FMADD_INTERVAL_FM1FM1
MODULE PROCEDURE FMADD_INTERVAL_FM1FMA1
MODULE PROCEDURE FMADD_INTERVAL_FMA1FM1
MODULE PROCEDURE FMADD_INTERVAL_IM1FM1
MODULE PROCEDURE FMADD_INTERVAL_FM1IM1
MODULE PROCEDURE FMADD_INTERVAL_IFM2
MODULE PROCEDURE FMADD_INTERVAL_RFM2
MODULE PROCEDURE FMADD_INTERVAL_DFM2
MODULE PROCEDURE FMADD_INTERVAL_FMI2
MODULE PROCEDURE FMADD_INTERVAL_FMR2
MODULE PROCEDURE FMADD_INTERVAL_FMD2
MODULE PROCEDURE FMADD_INTERVAL_FMFM2
MODULE PROCEDURE FMADD_INTERVAL_FMFMA2
MODULE PROCEDURE FMADD_INTERVAL_FMAFM2
MODULE PROCEDURE FMADD_INTERVAL_IMFM2
MODULE PROCEDURE FMADD_INTERVAL_FMIM2
MODULE PROCEDURE FMADD_INTERVAL_FM2I
MODULE PROCEDURE FMADD_INTERVAL_FM2R
MODULE PROCEDURE FMADD_INTERVAL_FM2D
MODULE PROCEDURE FMADD_INTERVAL_I2FM
MODULE PROCEDURE FMADD_INTERVAL_R2FM
MODULE PROCEDURE FMADD_INTERVAL_D2FM
MODULE PROCEDURE FMADD_INTERVAL_FM2FM
MODULE PROCEDURE FMADD_INTERVAL_FM2FMA
MODULE PROCEDURE FMADD_INTERVAL_FMA2FM
MODULE PROCEDURE FMADD_INTERVAL_FM2IM
MODULE PROCEDURE FMADD_INTERVAL_IM2FM
MODULE PROCEDURE FMADD_INTERVAL_I2FM2
MODULE PROCEDURE FMADD_INTERVAL_R2FM2
MODULE PROCEDURE FMADD_INTERVAL_D2FM2
MODULE PROCEDURE FMADD_INTERVAL_FM2I2
MODULE PROCEDURE FMADD_INTERVAL_FM2R2
MODULE PROCEDURE FMADD_INTERVAL_FM2D2
MODULE PROCEDURE FMADD_INTERVAL_FM2FM2
MODULE PROCEDURE FMADD_INTERVAL_FM2FMA2
MODULE PROCEDURE FMADD_INTERVAL_FMA2FM2
MODULE PROCEDURE FMADD_INTERVAL_IM2FM2
MODULE PROCEDURE FMADD_INTERVAL_FM2IM2
MODULE PROCEDURE FMADD_INTERVAL_FM1
MODULE PROCEDURE FMADD_INTERVAL_FM2
END INTERFACE
CONTAINS
! +
FUNCTION FMADD_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_IFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IFM
FUNCTION FMADD_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_RFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_RFM
FUNCTION FMADD_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_DFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_DFM
FUNCTION FMADD_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMI
FUNCTION FMADD_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMR)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMR
FUNCTION FMADD_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMD
FUNCTION FMADD_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMADD_INTERVAL_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMADD_INTERVAL(MA,MB,FMADD_INTERVAL_FMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFM
FUNCTION FMADD_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FMFMA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMADD_INTERVAL(MA,TO_FM_INTERVAL(MB),FMADD_INTERVAL_FMFMA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFMA
FUNCTION FMADD_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB,FMADD_INTERVAL_FMAFM
TYPE (FM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA),MB,FMADD_INTERVAL_FMAFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMAFM
FUNCTION FMADD_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMIM
FUNCTION FMADD_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB,FMADD_INTERVAL_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MB,FMADD_INTERVAL_IMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IMFM
FUNCTION FMADD_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMADD_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(MA,FMADD_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM
! Array addition operations for FM.
! (1) rank 0 + rank 1
FUNCTION FMADD_INTERVAL_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_IFM1%LEFT = -1
FMADD_INTERVAL_IFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_IFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IFM1
FUNCTION FMADD_INTERVAL_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_RFM1%LEFT = -1
FMADD_INTERVAL_RFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_RFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_RFM1
FUNCTION FMADD_INTERVAL_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_DFM1%LEFT = -1
FMADD_INTERVAL_DFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_DFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_DFM1
FUNCTION FMADD_INTERVAL_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMADD_INTERVAL_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FMI1%LEFT = -1
FMADD_INTERVAL_FMI1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMI1
FUNCTION FMADD_INTERVAL_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMADD_INTERVAL_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_INTERVAL_FMR1%LEFT = -1
FMADD_INTERVAL_FMR1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMR1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMR1
FUNCTION FMADD_INTERVAL_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMADD_INTERVAL_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_INTERVAL_FMD1%LEFT = -1
FMADD_INTERVAL_FMD1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMD1
FUNCTION FMADD_INTERVAL_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMADD_INTERVAL_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMFM1%LEFT = -1
FMADD_INTERVAL_FMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMADD_INTERVAL(MA,MB(J),FMADD_INTERVAL_FMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFM1
FUNCTION FMADD_INTERVAL_FMFMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMADD_INTERVAL_FMFMA1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMFMA1%LEFT = -1
FMADD_INTERVAL_FMFMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMADD_INTERVAL(MA,TO_FM_INTERVAL(MB(J)),FMADD_INTERVAL_FMFMA1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFMA1
FUNCTION FMADD_INTERVAL_FMAFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMADD_INTERVAL_FMAFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMAFM1%LEFT = -1
FMADD_INTERVAL_FMAFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA),MB(J),FMADD_INTERVAL_FMAFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMAFM1
FUNCTION FMADD_INTERVAL_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMADD_INTERVAL_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IMFM1%LEFT = -1
FMADD_INTERVAL_IMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MTFM_I,MB(J),FMADD_INTERVAL_IMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IMFM1
FUNCTION FMADD_INTERVAL_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMADD_INTERVAL_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMIM1%LEFT = -1
FMADD_INTERVAL_FMIM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMIM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMIM1
! (2) rank 1 + rank 0
FUNCTION FMADD_INTERVAL_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FM1I%LEFT = -1
FMADD_INTERVAL_FM1I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1I(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1I
FUNCTION FMADD_INTERVAL_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_FM1R%LEFT = -1
FMADD_INTERVAL_FM1R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1R(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1R
FUNCTION FMADD_INTERVAL_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_FM1D%LEFT = -1
FMADD_INTERVAL_FM1D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1D(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1D
FUNCTION FMADD_INTERVAL_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMADD_INTERVAL_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_I1FM%LEFT = -1
FMADD_INTERVAL_I1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_I1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_I1FM
FUNCTION FMADD_INTERVAL_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMADD_INTERVAL_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_INTERVAL_R1FM%LEFT = -1
FMADD_INTERVAL_R1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_R1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_R1FM
FUNCTION FMADD_INTERVAL_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMADD_INTERVAL_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_INTERVAL_D1FM%LEFT = -1
FMADD_INTERVAL_D1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_D1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_D1FM
FUNCTION FMADD_INTERVAL_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1FM%LEFT = -1
FMADD_INTERVAL_FM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MB,FMADD_INTERVAL_FM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1FM
FUNCTION FMADD_INTERVAL_FM1FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1FMA
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1FMA%LEFT = -1
FMADD_INTERVAL_FM1FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),TO_FM_INTERVAL(MB),FMADD_INTERVAL_FM1FMA(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1FMA
FUNCTION FMADD_INTERVAL_FMA1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FMA1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FMA1FM%LEFT = -1
FMADD_INTERVAL_FMA1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA(J)),MB,FMADD_INTERVAL_FMA1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMA1FM
FUNCTION FMADD_INTERVAL_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1IM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1IM%LEFT = -1
FMADD_INTERVAL_FM1IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1IM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1IM
FUNCTION FMADD_INTERVAL_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IM1FM%LEFT = -1
FMADD_INTERVAL_IM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MB,FMADD_INTERVAL_IM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IM1FM
! (3) rank 1 + rank 1
FUNCTION FMADD_INTERVAL_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FM1I1%LEFT = -1
FMADD_INTERVAL_FM1I1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1I1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1I1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1I1
FUNCTION FMADD_INTERVAL_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_FM1R1%LEFT = -1
FMADD_INTERVAL_FM1R1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1R1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1R1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1R1
FUNCTION FMADD_INTERVAL_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_FM1D1%LEFT = -1
FMADD_INTERVAL_FM1D1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1D1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1D1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1D1
FUNCTION FMADD_INTERVAL_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMADD_INTERVAL_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_I1FM1%LEFT = -1
FMADD_INTERVAL_I1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_I1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_I1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_I1FM1
FUNCTION FMADD_INTERVAL_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMADD_INTERVAL_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_INTERVAL_R1FM1%LEFT = -1
FMADD_INTERVAL_R1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_R1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_R1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_R1FM1
FUNCTION FMADD_INTERVAL_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMADD_INTERVAL_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_INTERVAL_D1FM1%LEFT = -1
FMADD_INTERVAL_D1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_D1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J),FMADD_INTERVAL_D1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_D1FM1
FUNCTION FMADD_INTERVAL_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1FM1%LEFT = -1
FMADD_INTERVAL_FM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),MB(J),FMADD_INTERVAL_FM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1FM1
FUNCTION FMADD_INTERVAL_FM1FMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1FMA1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1FMA1%LEFT = -1
FMADD_INTERVAL_FM1FMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1FMA1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(MA(J),TO_FM_INTERVAL(MB(J)),FMADD_INTERVAL_FM1FMA1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1FMA1
FUNCTION FMADD_INTERVAL_FMA1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FMA1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FMA1FM1%LEFT = -1
FMADD_INTERVAL_FMA1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FMA1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA(J)),MB(J),FMADD_INTERVAL_FMA1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMA1FM1
FUNCTION FMADD_INTERVAL_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM1IM1%LEFT = -1
FMADD_INTERVAL_FM1IM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM1IM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MA(J),MTFM_I,FMADD_INTERVAL_FM1IM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1IM1
FUNCTION FMADD_INTERVAL_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IM1FM1%LEFT = -1
FMADD_INTERVAL_IM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_IM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MB(J),FMADD_INTERVAL_IM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IM1FM1
! (4) rank 0 + rank 2
FUNCTION FMADD_INTERVAL_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_IFM2%LEFT = -1
FMADD_INTERVAL_IFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_IFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IFM2
FUNCTION FMADD_INTERVAL_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_RFM2%LEFT = -1
FMADD_INTERVAL_RFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_RFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_RFM2
FUNCTION FMADD_INTERVAL_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_DFM2%LEFT = -1
FMADD_INTERVAL_DFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_DFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_DFM2
FUNCTION FMADD_INTERVAL_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_INTERVAL_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FMI2%LEFT = -1
FMADD_INTERVAL_FMI2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMI2
FUNCTION FMADD_INTERVAL_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_INTERVAL_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_INTERVAL_FMR2%LEFT = -1
FMADD_INTERVAL_FMR2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMR2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMR2
FUNCTION FMADD_INTERVAL_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_INTERVAL_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_INTERVAL_FMD2%LEFT = -1
FMADD_INTERVAL_FMD2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMD2
FUNCTION FMADD_INTERVAL_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_INTERVAL_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMFM2%LEFT = -1
FMADD_INTERVAL_FMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD_INTERVAL(MA,MB(J,K),FMADD_INTERVAL_FMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFM2
FUNCTION FMADD_INTERVAL_FMFMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_INTERVAL_FMFMA2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMFMA2%LEFT = -1
FMADD_INTERVAL_FMFMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD_INTERVAL(MA,TO_FM_INTERVAL(MB(J,K)),FMADD_INTERVAL_FMFMA2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMFMA2
FUNCTION FMADD_INTERVAL_FMAFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_INTERVAL_FMAFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMAFM2%LEFT = -1
FMADD_INTERVAL_FMAFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA),MB(J,K),FMADD_INTERVAL_FMAFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMAFM2
FUNCTION FMADD_INTERVAL_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_INTERVAL_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IMFM2%LEFT = -1
FMADD_INTERVAL_IMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD_INTERVAL(MTFM_I,MB(J,K),FMADD_INTERVAL_IMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IMFM2
FUNCTION FMADD_INTERVAL_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_INTERVAL_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_FMIM2%LEFT = -1
FMADD_INTERVAL_FMIM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MA,MTFM_I,FMADD_INTERVAL_FMIM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMIM2
! (5) rank 2 + rank 0
FUNCTION FMADD_INTERVAL_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FM2I%LEFT = -1
FMADD_INTERVAL_FM2I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2I(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2I
FUNCTION FMADD_INTERVAL_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_FM2R%LEFT = -1
FMADD_INTERVAL_FM2R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2R(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2R
FUNCTION FMADD_INTERVAL_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_FM2D%LEFT = -1
FMADD_INTERVAL_FM2D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2D(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2D
FUNCTION FMADD_INTERVAL_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_INTERVAL_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_I2FM%LEFT = -1
FMADD_INTERVAL_I2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_I2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_I2FM
FUNCTION FMADD_INTERVAL_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_INTERVAL_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_INTERVAL_R2FM%LEFT = -1
FMADD_INTERVAL_R2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_R2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_R2FM
FUNCTION FMADD_INTERVAL_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_INTERVAL_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_INTERVAL_D2FM%LEFT = -1
FMADD_INTERVAL_D2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA,FMADD_INTERVAL_D2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_D2FM
FUNCTION FMADD_INTERVAL_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2FM%LEFT = -1
FMADD_INTERVAL_FM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MB,FMADD_INTERVAL_FM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2FM
FUNCTION FMADD_INTERVAL_FM2FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2FMA
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2FMA%LEFT = -1
FMADD_INTERVAL_FM2FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB),FMADD_INTERVAL_FM2FMA(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2FMA
FUNCTION FMADD_INTERVAL_FMA2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FMA2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FMA2FM%LEFT = -1
FMADD_INTERVAL_FMA2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB,FMADD_INTERVAL_FMA2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMA2FM
FUNCTION FMADD_INTERVAL_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2IM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2IM%LEFT = -1
FMADD_INTERVAL_FM2IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2IM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2IM
FUNCTION FMADD_INTERVAL_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IM2FM%LEFT = -1
FMADD_INTERVAL_IM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MB,FMADD_INTERVAL_IM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IM2FM
! (6) rank 2 + rank 2
FUNCTION FMADD_INTERVAL_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_FM2I2%LEFT = -1
FMADD_INTERVAL_FM2I2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2I2
FUNCTION FMADD_INTERVAL_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMADD_INTERVAL_FM2R2%LEFT = -1
FMADD_INTERVAL_FM2R2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2R2
FUNCTION FMADD_INTERVAL_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_INTERVAL_FM2D2%LEFT = -1
FMADD_INTERVAL_FM2D2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2D2
FUNCTION FMADD_INTERVAL_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_INTERVAL_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_INTERVAL_I2FM2%LEFT = -1
FMADD_INTERVAL_I2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_I2FM2
FUNCTION FMADD_INTERVAL_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_INTERVAL_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_INTERVAL_R2FM2%LEFT = -1
FMADD_INTERVAL_R2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_R2FM2
FUNCTION FMADD_INTERVAL_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_INTERVAL_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_INTERVAL_D2FM2%LEFT = -1
FMADD_INTERVAL_D2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MA(J,K),FMADD_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_D2FM2
FUNCTION FMADD_INTERVAL_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2FM2%LEFT = -1
FMADD_INTERVAL_FM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),MB(J,K),FMADD_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2FM2
FUNCTION FMADD_INTERVAL_FM2FMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2FMA2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2FMA2%LEFT = -1
FMADD_INTERVAL_FM2FMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB(J,K)),FMADD_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2FMA2
FUNCTION FMADD_INTERVAL_FMA2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FMA2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FMA2FM2%LEFT = -1
FMADD_INTERVAL_FMA2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB(J,K),FMADD_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FMA2FM2
FUNCTION FMADD_INTERVAL_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMADD_INTERVAL_FM2IM2%LEFT = -1
FMADD_INTERVAL_FM2IM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MA(J,K),MTFM_I,FMADD_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2IM2
FUNCTION FMADD_INTERVAL_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_INTERVAL_IM2FM2%LEFT = -1
FMADD_INTERVAL_IM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMADD_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMADD_INTERVAL(MTFM_I,MB(J,K),FMADD_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_IM2FM2
FUNCTION FMADD_INTERVAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMADD_INTERVAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMADD_INTERVAL_FM1%LEFT = -1
FMADD_INTERVAL_FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ_INTERVAL(MA(J),FMADD_INTERVAL_FM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM1
FUNCTION FMADD_INTERVAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_INTERVAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMADD_INTERVAL_FM2%LEFT = -1
FMADD_INTERVAL_FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ_INTERVAL(MA(J,K),FMADD_INTERVAL_FM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_INTERVAL_FM2
END MODULE FM_INTERVAL_ARITHMETIC_4
MODULE FM_INTERVAL_ARITHMETIC_5
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (-)
MODULE PROCEDURE FMSUB_INTERVAL_IFM
MODULE PROCEDURE FMSUB_INTERVAL_RFM
MODULE PROCEDURE FMSUB_INTERVAL_DFM
MODULE PROCEDURE FMSUB_INTERVAL_FMI
MODULE PROCEDURE FMSUB_INTERVAL_FMR
MODULE PROCEDURE FMSUB_INTERVAL_FMD
MODULE PROCEDURE FMSUB_INTERVAL_FMFM
MODULE PROCEDURE FMSUB_INTERVAL_FMFMA
MODULE PROCEDURE FMSUB_INTERVAL_FMAFM
MODULE PROCEDURE FMSUB_INTERVAL_FMIM
MODULE PROCEDURE FMSUB_INTERVAL_IMFM
MODULE PROCEDURE FMSUB_INTERVAL_FM
MODULE PROCEDURE FMSUB_INTERVAL_IFM1
MODULE PROCEDURE FMSUB_INTERVAL_RFM1
MODULE PROCEDURE FMSUB_INTERVAL_DFM1
MODULE PROCEDURE FMSUB_INTERVAL_FMI1
MODULE PROCEDURE FMSUB_INTERVAL_FMR1
MODULE PROCEDURE FMSUB_INTERVAL_FMD1
MODULE PROCEDURE FMSUB_INTERVAL_FMFM1
MODULE PROCEDURE FMSUB_INTERVAL_FMFMA1
MODULE PROCEDURE FMSUB_INTERVAL_FMAFM1
MODULE PROCEDURE FMSUB_INTERVAL_IMFM1
MODULE PROCEDURE FMSUB_INTERVAL_FMIM1
MODULE PROCEDURE FMSUB_INTERVAL_FM1I
MODULE PROCEDURE FMSUB_INTERVAL_FM1R
MODULE PROCEDURE FMSUB_INTERVAL_FM1D
MODULE PROCEDURE FMSUB_INTERVAL_I1FM
MODULE PROCEDURE FMSUB_INTERVAL_R1FM
MODULE PROCEDURE FMSUB_INTERVAL_D1FM
MODULE PROCEDURE FMSUB_INTERVAL_FM1FM
MODULE PROCEDURE FMSUB_INTERVAL_FM1FMA
MODULE PROCEDURE FMSUB_INTERVAL_FMA1FM
MODULE PROCEDURE FMSUB_INTERVAL_FM1IM
MODULE PROCEDURE FMSUB_INTERVAL_IM1FM
MODULE PROCEDURE FMSUB_INTERVAL_I1FM1
MODULE PROCEDURE FMSUB_INTERVAL_R1FM1
MODULE PROCEDURE FMSUB_INTERVAL_D1FM1
MODULE PROCEDURE FMSUB_INTERVAL_FM1I1
MODULE PROCEDURE FMSUB_INTERVAL_FM1R1
MODULE PROCEDURE FMSUB_INTERVAL_FM1D1
MODULE PROCEDURE FMSUB_INTERVAL_FM1FM1
MODULE PROCEDURE FMSUB_INTERVAL_FM1FMA1
MODULE PROCEDURE FMSUB_INTERVAL_FMA1FM1
MODULE PROCEDURE FMSUB_INTERVAL_IM1FM1
MODULE PROCEDURE FMSUB_INTERVAL_FM1IM1
MODULE PROCEDURE FMSUB_INTERVAL_IFM2
MODULE PROCEDURE FMSUB_INTERVAL_RFM2
MODULE PROCEDURE FMSUB_INTERVAL_DFM2
MODULE PROCEDURE FMSUB_INTERVAL_FMI2
MODULE PROCEDURE FMSUB_INTERVAL_FMR2
MODULE PROCEDURE FMSUB_INTERVAL_FMD2
MODULE PROCEDURE FMSUB_INTERVAL_FMFM2
MODULE PROCEDURE FMSUB_INTERVAL_FMFMA2
MODULE PROCEDURE FMSUB_INTERVAL_FMAFM2
MODULE PROCEDURE FMSUB_INTERVAL_IMFM2
MODULE PROCEDURE FMSUB_INTERVAL_FMIM2
MODULE PROCEDURE FMSUB_INTERVAL_FM2I
MODULE PROCEDURE FMSUB_INTERVAL_FM2R
MODULE PROCEDURE FMSUB_INTERVAL_FM2D
MODULE PROCEDURE FMSUB_INTERVAL_I2FM
MODULE PROCEDURE FMSUB_INTERVAL_R2FM
MODULE PROCEDURE FMSUB_INTERVAL_D2FM
MODULE PROCEDURE FMSUB_INTERVAL_FM2FM
MODULE PROCEDURE FMSUB_INTERVAL_FM2FMA
MODULE PROCEDURE FMSUB_INTERVAL_FMA2FM
MODULE PROCEDURE FMSUB_INTERVAL_FM2IM
MODULE PROCEDURE FMSUB_INTERVAL_IM2FM
MODULE PROCEDURE FMSUB_INTERVAL_I2FM2
MODULE PROCEDURE FMSUB_INTERVAL_R2FM2
MODULE PROCEDURE FMSUB_INTERVAL_D2FM2
MODULE PROCEDURE FMSUB_INTERVAL_FM2I2
MODULE PROCEDURE FMSUB_INTERVAL_FM2R2
MODULE PROCEDURE FMSUB_INTERVAL_FM2D2
MODULE PROCEDURE FMSUB_INTERVAL_FM2FM2
MODULE PROCEDURE FMSUB_INTERVAL_FM2FMA2
MODULE PROCEDURE FMSUB_INTERVAL_FMA2FM2
MODULE PROCEDURE FMSUB_INTERVAL_IM2FM2
MODULE PROCEDURE FMSUB_INTERVAL_FM2IM2
MODULE PROCEDURE FMSUB_INTERVAL_FM1
MODULE PROCEDURE FMSUB_INTERVAL_FM2
END INTERFACE
CONTAINS
! -
FUNCTION FMSUB_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_IFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IFM
FUNCTION FMSUB_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_RFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_RFM
FUNCTION FMSUB_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_DFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_DFM
FUNCTION FMSUB_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMI
FUNCTION FMSUB_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMR)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMR
FUNCTION FMSUB_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMD
FUNCTION FMSUB_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMSUB_INTERVAL_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMSUB_INTERVAL(MA,MB,FMSUB_INTERVAL_FMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFM
FUNCTION FMSUB_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FMFMA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMSUB_INTERVAL(MA,TO_FM_INTERVAL(MB),FMSUB_INTERVAL_FMFMA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFMA
FUNCTION FMSUB_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB,FMSUB_INTERVAL_FMAFM
TYPE (FM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA),MB,FMSUB_INTERVAL_FMAFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMAFM
FUNCTION FMSUB_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMIM
FUNCTION FMSUB_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB,FMSUB_INTERVAL_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MB,FMSUB_INTERVAL_IMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IMFM
FUNCTION FMSUB_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSUB_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(0,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM
! Array subtraction operations for FM.
! (1) rank 0 - rank 1
FUNCTION FMSUB_INTERVAL_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_IFM1%LEFT = -1
FMSUB_INTERVAL_IFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_IFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IFM1
FUNCTION FMSUB_INTERVAL_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_RFM1%LEFT = -1
FMSUB_INTERVAL_RFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_RFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_RFM1
FUNCTION FMSUB_INTERVAL_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_DFM1%LEFT = -1
FMSUB_INTERVAL_DFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_DFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_DFM1
FUNCTION FMSUB_INTERVAL_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMSUB_INTERVAL_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FMI1%LEFT = -1
FMSUB_INTERVAL_FMI1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMI1
FUNCTION FMSUB_INTERVAL_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMSUB_INTERVAL_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FMR1%LEFT = -1
FMSUB_INTERVAL_FMR1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMR1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMR1
FUNCTION FMSUB_INTERVAL_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMSUB_INTERVAL_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FMD1%LEFT = -1
FMSUB_INTERVAL_FMD1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMD1
FUNCTION FMSUB_INTERVAL_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMSUB_INTERVAL_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMFM1%LEFT = -1
FMSUB_INTERVAL_FMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMSUB_INTERVAL(MA,MB(J),FMSUB_INTERVAL_FMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFM1
FUNCTION FMSUB_INTERVAL_FMFMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMSUB_INTERVAL_FMFMA1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMFMA1%LEFT = -1
FMSUB_INTERVAL_FMFMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMSUB_INTERVAL(MA,TO_FM_INTERVAL(MB(J)),FMSUB_INTERVAL_FMFMA1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFMA1
FUNCTION FMSUB_INTERVAL_FMAFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMSUB_INTERVAL_FMAFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMAFM1%LEFT = -1
FMSUB_INTERVAL_FMAFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA),MB(J),FMSUB_INTERVAL_FMAFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMAFM1
FUNCTION FMSUB_INTERVAL_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMSUB_INTERVAL_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IMFM1%LEFT = -1
FMSUB_INTERVAL_IMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MTFM_I,MB(J),FMSUB_INTERVAL_IMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IMFM1
FUNCTION FMSUB_INTERVAL_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMSUB_INTERVAL_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMIM1%LEFT = -1
FMSUB_INTERVAL_FMIM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMIM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMIM1
! (2) rank 1 - rank 0
FUNCTION FMSUB_INTERVAL_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FM1I%LEFT = -1
FMSUB_INTERVAL_FM1I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1I(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1I
FUNCTION FMSUB_INTERVAL_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FM1R%LEFT = -1
FMSUB_INTERVAL_FM1R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1R(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1R
FUNCTION FMSUB_INTERVAL_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FM1D%LEFT = -1
FMSUB_INTERVAL_FM1D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1D(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1D
FUNCTION FMSUB_INTERVAL_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMSUB_INTERVAL_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_I1FM%LEFT = -1
FMSUB_INTERVAL_I1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_I1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_I1FM
FUNCTION FMSUB_INTERVAL_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMSUB_INTERVAL_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_INTERVAL_R1FM%LEFT = -1
FMSUB_INTERVAL_R1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_R1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_R1FM
FUNCTION FMSUB_INTERVAL_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMSUB_INTERVAL_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_INTERVAL_D1FM%LEFT = -1
FMSUB_INTERVAL_D1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_D1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_D1FM
FUNCTION FMSUB_INTERVAL_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1FM%LEFT = -1
FMSUB_INTERVAL_FM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MB,FMSUB_INTERVAL_FM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1FM
FUNCTION FMSUB_INTERVAL_FM1FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1FMA
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1FMA%LEFT = -1
FMSUB_INTERVAL_FM1FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),TO_FM_INTERVAL(MB),FMSUB_INTERVAL_FM1FMA(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1FMA
FUNCTION FMSUB_INTERVAL_FMA1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FMA1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FMA1FM%LEFT = -1
FMSUB_INTERVAL_FMA1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA(J)),MB,FMSUB_INTERVAL_FMA1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMA1FM
FUNCTION FMSUB_INTERVAL_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1IM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1IM%LEFT = -1
FMSUB_INTERVAL_FM1IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1IM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1IM
FUNCTION FMSUB_INTERVAL_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IM1FM%LEFT = -1
FMSUB_INTERVAL_IM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MB,FMSUB_INTERVAL_IM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IM1FM
! (3) rank 1 - rank 1
FUNCTION FMSUB_INTERVAL_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FM1I1%LEFT = -1
FMSUB_INTERVAL_FM1I1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1I1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1I1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1I1
FUNCTION FMSUB_INTERVAL_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FM1R1%LEFT = -1
FMSUB_INTERVAL_FM1R1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1R1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1R1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1R1
FUNCTION FMSUB_INTERVAL_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FM1D1%LEFT = -1
FMSUB_INTERVAL_FM1D1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1D1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1D1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1D1
FUNCTION FMSUB_INTERVAL_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMSUB_INTERVAL_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_I1FM1%LEFT = -1
FMSUB_INTERVAL_I1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_I1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_I1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_I1FM1
FUNCTION FMSUB_INTERVAL_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMSUB_INTERVAL_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_INTERVAL_R1FM1%LEFT = -1
FMSUB_INTERVAL_R1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_R1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_R1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_R1FM1
FUNCTION FMSUB_INTERVAL_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMSUB_INTERVAL_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_INTERVAL_D1FM1%LEFT = -1
FMSUB_INTERVAL_D1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_D1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_D1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_D1FM1
FUNCTION FMSUB_INTERVAL_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1FM1%LEFT = -1
FMSUB_INTERVAL_FM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),MB(J),FMSUB_INTERVAL_FM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1FM1
FUNCTION FMSUB_INTERVAL_FM1FMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1FMA1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1FMA1%LEFT = -1
FMSUB_INTERVAL_FM1FMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1FMA1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(MA(J),TO_FM_INTERVAL(MB(J)),FMSUB_INTERVAL_FM1FMA1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1FMA1
FUNCTION FMSUB_INTERVAL_FMA1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FMA1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FMA1FM1%LEFT = -1
FMSUB_INTERVAL_FMA1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FMA1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA(J)),MB(J),FMSUB_INTERVAL_FMA1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMA1FM1
FUNCTION FMSUB_INTERVAL_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM1IM1%LEFT = -1
FMSUB_INTERVAL_FM1IM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM1IM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MA(J),MTFM_I,FMSUB_INTERVAL_FM1IM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1IM1
FUNCTION FMSUB_INTERVAL_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IM1FM1%LEFT = -1
FMSUB_INTERVAL_IM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_IM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MB(J),FMSUB_INTERVAL_IM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IM1FM1
! (4) rank 0 - rank 2
FUNCTION FMSUB_INTERVAL_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_IFM2%LEFT = -1
FMSUB_INTERVAL_IFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_IFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IFM2
FUNCTION FMSUB_INTERVAL_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_RFM2%LEFT = -1
FMSUB_INTERVAL_RFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_RFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_RFM2
FUNCTION FMSUB_INTERVAL_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_DFM2%LEFT = -1
FMSUB_INTERVAL_DFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_DFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_DFM2
FUNCTION FMSUB_INTERVAL_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_INTERVAL_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FMI2%LEFT = -1
FMSUB_INTERVAL_FMI2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMI2
FUNCTION FMSUB_INTERVAL_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_INTERVAL_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FMR2%LEFT = -1
FMSUB_INTERVAL_FMR2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMR2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMR2
FUNCTION FMSUB_INTERVAL_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_INTERVAL_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FMD2%LEFT = -1
FMSUB_INTERVAL_FMD2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMD2
FUNCTION FMSUB_INTERVAL_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_INTERVAL_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMFM2%LEFT = -1
FMSUB_INTERVAL_FMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB_INTERVAL(MA,MB(J,K),FMSUB_INTERVAL_FMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFM2
FUNCTION FMSUB_INTERVAL_FMFMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_INTERVAL_FMFMA2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMFMA2%LEFT = -1
FMSUB_INTERVAL_FMFMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB_INTERVAL(MA,TO_FM_INTERVAL(MB(J,K)),FMSUB_INTERVAL_FMFMA2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMFMA2
FUNCTION FMSUB_INTERVAL_FMAFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_INTERVAL_FMAFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMAFM2%LEFT = -1
FMSUB_INTERVAL_FMAFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA),MB(J,K),FMSUB_INTERVAL_FMAFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMAFM2
FUNCTION FMSUB_INTERVAL_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_INTERVAL_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IMFM2%LEFT = -1
FMSUB_INTERVAL_IMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB_INTERVAL(MTFM_I,MB(J,K),FMSUB_INTERVAL_IMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IMFM2
FUNCTION FMSUB_INTERVAL_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_INTERVAL_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_FMIM2%LEFT = -1
FMSUB_INTERVAL_FMIM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MA,MTFM_I,FMSUB_INTERVAL_FMIM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMIM2
! (5) rank 2 - rank 0
FUNCTION FMSUB_INTERVAL_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FM2I%LEFT = -1
FMSUB_INTERVAL_FM2I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2I(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2I
FUNCTION FMSUB_INTERVAL_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FM2R%LEFT = -1
FMSUB_INTERVAL_FM2R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2R(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2R
FUNCTION FMSUB_INTERVAL_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FM2D%LEFT = -1
FMSUB_INTERVAL_FM2D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2D(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2D
FUNCTION FMSUB_INTERVAL_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_INTERVAL_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_I2FM%LEFT = -1
FMSUB_INTERVAL_I2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_I2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_I2FM
FUNCTION FMSUB_INTERVAL_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_INTERVAL_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_INTERVAL_R2FM%LEFT = -1
FMSUB_INTERVAL_R2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_R2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_R2FM
FUNCTION FMSUB_INTERVAL_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_INTERVAL_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_INTERVAL_D2FM%LEFT = -1
FMSUB_INTERVAL_D2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA,FMSUB_INTERVAL_D2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_D2FM
FUNCTION FMSUB_INTERVAL_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2FM%LEFT = -1
FMSUB_INTERVAL_FM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MB,FMSUB_INTERVAL_FM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2FM
FUNCTION FMSUB_INTERVAL_FM2FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2FMA
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2FMA%LEFT = -1
FMSUB_INTERVAL_FM2FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB),FMSUB_INTERVAL_FM2FMA(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2FMA
FUNCTION FMSUB_INTERVAL_FMA2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FMA2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FMA2FM%LEFT = -1
FMSUB_INTERVAL_FMA2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB,FMSUB_INTERVAL_FMA2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMA2FM
FUNCTION FMSUB_INTERVAL_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2IM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2IM%LEFT = -1
FMSUB_INTERVAL_FM2IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2IM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2IM
FUNCTION FMSUB_INTERVAL_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IM2FM%LEFT = -1
FMSUB_INTERVAL_IM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MB,FMSUB_INTERVAL_IM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IM2FM
! (6) rank 2 - rank 2
FUNCTION FMSUB_INTERVAL_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_FM2I2%LEFT = -1
FMSUB_INTERVAL_FM2I2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2I2
FUNCTION FMSUB_INTERVAL_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMSUB_INTERVAL_FM2R2%LEFT = -1
FMSUB_INTERVAL_FM2R2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2R2
FUNCTION FMSUB_INTERVAL_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_INTERVAL_FM2D2%LEFT = -1
FMSUB_INTERVAL_FM2D2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2D2
FUNCTION FMSUB_INTERVAL_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_INTERVAL_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_INTERVAL_I2FM2%LEFT = -1
FMSUB_INTERVAL_I2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_I2FM2
FUNCTION FMSUB_INTERVAL_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_INTERVAL_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_INTERVAL_R2FM2%LEFT = -1
FMSUB_INTERVAL_R2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_R2FM2
FUNCTION FMSUB_INTERVAL_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_INTERVAL_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_INTERVAL_D2FM2%LEFT = -1
FMSUB_INTERVAL_D2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_D2FM2
FUNCTION FMSUB_INTERVAL_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2FM2%LEFT = -1
FMSUB_INTERVAL_FM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),MB(J,K),FMSUB_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2FM2
FUNCTION FMSUB_INTERVAL_FM2FMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2FMA2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2FMA2%LEFT = -1
FMSUB_INTERVAL_FM2FMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB(J,K)),FMSUB_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2FMA2
FUNCTION FMSUB_INTERVAL_FMA2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FMA2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FMA2FM2%LEFT = -1
FMSUB_INTERVAL_FMA2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB(J,K),FMSUB_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FMA2FM2
FUNCTION FMSUB_INTERVAL_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMSUB_INTERVAL_FM2IM2%LEFT = -1
FMSUB_INTERVAL_FM2IM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MA(J,K),MTFM_I,FMSUB_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2IM2
FUNCTION FMSUB_INTERVAL_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_INTERVAL_IM2FM2%LEFT = -1
FMSUB_INTERVAL_IM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMSUB_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMSUB_INTERVAL(MTFM_I,MB(J,K),FMSUB_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_IM2FM2
FUNCTION FMSUB_INTERVAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMSUB_INTERVAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSUB_INTERVAL_FM1%LEFT = -1
FMSUB_INTERVAL_FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO J = 1, N
CALL FMSUB_INTERVAL(MTFM_I,MA(J),FMSUB_INTERVAL_FM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM1
FUNCTION FMSUB_INTERVAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_INTERVAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSUB_INTERVAL_FM2%LEFT = -1
FMSUB_INTERVAL_FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB_INTERVAL(MTFM_I,MA(J,K),FMSUB_INTERVAL_FM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_INTERVAL_FM2
END MODULE FM_INTERVAL_ARITHMETIC_5
MODULE FM_INTERVAL_ARITHMETIC_6
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (*)
MODULE PROCEDURE FMMPY_INTERVAL_IFM
MODULE PROCEDURE FMMPY_INTERVAL_RFM
MODULE PROCEDURE FMMPY_INTERVAL_DFM
MODULE PROCEDURE FMMPY_INTERVAL_FMI
MODULE PROCEDURE FMMPY_INTERVAL_FMR
MODULE PROCEDURE FMMPY_INTERVAL_FMD
MODULE PROCEDURE FMMPY_INTERVAL_FMFM
MODULE PROCEDURE FMMPY_INTERVAL_FMFMA
MODULE PROCEDURE FMMPY_INTERVAL_FMAFM
MODULE PROCEDURE FMMPY_INTERVAL_FMIM
MODULE PROCEDURE FMMPY_INTERVAL_IMFM
MODULE PROCEDURE FMMPY_INTERVAL_IFM1
MODULE PROCEDURE FMMPY_INTERVAL_RFM1
MODULE PROCEDURE FMMPY_INTERVAL_DFM1
MODULE PROCEDURE FMMPY_INTERVAL_FMI1
MODULE PROCEDURE FMMPY_INTERVAL_FMR1
MODULE PROCEDURE FMMPY_INTERVAL_FMD1
MODULE PROCEDURE FMMPY_INTERVAL_FMFM1
MODULE PROCEDURE FMMPY_INTERVAL_FMFMA1
MODULE PROCEDURE FMMPY_INTERVAL_FMAFM1
MODULE PROCEDURE FMMPY_INTERVAL_IMFM1
MODULE PROCEDURE FMMPY_INTERVAL_FMIM1
MODULE PROCEDURE FMMPY_INTERVAL_FM1I
MODULE PROCEDURE FMMPY_INTERVAL_FM1R
MODULE PROCEDURE FMMPY_INTERVAL_FM1D
MODULE PROCEDURE FMMPY_INTERVAL_I1FM
MODULE PROCEDURE FMMPY_INTERVAL_R1FM
MODULE PROCEDURE FMMPY_INTERVAL_D1FM
MODULE PROCEDURE FMMPY_INTERVAL_FM1FM
MODULE PROCEDURE FMMPY_INTERVAL_FM1FMA
MODULE PROCEDURE FMMPY_INTERVAL_FMA1FM
MODULE PROCEDURE FMMPY_INTERVAL_FM1IM
MODULE PROCEDURE FMMPY_INTERVAL_IM1FM
MODULE PROCEDURE FMMPY_INTERVAL_I1FM1
MODULE PROCEDURE FMMPY_INTERVAL_R1FM1
MODULE PROCEDURE FMMPY_INTERVAL_D1FM1
MODULE PROCEDURE FMMPY_INTERVAL_FM1I1
MODULE PROCEDURE FMMPY_INTERVAL_FM1R1
MODULE PROCEDURE FMMPY_INTERVAL_FM1D1
MODULE PROCEDURE FMMPY_INTERVAL_FM1FM1
MODULE PROCEDURE FMMPY_INTERVAL_FM1FMA1
MODULE PROCEDURE FMMPY_INTERVAL_FMA1FM1
MODULE PROCEDURE FMMPY_INTERVAL_IM1FM1
MODULE PROCEDURE FMMPY_INTERVAL_FM1IM1
MODULE PROCEDURE FMMPY_INTERVAL_IFM2
MODULE PROCEDURE FMMPY_INTERVAL_RFM2
MODULE PROCEDURE FMMPY_INTERVAL_DFM2
MODULE PROCEDURE FMMPY_INTERVAL_FMI2
MODULE PROCEDURE FMMPY_INTERVAL_FMR2
MODULE PROCEDURE FMMPY_INTERVAL_FMD2
MODULE PROCEDURE FMMPY_INTERVAL_FMFM2
MODULE PROCEDURE FMMPY_INTERVAL_FMFMA2
MODULE PROCEDURE FMMPY_INTERVAL_FMAFM2
MODULE PROCEDURE FMMPY_INTERVAL_IMFM2
MODULE PROCEDURE FMMPY_INTERVAL_FMIM2
MODULE PROCEDURE FMMPY_INTERVAL_FM2I
MODULE PROCEDURE FMMPY_INTERVAL_FM2R
MODULE PROCEDURE FMMPY_INTERVAL_FM2D
MODULE PROCEDURE FMMPY_INTERVAL_I2FM
MODULE PROCEDURE FMMPY_INTERVAL_R2FM
MODULE PROCEDURE FMMPY_INTERVAL_D2FM
MODULE PROCEDURE FMMPY_INTERVAL_FM2FM
MODULE PROCEDURE FMMPY_INTERVAL_FM2FMA
MODULE PROCEDURE FMMPY_INTERVAL_FMA2FM
MODULE PROCEDURE FMMPY_INTERVAL_FM2IM
MODULE PROCEDURE FMMPY_INTERVAL_IM2FM
MODULE PROCEDURE FMMPY_INTERVAL_I2FM2
MODULE PROCEDURE FMMPY_INTERVAL_R2FM2
MODULE PROCEDURE FMMPY_INTERVAL_D2FM2
MODULE PROCEDURE FMMPY_INTERVAL_FM2I2
MODULE PROCEDURE FMMPY_INTERVAL_FM2R2
MODULE PROCEDURE FMMPY_INTERVAL_FM2D2
MODULE PROCEDURE FMMPY_INTERVAL_FM2FM2
MODULE PROCEDURE FMMPY_INTERVAL_FM2FMA2
MODULE PROCEDURE FMMPY_INTERVAL_FMA2FM2
MODULE PROCEDURE FMMPY_INTERVAL_IM2FM2
MODULE PROCEDURE FMMPY_INTERVAL_FM2IM2
END INTERFACE
CONTAINS
! *
FUNCTION FMMPY_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMMPYI_INTERVAL(MA,IVAL,FMMPY_INTERVAL_IFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IFM
FUNCTION FMMPY_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_RFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_RFM
FUNCTION FMMPY_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_DFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_DFM
FUNCTION FMMPY_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMMPYI_INTERVAL(MA,IVAL,FMMPY_INTERVAL_FMI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMI
FUNCTION FMMPY_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMR)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMR
FUNCTION FMMPY_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMD
FUNCTION FMMPY_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMMPY_INTERVAL_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMMPY_INTERVAL(MA,MB,FMMPY_INTERVAL_FMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFM
FUNCTION FMMPY_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_FMFMA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMPY_INTERVAL(MA,TO_FM_INTERVAL(MB),FMMPY_INTERVAL_FMFMA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFMA
FUNCTION FMMPY_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB,FMMPY_INTERVAL_FMAFM
TYPE (FM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA),MB,FMMPY_INTERVAL_FMAFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMAFM
FUNCTION FMMPY_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMPY_INTERVAL_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMIM
FUNCTION FMMPY_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB,FMMPY_INTERVAL_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MB,FMMPY_INTERVAL_IMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IMFM
! Array multiplication operations for FM.
! (1) rank 0 * rank 1
FUNCTION FMMPY_INTERVAL_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_IFM1%LEFT = -1
FMMPY_INTERVAL_IFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_IFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IFM1
FUNCTION FMMPY_INTERVAL_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_RFM1%LEFT = -1
FMMPY_INTERVAL_RFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_RFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_RFM1
FUNCTION FMMPY_INTERVAL_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_DFM1%LEFT = -1
FMMPY_INTERVAL_DFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_DFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_DFM1
FUNCTION FMMPY_INTERVAL_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMMPY_INTERVAL_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FMI1%LEFT = -1
FMMPY_INTERVAL_FMI1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMI1
FUNCTION FMMPY_INTERVAL_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMMPY_INTERVAL_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FMR1%LEFT = -1
FMMPY_INTERVAL_FMR1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMR1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMR1
FUNCTION FMMPY_INTERVAL_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMMPY_INTERVAL_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FMD1%LEFT = -1
FMMPY_INTERVAL_FMD1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMD1
FUNCTION FMMPY_INTERVAL_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMMPY_INTERVAL_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMFM1%LEFT = -1
FMMPY_INTERVAL_FMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMMPY_INTERVAL(MA,MB(J),FMMPY_INTERVAL_FMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFM1
FUNCTION FMMPY_INTERVAL_FMFMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMMPY_INTERVAL_FMFMA1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMFMA1%LEFT = -1
FMMPY_INTERVAL_FMFMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMMPY_INTERVAL(MA,TO_FM_INTERVAL(MB(J)),FMMPY_INTERVAL_FMFMA1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFMA1
FUNCTION FMMPY_INTERVAL_FMAFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMMPY_INTERVAL_FMAFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMAFM1%LEFT = -1
FMMPY_INTERVAL_FMAFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA),MB(J),FMMPY_INTERVAL_FMAFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMAFM1
FUNCTION FMMPY_INTERVAL_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMMPY_INTERVAL_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IMFM1%LEFT = -1
FMMPY_INTERVAL_IMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MTFM_I,MB(J),FMMPY_INTERVAL_IMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IMFM1
FUNCTION FMMPY_INTERVAL_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMMPY_INTERVAL_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMIM1%LEFT = -1
FMMPY_INTERVAL_FMIM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMIM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMIM1
! (2) rank 1 * rank 0
FUNCTION FMMPY_INTERVAL_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FM1I%LEFT = -1
FMMPY_INTERVAL_FM1I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1I(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1I
FUNCTION FMMPY_INTERVAL_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FM1R%LEFT = -1
FMMPY_INTERVAL_FM1R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1R(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1R
FUNCTION FMMPY_INTERVAL_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FM1D%LEFT = -1
FMMPY_INTERVAL_FM1D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1D(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1D
FUNCTION FMMPY_INTERVAL_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMMPY_INTERVAL_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_I1FM%LEFT = -1
FMMPY_INTERVAL_I1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_I1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_I1FM
FUNCTION FMMPY_INTERVAL_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMMPY_INTERVAL_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_INTERVAL_R1FM%LEFT = -1
FMMPY_INTERVAL_R1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_R1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_R1FM
FUNCTION FMMPY_INTERVAL_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMMPY_INTERVAL_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_INTERVAL_D1FM%LEFT = -1
FMMPY_INTERVAL_D1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_D1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_D1FM
FUNCTION FMMPY_INTERVAL_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1FM%LEFT = -1
FMMPY_INTERVAL_FM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MB,FMMPY_INTERVAL_FM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1FM
FUNCTION FMMPY_INTERVAL_FM1FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1FMA
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1FMA%LEFT = -1
FMMPY_INTERVAL_FM1FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),TO_FM_INTERVAL(MB),FMMPY_INTERVAL_FM1FMA(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1FMA
FUNCTION FMMPY_INTERVAL_FMA1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FMA1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FMA1FM%LEFT = -1
FMMPY_INTERVAL_FMA1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA(J)),MB,FMMPY_INTERVAL_FMA1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMA1FM
FUNCTION FMMPY_INTERVAL_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1IM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1IM%LEFT = -1
FMMPY_INTERVAL_FM1IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1IM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1IM
FUNCTION FMMPY_INTERVAL_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IM1FM%LEFT = -1
FMMPY_INTERVAL_IM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MB,FMMPY_INTERVAL_IM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IM1FM
! (3) rank 1 * rank 1
FUNCTION FMMPY_INTERVAL_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FM1I1%LEFT = -1
FMMPY_INTERVAL_FM1I1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1I1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1I1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1I1
FUNCTION FMMPY_INTERVAL_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FM1R1%LEFT = -1
FMMPY_INTERVAL_FM1R1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1R1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1R1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1R1
FUNCTION FMMPY_INTERVAL_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FM1D1%LEFT = -1
FMMPY_INTERVAL_FM1D1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1D1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1D1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1D1
FUNCTION FMMPY_INTERVAL_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMMPY_INTERVAL_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_I1FM1%LEFT = -1
FMMPY_INTERVAL_I1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_I1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_I1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_I1FM1
FUNCTION FMMPY_INTERVAL_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMMPY_INTERVAL_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_INTERVAL_R1FM1%LEFT = -1
FMMPY_INTERVAL_R1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_R1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_R1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_R1FM1
FUNCTION FMMPY_INTERVAL_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMMPY_INTERVAL_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_INTERVAL_D1FM1%LEFT = -1
FMMPY_INTERVAL_D1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_D1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J),FMMPY_INTERVAL_D1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_D1FM1
FUNCTION FMMPY_INTERVAL_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1FM1%LEFT = -1
FMMPY_INTERVAL_FM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),MB(J),FMMPY_INTERVAL_FM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1FM1
FUNCTION FMMPY_INTERVAL_FM1FMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1FMA1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1FMA1%LEFT = -1
FMMPY_INTERVAL_FM1FMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1FMA1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(MA(J),TO_FM_INTERVAL(MB(J)),FMMPY_INTERVAL_FM1FMA1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1FMA1
FUNCTION FMMPY_INTERVAL_FMA1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FMA1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FMA1FM1%LEFT = -1
FMMPY_INTERVAL_FMA1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FMA1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA(J)),MB(J),FMMPY_INTERVAL_FMA1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMA1FM1
FUNCTION FMMPY_INTERVAL_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM1IM1%LEFT = -1
FMMPY_INTERVAL_FM1IM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM1IM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MA(J),MTFM_I,FMMPY_INTERVAL_FM1IM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM1IM1
FUNCTION FMMPY_INTERVAL_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMMPY_INTERVAL_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IM1FM1%LEFT = -1
FMMPY_INTERVAL_IM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_IM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MB(J),FMMPY_INTERVAL_IM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IM1FM1
! (4) rank 0 * rank 2
FUNCTION FMMPY_INTERVAL_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_IFM2%LEFT = -1
FMMPY_INTERVAL_IFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_IFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IFM2
FUNCTION FMMPY_INTERVAL_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_RFM2%LEFT = -1
FMMPY_INTERVAL_RFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_RFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_RFM2
FUNCTION FMMPY_INTERVAL_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_DFM2%LEFT = -1
FMMPY_INTERVAL_DFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_DFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_DFM2
FUNCTION FMMPY_INTERVAL_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_INTERVAL_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FMI2%LEFT = -1
FMMPY_INTERVAL_FMI2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMI2
FUNCTION FMMPY_INTERVAL_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_INTERVAL_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FMR2%LEFT = -1
FMMPY_INTERVAL_FMR2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMR2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMR2
FUNCTION FMMPY_INTERVAL_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_INTERVAL_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FMD2%LEFT = -1
FMMPY_INTERVAL_FMD2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMD2
FUNCTION FMMPY_INTERVAL_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_INTERVAL_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMFM2%LEFT = -1
FMMPY_INTERVAL_FMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY_INTERVAL(MA,MB(J,K),FMMPY_INTERVAL_FMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFM2
FUNCTION FMMPY_INTERVAL_FMFMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_INTERVAL_FMFMA2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMFMA2%LEFT = -1
FMMPY_INTERVAL_FMFMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY_INTERVAL(MA,TO_FM_INTERVAL(MB(J,K)),FMMPY_INTERVAL_FMFMA2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMFMA2
FUNCTION FMMPY_INTERVAL_FMAFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_INTERVAL_FMAFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMAFM2%LEFT = -1
FMMPY_INTERVAL_FMAFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA),MB(J,K),FMMPY_INTERVAL_FMAFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMAFM2
FUNCTION FMMPY_INTERVAL_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_INTERVAL_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IMFM2%LEFT = -1
FMMPY_INTERVAL_IMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY_INTERVAL(MTFM_I,MB(J,K),FMMPY_INTERVAL_IMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IMFM2
FUNCTION FMMPY_INTERVAL_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_INTERVAL_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_FMIM2%LEFT = -1
FMMPY_INTERVAL_FMIM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MA,MTFM_I,FMMPY_INTERVAL_FMIM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMIM2
! (5) rank 2 * rank 0
FUNCTION FMMPY_INTERVAL_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FM2I%LEFT = -1
FMMPY_INTERVAL_FM2I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2I(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2I
FUNCTION FMMPY_INTERVAL_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FM2R%LEFT = -1
FMMPY_INTERVAL_FM2R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2R(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2R
FUNCTION FMMPY_INTERVAL_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FM2D%LEFT = -1
FMMPY_INTERVAL_FM2D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2D(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2D
FUNCTION FMMPY_INTERVAL_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_INTERVAL_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_I2FM%LEFT = -1
FMMPY_INTERVAL_I2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_I2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_I2FM
FUNCTION FMMPY_INTERVAL_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_INTERVAL_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_INTERVAL_R2FM%LEFT = -1
FMMPY_INTERVAL_R2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_R2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_R2FM
FUNCTION FMMPY_INTERVAL_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_INTERVAL_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_INTERVAL_D2FM%LEFT = -1
FMMPY_INTERVAL_D2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA,FMMPY_INTERVAL_D2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_D2FM
FUNCTION FMMPY_INTERVAL_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2FM%LEFT = -1
FMMPY_INTERVAL_FM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MB,FMMPY_INTERVAL_FM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2FM
FUNCTION FMMPY_INTERVAL_FM2FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2FMA
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2FMA%LEFT = -1
FMMPY_INTERVAL_FM2FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB),FMMPY_INTERVAL_FM2FMA(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2FMA
FUNCTION FMMPY_INTERVAL_FMA2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FMA2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FMA2FM%LEFT = -1
FMMPY_INTERVAL_FMA2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB,FMMPY_INTERVAL_FMA2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMA2FM
FUNCTION FMMPY_INTERVAL_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2IM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2IM%LEFT = -1
FMMPY_INTERVAL_FM2IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2IM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2IM
FUNCTION FMMPY_INTERVAL_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IM2FM%LEFT = -1
FMMPY_INTERVAL_IM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MB,FMMPY_INTERVAL_IM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IM2FM
! (6) rank 2 * rank 2
FUNCTION FMMPY_INTERVAL_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_FM2I2%LEFT = -1
FMMPY_INTERVAL_FM2I2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2I2
FUNCTION FMMPY_INTERVAL_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMMPY_INTERVAL_FM2R2%LEFT = -1
FMMPY_INTERVAL_FM2R2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2R2
FUNCTION FMMPY_INTERVAL_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_INTERVAL_FM2D2%LEFT = -1
FMMPY_INTERVAL_FM2D2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2D2
FUNCTION FMMPY_INTERVAL_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_INTERVAL_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_INTERVAL_I2FM2%LEFT = -1
FMMPY_INTERVAL_I2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_I2FM2
FUNCTION FMMPY_INTERVAL_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_INTERVAL_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_INTERVAL_R2FM2%LEFT = -1
FMMPY_INTERVAL_R2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_R2FM2
FUNCTION FMMPY_INTERVAL_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_INTERVAL_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_INTERVAL_D2FM2%LEFT = -1
FMMPY_INTERVAL_D2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MA(J,K),FMMPY_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_D2FM2
FUNCTION FMMPY_INTERVAL_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2FM2%LEFT = -1
FMMPY_INTERVAL_FM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),MB(J,K),FMMPY_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2FM2
FUNCTION FMMPY_INTERVAL_FM2FMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2FMA2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2FMA2%LEFT = -1
FMMPY_INTERVAL_FM2FMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB(J,K)),FMMPY_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2FMA2
FUNCTION FMMPY_INTERVAL_FMA2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FMA2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FMA2FM2%LEFT = -1
FMMPY_INTERVAL_FMA2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB(J,K),FMMPY_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FMA2FM2
FUNCTION FMMPY_INTERVAL_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMMPY_INTERVAL_FM2IM2%LEFT = -1
FMMPY_INTERVAL_FM2IM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MA(J,K),MTFM_I,FMMPY_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_FM2IM2
FUNCTION FMMPY_INTERVAL_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_INTERVAL_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_INTERVAL_IM2FM2%LEFT = -1
FMMPY_INTERVAL_IM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMMPY_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMMPY_INTERVAL(MTFM_I,MB(J,K),FMMPY_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_INTERVAL_IM2FM2
END MODULE FM_INTERVAL_ARITHMETIC_6
MODULE FM_INTERVAL_ARITHMETIC_7
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (/)
MODULE PROCEDURE FMDIV_INTERVAL_IFM
MODULE PROCEDURE FMDIV_INTERVAL_RFM
MODULE PROCEDURE FMDIV_INTERVAL_DFM
MODULE PROCEDURE FMDIV_INTERVAL_FMI
MODULE PROCEDURE FMDIV_INTERVAL_FMR
MODULE PROCEDURE FMDIV_INTERVAL_FMD
MODULE PROCEDURE FMDIV_INTERVAL_FMFM
MODULE PROCEDURE FMDIV_INTERVAL_FMFMA
MODULE PROCEDURE FMDIV_INTERVAL_FMAFM
MODULE PROCEDURE FMDIV_INTERVAL_FMIM
MODULE PROCEDURE FMDIV_INTERVAL_IMFM
MODULE PROCEDURE FMDIV_INTERVAL_IFM1
MODULE PROCEDURE FMDIV_INTERVAL_RFM1
MODULE PROCEDURE FMDIV_INTERVAL_DFM1
MODULE PROCEDURE FMDIV_INTERVAL_FMI1
MODULE PROCEDURE FMDIV_INTERVAL_FMR1
MODULE PROCEDURE FMDIV_INTERVAL_FMD1
MODULE PROCEDURE FMDIV_INTERVAL_FMFM1
MODULE PROCEDURE FMDIV_INTERVAL_FMFMA1
MODULE PROCEDURE FMDIV_INTERVAL_FMAFM1
MODULE PROCEDURE FMDIV_INTERVAL_IMFM1
MODULE PROCEDURE FMDIV_INTERVAL_FMIM1
MODULE PROCEDURE FMDIV_INTERVAL_FM1I
MODULE PROCEDURE FMDIV_INTERVAL_FM1R
MODULE PROCEDURE FMDIV_INTERVAL_FM1D
MODULE PROCEDURE FMDIV_INTERVAL_I1FM
MODULE PROCEDURE FMDIV_INTERVAL_R1FM
MODULE PROCEDURE FMDIV_INTERVAL_D1FM
MODULE PROCEDURE FMDIV_INTERVAL_FM1FM
MODULE PROCEDURE FMDIV_INTERVAL_FM1FMA
MODULE PROCEDURE FMDIV_INTERVAL_FMA1FM
MODULE PROCEDURE FMDIV_INTERVAL_FM1IM
MODULE PROCEDURE FMDIV_INTERVAL_IM1FM
MODULE PROCEDURE FMDIV_INTERVAL_I1FM1
MODULE PROCEDURE FMDIV_INTERVAL_R1FM1
MODULE PROCEDURE FMDIV_INTERVAL_D1FM1
MODULE PROCEDURE FMDIV_INTERVAL_FM1I1
MODULE PROCEDURE FMDIV_INTERVAL_FM1R1
MODULE PROCEDURE FMDIV_INTERVAL_FM1D1
MODULE PROCEDURE FMDIV_INTERVAL_FM1FM1
MODULE PROCEDURE FMDIV_INTERVAL_FM1FMA1
MODULE PROCEDURE FMDIV_INTERVAL_FMA1FM1
MODULE PROCEDURE FMDIV_INTERVAL_IM1FM1
MODULE PROCEDURE FMDIV_INTERVAL_FM1IM1
MODULE PROCEDURE FMDIV_INTERVAL_IFM2
MODULE PROCEDURE FMDIV_INTERVAL_RFM2
MODULE PROCEDURE FMDIV_INTERVAL_DFM2
MODULE PROCEDURE FMDIV_INTERVAL_FMI2
MODULE PROCEDURE FMDIV_INTERVAL_FMR2
MODULE PROCEDURE FMDIV_INTERVAL_FMD2
MODULE PROCEDURE FMDIV_INTERVAL_FMFM2
MODULE PROCEDURE FMDIV_INTERVAL_FMFMA2
MODULE PROCEDURE FMDIV_INTERVAL_FMAFM2
MODULE PROCEDURE FMDIV_INTERVAL_IMFM2
MODULE PROCEDURE FMDIV_INTERVAL_FMIM2
MODULE PROCEDURE FMDIV_INTERVAL_FM2I
MODULE PROCEDURE FMDIV_INTERVAL_FM2R
MODULE PROCEDURE FMDIV_INTERVAL_FM2D
MODULE PROCEDURE FMDIV_INTERVAL_I2FM
MODULE PROCEDURE FMDIV_INTERVAL_R2FM
MODULE PROCEDURE FMDIV_INTERVAL_D2FM
MODULE PROCEDURE FMDIV_INTERVAL_FM2FM
MODULE PROCEDURE FMDIV_INTERVAL_FM2FMA
MODULE PROCEDURE FMDIV_INTERVAL_FMA2FM
MODULE PROCEDURE FMDIV_INTERVAL_FM2IM
MODULE PROCEDURE FMDIV_INTERVAL_IM2FM
MODULE PROCEDURE FMDIV_INTERVAL_I2FM2
MODULE PROCEDURE FMDIV_INTERVAL_R2FM2
MODULE PROCEDURE FMDIV_INTERVAL_D2FM2
MODULE PROCEDURE FMDIV_INTERVAL_FM2I2
MODULE PROCEDURE FMDIV_INTERVAL_FM2R2
MODULE PROCEDURE FMDIV_INTERVAL_FM2D2
MODULE PROCEDURE FMDIV_INTERVAL_FM2FM2
MODULE PROCEDURE FMDIV_INTERVAL_FM2FMA2
MODULE PROCEDURE FMDIV_INTERVAL_FMA2FM2
MODULE PROCEDURE FMDIV_INTERVAL_IM2FM2
MODULE PROCEDURE FMDIV_INTERVAL_FM2IM2
END INTERFACE
CONTAINS
! /
FUNCTION FMDIV_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_IFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IFM
FUNCTION FMDIV_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_RFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_RFM
FUNCTION FMDIV_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_DFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_DFM
FUNCTION FMDIV_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDIVI_INTERVAL(MA,IVAL,FMDIV_INTERVAL_FMI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMI
FUNCTION FMDIV_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMR)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMR
FUNCTION FMDIV_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMD
FUNCTION FMDIV_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMDIV_INTERVAL_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMDIV_INTERVAL(MA,MB,FMDIV_INTERVAL_FMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFM
FUNCTION FMDIV_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_FMFMA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMDIV_INTERVAL(MA,TO_FM_INTERVAL(MB),FMDIV_INTERVAL_FMFMA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFMA
FUNCTION FMDIV_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB,FMDIV_INTERVAL_FMAFM
TYPE (FM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA),MB,FMDIV_INTERVAL_FMAFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMAFM
FUNCTION FMDIV_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIV_INTERVAL_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMIM
FUNCTION FMDIV_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB,FMDIV_INTERVAL_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MB,FMDIV_INTERVAL_IMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IMFM
! Array division operations for FM.
! (1) rank 0 / rank 1
FUNCTION FMDIV_INTERVAL_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_IFM1%LEFT = -1
FMDIV_INTERVAL_IFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_IFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IFM1
FUNCTION FMDIV_INTERVAL_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_RFM1%LEFT = -1
FMDIV_INTERVAL_RFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_RFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_RFM1
FUNCTION FMDIV_INTERVAL_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_DFM1%LEFT = -1
FMDIV_INTERVAL_DFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_DFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_DFM1
FUNCTION FMDIV_INTERVAL_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMDIV_INTERVAL_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FMI1%LEFT = -1
FMDIV_INTERVAL_FMI1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMI1
FUNCTION FMDIV_INTERVAL_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMDIV_INTERVAL_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FMR1%LEFT = -1
FMDIV_INTERVAL_FMR1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMR1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMR1
FUNCTION FMDIV_INTERVAL_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMDIV_INTERVAL_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FMD1%LEFT = -1
FMDIV_INTERVAL_FMD1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMD1
FUNCTION FMDIV_INTERVAL_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMDIV_INTERVAL_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMFM1%LEFT = -1
FMDIV_INTERVAL_FMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMDIV_INTERVAL(MA,MB(J),FMDIV_INTERVAL_FMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFM1
FUNCTION FMDIV_INTERVAL_FMFMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMDIV_INTERVAL_FMFMA1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMFMA1%LEFT = -1
FMDIV_INTERVAL_FMFMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMDIV_INTERVAL(MA,TO_FM_INTERVAL(MB(J)),FMDIV_INTERVAL_FMFMA1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFMA1
FUNCTION FMDIV_INTERVAL_FMAFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMDIV_INTERVAL_FMAFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMAFM1%LEFT = -1
FMDIV_INTERVAL_FMAFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA),MB(J),FMDIV_INTERVAL_FMAFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMAFM1
FUNCTION FMDIV_INTERVAL_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMDIV_INTERVAL_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IMFM1%LEFT = -1
FMDIV_INTERVAL_IMFM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MTFM_I,MB(J),FMDIV_INTERVAL_IMFM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IMFM1
FUNCTION FMDIV_INTERVAL_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB)) :: FMDIV_INTERVAL_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMIM1%LEFT = -1
FMDIV_INTERVAL_FMIM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMIM1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMIM1
! (2) rank 1 / rank 0
FUNCTION FMDIV_INTERVAL_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FM1I%LEFT = -1
FMDIV_INTERVAL_FM1I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1I(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1I
FUNCTION FMDIV_INTERVAL_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FM1R%LEFT = -1
FMDIV_INTERVAL_FM1R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1R(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1R
FUNCTION FMDIV_INTERVAL_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FM1D%LEFT = -1
FMDIV_INTERVAL_FM1D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1D(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1D
FUNCTION FMDIV_INTERVAL_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMDIV_INTERVAL_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_I1FM%LEFT = -1
FMDIV_INTERVAL_I1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_I1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_I1FM
FUNCTION FMDIV_INTERVAL_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMDIV_INTERVAL_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_INTERVAL_R1FM%LEFT = -1
FMDIV_INTERVAL_R1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_R1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_R1FM
FUNCTION FMDIV_INTERVAL_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMDIV_INTERVAL_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_INTERVAL_D1FM%LEFT = -1
FMDIV_INTERVAL_D1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_D1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_D1FM
FUNCTION FMDIV_INTERVAL_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1FM%LEFT = -1
FMDIV_INTERVAL_FM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MB,FMDIV_INTERVAL_FM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1FM
FUNCTION FMDIV_INTERVAL_FM1FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1FMA
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1FMA%LEFT = -1
FMDIV_INTERVAL_FM1FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),TO_FM_INTERVAL(MB),FMDIV_INTERVAL_FM1FMA(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1FMA
FUNCTION FMDIV_INTERVAL_FMA1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FMA1FM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FMA1FM%LEFT = -1
FMDIV_INTERVAL_FMA1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA(J)),MB,FMDIV_INTERVAL_FMA1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMA1FM
FUNCTION FMDIV_INTERVAL_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1IM
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1IM%LEFT = -1
FMDIV_INTERVAL_FM1IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1IM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1IM
FUNCTION FMDIV_INTERVAL_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IM1FM%LEFT = -1
FMDIV_INTERVAL_IM1FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MB,FMDIV_INTERVAL_IM1FM(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IM1FM
! (3) rank 1 / rank 1
FUNCTION FMDIV_INTERVAL_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FM1I1%LEFT = -1
FMDIV_INTERVAL_FM1I1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1I1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1I1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1I1
FUNCTION FMDIV_INTERVAL_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FM1R1%LEFT = -1
FMDIV_INTERVAL_FM1R1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1R1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1R1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1R1
FUNCTION FMDIV_INTERVAL_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FM1D1%LEFT = -1
FMDIV_INTERVAL_FM1D1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1D1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1D1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1D1
FUNCTION FMDIV_INTERVAL_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL)) :: FMDIV_INTERVAL_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_I1FM1%LEFT = -1
FMDIV_INTERVAL_I1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_I1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M_INTERVAL(IVAL(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_I1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_I1FM1
FUNCTION FMDIV_INTERVAL_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R)) :: FMDIV_INTERVAL_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_INTERVAL_R1FM1%LEFT = -1
FMDIV_INTERVAL_R1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_R1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M_INTERVAL(R(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_R1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_R1FM1
FUNCTION FMDIV_INTERVAL_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D)) :: FMDIV_INTERVAL_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_INTERVAL_D1FM1%LEFT = -1
FMDIV_INTERVAL_D1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_D1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M_INTERVAL(D(J),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J),FMDIV_INTERVAL_D1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_D1FM1
FUNCTION FMDIV_INTERVAL_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1FM1%LEFT = -1
FMDIV_INTERVAL_FM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),MB(J),FMDIV_INTERVAL_FM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1FM1
FUNCTION FMDIV_INTERVAL_FM1FMA1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1FMA1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1FMA1%LEFT = -1
FMDIV_INTERVAL_FM1FMA1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1FMA1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(MA(J),TO_FM_INTERVAL(MB(J)),FMDIV_INTERVAL_FM1FMA1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1FMA1
FUNCTION FMDIV_INTERVAL_FMA1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FMA1FM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FMA1FM1%LEFT = -1
FMDIV_INTERVAL_FMA1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FMA1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA(J)),MB(J),FMDIV_INTERVAL_FMA1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMA1FM1
FUNCTION FMDIV_INTERVAL_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM1IM1%LEFT = -1
FMDIV_INTERVAL_FM1IM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM1IM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MB(J)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MA(J),MTFM_I,FMDIV_INTERVAL_FM1IM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM1IM1
FUNCTION FMDIV_INTERVAL_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA)) :: FMDIV_INTERVAL_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IM1FM1%LEFT = -1
FMDIV_INTERVAL_IM1FM1%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_IM1FM1(J))
ENDDO
GO TO 10
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM_INTERVAL(MA(J)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MB(J),FMDIV_INTERVAL_IM1FM1(J))
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IM1FM1
! (4) rank 0 / rank 2
FUNCTION FMDIV_INTERVAL_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_IFM2%LEFT = -1
FMDIV_INTERVAL_IFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_IFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IFM2
FUNCTION FMDIV_INTERVAL_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_RFM2%LEFT = -1
FMDIV_INTERVAL_RFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_RFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_RFM2
FUNCTION FMDIV_INTERVAL_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_DFM2%LEFT = -1
FMDIV_INTERVAL_DFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_DFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_DFM2
FUNCTION FMDIV_INTERVAL_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_INTERVAL_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FMI2%LEFT = -1
FMDIV_INTERVAL_FMI2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMI2
FUNCTION FMDIV_INTERVAL_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_INTERVAL_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FMR2%LEFT = -1
FMDIV_INTERVAL_FMR2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMR2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMR2
FUNCTION FMDIV_INTERVAL_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_INTERVAL_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FMD2%LEFT = -1
FMDIV_INTERVAL_FMD2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMD2
FUNCTION FMDIV_INTERVAL_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_INTERVAL_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMFM2%LEFT = -1
FMDIV_INTERVAL_FMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV_INTERVAL(MA,MB(J,K),FMDIV_INTERVAL_FMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFM2
FUNCTION FMDIV_INTERVAL_FMFMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_INTERVAL_FMFMA2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMFMA2%LEFT = -1
FMDIV_INTERVAL_FMFMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV_INTERVAL(MA,TO_FM_INTERVAL(MB(J,K)),FMDIV_INTERVAL_FMFMA2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMFMA2
FUNCTION FMDIV_INTERVAL_FMAFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_INTERVAL_FMAFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMAFM2%LEFT = -1
FMDIV_INTERVAL_FMAFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA),MB(J,K),FMDIV_INTERVAL_FMAFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMAFM2
FUNCTION FMDIV_INTERVAL_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_INTERVAL_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IMFM2%LEFT = -1
FMDIV_INTERVAL_IMFM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV_INTERVAL(MTFM_I,MB(J,K),FMDIV_INTERVAL_IMFM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IMFM2
FUNCTION FMDIV_INTERVAL_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_INTERVAL_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_FMIM2%LEFT = -1
FMDIV_INTERVAL_FMIM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MA,MTFM_I,FMDIV_INTERVAL_FMIM2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMIM2
! (5) rank 2 / rank 0
FUNCTION FMDIV_INTERVAL_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FM2I%LEFT = -1
FMDIV_INTERVAL_FM2I%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2I(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2I
FUNCTION FMDIV_INTERVAL_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FM2R%LEFT = -1
FMDIV_INTERVAL_FM2R%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2R(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2R
FUNCTION FMDIV_INTERVAL_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FM2D%LEFT = -1
FMDIV_INTERVAL_FM2D%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2D(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2D
FUNCTION FMDIV_INTERVAL_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_INTERVAL_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_I2FM%LEFT = -1
FMDIV_INTERVAL_I2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_I2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_I2FM
FUNCTION FMDIV_INTERVAL_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_INTERVAL_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_INTERVAL_R2FM%LEFT = -1
FMDIV_INTERVAL_R2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_R2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_R2FM
FUNCTION FMDIV_INTERVAL_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_INTERVAL_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_INTERVAL_D2FM%LEFT = -1
FMDIV_INTERVAL_D2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA,FMDIV_INTERVAL_D2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_D2FM
FUNCTION FMDIV_INTERVAL_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2FM%LEFT = -1
FMDIV_INTERVAL_FM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MB,FMDIV_INTERVAL_FM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2FM
FUNCTION FMDIV_INTERVAL_FM2FMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2FMA
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2FMA%LEFT = -1
FMDIV_INTERVAL_FM2FMA%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB),FMDIV_INTERVAL_FM2FMA(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2FMA
FUNCTION FMDIV_INTERVAL_FMA2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FMA2FM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FMA2FM%LEFT = -1
FMDIV_INTERVAL_FMA2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB,FMDIV_INTERVAL_FMA2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMA2FM
FUNCTION FMDIV_INTERVAL_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2IM
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2IM%LEFT = -1
FMDIV_INTERVAL_FM2IM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2IM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2IM
FUNCTION FMDIV_INTERVAL_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IM2FM%LEFT = -1
FMDIV_INTERVAL_IM2FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MB,FMDIV_INTERVAL_IM2FM(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IM2FM
! (6) rank 2 / rank 2
FUNCTION FMDIV_INTERVAL_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_FM2I2%LEFT = -1
FMDIV_INTERVAL_FM2I2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2I2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2I2
FUNCTION FMDIV_INTERVAL_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMDIV_INTERVAL_FM2R2%LEFT = -1
FMDIV_INTERVAL_FM2R2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2R2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2R2
FUNCTION FMDIV_INTERVAL_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_INTERVAL_FM2D2%LEFT = -1
FMDIV_INTERVAL_FM2D2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2D2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2D2
FUNCTION FMDIV_INTERVAL_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM_INTERVAL), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_INTERVAL_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_INTERVAL_I2FM2%LEFT = -1
FMDIV_INTERVAL_I2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMI2M_INTERVAL(IVAL(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_I2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_I2FM2
FUNCTION FMDIV_INTERVAL_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM_INTERVAL), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_INTERVAL_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_INTERVAL_R2FM2%LEFT = -1
FMDIV_INTERVAL_R2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSP2M_INTERVAL(R(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_R2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_R2FM2
FUNCTION FMDIV_INTERVAL_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM_INTERVAL), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_INTERVAL_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_INTERVAL_D2FM2%LEFT = -1
FMDIV_INTERVAL_D2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDP2M_INTERVAL(D(J,K),MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MA(J,K),FMDIV_INTERVAL_D2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_D2FM2
FUNCTION FMDIV_INTERVAL_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2FM2%LEFT = -1
FMDIV_INTERVAL_FM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),MB(J,K),FMDIV_INTERVAL_FM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2FM2
FUNCTION FMDIV_INTERVAL_FM2FMA2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2FMA2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2FMA2%LEFT = -1
FMDIV_INTERVAL_FM2FMA2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(MA(J,K),TO_FM_INTERVAL(MB(J,K)),FMDIV_INTERVAL_FM2FMA2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2FMA2
FUNCTION FMDIV_INTERVAL_FMA2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FMA2FM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FMA2FM2%LEFT = -1
FMDIV_INTERVAL_FMA2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV_INTERVAL(TO_FM_INTERVAL(MA(J,K)),MB(J,K),FMDIV_INTERVAL_FMA2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FMA2FM2
FUNCTION FMDIV_INTERVAL_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MB,MA
FMDIV_INTERVAL_FM2IM2%LEFT = -1
FMDIV_INTERVAL_FM2IM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MB(J,K)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MA(J,K),MTFM_I,FMDIV_INTERVAL_FM2IM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_FM2IM2
FUNCTION FMDIV_INTERVAL_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM_INTERVAL), DIMENSION(:,:) :: MB
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_INTERVAL_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_INTERVAL_IM2FM2%LEFT = -1
FMDIV_INTERVAL_IM2FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M_INTERVAL(' UNKNOWN ',FMDIV_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
GO TO 10
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM_INTERVAL(MA(J,K)%MIM,MTFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MB(J,K),FMDIV_INTERVAL_IM2FM2(J,K))
ENDDO
ENDDO
10 TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_INTERVAL_IM2FM2
END MODULE FM_INTERVAL_ARITHMETIC_7
MODULE FM_INTERVAL_ARITHMETIC_8
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE OPERATOR (**)
MODULE PROCEDURE FMPWR_INTERVAL_IFM
MODULE PROCEDURE FMPWR_INTERVAL_RFM
MODULE PROCEDURE FMPWR_INTERVAL_DFM
MODULE PROCEDURE FMPWR_INTERVAL_FMI
MODULE PROCEDURE FMPWR_INTERVAL_FMR
MODULE PROCEDURE FMPWR_INTERVAL_FMD
MODULE PROCEDURE FMPWR_INTERVAL_FMFM
MODULE PROCEDURE FMPWR_INTERVAL_FMFMA
MODULE PROCEDURE FMPWR_INTERVAL_FMAFM
MODULE PROCEDURE FMPWR_INTERVAL_FMIM
MODULE PROCEDURE FMPWR_INTERVAL_IMFM
END INTERFACE
INTERFACE ABS
MODULE PROCEDURE FMABS_INTERVAL_FM
END INTERFACE
INTERFACE ACOS
MODULE PROCEDURE FMACOS_INTERVAL_FM
END INTERFACE
INTERFACE ACOSH
MODULE PROCEDURE FMACOSH_INTERVAL_FM
END INTERFACE
INTERFACE AINT
MODULE PROCEDURE FMAINT_INTERVAL_FM
END INTERFACE
INTERFACE ANINT
MODULE PROCEDURE FMANINT_INTERVAL_FM
END INTERFACE
INTERFACE ASIN
MODULE PROCEDURE FMASIN_INTERVAL_FM
END INTERFACE
INTERFACE ASINH
MODULE PROCEDURE FMASINH_INTERVAL_FM
END INTERFACE
INTERFACE ATAN
MODULE PROCEDURE FMATAN_INTERVAL_FM
END INTERFACE
INTERFACE ATANH
MODULE PROCEDURE FMATANH_INTERVAL_FM
END INTERFACE
INTERFACE ATAN2
MODULE PROCEDURE FMATAN2_INTERVAL_FM
END INTERFACE
INTERFACE CEILING
MODULE PROCEDURE FMCEILING_INTERVAL_FM
END INTERFACE
INTERFACE COS
MODULE PROCEDURE FMCOS_INTERVAL_FM
END INTERFACE
INTERFACE COSH
MODULE PROCEDURE FMCOSH_INTERVAL_FM
END INTERFACE
INTERFACE DBLE
MODULE PROCEDURE FMDBLE_INTERVAL_FM
END INTERFACE
INTERFACE DIGITS
MODULE PROCEDURE FMDIGITS_INTERVAL_FM
END INTERFACE
INTERFACE DIM
MODULE PROCEDURE FMDIM_INTERVAL_FM
END INTERFACE
INTERFACE DINT
MODULE PROCEDURE FMDINT_INTERVAL_FM
END INTERFACE
INTERFACE DOT_PRODUCT
MODULE PROCEDURE FMDOTPRODUCT_INTERVAL_FM
END INTERFACE
INTERFACE EPSILON
MODULE PROCEDURE FMEPSILON_INTERVAL_FM
END INTERFACE
INTERFACE EXP
MODULE PROCEDURE FMEXP_INTERVAL_FM
END INTERFACE
INTERFACE EXPONENT
MODULE PROCEDURE FMEXPONENT_INTERVAL_FM
END INTERFACE
INTERFACE FLOOR
MODULE PROCEDURE FMFLOOR_INTERVAL_FM
END INTERFACE
INTERFACE FRACTION
MODULE PROCEDURE FMFRACTION_INTERVAL_FM
END INTERFACE
INTERFACE HUGE
MODULE PROCEDURE FMHUGE_INTERVAL_FM
END INTERFACE
INTERFACE INT
MODULE PROCEDURE FMINT_INTERVAL_FM
END INTERFACE
INTERFACE LOG
MODULE PROCEDURE FMLOG_INTERVAL_FM
END INTERFACE
INTERFACE LOG10
MODULE PROCEDURE FMLOG10_INTERVAL_FM
END INTERFACE
INTERFACE MATMUL
MODULE PROCEDURE FMMATMUL22_INTERVAL_FM
MODULE PROCEDURE FMMATMUL12_INTERVAL_FM
MODULE PROCEDURE FMMATMUL21_INTERVAL_FM
END INTERFACE
INTERFACE MAX
MODULE PROCEDURE FMMAX_INTERVAL_FM
END INTERFACE
INTERFACE MAXEXPONENT
MODULE PROCEDURE FMMAXEXPONENT_INTERVAL_FM
END INTERFACE
INTERFACE MAXVAL
MODULE PROCEDURE FMMAXVAL1_INTERVAL_FM
MODULE PROCEDURE FMMAXVAL2_INTERVAL_FM
END INTERFACE
INTERFACE MIN
MODULE PROCEDURE FMMIN_INTERVAL_FM
END INTERFACE
INTERFACE MINEXPONENT
MODULE PROCEDURE FMMINEXPONENT_INTERVAL_FM
END INTERFACE
INTERFACE MINVAL
MODULE PROCEDURE FMMINVAL1_INTERVAL_FM
MODULE PROCEDURE FMMINVAL2_INTERVAL_FM
END INTERFACE
INTERFACE MOD
MODULE PROCEDURE FMMOD_INTERVAL_FM
END INTERFACE
INTERFACE MODULO
MODULE PROCEDURE FMMODULO_INTERVAL_FM
END INTERFACE
INTERFACE NEAREST
MODULE PROCEDURE FMNEAREST_INTERVAL_FM
END INTERFACE
INTERFACE NINT
MODULE PROCEDURE FMNINT_INTERVAL_FM
END INTERFACE
INTERFACE PRECISION
MODULE PROCEDURE FMPRECISION_INTERVAL_FM
END INTERFACE
INTERFACE PRODUCT
MODULE PROCEDURE FMPRODUCT1_INTERVAL_FM
MODULE PROCEDURE FMPRODUCT2_INTERVAL_FM
END INTERFACE
INTERFACE RADIX
MODULE PROCEDURE FMRADIX_INTERVAL_FM
END INTERFACE
INTERFACE RANGE
MODULE PROCEDURE FMRANGE_INTERVAL_FM
END INTERFACE
INTERFACE REAL
MODULE PROCEDURE FMREAL_INTERVAL_FM
END INTERFACE
INTERFACE RRSPACING
MODULE PROCEDURE FMRRSPACING_INTERVAL_FM
END INTERFACE
INTERFACE SCALE
MODULE PROCEDURE FMSCALE_INTERVAL_FM
END INTERFACE
INTERFACE SETEXPONENT
MODULE PROCEDURE FMSETEXPONENT_INTERVAL_FM
END INTERFACE
INTERFACE SIGN
MODULE PROCEDURE FMSIGN_INTERVAL_FM
END INTERFACE
CONTAINS
! **
SUBROUTINE FMPWR_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
INTEGER :: KL,KRSAVE,KWRNSV,NDSAVE
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
IF (FMCOMP(MB%LEFT,'==',MB%RIGHT)) THEN
CALL FMM2I(MB%LEFT,KL)
IF (KFLAG == 0) THEN
CALL FMIPWR_INTERVAL(MA,KL,MC)
GO TO 110
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMST2M('UNKNOWN',MC%LEFT)
CALL FMST2M('UNKNOWN',MC%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) < 0) THEN
CALL FMI2M(0,MVFM)
ELSE
CALL FMEQ(MA%LEFT,MVFM)
ENDIF
IF (MWK(START(MVFM)+3) == 0 .AND. MWK(START(MA%RIGHT)+3) == 0) THEN
IF (MWK(START(MB%RIGHT)) < 0) THEN
CALL FMST2M('-OVERFLOW',MC%LEFT)
CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE IF (MWK(START(MB%LEFT)) > 0) THEN
CALL FMI2M(0,MC%LEFT)
CALL FMI2M(0,MC%RIGHT)
ELSE
CALL FMI2M(0,MC%LEFT)
CALL FMST2M('+OVERFLOW',MC%RIGHT)
ENDIF
GO TO 110
ENDIF
IF (ABS(MWK(START(MA%LEFT)+2)) == MEXPOV .OR. ABS(MWK(START(MA%RIGHT)+2)) == MEXPOV .OR. &
ABS(MWK(START(MB%LEFT)+2)) == MEXPOV .OR. ABS(MWK(START(MB%RIGHT)+2)) == MEXPOV) THEN
NDSAVE = NDIG
NDIG = MAX(NDIG+NGRD52,2)
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL(M9FM_I,LOG(M8FM_I),M7FM_I)
CALL FMEQ_INTERVAL(EXP(M7FM_I),M8FM_I)
KROUND = -1
CALL FMEQU(M8FM_I%LEFT,MC%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMEQU(M8FM_I%RIGHT,MC%RIGHT,NDIG,NDSAVE)
NDIG = NDSAVE
GO TO 110
ENDIF
CALL FMI2M(1,MTFM)
CALL FMI2M(0,MUFM)
IF (FMCOMP(MA%LEFT,'>=',MTFM) .AND. FMCOMP(MB%LEFT,'>=',MUFM)) THEN
KROUND = -1
CALL FMPWR(MA%LEFT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (FMCOMP(MA%LEFT,'>=',MTFM) .AND. FMCOMP(MB%RIGHT,'<',MUFM)) THEN
KROUND = -1
CALL FMPWR(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%LEFT,MB%RIGHT,MC%RIGHT)
ELSE IF (FMCOMP(MA%LEFT,'>=',MTFM)) THEN
KROUND = -1
CALL FMPWR(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (FMCOMP(MA%RIGHT,'<',MTFM) .AND. FMCOMP(MB%LEFT,'>=',MUFM)) THEN
KROUND = -1
CALL FMPWR(MVFM,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%RIGHT,MB%LEFT,MC%RIGHT)
ELSE IF (FMCOMP(MA%RIGHT,'<',MTFM) .AND. FMCOMP(MB%RIGHT,'<',MUFM)) THEN
KROUND = -1
CALL FMPWR(MA%RIGHT,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMPWR(MVFM,MB%LEFT,MC%RIGHT)
IF (MWK(START(MVFM)+3) == 0) CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE IF (FMCOMP(MA%RIGHT,'<',MTFM)) THEN
KROUND = -1
CALL FMPWR(MVFM,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMPWR(MVFM,MB%LEFT,MC%RIGHT)
IF (MWK(START(MVFM)+3) == 0) CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE IF (FMCOMP(MB%LEFT,'>=',MUFM)) THEN
KROUND = -1
CALL FMPWR(MVFM,MB%RIGHT,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%RIGHT,MB%RIGHT,MC%RIGHT)
ELSE IF (FMCOMP(MB%RIGHT,'<',MUFM)) THEN
KROUND = -1
CALL FMPWR(MA%RIGHT,MB%LEFT,MC%LEFT)
KROUND = 2
CALL FMPWR(MVFM,MB%LEFT,MC%RIGHT)
IF (MWK(START(MVFM)+3) == 0) CALL FMST2M('+OVERFLOW',MC%RIGHT)
ELSE
KROUND = -1
CALL FMPWR(MVFM,MB%RIGHT,MTFM)
CALL FMPWR(MA%RIGHT,MB%LEFT,MUFM)
CALL FMMIN(MTFM,MUFM,MC%LEFT)
KROUND = 2
CALL FMPWR(MA%RIGHT,MB%RIGHT,MTFM)
CALL FMPWR(MVFM,MB%LEFT,MUFM)
IF (MWK(START(MVFM)+3) == 0) CALL FMST2M('+OVERFLOW',MUFM)
CALL FMMAX(MTFM,MUFM,MC%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMPWR_INTERVAL
FUNCTION FMPWR_INTERVAL_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMI2M_INTERVAL(IVAL,MTFM_I)
CALL FMPWR_INTERVAL(MTFM_I,MA,FMPWR_INTERVAL_IFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_IFM
FUNCTION FMPWR_INTERVAL_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMPWR_INTERVAL(MTFM_I,MA,FMPWR_INTERVAL_RFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_RFM
FUNCTION FMPWR_INTERVAL_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMPWR_INTERVAL(MTFM_I,MA,FMPWR_INTERVAL_DFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_DFM
SUBROUTINE FMIPWR_INTERVAL(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
INTENT (INOUT) :: MB
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (IVAL > 0) THEN
IF (MOD(IVAL,2) == 1) THEN
KROUND = -1
CALL FMIPWR(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMIPWR(MA%RIGHT,IVAL,MB%RIGHT)
ELSE
CALL FMABS(MA%LEFT,M_1%MFM)
CALL FMABS(MA%RIGHT,M_2%MFM)
CALL FMI2M(0,M_3%MFM)
IF (FMCOMP(M_1%MFM,'<=',M_2%MFM)) THEN
KROUND = -1
IF (FMCOMP(MA%LEFT,'<=',M_3%MFM) .AND. FMCOMP(MA%RIGHT,'>=',M_3%MFM)) THEN
CALL FMI2M(0,MB%LEFT)
ELSE
CALL FMIPWR(MA%LEFT,IVAL,MB%LEFT)
ENDIF
KROUND = 2
CALL FMIPWR(MA%RIGHT,IVAL,MB%RIGHT)
ELSE
KROUND = -1
IF (FMCOMP(MA%LEFT,'<=',M_3%MFM) .AND. FMCOMP(MA%RIGHT,'>=',M_3%MFM)) THEN
CALL FMI2M(0,MB%LEFT)
ELSE
CALL FMIPWR(MA%RIGHT,IVAL,MB%LEFT)
ENDIF
KROUND = 2
CALL FMIPWR(MA%LEFT,IVAL,MB%RIGHT)
ENDIF
ENDIF
ELSE IF (IVAL < 0) THEN
IF (MOD(IVAL,2) /= 0) THEN
CALL FMI2M(0,M_3%MFM)
IF (FMCOMP(MA%LEFT,'<=',M_3%MFM) .AND. FMCOMP(MA%RIGHT,'>=',M_3%MFM)) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
CALL FMST2M('+OVERFLOW',MB%RIGHT)
ELSE
KROUND = -1
CALL FMIPWR(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMIPWR(MA%LEFT,IVAL,MB%RIGHT)
ENDIF
ELSE
CALL FMI2M(0,M_3%MFM)
IF (FMCOMP(MA%LEFT,'<=',M_3%MFM) .AND. FMCOMP(MA%RIGHT,'>=',M_3%MFM)) THEN
CALL FMST2M('0',MB%LEFT)
CALL FMST2M('+OVERFLOW',MB%RIGHT)
ELSE
IF (FMCOMP(MA%LEFT,'<',M_3%MFM)) THEN
KROUND = -1
CALL FMIPWR(MA%LEFT,IVAL,MB%LEFT)
KROUND = 2
CALL FMIPWR(MA%RIGHT,IVAL,MB%RIGHT)
ELSE
KROUND = -1
CALL FMIPWR(MA%RIGHT,IVAL,MB%LEFT)
KROUND = 2
CALL FMIPWR(MA%LEFT,IVAL,MB%RIGHT)
ENDIF
ENDIF
ENDIF
ELSE
CALL FMI2M(0,M_3%MFM)
IF (FMCOMP(MA%LEFT,'<=',M_3%MFM) .AND. FMCOMP(MA%RIGHT,'>=',M_3%MFM)) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
CALL FMST2M('+OVERFLOW',MB%RIGHT)
ELSE
CALL FMI2M(1,MB%LEFT)
CALL FMI2M(1,MB%RIGHT)
ENDIF
ENDIF
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMIPWR_INTERVAL
FUNCTION FMPWR_INTERVAL_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMIPWR_INTERVAL(MA,IVAL,FMPWR_INTERVAL_FMI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMI
FUNCTION FMPWR_INTERVAL_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSP2M_INTERVAL(R,MTFM_I)
CALL FMPWR_INTERVAL(MA,MTFM_I,FMPWR_INTERVAL_FMR)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMR
FUNCTION FMPWR_INTERVAL_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMDP2M_INTERVAL(D,MTFM_I)
CALL FMPWR_INTERVAL(MA,MTFM_I,FMPWR_INTERVAL_FMD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMD
FUNCTION FMPWR_INTERVAL_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMPWR_INTERVAL_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMPWR_INTERVAL(MA,MB,FMPWR_INTERVAL_FMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMFM
FUNCTION FMPWR_INTERVAL_FMFMA(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_FMFMA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMPWR_INTERVAL(MA,TO_FM_INTERVAL(MB),FMPWR_INTERVAL_FMFMA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMFMA
FUNCTION FMPWR_INTERVAL_FMAFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MB,FMPWR_INTERVAL_FMAFM
TYPE (FM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMPWR_INTERVAL(TO_FM_INTERVAL(MA),MB,FMPWR_INTERVAL_FMAFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMAFM
FUNCTION FMPWR_INTERVAL_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPWR_INTERVAL_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MB%MIM,MTFM_I)
CALL FMPWR_INTERVAL(MA,MTFM_I,FMPWR_INTERVAL_FMIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_FMIM
FUNCTION FMPWR_INTERVAL_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM_INTERVAL) :: MB,FMPWR_INTERVAL_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MTFM_I)
CALL FMPWR_INTERVAL(MTFM_I,MB,FMPWR_INTERVAL_IMFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_INTERVAL_IMFM
! ABS
FUNCTION FMABS_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMABS_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMABS_INTERVAL(MA,FMABS_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_INTERVAL_FM
! ACOS
FUNCTION FMACOS_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMACOS_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
CALL FMI2M(-1,MTFM)
CALL FMI2M(1,MUFM)
IF (FMCOMP(MA%RIGHT,'<',MTFM) .OR. FMCOMP(MA%LEFT,'>',MUFM)) THEN
CALL FMST2M('UNKNOWN',FMACOS_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMACOS_INTERVAL_FM%RIGHT)
ELSE
IF (FMCOMP(MA%LEFT,'<',MTFM)) THEN
CALL FMI2M(-1,M_1%MFM)
ELSE
CALL FMEQ(MA%LEFT,M_1%MFM)
ENDIF
IF (FMCOMP(MA%RIGHT,'>',MUFM)) THEN
CALL FMI2M(1,M_2%MFM)
ELSE
CALL FMEQ(MA%RIGHT,M_2%MFM)
ENDIF
KROUND = -1
CALL FMACOS(M_2%MFM,FMACOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMACOS(M_1%MFM,FMACOS_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_INTERVAL_FM
! ACOSH
FUNCTION FMACOSH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMACOSH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (LEFT_ENDPOINT(MA) < 1) THEN
CALL FMST2M('UNKNOWN',FMACOSH_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMACOSH_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FM_INTERVAL_UNDEF_INP(MA)
KROUND = -1
CALL FMACOSH(MA%LEFT,FMACOSH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMACOSH(MA%RIGHT,FMACOSH_INTERVAL_FM%RIGHT)
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_INTERVAL_FM
! AINT
FUNCTION FMAINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMAINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMINT_INTERVAL(MA,FMAINT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_INTERVAL_FM
! ANINT
FUNCTION FMANINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMANINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMNINT_INTERVAL(MA,FMANINT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_INTERVAL_FM
! ASIN
FUNCTION FMASIN_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMASIN_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KROUND = -1
KWRNSV = KWARN
KWARN = 0
CALL FMI2M(-1,MTFM)
CALL FMI2M(1,MUFM)
IF (FMCOMP(MA%RIGHT,'<',MTFM) .OR. FMCOMP(MA%LEFT,'>',MUFM)) THEN
CALL FMST2M('UNKNOWN',FMASIN_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMASIN_INTERVAL_FM%RIGHT)
ELSE
IF (FMCOMP(MA%LEFT,'<',MTFM)) THEN
CALL FMI2M(-1,M_1%MFM)
ELSE
CALL FMEQ(MA%LEFT,M_1%MFM)
ENDIF
IF (FMCOMP(MA%RIGHT,'>',MUFM)) THEN
CALL FMI2M(1,M_2%MFM)
ELSE
CALL FMEQ(MA%RIGHT,M_2%MFM)
ENDIF
KROUND = -1
CALL FMASIN(M_1%MFM,FMASIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMASIN(M_2%MFM,FMASIN_INTERVAL_FM%RIGHT)
IF (KRAD /= 1) THEN
IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
IF (MWK(START(MA%LEFT)) < 0) THEN
CALL FMTINY(M_1%MFM)
CALL FMMPYI_R1(M_1%MFM,-1)
KROUND = -1
CALL FMASIN(M_1%MFM,FMASIN_INTERVAL_FM%LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',FMASIN_INTERVAL_FM%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMST2M('-UNDERFLOW',FMASIN_INTERVAL_FM%RIGHT)
ELSE
CALL FMTINY(M_1%MFM)
KROUND = 2
CALL FMASIN(M_1%MFM,FMASIN_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
ENDIF
ENDIF
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_INTERVAL_FM
! ASINH
FUNCTION FMASINH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMASINH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KROUND = -1
CALL FMASINH(MA%LEFT,FMASINH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMASINH(MA%RIGHT,FMASINH_INTERVAL_FM%RIGHT)
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_INTERVAL_FM
! ATAN
FUNCTION FMATAN_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMATAN_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KROUND = -1
KWRNSV = KWARN
KWARN = 0
CALL FMATAN(MA%LEFT,FMATAN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATAN(MA%RIGHT,FMATAN_INTERVAL_FM%RIGHT)
IF (KRAD /= 1) THEN
IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
IF (MWK(START(MA%LEFT)) < 0) THEN
CALL FMTINY(M_1%MFM)
CALL FMMPYI_R1(M_1%MFM,-1)
KROUND = -1
CALL FMATAN(M_1%MFM,FMATAN_INTERVAL_FM%LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',FMATAN_INTERVAL_FM%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMST2M('-UNDERFLOW',FMATAN_INTERVAL_FM%RIGHT)
ELSE
CALL FMTINY(M_1%MFM)
KROUND = 2
CALL FMATAN(M_1%MFM,FMATAN_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
ENDIF
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_INTERVAL_FM
! ATAN2
FUNCTION FMATAN2_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMATAN2_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV,NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO .OR. &
MWK(START(MB%LEFT)+2) == MUNKNO .OR. MWK(START(MB%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMATAN2_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMATAN2_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MA%RIGHT)+3) == 0) THEN
IF (MWK(START(MB%LEFT)+3) == 0 .AND. MWK(START(MB%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMATAN2_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MB%LEFT)) > 0) THEN
CALL FMI2M(0,FMATAN2_INTERVAL_FM%LEFT)
CALL FMI2M(0,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MB%RIGHT)) < 0) THEN
CALL FMI2M(-1,MUFM)
KROUND = -1
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
ELSE
CALL FMI2M(-1,MUFM)
CALL FMI2M(0,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
IF (MWK(START(MB%LEFT)+3) == 0 .AND. MWK(START(MB%RIGHT)+3) == 0) THEN
IF (MWK(START(MA%LEFT)) > 0) THEN
CALL FMI2M(0,MUFM)
KROUND = -1
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMI2M(0,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%LEFT)
CALL FMMPYI_R1(FMATAN2_INTERVAL_FM%LEFT,-1)
KROUND = -1
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI_R1(FMATAN2_INTERVAL_FM%RIGHT,-1)
ELSE
CALL FMI2M(0,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%RIGHT,-1,FMATAN2_INTERVAL_FM%LEFT)
ENDIF
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MB%LEFT)+3) == 0) THEN
CALL FMI2M(0,FMATAN2_INTERVAL_FM%LEFT)
CALL FMI2M(0,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MB%RIGHT)+3) == 0) THEN
CALL FMI2M(0,MUFM)
KROUND = -1
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%LEFT)
CALL FMI2M(-1,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)+3) == 0 .AND. MWK(START(MB%LEFT)+3) == 0) THEN
CALL FMI2M(0,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%RIGHT,-1,FMATAN2_INTERVAL_FM%LEFT)
CALL FMI2M(0,FMATAN2_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)+3) == 0 .AND. MWK(START(MB%RIGHT)+3) == 0) THEN
CALL FMI2M(-1,MUFM)
KROUND = 2
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%LEFT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%LEFT,-1,FMATAN2_INTERVAL_FM%LEFT)
KROUND = -1
CALL FMI2M(0,MUFM)
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%RIGHT,-1,FMATAN2_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (ABS(MWK(START(MA%LEFT)+2)) == MEXPOV .OR. ABS(MWK(START(MA%RIGHT)+2)) == MEXPOV .OR. &
ABS(MWK(START(MB%LEFT)+2)) == MEXPOV .OR. ABS(MWK(START(MB%RIGHT)+2)) == MEXPOV) THEN
NDSAVE = NDIG
NDIG = MAX(NDIG+NGRD52,2)
IF (MWK(START(MB%LEFT)) > 0) THEN
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMDIV_INTERVAL(M8FM_I,M9FM_I,M7FM_I)
CALL FMEQ_INTERVAL(ATAN(M7FM_I),M8FM_I)
KROUND = -1
CALL FMEQU(M8FM_I%LEFT,FMATAN2_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMEQU(M8FM_I%RIGHT,FMATAN2_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
ELSE IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) > 0) THEN
NDIG = NDSAVE
KROUND = 2
CALL FMI2M(-1,MUFM)
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%RIGHT,-1,FMATAN2_INTERVAL_FM%LEFT)
ELSE IF (MWK(START(MB%RIGHT)) < 0 .AND. MWK(START(MA%RIGHT)) < 0) THEN
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMDIV_INTERVAL(M8FM_I,M9FM_I,M7FM_I)
CALL FMEQ_INTERVAL(ATAN(M7FM_I),M8FM_I)
CALL FMI2M(-1,MUFM)
CALL FMACOS(MUFM,MVFM)
KROUND = -1
CALL FMSUB(M8FM_I%LEFT,MVFM,M9FM_I%LEFT)
CALL FMEQU(M9FM_I%LEFT,FMATAN2_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMSUB(M8FM_I%RIGHT,MVFM,M9FM_I%RIGHT)
CALL FMEQU(M9FM_I%RIGHT,FMATAN2_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
ELSE IF (MWK(START(MB%LEFT)) < 0 .AND. MWK(START(MB%RIGHT)) > 0 .AND. &
MWK(START(MA%RIGHT)) < 0) THEN
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMDIV_INTERVAL(M9FM_I,M8FM_I,M7FM_I)
CALL FMMPYI_INTERVAL(M7FM_I,-1,M9FM_I)
CALL FMEQ_INTERVAL(ATAN(M9FM_I),M8FM_I)
CALL FMI2M(0,MUFM)
CALL FMACOS(MUFM,MVFM)
KROUND = -1
CALL FMSUB(M8FM_I%LEFT,MVFM,M9FM_I%LEFT)
CALL FMEQU(M9FM_I%LEFT,FMATAN2_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMSUB(M8FM_I%RIGHT,MVFM,M9FM_I%RIGHT)
CALL FMEQU(M9FM_I%RIGHT,FMATAN2_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
ELSE IF (MWK(START(MB%RIGHT)) < 0 .AND. MWK(START(MA%LEFT)) > 0) THEN
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMDIV_INTERVAL(M8FM_I,M9FM_I,M7FM_I)
CALL FMEQ_INTERVAL(ATAN(M7FM_I),M8FM_I)
CALL FMI2M(-1,MUFM)
CALL FMACOS(MUFM,MVFM)
KROUND = -1
CALL FMADD(M8FM_I%LEFT,MVFM,M9FM_I%LEFT)
CALL FMEQU(M9FM_I%LEFT,FMATAN2_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMADD(M8FM_I%RIGHT,MVFM,M9FM_I%RIGHT)
CALL FMEQU(M9FM_I%RIGHT,FMATAN2_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
ELSE IF (MWK(START(MB%LEFT)) < 0 .AND. MWK(START(MB%RIGHT)) > 0 .AND. &
MWK(START(MA%LEFT)) > 0) THEN
KROUND = 1
CALL FMEQU_INTERVAL(MA,M8FM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB,M9FM_I,NDSAVE,NDIG)
CALL FMDIV_INTERVAL(M9FM_I,M8FM_I,M7FM_I)
CALL FMMPYI_INTERVAL(M7FM_I,-1,M9FM_I)
CALL FMEQ_INTERVAL(ATAN(M9FM_I),M8FM_I)
CALL FMI2M(0,MUFM)
CALL FMACOS(MUFM,MVFM)
KROUND = -1
CALL FMADD(M8FM_I%LEFT,MVFM,M9FM_I%LEFT)
CALL FMEQU(M9FM_I%LEFT,FMATAN2_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMADD(M8FM_I%RIGHT,MVFM,M9FM_I%RIGHT)
CALL FMEQU(M9FM_I%RIGHT,FMATAN2_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
ENDIF
NDIG = NDSAVE
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
KROUND = -1
CALL FMATN2(MA%LEFT,MB%RIGHT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%RIGHT,MB%LEFT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%RIGHT)) <= 0) THEN
KROUND = -1
CALL FMATN2(MA%RIGHT,MB%RIGHT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%LEFT,MB%LEFT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) <= 0 .AND. MWK(START(MB%RIGHT)) <= 0) THEN
KROUND = -1
CALL FMATN2(MA%RIGHT,MB%LEFT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%LEFT,MB%RIGHT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) <= 0 .AND. MWK(START(MB%LEFT)) >= 0) THEN
KROUND = -1
CALL FMATN2(MA%LEFT,MB%LEFT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%RIGHT,MB%RIGHT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%LEFT)) >= 0 .AND. MWK(START(MB%LEFT)) <= 0 .AND. &
MWK(START(MB%RIGHT)) >= 0) THEN
KROUND = -1
CALL FMATN2(MA%LEFT,MB%RIGHT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%LEFT,MB%LEFT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MB%LEFT)) >= 0 .AND. MWK(START(MA%LEFT)) <= 0 .AND. &
MWK(START(MA%RIGHT)) >= 0) THEN
KROUND = -1
CALL FMATN2(MA%LEFT,MB%LEFT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%RIGHT,MB%LEFT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) <= 0 .AND. MWK(START(MB%LEFT)) <= 0 .AND. &
MWK(START(MB%RIGHT)) >= 0) THEN
KROUND = -1
CALL FMATN2(MA%RIGHT,MB%LEFT,FMATAN2_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATN2(MA%RIGHT,MB%RIGHT,FMATAN2_INTERVAL_FM%RIGHT)
ELSE
KROUND = 2
CALL FMI2M(-1,MUFM)
CALL FMACOS(MUFM,FMATAN2_INTERVAL_FM%RIGHT)
CALL FMMPYI(FMATAN2_INTERVAL_FM%RIGHT,-1,FMATAN2_INTERVAL_FM%LEFT)
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN2_INTERVAL_FM
! ATANH
FUNCTION FMATANH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMATANH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (LEFT_ENDPOINT(MA) <= -1 .OR. RIGHT_ENDPOINT(MA) >= 1) THEN
CALL FMST2M('UNKNOWN',FMATANH_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMATANH_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FM_INTERVAL_UNDEF_INP(MA)
KROUND = -1
CALL FMATANH(MA%LEFT,FMATANH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMATANH(MA%RIGHT,FMATANH_INTERVAL_FM%RIGHT)
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_INTERVAL_FM
! CEILING
FUNCTION FMCEILING_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMCEILING_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
CALL FMINT_INTERVAL(MA,M7FM_I)
CALL FMEQ_INTERVAL(M7FM_I,MTFM_I)
IF (FMCOMP(MA%LEFT,'/=',MTFM_I%LEFT)) THEN
IF (MWK(START(MA%LEFT)) >= 0) THEN
CALL FMADDI(MTFM_I%LEFT,1)
ENDIF
ENDIF
IF (FMCOMP(MA%RIGHT,'/=',MTFM_I%RIGHT)) THEN
IF (MWK(START(MA%RIGHT)) >= 0) THEN
CALL FMADDI(MTFM_I%RIGHT,1)
ENDIF
ENDIF
CALL FMEQ_INTERVAL(MTFM_I,FMCEILING_INTERVAL_FM)
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_INTERVAL_FM
! COS
FUNCTION FMCOS_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMCOS_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMCOS_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMCOS_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+2) == MEXPOV .OR. MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA)) THEN
KROUND = -1
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
IF ( IS_UNKNOWN(LEFT_ENDPOINT(FMCOS_INTERVAL_FM)) ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
IF ( IS_UNKNOWN(RIGHT_ENDPOINT(FMCOS_INTERVAL_FM)) ) THEN
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
CALL FM_EQ( ASIN( TO_FM(1) ) , M_1 )
IF (RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 4.01*M_1) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA) / M_1 ) , M_3 )
IF ( M_3 - M_2 >= 4 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 0 ) THEN
IF ( M_3 - M_2 <= 1 ) THEN
KROUND = -1
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
IF ( RIGHT_ENDPOINT(MA) - M_1*(M_3-1) > M_1*(M_3-1) - LEFT_ENDPOINT(MA) ) THEN
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
ELSE
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 1 ) THEN
IF ( M_3 - M_2 == 0 ) THEN
KROUND = -1
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 1 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
IF ( RIGHT_ENDPOINT(MA) - M_1*M_3 > M_1*M_3 - LEFT_ENDPOINT(MA) ) THEN
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
ELSE
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 2 ) THEN
IF ( M_3 - M_2 <= 1 ) THEN
KROUND = -1
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
KROUND = -1
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
KROUND = -1
IF ( RIGHT_ENDPOINT(MA) - M_1*(M_3-1) > M_1*(M_3-1) - LEFT_ENDPOINT(MA) ) THEN
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%LEFT)
ELSE
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
ENDIF
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 3 ) THEN
IF ( M_3 - M_2 == 0 ) THEN
KROUND = -1
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 1 ) THEN
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
KROUND = -1
IF ( RIGHT_ENDPOINT(MA) - M_1*M_3 > M_1*M_3 - LEFT_ENDPOINT(MA) ) THEN
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%LEFT)
ELSE
CALL FMCOS(MA%LEFT,FMCOS_INTERVAL_FM%LEFT)
ENDIF
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
KROUND = -1
CALL FMCOS(MA%RIGHT,FMCOS_INTERVAL_FM%LEFT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMCOS_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMCOS_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_INTERVAL_FM
! COSH
FUNCTION FMCOSH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMCOSH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMCOSH_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMCOSH_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
KROUND = -1
IF (MWK(START(MA%LEFT)) >= 0) THEN
CALL FMEQ(MA%LEFT,MTFM_I%LEFT)
CALL FMEQ(MA%RIGHT,MTFM_I%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) <= 0) THEN
CALL FMABS(MA%RIGHT,MTFM_I%LEFT)
CALL FMABS(MA%LEFT,MTFM_I%RIGHT)
ELSE
CALL FMI2M(1,FMCOSH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOSH(MA%LEFT,MUFM)
CALL FMCOSH(MA%RIGHT,MVFM)
CALL FMMAX(MUFM,MVFM,FMCOSH_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
KROUND = -1
CALL FMCOSH(MTFM_I%LEFT,FMCOSH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMCOSH(MTFM_I%RIGHT,FMCOSH_INTERVAL_FM%RIGHT)
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_INTERVAL_FM
! DBLE
FUNCTION FMDBLE_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDBLE_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(MA,FMDBLE_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDBLE_INTERVAL_FM
! DIGITS
FUNCTION FMDIGITS_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDIGITS_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(DIGITS(LEFT_ENDPOINT(MA))),FMDIGITS_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIGITS_INTERVAL_FM
! DIM
FUNCTION FMDIM_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMDIM_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMDIM_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMDIM_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMSUB_INTERVAL(MA,MB,MTFM_I)
CALL FMEQ(MTFM_I%LEFT,FMDIM_INTERVAL_FM%LEFT)
CALL FMEQ(MTFM_I%RIGHT,FMDIM_INTERVAL_FM%RIGHT)
IF (MWK(START(MTFM_I%LEFT)) < 0) THEN
CALL FMI2M(0,FMDIM_INTERVAL_FM%LEFT)
ENDIF
IF (MWK(START(MTFM_I%RIGHT)) < 0) THEN
CALL FMI2M(0,FMDIM_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIM_INTERVAL_FM
! DINT
FUNCTION FMDINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMDINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMINT_INTERVAL(MA,FMDINT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDINT_INTERVAL_FM
! DOT_PRODUCT
FUNCTION FMDOTPRODUCT_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),MB(:),FMDOTPRODUCT_INTERVAL_FM
INTEGER :: J,JA,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMDOTPRODUCT_INTERVAL_FM%LEFT = -1
FMDOTPRODUCT_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
CALL FMI2M_INTERVAL(0,M2FM_I)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU_INTERVAL(MA(JA),MUFM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB(JA),MVFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL(MUFM_I,MVFM_I,MTFM_I)
CALL FMADD_INTERVAL_R1(M2FM_I,MTFM_I)
ENDDO
CALL FMEQU_INTERVAL(M2FM_I,FMDOTPRODUCT_INTERVAL_FM,NDIG,NDSAVE)
NDIG = NDSAVE
ELSE
CALL FMI2M_INTERVAL(1,MTFM_I)
CALL FMI2M_INTERVAL(0,MUFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MUFM_I,FMDOTPRODUCT_INTERVAL_FM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDOTPRODUCT_INTERVAL_FM
! EPSILON
FUNCTION FMEPSILON_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMEPSILON_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (DIGITS(MA%LEFT) > -31) CALL FMI2M_INTERVAL(1,MTFM_I)
CALL FMULP_INTERVAL(MTFM_I,FMEPSILON_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEPSILON_INTERVAL_FM
! EXP
FUNCTION FMEXP_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMEXP_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KROUND = -1
CALL FMEXP(MA%LEFT,FMEXP_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEXP(MA%RIGHT,FMEXP_INTERVAL_FM%RIGHT)
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTERVAL_FM
! EXPONENT
FUNCTION FMEXPONENT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMEXPONENT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
IF (MWK(START(MA%LEFT)) >= 0) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(EXPONENT(LEFT_ENDPOINT(MA)), &
EXPONENT(RIGHT_ENDPOINT(MA))),FMEXPONENT_INTERVAL_FM)
ELSE IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(EXPONENT(RIGHT_ENDPOINT(MA)), &
EXPONENT(LEFT_ENDPOINT(MA))),FMEXPONENT_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(MEXPUN),TO_FM( &
MAX(EXPONENT(LEFT_ENDPOINT(MA)),EXPONENT(RIGHT_ENDPOINT(MA))))), &
FMEXPONENT_INTERVAL_FM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXPONENT_INTERVAL_FM
! FLOOR
FUNCTION FMFLOOR_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMFLOOR_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KWRNSV = KWARN
KWARN = 0
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMINT_INTERVAL(MA,M7FM_I)
CALL FMEQ_INTERVAL(M7FM_I,MTFM_I)
IF (FMCOMP(MA%LEFT,'/=',MTFM_I%LEFT)) THEN
IF (MWK(START(MA%LEFT)) < 0) THEN
CALL FMADDI(MTFM_I%LEFT,-1)
ENDIF
ENDIF
IF (FMCOMP(MA%RIGHT,'/=',MTFM_I%RIGHT)) THEN
IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMADDI(MTFM_I%RIGHT,-1)
ENDIF
ENDIF
CALL FMEQ_INTERVAL(MTFM_I,FMFLOOR_INTERVAL_FM)
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_INTERVAL_FM
! FRACTION
FUNCTION FMFRACTION_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMFRACTION_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
IF (IS_UNKNOWN(MA)) THEN
CALL FMST2M(' UNKNOWN ',FMFRACTION_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMFRACTION_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%LEFT)
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%LEFT)+3) == 0) THEN
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%LEFT)
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMEQ(M_1%MFM,FMFRACTION_INTERVAL_FM%RIGHT)
ELSE
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMMPYI(M_1%MFM,-1,FMFRACTION_INTERVAL_FM%LEFT)
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (MWK(START(MA%LEFT)) == MWK(START(MA%RIGHT)) .AND. &
MWK(START(MA%LEFT)+2) == MWK(START(MA%RIGHT)+2)) THEN
CALL FMEQ_INTERVAL(MA,FMFRACTION_INTERVAL_FM)
MWK(START(FMFRACTION_INTERVAL_FM%LEFT)+2) = 0
MWK(START(FMFRACTION_INTERVAL_FM%RIGHT)+2) = 0
ELSE IF (MWK(START(MA%LEFT)) > 0) THEN
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%LEFT)
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMEQ(M_1%MFM,FMFRACTION_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMMPYI(M_1%MFM,-1,FMFRACTION_INTERVAL_FM%LEFT)
CALL FMI2M(0,FMFRACTION_INTERVAL_FM%RIGHT)
ELSE
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMMPYI(M_1%MFM,-1,FMFRACTION_INTERVAL_FM%LEFT)
CALL FM_EQ(FRACTION(HUGE(TO_FM(1))),M_1)
CALL FMEQ(M_1%MFM,FMFRACTION_INTERVAL_FM%RIGHT)
ENDIF
110 KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_INTERVAL_FM
! HUGE
FUNCTION FMHUGE_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMHUGE_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (DIGITS(MA%LEFT) > -31) CALL FMBIG(FMHUGE_INTERVAL_FM%LEFT)
CALL FMEQ(FMHUGE_INTERVAL_FM%LEFT,FMHUGE_INTERVAL_FM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMHUGE_INTERVAL_FM
! INT
FUNCTION FMINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMINT_INTERVAL(MA,FMINT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_INTERVAL_FM
! LOG
FUNCTION FMLOG_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMLOG_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMLOG_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMLOG_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) < 0 .OR. MWK(START(MA%LEFT)+3) == 0) THEN
CALL FMST2M('-OVERFLOW',FMLOG_INTERVAL_FM%LEFT)
ELSE
IF (MWK(START(MA%LEFT)+2) == MEXPOV) THEN
CALL FMBIG(M_12%MFM)
KROUND = -1
CALL FMLN(M_12%MFM,FMLOG_INTERVAL_FM%LEFT)
ELSE IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
CALL FMST2M('-OVERFLOW',FMLOG_INTERVAL_FM%LEFT)
ELSE
KROUND = -1
CALL FMLN(MA%LEFT,FMLOG_INTERVAL_FM%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMST2M('+OVERFLOW',FMLOG_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
CALL FMTINY(M_11%MFM)
CALL FMLN(M_11%MFM,FMLOG_INTERVAL_FM%RIGHT)
ELSE
KROUND = 2
CALL FMLN(MA%RIGHT,FMLOG_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_INTERVAL_FM
! LOG10
FUNCTION FMLOG10_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMLOG10_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMLOG10_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG10_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMLOG10_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG10_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) < 0 .OR. MWK(START(MA%LEFT)+3) == 0) THEN
CALL FMST2M('-OVERFLOW',FMLOG10_INTERVAL_FM%LEFT)
ELSE
IF (MWK(START(MA%LEFT)+2) == MEXPOV) THEN
CALL FMBIG(M_12%MFM)
KROUND = -1
CALL FMLG10(M_12%MFM,FMLOG10_INTERVAL_FM%LEFT)
ELSE IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
CALL FMST2M('-OVERFLOW',FMLOG10_INTERVAL_FM%LEFT)
ELSE
KROUND = -1
CALL FMLG10(MA%LEFT,FMLOG10_INTERVAL_FM%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMST2M('+OVERFLOW',FMLOG10_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
CALL FMTINY(M_11%MFM)
CALL FMLG10(M_11%MFM,FMLOG10_INTERVAL_FM%RIGHT)
ELSE
KROUND = 2
CALL FMLG10(MA%RIGHT,FMLOG10_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_INTERVAL_FM
! MATMUL
FUNCTION FMMATMUL22_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),MB(:,:)
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1),SIZE(MB,DIM=2)) :: FMMATMUL22_INTERVAL_FM
INTEGER :: I,J,K,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL22_INTERVAL_FM%LEFT = -1
FMMATMUL22_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA,DIM=2) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQU_INTERVAL(MA(I,K),MUFM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB(K,J),MVFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL(MUFM_I,MVFM_I,M3FM_I)
CALL FMADD_INTERVAL_R1(MTFM_I,M3FM_I)
ENDDO
CALL FMEQU_INTERVAL(MTFM_I,FMMATMUL22_INTERVAL_FM(I,J),NDIG,NDSAVE)
ENDDO
ENDDO
NDIG = NDSAVE
ELSE
CALL FMI2M_INTERVAL(1,MTFM_I)
CALL FMI2M_INTERVAL(0,MUFM_I)
CALL FMDIV_INTERVAL(MTFM_I,MUFM_I,MVFM_I)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL FMEQ_INTERVAL(MVFM_I,FMMATMUL22_INTERVAL_FM(I,J))
ENDDO
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL22_INTERVAL_FM
FUNCTION FMMATMUL12_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),MB(:,:)
TYPE (FM_INTERVAL), DIMENSION(SIZE(MB,DIM=2)) :: FMMATMUL12_INTERVAL_FM
INTEGER :: J,K,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL12_INTERVAL_FM%LEFT = -1
FMMATMUL12_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
DO J = 1, SIZE(MB,DIM=2)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO K = 1, SIZE(MA,DIM=1)
CALL FMEQU_INTERVAL(MA(K),MUFM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB(K,J),MVFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL(MUFM_I,MVFM_I,M3FM_I)
CALL FMADD_INTERVAL_R1(MTFM_I,M3FM_I)
ENDDO
CALL FMEQU_INTERVAL(MTFM_I,FMMATMUL12_INTERVAL_FM(J),NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL FMST2M_INTERVAL(' UNKNOWN ',MVFM_I)
DO J = 1, SIZE(MB,DIM=2)
CALL FMEQ_INTERVAL(MVFM_I,FMMATMUL12_INTERVAL_FM(J))
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL12_INTERVAL_FM
FUNCTION FMMATMUL21_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),MB(:)
TYPE (FM_INTERVAL), DIMENSION(SIZE(MA,DIM=1)) :: FMMATMUL21_INTERVAL_FM
INTEGER :: J,K,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL21_INTERVAL_FM%LEFT = -1
FMMATMUL21_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (SIZE(MB) == SIZE(MA,DIM=2)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
DO J = 1, SIZE(MA,DIM=1)
CALL FMI2M_INTERVAL(0,MTFM_I)
DO K = 1, SIZE(MB,DIM=1)
CALL FMEQU_INTERVAL(MA(J,K),MUFM_I,NDSAVE,NDIG)
CALL FMEQU_INTERVAL(MB(K),MVFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL(MUFM_I,MVFM_I,M3FM_I)
CALL FMADD_INTERVAL_R1(MTFM_I,M3FM_I)
ENDDO
CALL FMEQU_INTERVAL(MTFM_I,FMMATMUL21_INTERVAL_FM(J),NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL FMST2M_INTERVAL(' UNKNOWN ',MVFM_I)
DO J = 1, SIZE(MA,DIM=1)
CALL FMEQ_INTERVAL(MVFM_I,FMMATMUL21_INTERVAL_FM(J))
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL21_INTERVAL_FM
! MAX
SUBROUTINE FMMAX_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMMAX(MA%LEFT,MB%LEFT,MC%LEFT)
CALL FMMAX(MA%RIGHT,MB%RIGHT,MC%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMAX_INTERVAL
FUNCTION FMMAX_INTERVAL_FM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMMAX_INTERVAL_FM
TYPE (FM_INTERVAL), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMMAX_INTERVAL(MA,MB,MTFM_I)
IF (PRESENT(MC)) THEN
CALL FM_INTERVAL_UNDEF_INP(MC)
CALL FMMAX_INTERVAL(MTFM_I,MC,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_INTERVAL_UNDEF_INP(MD)
CALL FMMAX_INTERVAL(MTFM_I,MD,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_INTERVAL_UNDEF_INP(ME)
CALL FMMAX_INTERVAL(MTFM_I,ME,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_INTERVAL_UNDEF_INP(MF)
CALL FMMAX_INTERVAL(MTFM_I,MF,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_INTERVAL_UNDEF_INP(MG)
CALL FMMAX_INTERVAL(MTFM_I,MG,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_INTERVAL_UNDEF_INP(MH)
CALL FMMAX_INTERVAL(MTFM_I,MH,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_INTERVAL_UNDEF_INP(MI)
CALL FMMAX_INTERVAL(MTFM_I,MI,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_INTERVAL_UNDEF_INP(MJ)
CALL FMMAX_INTERVAL(MTFM_I,MJ,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
CALL FMEQ_INTERVAL(MTFM_I,FMMAX_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAX_INTERVAL_FM
! MAXEXPONENT
FUNCTION FMMAXEXPONENT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMAXEXPONENT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MAXEXPONENT(LEFT_ENDPOINT(MA))),FMMAXEXPONENT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXEXPONENT_INTERVAL_FM
! MAXVAL
FUNCTION FMMAXVAL1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),FMMAXVAL1_INTERVAL_FM
INTEGER :: J,JA
INTENT (IN) :: MA
FMMAXVAL1_INTERVAL_FM%LEFT = -1
FMMAXVAL1_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMST2M_INTERVAL(' -OVERFLOW ',M2FM_I)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMMAX_INTERVAL(M2FM_I,MA(JA),M2FM_I)
ENDDO
CALL FMEQ_INTERVAL(M2FM_I,FMMAXVAL1_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL1_INTERVAL_FM
FUNCTION FMMAXVAL2_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),FMMAXVAL2_INTERVAL_FM
INTEGER :: J,K,JA,JB
INTENT (IN) :: MA
FMMAXVAL2_INTERVAL_FM%LEFT = -1
FMMAXVAL2_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMST2M_INTERVAL(' -OVERFLOW ',M2FM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMMAX_INTERVAL(M2FM_I,MA(JA,JB),M2FM_I)
ENDDO
ENDDO
CALL FMEQ_INTERVAL(M2FM_I,FMMAXVAL2_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL2_INTERVAL_FM
! MIN
SUBROUTINE FMMIN_INTERVAL(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMMIN(MA%LEFT,MB%LEFT,MC%LEFT)
CALL FMMIN(MA%RIGHT,MB%RIGHT,MC%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMMIN_INTERVAL
FUNCTION FMMIN_INTERVAL_FM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMMIN_INTERVAL_FM
TYPE (FM_INTERVAL), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMMIN_INTERVAL(MA,MB,MTFM_I)
IF (PRESENT(MC)) THEN
CALL FM_INTERVAL_UNDEF_INP(MC)
CALL FMMIN_INTERVAL(MTFM_I,MC,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_INTERVAL_UNDEF_INP(MD)
CALL FMMIN_INTERVAL(MTFM_I,MD,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_INTERVAL_UNDEF_INP(ME)
CALL FMMIN_INTERVAL(MTFM_I,ME,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_INTERVAL_UNDEF_INP(MF)
CALL FMMIN_INTERVAL(MTFM_I,MF,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_INTERVAL_UNDEF_INP(MG)
CALL FMMIN_INTERVAL(MTFM_I,MG,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_INTERVAL_UNDEF_INP(MH)
CALL FMMIN_INTERVAL(MTFM_I,MH,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_INTERVAL_UNDEF_INP(MI)
CALL FMMIN_INTERVAL(MTFM_I,MI,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_INTERVAL_UNDEF_INP(MJ)
CALL FMMIN_INTERVAL(MTFM_I,MJ,MUFM_I)
CALL FMEQ_INTERVAL(MUFM_I,MTFM_I)
ENDIF
CALL FMEQ_INTERVAL(MTFM_I,FMMIN_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMIN_INTERVAL_FM
! MINEXPONENT
FUNCTION FMMINEXPONENT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMMINEXPONENT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MINEXPONENT(LEFT_ENDPOINT(MA))),FMMINEXPONENT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINEXPONENT_INTERVAL_FM
! MINVAL
FUNCTION FMMINVAL1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),FMMINVAL1_INTERVAL_FM
INTEGER :: J,JA
INTENT (IN) :: MA
FMMINVAL1_INTERVAL_FM%LEFT = -1
FMMINVAL1_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMST2M_INTERVAL(' OVERFLOW ',M2FM_I)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMMIN_INTERVAL(M2FM_I,MA(JA),M2FM_I)
ENDDO
CALL FMEQ_INTERVAL(M2FM_I,FMMINVAL1_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL1_INTERVAL_FM
FUNCTION FMMINVAL2_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),FMMINVAL2_INTERVAL_FM
INTEGER :: J,K,JA,JB
INTENT (IN) :: MA
FMMINVAL2_INTERVAL_FM%LEFT = -1
FMMINVAL2_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMST2M_INTERVAL(' OVERFLOW ',M2FM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMMIN_INTERVAL(M2FM_I,MA(JA,JB),M2FM_I)
ENDDO
ENDDO
CALL FMEQ_INTERVAL(M2FM_I,FMMINVAL2_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL2_INTERVAL_FM
! MOD
FUNCTION FMMOD_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMMOD_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
IF (IS_UNKNOWN(MA) .OR. IS_UNKNOWN(MB)) THEN
CALL FMST2M(' UNKNOWN ',FMMOD_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMMOD_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MB%LEFT,'<=',M_2%MFM) .AND. FMCOMP(MB%RIGHT,'>=',M_2%MFM)) THEN
CALL FMST2M(' UNKNOWN ',FMMOD_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMMOD_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) == RIGHT_ENDPOINT(MA) .AND. &
LEFT_ENDPOINT(MB) == RIGHT_ENDPOINT(MB)) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MOD(LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB))), &
FMMOD_INTERVAL_FM)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) >= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,FMMOD_INTERVAL_FM)
ELSE IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M4FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M4FM_I,FMMOD_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M1FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M2FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(-RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I)), &
FMMOD_INTERVAL_FM)
ENDIF
110 KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMOD_INTERVAL_FM
SUBROUTINE FMMOD_INTERVAL_POS(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
IF (RIGHT_ENDPOINT(MA) <= LEFT_ENDPOINT(MB)) THEN
CALL FMEQ_INTERVAL(MA,MC)
RETURN
ENDIF
CALL FMDIV_INTERVAL(MA,MB,MC)
IF (AINT(RIGHT_ENDPOINT(MC)) < LEFT_ENDPOINT(MC)) THEN
CALL FM_EQ(MOD(LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),M_1)
CALL FM_EQ(MOD(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),M_2)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(M_1,M_2),MC)
ELSE
CALL FM_I2M(0,M_1)
IF (AINT(RIGHT_ENDPOINT(MC)) /= 0) THEN
CALL FM_DIV(RIGHT_ENDPOINT(MA),AINT(RIGHT_ENDPOINT(MC)),M_3)
CALL FM_MIN(RIGHT_ENDPOINT(MB),M_3,M_2)
ELSE
CALL FM_EQ(RIGHT_ENDPOINT(MB),M_2)
ENDIF
IF (CEILING(LEFT_ENDPOINT(MC)) /= 0) THEN
CALL FM_DIV(RIGHT_ENDPOINT(MA),CEILING(LEFT_ENDPOINT(MC)),M_3)
IF (M_3 >= LEFT_ENDPOINT(MB) .AND. M_3 <= RIGHT_ENDPOINT(MB)) CALL FM_EQ(M_3,M_2)
ENDIF
IF (AINT(RIGHT_ENDPOINT(MA)/RIGHT_ENDPOINT(MB))*RIGHT_ENDPOINT(MB) >= &
LEFT_ENDPOINT(MA)) CALL FM_EQ(RIGHT_ENDPOINT(MB),M_2)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(M_1,M_2),MC)
ENDIF
END SUBROUTINE FMMOD_INTERVAL_POS
! MODULO
FUNCTION FMMODULO_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMMODULO_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
IF (IS_UNKNOWN(MA) .OR. IS_UNKNOWN(MB)) THEN
CALL FMST2M(' UNKNOWN ',FMMODULO_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMMODULO_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MB%LEFT,'<=',M_2%MFM) .AND. FMCOMP(MB%RIGHT,'>=',M_2%MFM)) THEN
CALL FMST2M(' UNKNOWN ',FMMODULO_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMMODULO_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) >= 0) THEN
IF (LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,FMMODULO_INTERVAL_FM)
ELSE
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMADD_INTERVAL(M5FM_I,MB,MUFM_I)
IF (FMCOMP(MUFM_I%LEFT,'<',MB%LEFT)) CALL FMEQ(MB%LEFT,MUFM_I%LEFT)
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MUFM_I%RIGHT,'>',M_2%MFM)) CALL FMI2M(0,MUFM_I%RIGHT)
CALL FMEQ_INTERVAL(MUFM_I,FMMODULO_INTERVAL_FM)
ENDIF
ELSE IF (RIGHT_ENDPOINT(MA) < 0) THEN
IF (LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMSUB_INTERVAL(MB,M5FM_I,MUFM_I)
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MUFM_I%LEFT,'<',M_2%MFM)) CALL FMI2M(0,MUFM_I%LEFT)
IF (FMCOMP(MUFM_I%RIGHT,'>',MB%RIGHT)) CALL FMEQ(MB%RIGHT,MUFM_I%RIGHT)
CALL FMEQ_INTERVAL(MUFM_I,FMMODULO_INTERVAL_FM)
ELSE
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,FMMODULO_INTERVAL_FM)
ENDIF
ELSE
IF (LEFT_ENDPOINT(MB) >= 0) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMSUB_INTERVAL(MB,M5FM_I,MUFM_I)
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MUFM_I%LEFT,'<',M_2%MFM)) CALL FMI2M(0,MUFM_I%LEFT)
IF (FMCOMP(MUFM_I%RIGHT,'>',MB%RIGHT)) CALL FMEQ(MB%RIGHT,MUFM_I%RIGHT)
CALL FMEQ_INTERVAL(MUFM_I,M1FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M2FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I)), &
MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I))), &
FMMODULO_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,M1FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMABS_INTERVAL(MB,M7FM_I)
CALL FMMOD_INTERVAL_POS(M6FM_I,M7FM_I,M5FM_I)
CALL FMADD_INTERVAL(M5FM_I,MB,MUFM_I)
IF (FMCOMP(MUFM_I%LEFT,'<',MB%LEFT)) CALL FMEQ(MB%LEFT,MUFM_I%LEFT)
CALL FMI2M(0,M_2%MFM)
IF (FMCOMP(MUFM_I%RIGHT,'>',M_2%MFM)) CALL FMI2M(0,MUFM_I%RIGHT)
CALL FMEQ_INTERVAL(MUFM_I,M2FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I)), &
MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I))), &
FMMODULO_INTERVAL_FM)
ENDIF
ENDIF
110 KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMODULO_INTERVAL_FM
! NEAREST
FUNCTION FMNEAREST_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMNEAREST_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%RIGHT)+2) == MEXPOV .AND. MWK(START(MA%RIGHT)) < 0 .AND. &
MWK(START(MB%LEFT)) > 0) THEN
CALL FMST2M(' -OVERFLOW ',FMNEAREST_INTERVAL_FM%LEFT)
CALL FMBIG(FMNEAREST_INTERVAL_FM%RIGHT)
CALL FMMPYI_R1(FMNEAREST_INTERVAL_FM%RIGHT,-1)
ELSE IF (MWK(START(MA%LEFT)+2) == MEXPOV .AND. MWK(START(MA%LEFT)) > 0 .AND. &
MWK(START(MB%RIGHT)) < 0) THEN
CALL FMBIG(FMNEAREST_INTERVAL_FM%LEFT)
CALL FMST2M(' +OVERFLOW ',FMNEAREST_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MB) <= 0 .AND. RIGHT_ENDPOINT(MB) >= 0) THEN
CALL FM_EQ(NEAREST(LEFT_ENDPOINT(MA),TO_FM(-1)),M_1)
CALL FM_EQ(NEAREST(RIGHT_ENDPOINT(MA),TO_FM(1)),M_2)
CALL FMEQ_INTERVAL( TO_FM_INTERVAL( M_1 , M_2 ) , FMNEAREST_INTERVAL_FM )
ELSE IF (RIGHT_ENDPOINT(MB) < 0) THEN
CALL FM_EQ(NEAREST(LEFT_ENDPOINT(MA),TO_FM(-1)),M_1)
CALL FM_EQ(NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)),M_2)
CALL FMEQ_INTERVAL( TO_FM_INTERVAL( M_1 , M_2 ) , FMNEAREST_INTERVAL_FM )
ELSE
CALL FM_EQ(NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)),M_1)
CALL FM_EQ(NEAREST(RIGHT_ENDPOINT(MA),TO_FM(1)),M_2)
CALL FMEQ_INTERVAL( TO_FM_INTERVAL( M_1 , M_2 ) , FMNEAREST_INTERVAL_FM )
ENDIF
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNEAREST_INTERVAL_FM
! NINT
SUBROUTINE FMNINT_INTERVAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMNINT(MA%LEFT,MB%LEFT)
CALL FMNINT(MA%RIGHT,MB%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMNINT_INTERVAL
FUNCTION FMNINT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMNINT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMNINT_INTERVAL(MA,FMNINT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_INTERVAL_FM
! PRECISION
FUNCTION FMPRECISION_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPRECISION_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(PRECISION(LEFT_ENDPOINT(MA))),FMPRECISION_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRECISION_INTERVAL_FM
! PRODUCT
FUNCTION FMPRODUCT1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),FMPRODUCT1_INTERVAL_FM
INTEGER :: J,JA,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT1_INTERVAL_FM%LEFT = -1
FMPRODUCT1_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
CALL FMI2M_INTERVAL(1,M2FM_I)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU_INTERVAL(MA(JA),MUFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL_R1(M2FM_I,MUFM_I)
ENDDO
CALL FMEQU_INTERVAL(M2FM_I,FMPRODUCT1_INTERVAL_FM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT1_INTERVAL_FM
FUNCTION FMPRODUCT2_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),FMPRODUCT2_INTERVAL_FM
INTEGER :: J,K,JA,JB,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT2_INTERVAL_FM%LEFT = -1
FMPRODUCT2_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
CALL FMI2M_INTERVAL(1,M2FM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMEQU_INTERVAL(MA(JA,JB),MUFM_I,NDSAVE,NDIG)
CALL FMMPY_INTERVAL_R1(M2FM_I,MUFM_I)
ENDDO
ENDDO
CALL FMEQU_INTERVAL(M2FM_I,FMPRODUCT2_INTERVAL_FM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT2_INTERVAL_FM
! RADIX
FUNCTION FMRADIX_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMRADIX_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(RADIX(LEFT_ENDPOINT(MA))),FMRADIX_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRADIX_INTERVAL_FM
! RANGE
FUNCTION FMRANGE_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMRANGE_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(RANGE(LEFT_ENDPOINT(MA))),FMRANGE_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRANGE_INTERVAL_FM
! REAL
FUNCTION FMREAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMREAL_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(MA,FMREAL_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMREAL_INTERVAL_FM
! RRSPACING
FUNCTION FMRRSPACING_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMRRSPACING_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: ND
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMABS_INTERVAL(MA,MTFM_I)
IF (LEFT_ENDPOINT(MTFM_I) == 0 .OR. &
MWK(START(MTFM_I%LEFT)+2) /= MWK(START(MTFM_I%RIGHT)+2)) THEN
ND = NDIG
CALL FM_EQ(TO_FM(MBASE)**(ND-1),M_1)
CALL FM_EQ(NEAREST(TO_FM(MBASE)**ND,TO_FM(-1)),M_2)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(M_1,M_2),FMRRSPACING_INTERVAL_FM)
ELSE
MWK(START(MTFM_I%LEFT)+2) = NDIG
MWK(START(MTFM_I%RIGHT)+2) = NDIG
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(MTFM_I),FMRRSPACING_INTERVAL_FM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRRSPACING_INTERVAL_FM
! SCALE
FUNCTION FMSCALE_INTERVAL_FM(MA,L)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSCALE_INTERVAL_FM
INTEGER :: L
INTENT (IN) :: MA,L
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(MA,MTFM_I)
IF (ABS(MWK(START(MTFM_I%RIGHT)+2)+L) < MXEXP) THEN
MWK(START(MTFM_I%LEFT)+2) = MWK(START(MTFM_I%LEFT)+2) + L
MWK(START(MTFM_I%RIGHT)+2) = MWK(START(MTFM_I%RIGHT)+2) + L
CALL FMEQ_INTERVAL(MTFM_I,FMSCALE_INTERVAL_FM)
ELSE
CALL FMI2M_INTERVAL(INT(MBASE),MUFM_I)
CALL FMIPWR_INTERVAL(MUFM_I,L,MVFM_I)
CALL FMMPY_INTERVAL(MA,MVFM_I,M2FM_I)
CALL FMEQ_INTERVAL(M2FM_I,FMSCALE_INTERVAL_FM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSCALE_INTERVAL_FM
! SETEXPONENT
FUNCTION FMSETEXPONENT_INTERVAL_FM(MA,L)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSETEXPONENT_INTERVAL_FM
INTEGER :: L
INTENT (IN) :: MA,L
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(MA,MTFM_I)
IF (MWK(START(MA%LEFT)) <= 0 .AND. MWK(START(MA%RIGHT)) >= 0) THEN
CALL FMST2M('UNKNOWN',FMSETEXPONENT_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMSETEXPONENT_INTERVAL_FM%RIGHT)
ELSE IF (MWK(START(MTFM_I%LEFT)+2) == MWK(START(MTFM_I%RIGHT)+2)) THEN
MWK(START(MTFM_I%LEFT)+2) = L
MWK(START(MTFM_I%RIGHT)+2) = L
CALL FMMIN(MTFM_I%LEFT,MTFM_I%RIGHT,FMSETEXPONENT_INTERVAL_FM%LEFT)
CALL FMMAX(MTFM_I%LEFT,MTFM_I%RIGHT,FMSETEXPONENT_INTERVAL_FM%RIGHT)
ELSE
CALL FMI2M_INTERVAL(1,FMSETEXPONENT_INTERVAL_FM)
MWK(START(FMSETEXPONENT_INTERVAL_FM%LEFT)+2) = L
MWK(START(FMSETEXPONENT_INTERVAL_FM%RIGHT)+2) = L + 1
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSETEXPONENT_INTERVAL_FM
! SIGN
FUNCTION FMSIGN_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMSIGN_INTERVAL_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
IF (MWK(START(MB%LEFT)) >= 0) THEN
CALL FMABS_INTERVAL(MA,FMSIGN_INTERVAL_FM)
ELSE IF (MWK(START(MB%RIGHT)) < 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMMPYI_INTERVAL(M6FM_I,-1,FMSIGN_INTERVAL_FM)
ELSE
CALL FMMPY_INTERVAL(MA,TO_FM_INTERVAL( '-1' , '1' ),FMSIGN_INTERVAL_FM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIGN_INTERVAL_FM
END MODULE FM_INTERVAL_ARITHMETIC_8
MODULE FM_INTERVAL_ARITHMETIC_9
USE FM_INTERVAL_ARITHMETIC_1
INTERFACE SIN
MODULE PROCEDURE FMSIN_INTERVAL_FM
END INTERFACE
INTERFACE SINH
MODULE PROCEDURE FMSINH_INTERVAL_FM
END INTERFACE
INTERFACE SPACING
MODULE PROCEDURE FMSPACING_INTERVAL_FM
END INTERFACE
INTERFACE SQRT
MODULE PROCEDURE FMSQRT_INTERVAL_FM
END INTERFACE
INTERFACE SUM
MODULE PROCEDURE FMSUM1_INTERVAL_FM
MODULE PROCEDURE FMSUM2_INTERVAL_FM
END INTERFACE
INTERFACE TAN
MODULE PROCEDURE FMTAN_INTERVAL_FM
END INTERFACE
INTERFACE TANH
MODULE PROCEDURE FMTANH_INTERVAL_FM
END INTERFACE
INTERFACE TINY
MODULE PROCEDURE FMTINY_INTERVAL_FM
END INTERFACE
INTERFACE BETA
MODULE PROCEDURE FMBETA_INTERVAL_FM
END INTERFACE
INTERFACE BINOMIAL
MODULE PROCEDURE FMBINOMIAL_INTERVAL_FM
END INTERFACE
INTERFACE FACTORIAL
MODULE PROCEDURE FMFACTORIAL_INTERVAL_FM
END INTERFACE
INTERFACE GAMMA
MODULE PROCEDURE FMGAMMA_INTERVAL_FM
END INTERFACE
INTERFACE INCOMPLETE_BETA
MODULE PROCEDURE FMINCOMPLETE_BETA_INTERVAL_FM
END INTERFACE
INTERFACE INCOMPLETE_GAMMA1
MODULE PROCEDURE FMINCOMPLETE_GAMMA1_INTERVAL_FM
END INTERFACE
INTERFACE INCOMPLETE_GAMMA2
MODULE PROCEDURE FMINCOMPLETE_GAMMA2_INTERVAL_FM
END INTERFACE
INTERFACE LOG_GAMMA
MODULE PROCEDURE FMLOG_GAMMA_INTERVAL_FM
END INTERFACE
INTERFACE POLYGAMMA
MODULE PROCEDURE FMPOLYGAMMA_INTERVAL_FM
END INTERFACE
INTERFACE POCHHAMMER
MODULE PROCEDURE FMPOCHHAMMER_INTERVAL_FM
END INTERFACE
INTERFACE PSI
MODULE PROCEDURE FMPSI_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_J
MODULE PROCEDURE FMBESSEL_J_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_J0
MODULE PROCEDURE FMBESSEL_J0_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_J1
MODULE PROCEDURE FMBESSEL_J1_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_JN
MODULE PROCEDURE FMBESSEL_JN_INTERVAL_FM1
MODULE PROCEDURE FMBESSEL_JN_INTERVAL_FM2
END INTERFACE
INTERFACE BESSEL_Y
MODULE PROCEDURE FMBESSEL_Y_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_Y0
MODULE PROCEDURE FMBESSEL_Y0_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_Y1
MODULE PROCEDURE FMBESSEL_Y1_INTERVAL_FM
END INTERFACE
INTERFACE BESSEL_YN
MODULE PROCEDURE FMBESSEL_YN_INTERVAL_FM1
MODULE PROCEDURE FMBESSEL_YN_INTERVAL_FM2
END INTERFACE
INTERFACE COS_INTEGRAL
MODULE PROCEDURE FMCOS_INTEGRAL_INTERVAL_FM
END INTERFACE
INTERFACE COSH_INTEGRAL
MODULE PROCEDURE FMCOSH_INTEGRAL_INTERVAL_FM
END INTERFACE
INTERFACE EXP_INTEGRAL_EI
MODULE PROCEDURE FMEXP_INTEGRAL_EI_INTERVAL_FM
END INTERFACE
INTERFACE EXP_INTEGRAL_EN
MODULE PROCEDURE FMEXP_INTEGRAL_EN_INTERVAL_FM
END INTERFACE
INTERFACE FRESNEL_C
MODULE PROCEDURE FMFRESNEL_C_INTERVAL_FM
END INTERFACE
INTERFACE FRESNEL_S
MODULE PROCEDURE FMFRESNEL_S_INTERVAL_FM
END INTERFACE
INTERFACE ERF
MODULE PROCEDURE FMERF_INTERVAL_FM
END INTERFACE
INTERFACE ERFC
MODULE PROCEDURE FMERFC_INTERVAL_FM
END INTERFACE
INTERFACE LOG_ERFC
MODULE PROCEDURE FMLOG_ERFC_INTERVAL_FM
END INTERFACE
INTERFACE LOG_INTEGRAL
MODULE PROCEDURE FMLOG_INTEGRAL_INTERVAL_FM
END INTERFACE
INTERFACE SIN_INTEGRAL
MODULE PROCEDURE FMSIN_INTEGRAL_INTERVAL_FM
END INTERFACE
INTERFACE SINH_INTEGRAL
MODULE PROCEDURE FMSINH_INTEGRAL_INTERVAL_FM
END INTERFACE
CONTAINS
! SIN
FUNCTION FMSIN_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSIN_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMSIN_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMSIN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+2) == MEXPOV .OR. MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA)) THEN
KROUND = -1
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
IF ( IS_UNKNOWN(LEFT_ENDPOINT(FMSIN_INTERVAL_FM)) ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
IF ( IS_UNKNOWN(RIGHT_ENDPOINT(FMSIN_INTERVAL_FM)) ) THEN
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
CALL FM_EQ( ASIN( TO_FM(1) ) , M_1 )
IF (RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 4.01*M_1) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA) / M_1 ) , M_3 )
IF ( M_3 - M_2 >= 4 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 0 ) THEN
IF ( M_3 - M_2 == 0 ) THEN
KROUND = -1
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 1 ) THEN
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
KROUND = -1
IF ( RIGHT_ENDPOINT(MA) - M_1*M_3 > M_1*M_3 - LEFT_ENDPOINT(MA) ) THEN
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%LEFT)
ELSE
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
ENDIF
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
KROUND = -1
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%LEFT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 1 ) THEN
IF ( M_3 - M_2 <= 1 ) THEN
KROUND = -1
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
IF ( RIGHT_ENDPOINT(MA) - M_1*(M_3-1) > M_1*(M_3-1) - LEFT_ENDPOINT(MA) ) THEN
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
ELSE
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 2 ) THEN
IF ( M_3 - M_2 == 0 ) THEN
KROUND = -1
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 1 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
IF ( RIGHT_ENDPOINT(MA) - M_1*M_3 > M_1*M_3 - LEFT_ENDPOINT(MA) ) THEN
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
ELSE
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(-1,FMSIN_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF ( MODULO( M_2 , TO_FM(4) ) == 3 ) THEN
IF ( M_3 - M_2 <= 1 ) THEN
KROUND = -1
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%RIGHT)
ELSE IF ( M_3 - M_2 == 2 ) THEN
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
KROUND = -1
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
ELSE IF ( M_3 - M_2 == 3 ) THEN
CALL FMI2M(1,FMSIN_INTERVAL_FM%RIGHT)
KROUND = -1
IF ( RIGHT_ENDPOINT(MA) - M_1*(M_3-1) > M_1*(M_3-1) - LEFT_ENDPOINT(MA) ) THEN
CALL FMSIN(MA%RIGHT,FMSIN_INTERVAL_FM%LEFT)
ELSE
CALL FMSIN(MA%LEFT,FMSIN_INTERVAL_FM%LEFT)
ENDIF
ENDIF
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_INTERVAL_FM
! SINH
FUNCTION FMSINH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSINH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
KROUND = -1
CALL FMSINH(MA%LEFT,FMSINH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSINH(MA%RIGHT,FMSINH_INTERVAL_FM%RIGHT)
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_INTERVAL_FM
! SPACING
FUNCTION FMSPACING_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSPACING_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMABS_INTERVAL(MA,MTFM_I)
CALL FM_EQ(SPACING(LEFT_ENDPOINT(MTFM_I)),M_1)
CALL FMEQ(M_1%MFM,FMSPACING_INTERVAL_FM%LEFT)
CALL FM_EQ(SPACING(RIGHT_ENDPOINT(MTFM_I)),M_1)
CALL FMEQ(M_1%MFM,FMSPACING_INTERVAL_FM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSPACING_INTERVAL_FM
! SQRT
FUNCTION FMSQRT_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSQRT_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMSQRT_INTERVAL(MA,FMSQRT_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_INTERVAL_FM
! SUM
FUNCTION FMSUM1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:),FMSUM1_INTERVAL_FM
INTEGER :: J,JA,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM1_INTERVAL_FM%LEFT = -1
FMSUM1_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
CALL FMI2M_INTERVAL(0,M2FM_I)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU_INTERVAL(MA(JA),MUFM_I,NDSAVE,NDIG)
CALL FMADD_INTERVAL_R1(M2FM_I,MUFM_I)
ENDDO
CALL FMEQU_INTERVAL(M2FM_I,FMSUM1_INTERVAL_FM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM1_INTERVAL_FM
FUNCTION FMSUM2_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA(:,:),FMSUM2_INTERVAL_FM
INTEGER :: J,K,JA,JB,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM2_INTERVAL_FM%LEFT = -1
FMSUM2_INTERVAL_FM%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
CALL FMI2M_INTERVAL(0,M2FM_I)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMEQU_INTERVAL(MA(JA,JB),MUFM_I,NDSAVE,NDIG)
CALL FMADD_INTERVAL_R1(M2FM_I,MUFM_I)
ENDDO
ENDDO
CALL FMEQU_INTERVAL(M2FM_I,FMSUM2_INTERVAL_FM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM2_INTERVAL_FM
! TAN
FUNCTION FMTAN_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMTAN_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMTAN_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMTAN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA)) THEN
KROUND = -1
CALL FMTAN(MA%LEFT,FMTAN_INTERVAL_FM%LEFT)
IF ( IS_UNKNOWN(LEFT_ENDPOINT(FMTAN_INTERVAL_FM)) ) THEN
CALL FMST2M('-OVERFLOW',FMTAN_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
CALL FMTAN(MA%RIGHT,FMTAN_INTERVAL_FM%RIGHT)
IF ( IS_UNKNOWN(RIGHT_ENDPOINT(FMTAN_INTERVAL_FM)) ) THEN
CALL FMST2M(' OVERFLOW',FMTAN_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
CALL FM_EQ( ASIN( TO_FM(1) ) , M_1 )
IF (RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 2.01*M_1) THEN
CALL FMST2M('-OVERFLOW',FMTAN_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMTAN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMEQ(MA%RIGHT,M_2%MFM)
CALL FM_EQ(FLOOR((M_2/M_1 - 1)/2),M_2)
CALL FM_EQ((2*M_2 + 1)*M_1,M_2)
IF (FMCOMP(MA%LEFT,'>=',M_2%MFM)) THEN
KROUND = -1
CALL FMTAN(MA%LEFT,FMTAN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMTAN(MA%RIGHT,FMTAN_INTERVAL_FM%RIGHT)
ELSE
CALL FMST2M('-OVERFLOW',FMTAN_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMTAN_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_INTERVAL_FM
! TANH
FUNCTION FMTANH_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMTANH_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
KROUND = -1
CALL FMTANH(MA%LEFT,FMTANH_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMTANH(MA%RIGHT,FMTANH_INTERVAL_FM%RIGHT)
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_INTERVAL_FM
! TINY
FUNCTION FMTINY_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMTINY_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (DIGITS(MA%LEFT) > -31) CALL FMTINY(FMTINY_INTERVAL_FM%LEFT)
CALL FMEQ(FMTINY_INTERVAL_FM%LEFT,FMTINY_INTERVAL_FM%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTINY_INTERVAL_FM
! BETA
FUNCTION FMBETA_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMBETA_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
ROUTINE_PREV = 0
KROUND_PREV = -4
NUM_PREV = 0
IF (LEFT_ENDPOINT(MA) <= 0) THEN
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
ENDIF
IF (LEFT_ENDPOINT(MB) <= 0) THEN
IF (IS_OVERFLOW(LEFT_ENDPOINT(MB))) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MB)),M_1)
IF (M_1 >= LEFT_ENDPOINT(MB)) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
ENDIF
K_ROUTINE_EDGE = 1
KROUND = -1
CALL FMEDGE_INTERVAL_FM(MA,MB,F_LEFT%MFM,M_6%MFM)
KROUND = 2
CALL FMEDGE_INTERVAL_FM(MA,MB,M_6%MFM,F_RIGHT%MFM)
110 IF (IS_UNKNOWN(F_LEFT) .OR. IS_UNKNOWN(F_RIGHT)) THEN
CALL FMST2M('-OVERFLOW',FMBETA_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMBETA_INTERVAL_FM%RIGHT)
ELSE
CALL FMEQ(F_LEFT%MFM,FMBETA_INTERVAL_FM%LEFT)
CALL FMEQ(F_RIGHT%MFM,FMBETA_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
IF (MWK(START(FMBETA_INTERVAL_FM%LEFT)+2) == MUNKNO) THEN
CALL FMST2M('-OVERFLOW',FMBETA_INTERVAL_FM%LEFT)
ENDIF
IF (MWK(START(F_RIGHT%MFM)+2) == MUNKNO) THEN
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBETA_INTERVAL_FM
! BINOMIAL
FUNCTION FMBINOMIAL_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMBINOMIAL_INTERVAL_FM
TYPE (FM_INTERVAL), SAVE :: MB_SPLIT = FM_INTERVAL(-3,-3)
TYPE (FM), SAVE :: MB_SPLIT1 = FM(-3), MB_SPLIT2 = FM(-3)
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
ROUTINE_PREV = 0
KROUND_PREV = -4
NUM_PREV = 0
IF (LEFT_ENDPOINT(MA) <= -1) THEN
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
ENDIF
IF (LEFT_ENDPOINT(MB) < 0 .AND. RIGHT_ENDPOINT(MB) > 0) THEN
K_ROUTINE_EDGE = 2
KROUND = -1
CALL FMEQ(MB%LEFT,MB_SPLIT%LEFT)
CALL FMI2M(0,MB_SPLIT%RIGHT)
CALL FMEDGE_INTERVAL_FM(MA,MB_SPLIT,MB_SPLIT1%MFM,M_6%MFM)
CALL FMI2M(0,MB_SPLIT%LEFT)
CALL FMEQ(MB%RIGHT,MB_SPLIT%RIGHT)
CALL FMEDGE_INTERVAL_FM(MA,MB_SPLIT,MB_SPLIT2%MFM,M_6%MFM)
CALL FMMIN(MB_SPLIT1%MFM,MB_SPLIT2%MFM,F_LEFT%MFM)
KROUND = 2
CALL FMEQ(MB%LEFT,MB_SPLIT%LEFT)
CALL FMI2M(0,MB_SPLIT%RIGHT)
CALL FMEDGE_INTERVAL_FM(MA,MB_SPLIT,M_6%MFM,MB_SPLIT1%MFM)
CALL FMI2M(0,MB_SPLIT%LEFT)
CALL FMEQ(MB%RIGHT,MB_SPLIT%RIGHT)
CALL FMEDGE_INTERVAL_FM(MA,MB_SPLIT,M_6%MFM,MB_SPLIT2%MFM)
CALL FMMAX(MB_SPLIT1%MFM,MB_SPLIT2%MFM,F_RIGHT%MFM)
GO TO 110
ENDIF
K_ROUTINE_EDGE = 2
KROUND = -1
CALL FMEDGE_INTERVAL_FM(MA,MB,F_LEFT%MFM,M_6%MFM)
KROUND = 2
CALL FMEDGE_INTERVAL_FM(MA,MB,M_6%MFM,F_RIGHT%MFM)
110 IF (IS_UNKNOWN(F_LEFT) .OR. IS_UNKNOWN(F_RIGHT)) THEN
CALL FMST2M('-OVERFLOW',FMBINOMIAL_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMBINOMIAL_INTERVAL_FM%RIGHT)
ELSE
CALL FMEQ(F_LEFT%MFM,FMBINOMIAL_INTERVAL_FM%LEFT)
CALL FMEQ(F_RIGHT%MFM,FMBINOMIAL_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
IF (MWK(START(F_LEFT%MFM)+2) == MUNKNO) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
ENDIF
IF (MWK(START(F_RIGHT%MFM)+2) == MUNKNO) THEN
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBINOMIAL_INTERVAL_FM
! FACTORIAL
FUNCTION FMFACTORIAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMFACTORIAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
EXTERNAL :: FMFACT
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMFACTORIAL_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMFACTORIAL_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMST2M('0.4617',MTFM)
CALL FMI2M(-1,MUFM)
CALL FMST2M('0.4616',MVFM)
IF (FMCOMP(MA%LEFT,'>=',MTFM)) THEN
KROUND = -1
CALL FMFACT(MA%LEFT,FMFACTORIAL_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMFACT(MA%RIGHT,FMFACTORIAL_INTERVAL_FM%RIGHT)
ELSE IF (FMCOMP(MA%LEFT,'>',MUFM) .AND. FMCOMP(MA%RIGHT,'<=',MVFM)) THEN
KROUND = -1
CALL FMFACT(MA%RIGHT,FMFACTORIAL_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMFACT(MA%LEFT,FMFACTORIAL_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA) <= -1 .AND. CEILING(LEFT_ENDPOINT(MA)) <= RIGHT_ENDPOINT(MA) ) THEN
CALL FMST2M('-OVERFLOW',FMFACTORIAL_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMFACTORIAL_INTERVAL_FM%RIGHT)
ELSE
IF (RIGHT_ENDPOINT(MA) > 10) THEN
CALL FMEQ(MA%LEFT,MTFM_I%LEFT)
CALL FMI2M(10,MTFM_I%RIGHT)
CALL FM_INTERVAL_F_FM(FMFACT,MTFM_I,MUFM_I)
CALL FMEQ(MUFM_I%LEFT,FMFACTORIAL_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMFACT(MA%RIGHT,FMFACTORIAL_INTERVAL_FM%RIGHT)
IF (FMCOMP(FMFACTORIAL_INTERVAL_FM%RIGHT,'<',MUFM_I%RIGHT)) THEN
CALL FMEQ(MUFM_I%RIGHT,FMFACTORIAL_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FM(FMFACT,MA,FMFACTORIAL_INTERVAL_FM)
ENDIF
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_INTERVAL_FM
! GAMMA
FUNCTION FMGAMMA_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMGAMMA_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
EXTERNAL :: FMGAM
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMGAMMA_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMGAMMA_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMST2M('1.4617',MTFM)
CALL FMI2M(0,MUFM)
CALL FMST2M('1.4616',MVFM)
IF (FMCOMP(MA%LEFT,'>=',MTFM)) THEN
KROUND = -1
CALL FMGAM(MA%LEFT,FMGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMGAM(MA%RIGHT,FMGAMMA_INTERVAL_FM%RIGHT)
ELSE IF (FMCOMP(MA%LEFT,'>',MUFM) .AND. FMCOMP(MA%RIGHT,'<=',MVFM)) THEN
KROUND = -1
CALL FMGAM(MA%RIGHT,FMGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMGAM(MA%LEFT,FMGAMMA_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA) <= 0 .AND. CEILING(LEFT_ENDPOINT(MA)) <= RIGHT_ENDPOINT(MA) ) THEN
CALL FMST2M('-OVERFLOW',FMGAMMA_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMGAMMA_INTERVAL_FM%RIGHT)
ELSE
IF (RIGHT_ENDPOINT(MA) > 10) THEN
CALL FMEQ(MA%LEFT,MTFM_I%LEFT)
CALL FMI2M(10,MTFM_I%RIGHT)
CALL FM_INTERVAL_F_FM(FMGAM,MTFM_I,MUFM_I)
CALL FMEQ(MUFM_I%LEFT,FMGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMGAM(MA%RIGHT,FMGAMMA_INTERVAL_FM%RIGHT)
IF (FMCOMP(FMGAMMA_INTERVAL_FM%RIGHT,'<',MUFM_I%RIGHT)) THEN
CALL FMEQ(MUFM_I%RIGHT,FMGAMMA_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FM(FMGAM,MA,FMGAMMA_INTERVAL_FM)
ENDIF
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMGAMMA_INTERVAL_FM
! INCOMPLETE_BETA
FUNCTION FMINCOMPLETE_BETA_INTERVAL_FM(MX,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MX,MA,MB,FMINCOMPLETE_BETA_INTERVAL_FM
INTENT (IN) :: MX,MA,MB
INTEGER :: KRSAVE,KWRNSV
EXTERNAL :: FMIBTA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MX)
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
KROUND = -1
CALL FM_EQ(INCOMPLETE_BETA(LEFT_ENDPOINT(MX),RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),F_LEFT)
KROUND = 2
CALL FM_EQ(INCOMPLETE_BETA(RIGHT_ENDPOINT(MX),LEFT_ENDPOINT(MA),LEFT_ENDPOINT(MB)),F_RIGHT)
CALL FMEQ(F_LEFT%MFM,FMINCOMPLETE_BETA_INTERVAL_FM%LEFT)
CALL FMEQ(F_RIGHT%MFM,FMINCOMPLETE_BETA_INTERVAL_FM%RIGHT)
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_BETA_INTERVAL_FM
! INCOMPLETE_GAMMA1
FUNCTION FMINCOMPLETE_GAMMA1_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMINCOMPLETE_GAMMA1_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (LEFT_ENDPOINT(MB) < 0) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) <= 0) THEN
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_1)
IF (M_1 >= LEFT_ENDPOINT(MA)) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
ENDIF
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1)))) .AND. &
ABS(RIGHT_ENDPOINT(MB)-LEFT_ENDPOINT(MB)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MB)),SPACING(LEFT_ENDPOINT(MB))) / &
(100*SQRT(EPSILON(TO_FM(1))))) THEN
KROUND = -1
CALL FM_EQ(INCOMPLETE_GAMMA1(LEFT_ENDPOINT(MA), LEFT_ENDPOINT(MB)), M_1)
CALL FM_EQ(INCOMPLETE_GAMMA1(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB)), M_2)
CALL FM_EQ(MIN(M_1,M_2),F_LEFT)
KROUND = 2
CALL FM_EQ(INCOMPLETE_GAMMA1(LEFT_ENDPOINT(MA), RIGHT_ENDPOINT(MB)),M_1)
CALL FM_EQ(INCOMPLETE_GAMMA1(RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),M_2)
CALL FM_EQ(MAX(M_1,M_2),F_RIGHT)
GO TO 110
ENDIF
KROUND = 1
CALL FMIGM1(MA%LEFT,MB%LEFT,M1FM)
CALL FMIGM1(MA%RIGHT,MB%LEFT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FMIGM1(M_3%MFM,MB%LEFT,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FMIGM1(M_3%MFM,MB%LEFT,M_2%MFM)
K_ROUTINE_EDGE = 3
CALL FM_EQ(LEFT_ENDPOINT(MB),Y_EDGE)
NDIG_XY_EDGE = NDIG
IF (FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = -1
CALL FMIGM1(M_1%MFM,MB%LEFT,F_LEFT%MFM)
KROUND = 2
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM1(MA%RIGHT,MB%LEFT,F_RIGHT%MFM)
ELSE
CALL FMIGM1(MA%LEFT,MB%LEFT,F_RIGHT%MFM)
ENDIF
ELSE IF (FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = 2
CALL FMIGM1(M_1%MFM,MB%LEFT,F_RIGHT%MFM)
KROUND = -1
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM1(MA%LEFT,MB%LEFT,F_LEFT%MFM)
ELSE
CALL FMIGM1(MA%RIGHT,MB%LEFT,F_LEFT%MFM)
ENDIF
ELSE
IF (FMCOMP(M1FM,'<',M2FM)) THEN
KROUND = -1
CALL FMIGM1(MA%LEFT,MB%LEFT,F_LEFT%MFM)
KROUND = 2
CALL FMIGM1(MA%RIGHT,MB%LEFT,F_RIGHT%MFM)
ELSE
KROUND = -1
CALL FMIGM1(MA%RIGHT,MB%LEFT,F_LEFT%MFM)
KROUND = 2
CALL FMIGM1(MA%LEFT,MB%LEFT,F_RIGHT%MFM)
ENDIF
ENDIF
KROUND = 1
CALL FMIGM1(MA%LEFT,MB%RIGHT,M1FM)
CALL FMIGM1(MA%RIGHT,MB%RIGHT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FMIGM1(M_3%MFM,MB%RIGHT,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FMIGM1(M_3%MFM,MB%RIGHT,M_2%MFM)
K_ROUTINE_EDGE = 3
CALL FM_EQ(RIGHT_ENDPOINT(MB),Y_EDGE)
NDIG_XY_EDGE = NDIG
IF (FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = -1
CALL FMIGM1(M_1%MFM,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM1(MA%RIGHT,MB%RIGHT,M_2%MFM)
ELSE
CALL FMIGM1(MA%LEFT,MB%RIGHT,M_2%MFM)
ENDIF
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ELSE IF (FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = 2
CALL FMIGM1(M_1%MFM,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
KROUND = -1
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM1(MA%LEFT,MB%RIGHT,M_2%MFM)
ELSE
CALL FMIGM1(MA%RIGHT,MB%RIGHT,M_2%MFM)
ENDIF
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
ELSE
IF (FMCOMP(M1FM,'<',M2FM)) THEN
KROUND = -1
CALL FMIGM1(MA%LEFT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
CALL FMIGM1(MA%RIGHT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ELSE
KROUND = -1
CALL FMIGM1(MA%RIGHT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
CALL FMIGM1(MA%LEFT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ENDIF
ENDIF
110 IF (IS_UNKNOWN(F_LEFT) .OR. IS_UNKNOWN(F_RIGHT)) THEN
CALL FMST2M('-OVERFLOW',FMINCOMPLETE_GAMMA1_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMINCOMPLETE_GAMMA1_INTERVAL_FM%RIGHT)
ELSE
CALL FMEQ(F_LEFT%MFM,FMINCOMPLETE_GAMMA1_INTERVAL_FM%LEFT)
CALL FMEQ(F_RIGHT%MFM,FMINCOMPLETE_GAMMA1_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_GAMMA1_INTERVAL_FM
! INCOMPLETE_GAMMA2
FUNCTION FMINCOMPLETE_GAMMA2_INTERVAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,FMINCOMPLETE_GAMMA2_INTERVAL_FM
INTENT (IN) :: MA,MB
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (LEFT_ENDPOINT(MB) < 0) THEN
CALL FMST2M('-OVERFLOW',F_LEFT%MFM)
CALL FMST2M(' OVERFLOW',F_RIGHT%MFM)
GO TO 110
ENDIF
IF ( RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA) .OR. &
IS_UNKNOWN(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) ) THEN
KROUND = -1
CALL FM_EQ(INCOMPLETE_GAMMA2(LEFT_ENDPOINT(MA), RIGHT_ENDPOINT(MB)),F_LEFT)
KROUND = 2
CALL FM_EQ(INCOMPLETE_GAMMA2(LEFT_ENDPOINT(MA), LEFT_ENDPOINT(MB)),F_RIGHT)
GO TO 110
ENDIF
IF ( ABS(RIGHT_ENDPOINT(MA)-LEFT_ENDPOINT(MA)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))) / &
(100*SQRT(EPSILON(TO_FM(1)))) .AND. &
ABS(RIGHT_ENDPOINT(MB)-LEFT_ENDPOINT(MB)) <= &
MAX(SPACING(RIGHT_ENDPOINT(MB)),SPACING(LEFT_ENDPOINT(MB))) / &
(100*SQRT(EPSILON(TO_FM(1))))) THEN
KROUND = -1
CALL FM_EQ(INCOMPLETE_GAMMA2(LEFT_ENDPOINT(MA), RIGHT_ENDPOINT(MB)),M_1)
CALL FM_EQ(INCOMPLETE_GAMMA2(RIGHT_ENDPOINT(MA),RIGHT_ENDPOINT(MB)),M_2)
CALL FM_EQ(MIN(M_1,M_2),F_LEFT)
KROUND = 2
CALL FM_EQ(INCOMPLETE_GAMMA2(LEFT_ENDPOINT(MA), LEFT_ENDPOINT(MB)), M_1)
CALL FM_EQ(INCOMPLETE_GAMMA2(RIGHT_ENDPOINT(MA),LEFT_ENDPOINT(MB)), M_2)
CALL FM_EQ(MAX(M_1,M_2),F_RIGHT)
GO TO 110
ENDIF
KROUND = 1
CALL FMIGM2(MA%LEFT,MB%LEFT,M1FM)
CALL FMIGM2(MA%RIGHT,MB%LEFT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FMIGM2(M_3%MFM,MB%LEFT,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FMIGM2(M_3%MFM,MB%LEFT,M_2%MFM)
K_ROUTINE_EDGE = 4
CALL FM_EQ(LEFT_ENDPOINT(MB),Y_EDGE)
NDIG_XY_EDGE = NDIG
IF (FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = -1
CALL FMIGM2(M_1%MFM,MB%LEFT,F_LEFT%MFM)
KROUND = 2
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM2(MA%RIGHT,MB%LEFT,F_RIGHT%MFM)
ELSE
CALL FMIGM2(MA%LEFT,MB%LEFT,F_RIGHT%MFM)
ENDIF
ELSE IF (FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = 2
CALL FMIGM2(M_1%MFM,MB%LEFT,F_RIGHT%MFM)
KROUND = -1
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM2(MA%LEFT,MB%LEFT,F_LEFT%MFM)
ELSE
CALL FMIGM2(MA%RIGHT,MB%LEFT,F_LEFT%MFM)
ENDIF
ELSE
IF (FMCOMP(M1FM,'<',M2FM)) THEN
KROUND = -1
CALL FMIGM2(MA%LEFT,MB%LEFT,F_LEFT%MFM)
KROUND = 2
CALL FMIGM2(MA%RIGHT,MB%LEFT,F_RIGHT%MFM)
ELSE
KROUND = -1
CALL FMIGM2(MA%RIGHT,MB%LEFT,F_LEFT%MFM)
KROUND = 2
CALL FMIGM2(MA%LEFT,MB%LEFT,F_RIGHT%MFM)
ENDIF
ENDIF
KROUND = 1
CALL FMIGM2(MA%LEFT,MB%RIGHT,M1FM)
CALL FMIGM2(MA%RIGHT,MB%RIGHT,M2FM)
IF (LEFT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + ABS(LEFT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_3)
ENDIF
CALL FMIGM2(M_3%MFM,MB%RIGHT,M_1%MFM)
IF (RIGHT_ENDPOINT(MA) /= 0) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - ABS(RIGHT_ENDPOINT(MA))*SQRT(EPSILON(TO_FM(1))) , M_3)
ELSE
CALL FM_EQ( -SQRT(EPSILON(TO_FM(1))) , M_3)
IF (M_3 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/100 , M_3)
ENDIF
ENDIF
IF (IS_UNKNOWN(M_3)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_3)
ENDIF
CALL FMIGM2(M_3%MFM,MB%RIGHT,M_2%MFM)
K_ROUTINE_EDGE = 4
CALL FM_EQ(RIGHT_ENDPOINT(MB),Y_EDGE)
NDIG_XY_EDGE = NDIG
IF (FMCOMP(M_1%MFM,'<=',M1FM) .AND. FMCOMP(M_2%MFM,'<=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(1,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = -1
CALL FMIGM2(M_1%MFM,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM2(MA%RIGHT,MB%RIGHT,M_2%MFM)
ELSE
CALL FMIGM2(MA%LEFT,MB%RIGHT,M_2%MFM)
ENDIF
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ELSE IF (FMCOMP(M_1%MFM,'>=',M1FM) .AND. FMCOMP(M_2%MFM,'>=',M2FM)) THEN
CALL FM_FIND_EXTREME_POINT(2,LEFT_ENDPOINT(MA),RIGHT_ENDPOINT(MA), &
MAX(SPACING(RIGHT_ENDPOINT(MA)),SPACING(LEFT_ENDPOINT(MA))), &
M_1,M_2,F_EDGE)
KROUND = 2
CALL FMIGM2(M_1%MFM,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
KROUND = -1
IF (FMCOMP(M1FM,'<',M2FM)) THEN
CALL FMIGM2(MA%LEFT,MB%RIGHT,M_2%MFM)
ELSE
CALL FMIGM2(MA%RIGHT,MB%RIGHT,M_2%MFM)
ENDIF
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
ELSE
IF (FMCOMP(M1FM,'<',M2FM)) THEN
KROUND = -1
CALL FMIGM2(MA%LEFT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
CALL FMIGM2(MA%RIGHT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ELSE
KROUND = -1
CALL FMIGM2(MA%RIGHT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MIN(F_LEFT,M_2),F_LEFT)
KROUND = 2
CALL FMIGM2(MA%LEFT,MB%RIGHT,M_2%MFM)
CALL FM_EQ(MAX(F_RIGHT,M_2),F_RIGHT)
ENDIF
ENDIF
110 IF (IS_UNKNOWN(F_LEFT) .OR. IS_UNKNOWN(F_RIGHT)) THEN
CALL FMST2M('-OVERFLOW',FMINCOMPLETE_GAMMA2_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMINCOMPLETE_GAMMA2_INTERVAL_FM%RIGHT)
ELSE
CALL FMEQ(F_LEFT%MFM,FMINCOMPLETE_GAMMA2_INTERVAL_FM%LEFT)
CALL FMEQ(F_RIGHT%MFM,FMINCOMPLETE_GAMMA2_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_GAMMA2_INTERVAL_FM
! LOG_GAMMA
FUNCTION FMLOG_GAMMA_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMLOG_GAMMA_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
LOGICAL, EXTERNAL :: FMCOMP
EXTERNAL :: FMLNGM
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMLOG_GAMMA_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+3) == 0 .AND. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMLOG_GAMMA_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
CALL FMST2M('1.4617',MTFM)
CALL FMI2M(0,MUFM)
CALL FMST2M('1.4616',MVFM)
IF (FMCOMP(MA%LEFT,'>=',MTFM)) THEN
KROUND = -1
CALL FMLNGM(MA%LEFT,FMLOG_GAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMLNGM(MA%RIGHT,FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ELSE IF (FMCOMP(MA%LEFT,'>=',MUFM) .AND. FMCOMP(MA%RIGHT,'<=',MVFM)) THEN
KROUND = -1
CALL FMLNGM(MA%RIGHT,FMLOG_GAMMA_INTERVAL_FM%LEFT)
KROUND = 2
IF (MWK(START(MA%LEFT)+3) == 0 .OR. MWK(START(MA%LEFT)+2) == MEXPUN) THEN
CALL FMST2M('+OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ELSE
CALL FMLNGM(MA%LEFT,FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (LEFT_ENDPOINT(MA) <= 0 .AND. CEILING(LEFT_ENDPOINT(MA)) <= RIGHT_ENDPOINT(MA) ) THEN
CALL FMST2M('-OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA) <= 0 .AND. MOD(CEILING(LEFT_ENDPOINT(MA)),TO_FM(2)) == 0) THEN
CALL FMST2M('-OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ELSE
IF (RIGHT_ENDPOINT(MA) > 10 .OR. &
(LEFT_ENDPOINT(MA) < 0.01 .AND. LEFT_ENDPOINT(MA) >= 0)) THEN
CALL FMDP2M(0.01D0,MTFM)
CALL FMMAX(MA%LEFT,MTFM,MTFM_I%LEFT)
CALL FMDP2M(10.0D0,MTFM)
CALL FMMIN(MA%RIGHT,MTFM,MTFM_I%RIGHT)
CALL FM_INTERVAL_F_FM(FMLNGM,MTFM_I,MUFM_I)
CALL FMEQ(MUFM_I%LEFT,FMLOG_GAMMA_INTERVAL_FM%LEFT)
KROUND = 2
IF (MWK(START(MA%LEFT)+3) == 0 .OR. MWK(START(MA%LEFT)+2) == MEXPUN) THEN
CALL FMST2M('+OVERFLOW',FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ELSE
CALL FMLNGM(MA%LEFT,MTFM)
CALL FMLNGM(MA%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,FMLOG_GAMMA_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FM(FMLNGM,MA,FMLOG_GAMMA_INTERVAL_FM)
ENDIF
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_GAMMA_INTERVAL_FM
! POLYGAMMA
FUNCTION FMPOLYGAMMA_INTERVAL_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPOLYGAMMA_INTERVAL_FM
INTEGER :: N
INTENT (IN) :: N,MA
INTEGER :: KRSAVE,KWRNSV
EXTERNAL :: FMPGAM
LOGICAL, EXTERNAL :: FMCOMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMPOLYGAMMA_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMPOLYGAMMA_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N < 0) THEN
CALL FMST2M('UNKNOWN',FMPOLYGAMMA_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMPOLYGAMMA_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MOD(N,2) == 0) THEN
CALL FMI2M(0,MUFM)
IF (FMCOMP(MA%LEFT,'>',MUFM)) THEN
KROUND = -1
IF (N == 0 .AND. MWK(START(MA%LEFT)+2) == MEXPOV) THEN
CALL FMBIG(MVFM)
CALL FMPGAM(N,MVFM,FMPOLYGAMMA_INTERVAL_FM%LEFT)
ELSE
CALL FMPGAM(N,MA%LEFT,FMPOLYGAMMA_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (N == 0 .AND. MWK(START(MA%RIGHT)+2) == MEXPOV) THEN
CALL FMST2M('+OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ELSE
CALL FMPGAM(N,MA%RIGHT,FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (LEFT_ENDPOINT(MA) == 0 .AND. RIGHT_ENDPOINT(MA) > 0) THEN
CALL FMST2M('-OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPGAM(N,MA%RIGHT,FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA) <= 0 .AND. &
CEILING(LEFT_ENDPOINT(MA)) <= RIGHT_ENDPOINT(MA) ) THEN
CALL FMST2M('-OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ELSE
KROUND = -1
CALL FMPGAM(N,MA%LEFT,FMPOLYGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPGAM(N,MA%RIGHT,FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FMI2M(0,MUFM)
IF (FMCOMP(MA%LEFT,'>',MUFM)) THEN
KROUND = -1
CALL FMPGAM(N,MA%RIGHT,FMPOLYGAMMA_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPGAM(N,MA%LEFT,FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA)<=0 .AND. CEILING(LEFT_ENDPOINT(MA))<=RIGHT_ENDPOINT(MA) ) THEN
IF (RIGHT_ENDPOINT(MA) > 0) THEN
IF (LEFT_ENDPOINT(MA) <= -1) THEN
CALL FM_I2M(-1,M_4)
CALL FM_I2M(0,M_5)
CALL FM_EQ( SPACING(TO_FM(0.9)) , M_3)
CALL FM_FIND_EXTREME_POINT_IFM(1,M_4,M_5,M_3,M_1,M_2,N,FMPGAM)
ELSE IF (LEFT_ENDPOINT(MA) < 0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) , M_4)
CALL FM_I2M(0,M_5)
CALL FM_EQ( SPACING(TO_FM(0.9)) , M_3)
IF (M_4 > -0.49D0) THEN
CALL FM_EQ(M_4,M_1)
CALL FMPGAM(N,M_1%MFM,M_2%MFM)
ELSE
CALL FM_FIND_EXTREME_POINT_IFM(1,M_4,M_5,M_3,M_1,M_2,N,FMPGAM)
ENDIF
ELSE
CALL FM_I2M(0,M_1)
ENDIF
KROUND = -1
CALL FMPGAM(N,MA%RIGHT,M_3%MFM)
IF (M_1 < 0) THEN
CALL FMPGAM(N,M_1%MFM,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(LEFT_ENDPOINT(MA)) /= LEFT_ENDPOINT(MA)) THEN
CALL FMPGAM(N,MA%LEFT,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
CALL FMEQ(M_3%MFM,FMPOLYGAMMA_INTERVAL_FM%LEFT)
ELSE
IF (LEFT_ENDPOINT(MA) == RIGHT_ENDPOINT(MA)) THEN
CALL FMST2M(' OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%LEFT)
ELSE IF (LEFT_ENDPOINT(MA) < FLOOR(RIGHT_ENDPOINT(MA))) THEN
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_4)
CALL FM_EQ(RIGHT_ENDPOINT(MA),M_5)
CALL FM_EQ( SPACING(RIGHT_ENDPOINT(MA)-TO_FM(0.1)) , M_3)
IF (M_4 == M_5) THEN
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_1)
ELSE IF (M_5 <= M_4+0.49D0) THEN
CALL FM_EQ(M_5,M_1)
CALL FMPGAM(N,M_1%MFM,M_2%MFM)
ELSE
CALL FM_FIND_EXTREME_POINT_IFM(1,M_4,M_5,M_3,M_1,M_2,N,FMPGAM)
ENDIF
CALL FM_EQ(MAX(FLOOR(RIGHT_ENDPOINT(MA))-1,LEFT_ENDPOINT(MA)),M_4)
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_5)
CALL FM_EQ( SPACING(FLOOR(RIGHT_ENDPOINT(MA))-TO_FM(0.1)) , M_3)
IF (M_4 == M_5) THEN
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_6)
ELSE IF (M_4 >= M_5-0.49D0) THEN
CALL FM_EQ(M_4,M_6)
CALL FMPGAM(N,M_6%MFM,M_7%MFM)
ELSE
CALL FM_FIND_EXTREME_POINT_IFM(1,M_4,M_5,M_3,M_6,M_7,N,FMPGAM)
ENDIF
KROUND = -1
CALL FMST2M(' OVERFLOW',M_3%MFM)
IF (CEILING(LEFT_ENDPOINT(MA)) /= LEFT_ENDPOINT(MA)) THEN
CALL FMPGAM(N,MA%LEFT,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(RIGHT_ENDPOINT(MA)) /= RIGHT_ENDPOINT(MA)) THEN
CALL FMPGAM(N,MA%RIGHT,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(M_1) /= M_1) THEN
CALL FMPGAM(N,M_1%MFM,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(M_6) /= M_6) THEN
CALL FMPGAM(N,M_6%MFM,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
CALL FMEQ(M_3%MFM,FMPOLYGAMMA_INTERVAL_FM%LEFT)
ELSE
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_4)
CALL FM_EQ(RIGHT_ENDPOINT(MA),M_5)
CALL FM_EQ( SPACING(RIGHT_ENDPOINT(MA)-TO_FM(0.1)) , M_3)
IF (M_4 == M_5) THEN
CALL FM_EQ(FLOOR(RIGHT_ENDPOINT(MA)),M_6)
ELSE IF (M_5 <= M_4+0.49D0) THEN
CALL FM_EQ(M_5,M_1)
CALL FMPGAM(N,M_1%MFM,M_2%MFM)
ELSE
CALL FM_FIND_EXTREME_POINT_IFM(1,M_4,M_5,M_3,M_1,M_2,N,FMPGAM)
ENDIF
KROUND = -1
CALL FMST2M(' OVERFLOW',M_3%MFM)
IF (CEILING(LEFT_ENDPOINT(MA)) /= LEFT_ENDPOINT(MA)) THEN
CALL FMPGAM(N,MA%LEFT,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(RIGHT_ENDPOINT(MA)) /= RIGHT_ENDPOINT(MA)) THEN
CALL FMPGAM(N,MA%RIGHT,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
IF (CEILING(M_1) /= M_1) THEN
CALL FMPGAM(N,M_1%MFM,M_4%MFM)
CALL FM_MIN(M_3,M_4,M_5)
CALL FM_EQ(M_5,M_3)
ENDIF
CALL FMEQ(M_3%MFM,FMPOLYGAMMA_INTERVAL_FM%LEFT)
ENDIF
ENDIF
CALL FMST2M(' OVERFLOW',FMPOLYGAMMA_INTERVAL_FM%RIGHT)
ELSE
CALL FM_INTERVAL_F_IFM(FMPGAM,N,MA,FMPOLYGAMMA_INTERVAL_FM)
ENDIF
ENDIF
110 KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPOLYGAMMA_INTERVAL_FM
! POCHHAMMER
FUNCTION FMPOCHHAMMER_INTERVAL_FM(MA,N)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPOCHHAMMER_INTERVAL_FM
INTEGER :: KRSAVE,KWRNSV,N
INTENT (IN) :: N,MA
EXTERNAL :: FMPOCH
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%LEFT)+2) == MUNKNO .OR. MWK(START(MA%RIGHT)+2) == MUNKNO) THEN
CALL FMST2M('UNKNOWN',FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N == 0) THEN
CALL FMI2M(1,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FMI2M(1,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ELSE IF (N == 1) THEN
CALL FMEQ(MA%LEFT,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FMEQ(MA%RIGHT,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) >= 0 .AND. N >= 0) THEN
KROUND = -1
IF (MWK(START(MA%LEFT)+2) /= MEXPUN) THEN
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
ELSE
CALL FMST2M('+UNDERFLOW',FMPOCHHAMMER_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (MWK(START(MA%RIGHT)+2) /= MEXPUN) THEN
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ELSE
CALL FMTINY(M_6%MFM)
CALL FMPOCH(M_6%MFM,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) <= -N+1 .AND. N >= 0 .AND. MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) <= -N+1 .AND. N >= 0 .AND. MOD(N,2) == 0) THEN
KROUND = -1
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N >= 0) THEN
CALL FM_EQ(MIN(TO_FM(0),CEILING(RIGHT_ENDPOINT(MA))),M_7)
IF (M_7 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ(CEILING(RIGHT_ENDPOINT(MA))-1,M_7)
ENDIF
IF (M_7 >= LEFT_ENDPOINT(MA) .AND. M_7 <= RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ(MAX(TO_FM(-N+1),FLOOR(LEFT_ENDPOINT(MA))),M_6)
IF (M_6 < LEFT_ENDPOINT(MA)) THEN
CALL FM_EQ(FLOOR(LEFT_ENDPOINT(MA))+1,M_6)
ENDIF
IF (M_6 >= LEFT_ENDPOINT(MA) .AND. M_6 <= RIGHT_ENDPOINT(MA) .AND. M_6 < M_7) THEN
IF (M_6+1 == M_7) THEN
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,-TINY(TO_FM(1))), &
N,M1FM_I)
CALL FMST2M('-UNDERFLOW',M2FM_I%RIGHT)
CALL FMMAX(M1FM_I%RIGHT,M2FM_I%RIGHT,M2FM_I%LEFT)
CALL FMEQ(M2FM_I%LEFT,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,TINY(TO_FM(1))), &
N,M1FM_I)
ENDIF
ELSE
IF (M_7 == 0) THEN
CALL FMI2M(0,M1FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH, &
TO_FM_INTERVAL(M_7,RIGHT_ENDPOINT(MA)), &
N,M1FM_I)
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_6,M_7),N,M2FM_I)
IF (M_6 == -N+1) THEN
IF (MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,M3FM_I%LEFT)
CALL FMI2M(0,M3FM_I%RIGHT)
ELSE
CALL FMI2M(0,M3FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,M3FM_I%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(LEFT_ENDPOINT(MA),M_6), &
N,M3FM_I)
ENDIF
CALL FM_EQ(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I), &
LEFT_ENDPOINT(M3FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FM_EQ(MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I), &
RIGHT_ENDPOINT(M3FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ELSE IF (M_6+2 == M_7) THEN
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,-TINY(TO_FM(1))), &
N,M1FM_I)
CALL FMST2M('-UNDERFLOW',M2FM_I%RIGHT)
CALL FMMAX(M1FM_I%RIGHT,M2FM_I%RIGHT,M2FM_I%LEFT)
CALL FMEQ(M2FM_I%LEFT,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,TINY(TO_FM(1))), &
N,M1FM_I)
ENDIF
ELSE
IF (M_7 == 0) THEN
CALL FMI2M(0,M1FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH, &
TO_FM_INTERVAL(M_7,RIGHT_ENDPOINT(MA)), &
N,M1FM_I)
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7-1,M_7),N,M2FM_I)
IF (M_6 == -N+1) THEN
IF (MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,M3FM_I%LEFT)
CALL FMI2M(0,M3FM_I%RIGHT)
ELSE
CALL FMI2M(0,M3FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,M3FM_I%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(LEFT_ENDPOINT(MA),M_6), &
N,M3FM_I)
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_6,M_6+1),N,M4FM_I)
CALL FM_EQ(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I), &
LEFT_ENDPOINT(M3FM_I),LEFT_ENDPOINT(M4FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FM_EQ(MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I), &
RIGHT_ENDPOINT(M3FM_I),RIGHT_ENDPOINT(M4FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ELSE IF (M_6+3 == M_7) THEN
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,-TINY(TO_FM(1))), &
N,M1FM_I)
CALL FMST2M('-UNDERFLOW',M2FM_I%RIGHT)
CALL FMMAX(M1FM_I%RIGHT,M2FM_I%RIGHT,M2FM_I%LEFT)
CALL FMEQ(M2FM_I%LEFT,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,TINY(TO_FM(1))), &
N,M1FM_I)
ENDIF
ELSE
IF (M_7 == 0) THEN
CALL FMI2M(0,M1FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH, &
TO_FM_INTERVAL(M_7,RIGHT_ENDPOINT(MA)), &
N,M1FM_I)
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7-1,M_7),N,M2FM_I)
CALL FM_EQ(MAX(M_7-2,LEFT_ENDPOINT(MA)),M_8)
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_8,M_7-1),N,M3FM_I)
IF (M_6 == -N+1) THEN
IF (MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,M4FM_I%LEFT)
CALL FMI2M(0,M4FM_I%RIGHT)
ELSE
CALL FMI2M(0,M4FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,M4FM_I%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(LEFT_ENDPOINT(MA),M_6), &
N,M4FM_I)
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_6,M_6+1),N,M5FM_I)
CALL FM_EQ(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I), &
LEFT_ENDPOINT(M3FM_I),LEFT_ENDPOINT(M4FM_I), &
LEFT_ENDPOINT(M5FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FM_EQ(MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I), &
RIGHT_ENDPOINT(M3FM_I),RIGHT_ENDPOINT(M4FM_I), &
RIGHT_ENDPOINT(M5FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ELSE
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,-TINY(TO_FM(1))), &
N,M1FM_I)
CALL FMST2M('-UNDERFLOW',M2FM_I%RIGHT)
CALL FMMAX(M1FM_I%RIGHT,M2FM_I%RIGHT,M2FM_I%LEFT)
CALL FMEQ(M2FM_I%LEFT,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,TINY(TO_FM(1))), &
N,M1FM_I)
ENDIF
ELSE
IF (M_7 == 0) THEN
CALL FMI2M(0,M1FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,M1FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH, &
TO_FM_INTERVAL(M_7,RIGHT_ENDPOINT(MA)), &
N,M1FM_I)
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7-1,M_7),N,M2FM_I)
CALL FM_EQ(MAX(M_7-2,LEFT_ENDPOINT(MA)),M_8)
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_8,M_7-1),N,M3FM_I)
IF (M_6 == -N+1) THEN
IF (MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,M4FM_I%LEFT)
CALL FMI2M(0,M4FM_I%RIGHT)
ELSE
CALL FMI2M(0,M4FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,M4FM_I%RIGHT)
ENDIF
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(LEFT_ENDPOINT(MA),M_6), &
N,M4FM_I)
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_6,M_6+1),N,M5FM_I)
CALL FM_EQ(MIN(M_6+2,RIGHT_ENDPOINT(MA)),M_8)
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_6+1,M_8),N,M6FM_I)
CALL FM_EQ(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I), &
LEFT_ENDPOINT(M3FM_I),LEFT_ENDPOINT(M4FM_I), &
LEFT_ENDPOINT(M5FM_I),LEFT_ENDPOINT(M6FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FM_EQ(MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I), &
RIGHT_ENDPOINT(M3FM_I),RIGHT_ENDPOINT(M4FM_I), &
RIGHT_ENDPOINT(M5FM_I),RIGHT_ENDPOINT(M6FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ENDIF
ELSE
IF (M_7 == -N+1) THEN
IF (MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,M1FM_I%LEFT)
CALL FMI2M(0,M1FM_I%RIGHT)
ELSE
CALL FMI2M(0,M1FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,M1FM_I%RIGHT)
ENDIF
ELSE
IF (MWK(START(MA%LEFT)+2) /= MEXPUN) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(LEFT_ENDPOINT(MA),M_7), &
N,M1FM_I)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(-TINY(TO_FM(1)),M_7), &
N,M1FM_I)
ENDIF
ENDIF
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) < 0) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,-TINY(TO_FM(1))), &
N,M2FM_I)
CALL FMST2M('-UNDERFLOW',M3FM_I%RIGHT)
CALL FMMAX(M2FM_I%RIGHT,M3FM_I%RIGHT,M3FM_I%LEFT)
CALL FMEQ(M3FM_I%LEFT,M2FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH,TO_FM_INTERVAL(M_7,TINY(TO_FM(1))), &
N,M2FM_I)
ENDIF
ELSE
IF (M_7 == 0) THEN
CALL FMI2M(0,M2FM_I%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,M2FM_I%RIGHT)
ELSE
CALL FM_INTERVAL_F_FMI(FMPOCH, &
TO_FM_INTERVAL(M_7,RIGHT_ENDPOINT(MA)), &
N,M2FM_I)
ENDIF
ENDIF
CALL FM_EQ(MIN(LEFT_ENDPOINT(M1FM_I),LEFT_ENDPOINT(M2FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FM_EQ(MAX(RIGHT_ENDPOINT(M1FM_I),RIGHT_ENDPOINT(M2FM_I)),M_6)
CALL FMEQ(M_6%MFM,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ELSE
IF (MWK(START(MA%LEFT)+2) /= MEXPUN .AND. MWK(START(MA%RIGHT)+2) /= MEXPUN) THEN
CALL FM_INTERVAL_F_FMI(FMPOCH,MA,N,FMPOCHHAMMER_INTERVAL_FM)
ELSE
CALL FMEQ(MA%LEFT,M1FM_I%LEFT)
IF (MWK(START(MA%LEFT)+2) == MEXPUN) THEN
IF (MWK(START(MA%LEFT)) < 0) THEN
CALL FMTINY(M1FM_I%LEFT)
CALL FMMPYI_R1(M1FM_I%LEFT,-1)
ELSE
CALL FMTINY(M1FM_I%LEFT)
ENDIF
ENDIF
IF (MWK(START(MA%RIGHT)+2) == MEXPUN) THEN
IF (MWK(START(MA%RIGHT)) < 0) THEN
CALL FMTINY(M1FM_I%RIGHT)
CALL FMMPYI_R1(M1FM_I%RIGHT,-1)
ELSE
CALL FMTINY(M1FM_I%RIGHT)
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,M1FM_I,N,FMPOCHHAMMER_INTERVAL_FM)
IF (MWK(START(MA%RIGHT)+2) == MEXPUN .AND. MWK(START(MA%RIGHT)) < 0) THEN
IF (TO_FM('-UNDERFLOW') > RIGHT_ENDPOINT(FMPOCHHAMMER_INTERVAL_FM)) THEN
CALL FMST2M('-UNDERFLOW',FMPOCHHAMMER_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
ENDIF
GO TO 110
ENDIF
ENDIF
IF (RIGHT_ENDPOINT(MA) < 1 .AND. N < 0 .AND. MOD(N,2) == 0) THEN
KROUND = -1
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > -N .AND. N < 0 .AND. MOD(N,2) == 0) THEN
KROUND = -1
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) < 1 .AND. N < 0 .AND. MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > -N .AND. N < 0 .AND. MOD(N,2) /= 0) THEN
KROUND = -1
CALL FMPOCH(MA%RIGHT,N,FMPOCHHAMMER_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMPOCH(MA%LEFT,N,FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N < 0) THEN
CALL FM_EQ(MIN(TO_FM(-N),CEILING(RIGHT_ENDPOINT(MA))),M_7)
IF (M_7 > RIGHT_ENDPOINT(MA)) THEN
CALL FM_EQ(CEILING(RIGHT_ENDPOINT(MA))-1,M_7)
ENDIF
IF (M_7 >= LEFT_ENDPOINT(MA) .AND. M_7 <= RIGHT_ENDPOINT(MA)) THEN
CALL FMST2M('-OVERFLOW',FMPOCHHAMMER_INTERVAL_FM%LEFT)
CALL FMST2M(' OVERFLOW',FMPOCHHAMMER_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
ENDIF
CALL FM_INTERVAL_F_FMI(FMPOCH,MA,N,FMPOCHHAMMER_INTERVAL_FM)
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPOCHHAMMER_INTERVAL_FM
! PSI
FUNCTION FMPSI_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMPSI_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INTERVAL(FMPOLYGAMMA_INTERVAL_FM(0,MA),FMPSI_INTERVAL_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPSI_INTERVAL_FM
! BESSEL_J
FUNCTION FMBESSEL_J_INTERVAL_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_J_INTERVAL_FM
INTEGER :: N
INTENT (IN) :: N,MA
INTEGER :: KRSAVE,KWRNSV,NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
NDSAVE = NDIG
IF (IS_UNKNOWN(MA)) THEN
CALL FMST2M(' UNKNOWN ',FMBESSEL_J_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMBESSEL_J_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+2) <= NDIG) THEN
NDIG = NDIG + 2*MWK(START(MA%LEFT)+2)
NDIG = MAX(NDSAVE,NDIG)
ELSE IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 &
.AND. MWK(START(MA%LEFT)+2) > NDIG) THEN
NDIG = NDIG + NGRD52
ENDIF
CALL FMEQU(MA%LEFT,M9FM_I%LEFT,NDSAVE,NDIG)
CALL FMEQU(MA%RIGHT,M9FM_I%RIGHT,NDSAVE,NDIG)
IF (LEFT_ENDPOINT(M9FM_I) >= 0) THEN
CALL FMBESJ_INTERVAL_POS(N,M9FM_I,FMBESSEL_J_INTERVAL_FM,NDSAVE)
ELSE IF (RIGHT_ENDPOINT(M9FM_I) <= 0) THEN
CALL FMABS_INTERVAL(M9FM_I,M6FM_I)
CALL FMBESJ_INTERVAL_POS(N,M6FM_I,M5FM_I,NDSAVE)
IF (MOD(N,2) == 0) THEN
CALL FMEQ_INTERVAL(M5FM_I,FMBESSEL_J_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,FMBESSEL_J_INTERVAL_FM)
ENDIF
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(M9FM_I),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMBESJ_INTERVAL_POS(N,M6FM_I,M5FM_I,NDSAVE)
IF (MOD(N,2) == 0) THEN
CALL FMEQ_INTERVAL(M5FM_I,M4FM_I)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,M4FM_I)
ENDIF
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(M9FM_I)),M3FM_I)
CALL FMBESJ_INTERVAL_POS(N,M3FM_I,M5FM_I,NDSAVE)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL( &
MIN(LEFT_ENDPOINT(M4FM_I),LEFT_ENDPOINT(M5FM_I)) , &
MAX(RIGHT_ENDPOINT(M4FM_I),RIGHT_ENDPOINT(M5FM_I)) ) , &
FMBESSEL_J_INTERVAL_FM)
ENDIF
KROUND = -1
CALL FMEQU_R1(FMBESSEL_J_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMEQU_R1(FMBESSEL_J_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
110 NDIG = NDSAVE
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J_INTERVAL_FM
SUBROUTINE FMBESJ_INTERVAL_POS(N,MA,MB,NDSAVE)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: N
INTENT (IN) :: N,MA
INTENT (INOUT) :: MB
INTEGER :: J,KRSAVE,KTMAX,KTMIN,KTRIGHT,NDSAVE
EXTERNAL :: FMBESJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_PI(M_3)
CALL FM_EQ( (1/SQRT(M_3/2))/SQRT(HUGE(TO_FM(1))) , M_5 )
CALL FM_EQ(-M_5,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_5%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF ((RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA) .AND. &
MWK(START(MA%LEFT)+2) <= MAX(3*10**5,NDSAVE)) &
.OR. IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (N == 0) THEN
KROUND = -1
CALL FMBESJ(N,MA%RIGHT,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,MA%LEFT,MB%RIGHT)
ELSE
KROUND = -1
CALL FMBESJ(N,MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,MA%RIGHT,MB%RIGHT)
ENDIF
GO TO 120
ENDIF
IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 .AND. &
MWK(START(MA%LEFT)+2) > NDSAVE) THEN
CALL FMEQ(MA%LEFT,M_4%MFM)
CALL FM_PI(M_3)
CALL FM_EQ( (1/SQRT(M_3/2))/SQRT(M_4) , M_5 )
CALL FM_EQ(-M_5,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_5%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF ( RIGHT_ENDPOINT(MA) ** N < TINY(TO_FM(1)) ) THEN
CALL FM_EQ( TINY(TO_FM(1)) , M_5 )
KROUND = -1
CALL FMBESJ(N,MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,M_5%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA) > 1.84D0) GO TO 110
KROUND = -1
CALL FMBESJ(N,MA%LEFT,M_1%MFM)
IF (LEFT_ENDPOINT(MA) > 0) THEN
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_5 )
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) * (1 + SQRT(EPSILON(TO_FM(1)))) , M_5 )
ENDIF
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + SQRT(EPSILON(TO_FM(1))) , M_5 )
ENDIF
IF (M_5 < RIGHT_ENDPOINT(MA)) THEN
CALL FMBESJ(N,M_5%MFM,M_2%MFM)
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (IS_UNKNOWN(M_5)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_5 )
CALL FMBESJ(N,M_5%MFM,M_2%MFM)
ELSE
CALL FMBESJ(N,M_5%MFM,M_2%MFM)
ENDIF
ENDIF
CALL FM_EQ( RIGHT_ENDPOINT(MA) * (1 - SQRT(EPSILON(TO_FM(1)))) , M_5 )
IF (M_5 > LEFT_ENDPOINT(MA)) THEN
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
ELSE
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (IS_UNKNOWN(M_5)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_5 )
IF (M_5 < LEFT_ENDPOINT(MA)) CALL FM_EQ( RIGHT_ENDPOINT(MA) , M_5 )
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
ELSE
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
ENDIF
ENDIF
CALL FMBESJ(N,MA%RIGHT,M_4%MFM)
IF (IS_UNDERFLOW(M_4)) THEN
CALL FMEQ(M_1%MFM,MB%LEFT)
CALL FMEQ(M_4%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF ((M_1 <= M_2 .OR. (IS_UNDERFLOW(M_1).AND.IS_UNDERFLOW(M_2))) .AND. M_3 <= M_4) THEN
CALL FMEQ(M_1%MFM,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,MA%RIGHT,MB%RIGHT)
ELSE IF (M_1 >= M_2 .AND. M_3 >= M_4) THEN
CALL FMEQ(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,MA%LEFT,MB%RIGHT)
ELSE IF (M_1 < M_2 .AND. M_3 > M_4) THEN
CALL FMMIN(M_1%MFM,M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMEQ(MA%LEFT,M_1%MFM)
CALL FMEQ(MA%RIGHT,M_2%MFM)
CALL FM_EQ( SPACING(MAX(RIGHT_ENDPOINT(MA),TO_FM(0.9))) , M_3)
CALL FM_FIND_EXTREME_POINT_IFM(2,M_1,M_2,M_3,M_4,M_5,N,FMBESJ)
CALL FMEQ(M_5%MFM,MB%RIGHT)
ELSE IF (M_1 > M_2 .AND. M_3 < M_4) THEN
KROUND = 2
CALL FMBESJ(N,MA%LEFT,M_1%MFM)
CALL FMBESJ(N,MA%RIGHT,M_4%MFM)
CALL FMMAX(M_1%MFM,M_4%MFM,MB%RIGHT)
KROUND = -1
CALL FMEQ(MA%LEFT,M_1%MFM)
CALL FMEQ(MA%RIGHT,M_2%MFM)
CALL FM_EQ( SPACING(MAX(RIGHT_ENDPOINT(MA),TO_FM(0.9))) , M_3)
CALL FM_FIND_EXTREME_POINT_IFM(1,M_1,M_2,M_3,M_4,M_5,N,FMBESJ)
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
GO TO 120
110 CALL FMEQ(MA%LEFT,M_5%MFM)
CALL FMEQ(MA%RIGHT,M_7%MFM)
IF (M_5+9+N+N/5 < M_7) CALL FM_EQ( M_5 + 9 + N + N/5 , M_7 )
CALL FMBESJ(N,MA%LEFT,M_2%MFM)
IF (LEFT_ENDPOINT(MA) > 0) THEN
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_5 )
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) * (1 + SQRT(EPSILON(TO_FM(1)))) , M_5 )
ENDIF
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + SQRT(EPSILON(TO_FM(1))) , M_5 )
ENDIF
IF (M_5 < M_7 .AND. M_5 <= LEFT_ENDPOINT(MA) + 0.2D0) THEN
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + (M_7 - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (M_5 >= LEFT_ENDPOINT(MA) + 0.2D0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + 0.125D0 , M_5 )
ENDIF
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
ENDIF
CALL FMDP2M(0.9D0,M_6%MFM)
KTMAX = 0
KTMIN = 0
KTRIGHT = 0
DO J = 1, MAX(1000,10+5*N)
CALL FM_EQ(M_2,M_1)
CALL FM_EQ(M_3,M_2)
CALL FMADD_R1(M_5%MFM,M_6%MFM)
IF (M_5 >= M_7) THEN
KTRIGHT = KTRIGHT + 1
IF (KTRIGHT == 1) THEN
CALL FM_EQ( M_7 * (1 - SQRT(EPSILON(TO_FM(1)))) , M_5 )
IF (M_5 < LEFT_ENDPOINT(MA) .OR. M_5 <= M_7 - 0.2D0) THEN
CALL FM_EQ( M_7 - (M_7 - LEFT_ENDPOINT(MA))/3 , &
M_5 )
IF (M_5 <= M_7 - 0.2D0) THEN
CALL FM_EQ( M_7 - 0.125D0 , M_5 )
ENDIF
ENDIF
ELSE
CALL FM_EQ(M_7,M_5)
ENDIF
ENDIF
CALL FMBESJ(N,M_5%MFM,M_3%MFM)
IF (M_1 <= M_2 .AND. M_2 >= M_3) THEN
KROUND = 2
CALL FM_SUB(M_5,M_6,M_4)
CALL FM_SUB(M_4,M_6,M_8)
CALL FM_EQ( SPACING(MAX(M_7,TO_FM(0.9))) , M_4)
CALL FM_FIND_EXTREME_POINT_IFM(2,M_8,M_5,M_4,M_9,M_10,N,FMBESJ)
KTMAX = KTMAX + 1
CALL FMEQ(M_10%MFM,MB%RIGHT)
ENDIF
IF (M_1 >= M_2 .AND. M_2 <= M_3) THEN
KROUND = -1
CALL FM_SUB(M_5,M_6,M_4)
CALL FM_SUB(M_4,M_6,M_8)
CALL FM_EQ( SPACING(MAX(M_7,TO_FM(0.9))) , M_4)
CALL FM_FIND_EXTREME_POINT_IFM(1,M_8,M_5,M_4,M_9,M_10,N,FMBESJ)
KTMIN = KTMIN + 1
CALL FMEQ(M_10%MFM,MB%LEFT)
ENDIF
IF (KTMAX > 0 .AND. KTMIN > 0) EXIT
IF (KTRIGHT == 2) EXIT
ENDDO
KROUND = -1
CALL FMBESJ(N,MA%LEFT,M_1%MFM)
CALL FMBESJ(N,MA%RIGHT,M_2%MFM)
IF (IS_UNKNOWN(M_2)) CALL FMI2M(2,M_2%MFM)
CALL FM_MIN(M_1,M_2,M_3)
IF (KTMIN > 0) THEN
CALL FMMIN(M_3%MFM,MB%LEFT,M_4%MFM)
CALL FMEQ(M_4%MFM,M_3%MFM)
ENDIF
CALL FMEQ(M_3%MFM,MB%LEFT)
KROUND = 2
CALL FMBESJ(N,MA%LEFT,M_1%MFM)
CALL FMBESJ(N,MA%RIGHT,M_2%MFM)
IF (IS_UNKNOWN(M_2)) CALL FMI2M(-2,M_2%MFM)
CALL FM_MAX(M_1,M_2,M_3)
IF (KTMAX > 0) THEN
CALL FMMAX(M_3%MFM,MB%RIGHT,M_4%MFM)
CALL FMEQ(M_4%MFM,M_3%MFM)
ENDIF
CALL FMEQ(M_3%MFM,MB%RIGHT)
120 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMBESJ_INTERVAL_POS
! BESSEL_J0
FUNCTION FMBESSEL_J0_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_J0_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_J0_INTERVAL_FM = FMBESSEL_J_INTERVAL_FM(0,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J0_INTERVAL_FM
! BESSEL_J1
FUNCTION FMBESSEL_J1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_J1_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_J1_INTERVAL_FM = FMBESSEL_J_INTERVAL_FM(1,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J1_INTERVAL_FM
! BESSEL_JN
FUNCTION FMBESSEL_JN_INTERVAL_FM1(N,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N
TYPE (FM_INTERVAL) :: MA,FMBESSEL_JN_INTERVAL_FM1
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_JN_INTERVAL_FM1 = FMBESSEL_J_INTERVAL_FM(N,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_JN_INTERVAL_FM1
FUNCTION FMBESSEL_JN_INTERVAL_FM2(N1,N2,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N1,N2
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(N2-N1+1) :: FMBESSEL_JN_INTERVAL_FM2
INTEGER :: J
INTENT (IN) :: N1,N2,MA
FMBESSEL_JN_INTERVAL_FM2%LEFT = -1
FMBESSEL_JN_INTERVAL_FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 0, N2-N1
FMBESSEL_JN_INTERVAL_FM2(J+1) = FMBESSEL_J_INTERVAL_FM(N1+J,MA)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_JN_INTERVAL_FM2
! BESSEL_Y
FUNCTION FMBESSEL_Y_INTERVAL_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_Y_INTERVAL_FM
INTEGER :: N
INTENT (IN) :: N,MA
INTEGER :: KRSAVE,KWRNSV,NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
NDSAVE = NDIG
IF (IS_UNKNOWN(MA)) THEN
CALL FMST2M(' UNKNOWN ',FMBESSEL_Y_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMBESSEL_Y_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)+2) <= NDIG) THEN
NDIG = NDIG + 2*MWK(START(MA%LEFT)+2)
NDIG = MAX(NDSAVE,NDIG)
ELSE IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 &
.AND. MWK(START(MA%LEFT)+2) > NDIG) THEN
NDIG = NDIG + NGRD52
ENDIF
CALL FMEQU(MA%LEFT,M9FM_I%LEFT,NDSAVE,NDIG)
CALL FMEQU(MA%RIGHT,M9FM_I%RIGHT,NDSAVE,NDIG)
IF (RIGHT_ENDPOINT(M9FM_I) <= 0) THEN
CALL FMST2M('UNKNOWN',FMBESSEL_Y_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMBESSEL_Y_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(M9FM_I) <= 0) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(M9FM_I)),M3FM_I)
CALL FMBESY_INTERVAL_POS(N,M3FM_I,FMBESSEL_Y_INTERVAL_FM,NDSAVE)
CALL FMST2M('-OVERFLOW',FMBESSEL_Y_INTERVAL_FM%LEFT)
ELSE
CALL FMBESY_INTERVAL_POS(N,M9FM_I,FMBESSEL_Y_INTERVAL_FM,NDSAVE)
ENDIF
KROUND = -1
CALL FMEQU_R1(FMBESSEL_Y_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMEQU_R1(FMBESSEL_Y_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
110 NDIG = NDSAVE
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y_INTERVAL_FM
SUBROUTINE FMBESY_INTERVAL_POS(N,MA,MB,NDSAVE)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: N
INTENT (IN) :: N,MA
INTENT (INOUT) :: MB
INTEGER :: J,KRSAVE,KTMAX,KTMIN,KTRIGHT,KWARNSAVE,NDSAVE
EXTERNAL :: FMBESY
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KWARNSAVE = KWARN
KWARN = 0
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_PI(M_3)
CALL FM_EQ( (1/SQRT(M_3/2))/SQRT(HUGE(TO_FM(1))) , M_5 )
CALL FM_EQ(-M_5,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_5%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
CALL FMTINY(M_4%MFM)
KROUND = 2
CALL FMBESY(N,M_4%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF (RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA) .AND. &
MWK(START(MA%LEFT)+2) <= MAX(3*10**5,NDSAVE)) THEN
KROUND = -1
CALL FMBESY(N,MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMBESY(N,MA%RIGHT,MB%RIGHT)
GO TO 120
ENDIF
IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 .AND. &
MWK(START(MA%LEFT)+2) > NDSAVE) THEN
CALL FMEQ(MA%LEFT,M_4%MFM)
CALL FM_PI(M_3)
CALL FM_EQ( (1/SQRT(M_3/2))/SQRT(M_4) , M_5 )
CALL FM_EQ(-M_5,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_5%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA) > 2.19D0) GO TO 110
KROUND = -1
IF (LEFT_ENDPOINT(MA) == 0 .OR. IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',M_1%MFM)
ELSE
CALL FMBESY(N,MA%LEFT,M_1%MFM)
ENDIF
IF (LEFT_ENDPOINT(MA) > 0) THEN
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_5 )
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) * (1 + SQRT(EPSILON(TO_FM(1)))) , M_5 )
ENDIF
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + SQRT(EPSILON(TO_FM(1))) , M_5 )
ENDIF
IF (M_5 < RIGHT_ENDPOINT(MA)) THEN
CALL FMBESY(N,M_5%MFM,M_2%MFM)
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (IS_UNKNOWN(M_5)) THEN
CALL FM_EQ( NEAREST(LEFT_ENDPOINT(MA),TO_FM(1)) , M_5 )
CALL FMBESY(N,M_5%MFM,M_2%MFM)
ELSE
CALL FMBESY(N,M_5%MFM,M_2%MFM)
ENDIF
ENDIF
CALL FM_EQ( RIGHT_ENDPOINT(MA) * (1 - SQRT(EPSILON(TO_FM(1)))) , M_5 )
IF (M_5 > LEFT_ENDPOINT(MA)) THEN
CALL FMBESY(N,M_5%MFM,M_3%MFM)
ELSE
CALL FM_EQ( RIGHT_ENDPOINT(MA) - (RIGHT_ENDPOINT(MA) - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (IS_UNKNOWN(M_5)) THEN
CALL FM_EQ( NEAREST(RIGHT_ENDPOINT(MA),TO_FM(-1)) , M_5 )
IF (M_5 < LEFT_ENDPOINT(MA)) CALL FM_EQ( RIGHT_ENDPOINT(MA) , M_5 )
CALL FMBESY(N,M_5%MFM,M_3%MFM)
ELSE
CALL FMBESY(N,M_5%MFM,M_3%MFM)
ENDIF
ENDIF
CALL FMBESY(N,MA%RIGHT,M_4%MFM)
IF (IS_UNDERFLOW(M_4)) THEN
CALL FMEQ(M_1%MFM,MB%LEFT)
CALL FMEQ(M_4%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF (IS_OVERFLOW(M_1) .AND. IS_OVERFLOW(M_4)) THEN
CALL FMEQ(M_1%MFM,MB%LEFT)
CALL FMEQ(M_4%MFM,MB%RIGHT)
GO TO 120
ENDIF
IF ((M_1 <= M_2 .OR. (IS_UNDERFLOW(M_1).AND.IS_UNDERFLOW(M_2))) .AND. M_3 <= M_4 ) THEN
CALL FMEQ(M_1%MFM,MB%LEFT)
KROUND = 2
CALL FMBESY(N,MA%RIGHT,MB%RIGHT)
ELSE IF (M_1 >= M_2 .AND. M_3 >= M_4) THEN
CALL FMEQ(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMBESY(N,MA%LEFT,MB%RIGHT)
ELSE IF (M_1 < M_2 .AND. M_3 > M_4) THEN
CALL FMMIN(M_1%MFM,M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMEQ(MA%LEFT,M_1%MFM)
CALL FMEQ(MA%RIGHT,M_2%MFM)
CALL FM_EQ( SPACING(MAX(RIGHT_ENDPOINT(MA),TO_FM(0.9))) , M_3)
CALL FM_FIND_EXTREME_POINT_IFM(2,M_1,M_2,M_3,M_4,M_5,N,FMBESY)
CALL FMEQ(M_5%MFM,MB%RIGHT)
ELSE IF (M_1 > M_2 .AND. M_3 < M_4) THEN
KROUND = 2
CALL FMBESY(N,MA%LEFT,M_1%MFM)
CALL FMBESY(N,MA%RIGHT,M_4%MFM)
CALL FMMAX(M_1%MFM,M_4%MFM,MB%RIGHT)
KROUND = -1
CALL FMEQ(MA%LEFT,M_1%MFM)
CALL FMEQ(MA%RIGHT,M_2%MFM)
CALL FM_EQ( SPACING(MAX(RIGHT_ENDPOINT(MA),TO_FM(0.9))) , M_3)
CALL FM_FIND_EXTREME_POINT_IFM(1,M_1,M_2,M_3,M_4,M_5,N,FMBESY)
CALL FMEQ(M_5%MFM,MB%LEFT)
ENDIF
GO TO 120
110 CALL FMEQ(MA%LEFT,M_5%MFM)
CALL FMEQ(MA%RIGHT,M_7%MFM)
IF (M_5+9+N+N/5 < M_7) CALL FM_EQ( M_5 + 9 + N + N/5 , M_7 )
IF (M_5 == 0 .OR. IS_UNDERFLOW(M_5)) THEN
CALL FMST2M('-OVERFLOW',M_2%MFM)
ELSE
CALL FMBESY(N,MA%LEFT,M_2%MFM)
ENDIF
IF (LEFT_ENDPOINT(MA) > 0) THEN
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_EQ( SQRT(EPSILON(TO_FM(1))) , M_5 )
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) * (1 + SQRT(EPSILON(TO_FM(1)))) , M_5 )
ENDIF
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + SQRT(EPSILON(TO_FM(1))) , M_5 )
ENDIF
IF (M_5 < M_7 .AND. M_5 <= LEFT_ENDPOINT(MA) + 0.2D0) THEN
CALL FMBESY(N,M_5%MFM,M_3%MFM)
ELSE
CALL FM_EQ( LEFT_ENDPOINT(MA) + (M_7 - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (M_5 >= LEFT_ENDPOINT(MA) + 0.2D0) THEN
CALL FM_EQ( LEFT_ENDPOINT(MA) + 0.125D0 , M_5 )
ENDIF
CALL FMBESY(N,M_5%MFM,M_3%MFM)
ENDIF
CALL FMDP2M(1.0D0,M_6%MFM)
KTMAX = 0
KTMIN = 0
KTRIGHT = 0
DO J = 1, MAX(1000,10+5*N)
CALL FM_EQ(M_2,M_1)
CALL FM_EQ(M_3,M_2)
CALL FMADD_R1(M_5%MFM,M_6%MFM)
IF (M_5 >= M_7) THEN
KTRIGHT = KTRIGHT + 1
IF (KTRIGHT == 1) THEN
CALL FM_EQ( M_7 * (1 - SQRT(EPSILON(TO_FM(1)))) , M_5 )
IF (M_5 < LEFT_ENDPOINT(MA) .OR. M_5 <= M_7 - 0.2D0) THEN
CALL FM_EQ( M_7 - (M_7 - LEFT_ENDPOINT(MA))/3 , M_5 )
IF (M_5 <= M_7 - 0.2D0) THEN
CALL FM_EQ( M_7 - 0.125D0 , M_5 )
ENDIF
ENDIF
ELSE
CALL FM_EQ(M_7,M_5)
ENDIF
ENDIF
CALL FMBESY(N,M_5%MFM,M_3%MFM)
IF (M_1 <= M_2 .AND. M_2 >= M_3) THEN
KROUND = 2
CALL FM_SUB(M_5,M_6,M_4)
CALL FM_SUB(M_4,M_6,M_8)
CALL FM_EQ( SPACING(MAX(M_7,TO_FM(0.9))) , M_4)
CALL FM_FIND_EXTREME_POINT_IFM(2,M_8,M_5,M_4,M_9,M_10,N,FMBESY)
KTMAX = KTMAX + 1
CALL FMEQ(M_10%MFM,MB%RIGHT)
ENDIF
IF (M_1 >= M_2 .AND. M_2 <= M_3) THEN
KROUND = -1
CALL FM_SUB(M_5,M_6,M_4)
CALL FM_SUB(M_4,M_6,M_8)
CALL FM_EQ( SPACING(MAX(M_7,TO_FM(0.9))) , M_4)
CALL FM_FIND_EXTREME_POINT_IFM(1,M_8,M_5,M_4,M_9,M_10,N,FMBESY)
KTMIN = KTMIN + 1
CALL FMEQ(M_10%MFM,MB%LEFT)
ENDIF
IF (KTMAX > 0 .AND. KTMIN > 0) EXIT
IF (KTRIGHT == 2) EXIT
ENDDO
KROUND = -1
CALL FMBESY(N,MA%LEFT,M_1%MFM)
IF (IS_UNKNOWN(M_1)) CALL FMST2M('-OVERFLOW',M_1%MFM)
CALL FMBESY(N,MA%RIGHT,M_2%MFM)
IF (IS_UNKNOWN(M_2)) CALL FMI2M(2,M_2%MFM)
CALL FM_MIN(M_1,M_2,M_3)
IF (KTMIN > 0) THEN
CALL FMMIN(M_3%MFM,MB%LEFT,M_4%MFM)
CALL FMEQ(M_4%MFM,M_3%MFM)
ENDIF
CALL FMEQ(M_3%MFM,MB%LEFT)
KROUND = 2
CALL FMBESY(N,MA%LEFT,M_1%MFM)
IF (IS_UNKNOWN(M_1)) CALL FMST2M('-OVERFLOW',M_1%MFM)
CALL FMBESY(N,MA%RIGHT,M_2%MFM)
IF (IS_UNKNOWN(M_2)) CALL FMI2M(-2,M_2%MFM)
CALL FM_MAX(M_1,M_2,M_3)
IF (KTMAX > 0) THEN
CALL FMMAX(M_3%MFM,MB%RIGHT,M_4%MFM)
CALL FMEQ(M_4%MFM,M_3%MFM)
ENDIF
CALL FMEQ(M_3%MFM,MB%RIGHT)
120 KROUND = KRSAVE
KWARN = KWARNSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMBESY_INTERVAL_POS
! BESSEL_Y0
FUNCTION FMBESSEL_Y0_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_Y0_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_Y0_INTERVAL_FM = FMBESSEL_Y_INTERVAL_FM(0,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y0_INTERVAL_FM
! BESSEL_Y1
FUNCTION FMBESSEL_Y1_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMBESSEL_Y1_INTERVAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_Y1_INTERVAL_FM = FMBESSEL_Y_INTERVAL_FM(1,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y1_INTERVAL_FM
! BESSEL_YN
FUNCTION FMBESSEL_YN_INTERVAL_FM1(N,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N
TYPE (FM_INTERVAL) :: MA,FMBESSEL_YN_INTERVAL_FM1
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
FMBESSEL_YN_INTERVAL_FM1 = FMBESSEL_Y_INTERVAL_FM(N,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_YN_INTERVAL_FM1
FUNCTION FMBESSEL_YN_INTERVAL_FM2(N1,N2,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N1,N2
TYPE (FM_INTERVAL) :: MA
TYPE (FM_INTERVAL), DIMENSION(N2-N1+1) :: FMBESSEL_YN_INTERVAL_FM2
INTEGER :: J
INTENT (IN) :: N1,N2,MA
FMBESSEL_YN_INTERVAL_FM2%LEFT = -1
FMBESSEL_YN_INTERVAL_FM2%RIGHT = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
DO J = 0, N2-N1
FMBESSEL_YN_INTERVAL_FM2(J+1) = FMBESSEL_Y_INTERVAL_FM(N1+J,MA)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_YN_INTERVAL_FM2
! COS_INTEGRAL
FUNCTION FMCOS_INTEGRAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMCOS_INTEGRAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV,NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
NDSAVE = NDIG
IF (MWK(START(MA%LEFT)+2) <= NDIG) THEN
NDIG = NDIG + 2*MWK(START(MA%LEFT)+2)
NDIG = MAX(NDSAVE,NDIG)
ELSE IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 &
.AND. MWK(START(MA%LEFT)+2) > NDIG) THEN
NDIG = NDIG + NGRD52
ENDIF
CALL FMEQU(MA%LEFT,M9FM_I%LEFT,NDSAVE,NDIG)
CALL FMEQU(MA%RIGHT,M9FM_I%RIGHT,NDSAVE,NDIG)
IF (RIGHT_ENDPOINT(M9FM_I) <= 0) THEN
CALL FMST2M('UNKNOWN',FMCOS_INTEGRAL_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMCOS_INTEGRAL_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(M9FM_I) <= 0) THEN
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(M9FM_I)),M3FM_I)
CALL FMCI_INTERVAL_POS(M3FM_I,FMCOS_INTEGRAL_INTERVAL_FM,NDSAVE)
CALL FMST2M('-OVERFLOW',FMCOS_INTEGRAL_INTERVAL_FM%LEFT)
ELSE
CALL FMCI_INTERVAL_POS(M9FM_I,FMCOS_INTEGRAL_INTERVAL_FM,NDSAVE)
ENDIF
KROUND = -1
CALL FMEQU_R1(FMCOS_INTEGRAL_INTERVAL_FM%LEFT,NDIG,NDSAVE)
KROUND = 2
CALL FMEQU_R1(FMCOS_INTEGRAL_INTERVAL_FM%RIGHT,NDIG,NDSAVE)
NDIG = NDSAVE
KWARN = KWRNSV
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_INTEGRAL_INTERVAL_FM
SUBROUTINE FMCI_INTERVAL_POS(MA,MB,NDSAVE)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV,NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KROUND = 1
KWARN = 0
CALL FM_PI(M_1)
CALL FM_DIVI_R1(M_1,2)
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FM_TINY(M_3)
CALL FM_EQ(-M_3,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_3%MFM,MB%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) == LEFT_ENDPOINT(MA) .AND. &
MWK(START(MA%LEFT)+2) <= MAX(3*10**5,NDSAVE)) THEN
KROUND = -1
CALL FMCI(MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMCI(MA%RIGHT,MB%RIGHT)
GO TO 110
ENDIF
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
KROUND = 2
CALL FMTINY(M_2%MFM)
CALL FMCI(M_2%MFM,MB%RIGHT)
GO TO 110
ENDIF
IF ((LEFT_ENDPOINT(MA) <= 0 .OR. IS_UNDERFLOW(LEFT_ENDPOINT(MA))) .AND. &
RIGHT_ENDPOINT(MA) <= M_1) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
KROUND = 2
CALL FMCI(MA%RIGHT,MB%RIGHT)
GO TO 110
ELSE IF ((LEFT_ENDPOINT(MA) <= 0 .OR. IS_UNDERFLOW(LEFT_ENDPOINT(MA))) .AND. &
RIGHT_ENDPOINT(MA) > M_1) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
KROUND = 2
CALL FMCI(M_1%MFM,MB%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > 1.0D+10 .AND. RIGHT_ENDPOINT(MA) >= LEFT_ENDPOINT(MA) + 7 .AND. &
MWK(START(MA%LEFT)+2) > NDSAVE) THEN
CALL FMEQ(MA%LEFT,M_4%MFM)
CALL FM_EQ( 1/M_4 , M_5 )
CALL FM_EQ(-M_5,M_4)
CALL FMEQ(M_4%MFM,MB%LEFT)
CALL FMEQ(M_5%MFM,MB%RIGHT)
GO TO 110
ENDIF
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA) / M_1 ) , M_3 )
IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 0 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 3 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 3 ) ) THEN
KROUND = -1
CALL FMCI(MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMCI(MA%RIGHT,MB%RIGHT)
ELSE IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 1 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 2 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 1 ) ) THEN
KROUND = -1
CALL FMCI(MA%RIGHT,MB%LEFT)
KROUND = 2
CALL FMCI(MA%LEFT,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 0 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 3 ) ) THEN
KROUND = -1
CALL FMCI(MA%LEFT,MTFM)
CALL FMCI(MA%RIGHT,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(4)) == 1) THEN
CALL FM_EQ( M_1*M_3 , M_4 )
ELSE
CALL FM_EQ( M_1*(M_3-1) , M_4 )
ENDIF
KROUND = 2
CALL FMCI(M_4%MFM,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 2 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 1 ) ) THEN
IF (MOD(M_3,TO_FM(4)) == 3) THEN
CALL FM_EQ( M_1*M_3 , M_4 )
ELSE
CALL FM_EQ( M_1*(M_3-1) , M_4 )
ENDIF
KROUND = -1
CALL FMCI(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMCI(MA%LEFT,MTFM)
CALL FMCI(MA%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ELSE
CALL FM_EQ( CEILING( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ(M_2,M_3)
IF (MOD(M_2,TO_FM(4)) == 0) THEN
CALL FM_ADDI(M_2,3)
ELSE IF (MOD(M_2,TO_FM(4)) == 1) THEN
CALL FM_ADDI(M_2,2)
ELSE IF (MOD(M_2,TO_FM(4)) == 2) THEN
CALL FM_ADDI(M_2,1)
ENDIF
CALL FM_MPY_R1(M_2,M_1)
KROUND = -1
CALL FMCI(MA%LEFT,MTFM)
CALL FMCI(M_2%MFM,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(4)) == 0) THEN
CALL FM_ADDI(M_3,1)
ELSE IF (MOD(M_3,TO_FM(4)) == 2) THEN
CALL FM_ADDI(M_3,3)
ELSE IF (MOD(M_3,TO_FM(4)) == 3) THEN
CALL FM_ADDI(M_3,2)
ENDIF
CALL FM_MPY_R1(M_3,M_1)
KROUND = 2
CALL FMCI(MA%LEFT,MTFM)
CALL FMCI(M_3%MFM,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMCI_INTERVAL_POS
! COSH_INTEGRAL
FUNCTION FMCOSH_INTEGRAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMCOSH_INTEGRAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMCOSH_INTEGRAL_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMCOSH_INTEGRAL_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%LEFT)) < 0 .OR. MWK(START(MA%LEFT)+3) == 0) THEN
CALL FMST2M('-OVERFLOW',FMCOSH_INTEGRAL_INTERVAL_FM%LEFT)
ELSE
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',FMCOSH_INTEGRAL_INTERVAL_FM%LEFT)
ELSE
KROUND = -1
CALL FMCHI(MA%LEFT,FMCOSH_INTEGRAL_INTERVAL_FM%LEFT)
ENDIF
ENDIF
KROUND = 2
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMTINY(M_1%MFM)
CALL FMCHI(M_1%MFM,FMCOSH_INTEGRAL_INTERVAL_FM%RIGHT)
ELSE
CALL FMCHI(MA%RIGHT,FMCOSH_INTEGRAL_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_INTEGRAL_INTERVAL_FM
! EXP_INTEGRAL_EI
FUNCTION FMEXP_INTEGRAL_EI_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMEXP_INTEGRAL_EI_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
IF (IS_UNKNOWN(MA)) THEN
CALL FMST2M(' UNKNOWN ',FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > 0) THEN
KROUND = -1
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
ELSE
CALL FMEI(MA%LEFT,FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMTINY(M_1%MFM)
CALL FMEI(M_1%MFM,FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
ELSE
CALL FMEI(MA%RIGHT,FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (RIGHT_ENDPOINT(MA) < 0) THEN
KROUND = -1
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMST2M('-OVERFLOW',FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
ELSE
CALL FMEI(MA%RIGHT,FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMTINY(M_1%MFM)
CALL FMEI(M_1%MFM,FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
ELSE
CALL FMEI(MA%LEFT,FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FMST2M('-OVERFLOW',FMEXP_INTEGRAL_EI_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMST2M('-OVERFLOW',M_1%MFM)
IF (LEFT_ENDPOINT(MA) < 0) THEN
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMTINY(M_2%MFM)
CALL FMEI(M_2%MFM,M_1%MFM)
ELSE
CALL FMEI(MA%LEFT,M_1%MFM)
ENDIF
ENDIF
CALL FMST2M('-OVERFLOW',M_2%MFM)
IF (RIGHT_ENDPOINT(MA) > 0) THEN
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMTINY(M_3%MFM)
CALL FMEI(M_3%MFM,M_2%MFM)
ELSE
CALL FMEI(MA%RIGHT,M_2%MFM)
ENDIF
ENDIF
CALL FMMAX(M_1%MFM,M_2%MFM,FMEXP_INTEGRAL_EI_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EI_INTERVAL_FM
! EXP_INTEGRAL_EN
FUNCTION FMEXP_INTEGRAL_EN_INTERVAL_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMEXP_INTEGRAL_EN_INTERVAL_FM
INTEGER :: N
INTENT (IN) :: N,MA
INTEGER :: KWRNSV
EXTERNAL :: FMEN
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
IF (IS_UNKNOWN(MA)) THEN
CALL FMST2M(' UNKNOWN ',FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
CALL FMST2M(' UNKNOWN ',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N >= 1) THEN
IF (RIGHT_ENDPOINT(MA) <= 0) THEN
CALL FMST2M('UNKNOWN',FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
IF (N > 1 .AND. RIGHT_ENDPOINT(MA) == 0) THEN
KROUND = -1
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (LEFT_ENDPOINT(MA) > 0) THEN
KROUND = -1
IF (N == 1 .AND. IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMTINY(M_1%MFM)
CALL FMEN(N,M_1%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
ELSE
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (N == 1 .AND. IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
CALL FMST2M('+OVERFLOW',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ELSE
CALL FMEN(N,MA%LEFT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ENDIF
ELSE
KROUND = -1
IF (N == 1 .AND. IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMTINY(M_1%MFM)
CALL FMEN(N,M_1%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
ELSE
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
ENDIF
IF (N == 1) THEN
CALL FMST2M('+OVERFLOW',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ELSE
KROUND = 2
CALL FMI2M(0,M_1%MFM)
CALL FMEN(N,M_1%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ENDIF
ENDIF
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > 0) THEN
KROUND = -1
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEN(N,MA%LEFT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) <= 0 .AND. RIGHT_ENDPOINT(MA) >= 0 .AND. MOD(-N,2) == 0) THEN
CALL FMST2M('-OVERFLOW',FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
CALL FMST2M('+OVERFLOW',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) <= 0 .AND. RIGHT_ENDPOINT(MA) >= 0 .AND. MOD(-N,2) /= 0) THEN
KROUND = -1
IF (LEFT_ENDPOINT(MA) < 0) THEN
CALL FMEN(N,MA%LEFT,M_1%MFM)
ELSE
CALL FMST2M('+OVERFLOW',M_1%MFM)
ENDIF
IF (RIGHT_ENDPOINT(MA) > 0) THEN
CALL FMEN(N,MA%RIGHT,M_2%MFM)
ELSE
CALL FMST2M('+OVERFLOW',M_2%MFM)
ENDIF
CALL FMMIN(M_1%MFM,M_2%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
CALL FMST2M('+OVERFLOW',FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (RIGHT_ENDPOINT(MA) < 0 .AND. MOD(-N,2) /= 0) THEN
KROUND = -1
CALL FMEN(N,MA%LEFT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (N == 0) THEN
IF (RIGHT_ENDPOINT(MA) <= -1) THEN
KROUND = -1
CALL FMEN(N,MA%LEFT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ELSE IF (LEFT_ENDPOINT(MA) >= -1) THEN
KROUND = -1
CALL FMEN(N,MA%RIGHT,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMEN(N,MA%LEFT,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ELSE
KROUND = -1
CALL FMEN(N,MA%LEFT,M_1%MFM)
CALL FMEN(N,MA%RIGHT,M_2%MFM)
CALL FMMIN(M_1%MFM,M_2%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%LEFT)
CALL FMI2M(-1,M_1%MFM)
CALL FMEN(N,M_1%MFM,FMEXP_INTEGRAL_EN_INTERVAL_FM%RIGHT)
ENDIF
GO TO 110
ENDIF
CALL FM_INTERVAL_F_IFM(FMEN,N,MA,FMEXP_INTEGRAL_EN_INTERVAL_FM)
110 KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EN_INTERVAL_FM
! FRESNEL_C
FUNCTION FMFRESNEL_C_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMFRESNEL_C_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
IF (LEFT_ENDPOINT(MA) >= 0) THEN
CALL FMC_INTERVAL_POS(MA,FMFRESNEL_C_INTERVAL_FM)
ELSE IF (RIGHT_ENDPOINT(MA) <= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMC_INTERVAL_POS(M6FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,FMFRESNEL_C_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMC_INTERVAL_POS(M6FM_I,M4FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMC_INTERVAL_POS(M3FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(-RIGHT_ENDPOINT(M4FM_I),RIGHT_ENDPOINT(M5FM_I)), &
FMFRESNEL_C_INTERVAL_FM)
ENDIF
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_C_INTERVAL_FM
SUBROUTINE FMC_INTERVAL_POS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA)**2 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA)**2 ) , M_3 )
IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 0 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 3 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 3 ) ) THEN
KROUND = -1
CALL FMC(MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMC(MA%RIGHT,MB%RIGHT)
ELSE IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 1 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 2 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 1 ) ) THEN
KROUND = -1
CALL FMC(MA%RIGHT,MB%LEFT)
KROUND = 2
CALL FMC(MA%LEFT,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 0 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 3 ) ) THEN
KROUND = -1
CALL FMC(MA%LEFT,MTFM)
CALL FMC(MA%RIGHT,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(4)) == 1) THEN
CALL FM_EQ( SQRT(M_3) , M_4 )
ELSE
CALL FM_EQ( SQRT(M_3-1) , M_4 )
ENDIF
KROUND = 2
CALL FMC(M_4%MFM,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 2 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 1 ) ) THEN
IF (MOD(M_3,TO_FM(4)) == 3) THEN
CALL FM_EQ( SQRT(M_3) , M_4 )
ELSE
CALL FM_EQ( SQRT(M_3-1) , M_4 )
ENDIF
KROUND = -1
CALL FMC(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMC(MA%LEFT,MTFM)
CALL FMC(MA%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ELSE
CALL FM_EQ( CEILING( LEFT_ENDPOINT(MA)**2 ) , M_2 )
CALL FM_EQ(M_2,M_3)
IF (MOD(M_2,TO_FM(4)) == 0) THEN
CALL FM_ADDI(M_2,3)
ELSE IF (MOD(M_2,TO_FM(4)) == 1) THEN
CALL FM_ADDI(M_2,2)
ELSE IF (MOD(M_2,TO_FM(4)) == 2) THEN
CALL FM_ADDI(M_2,1)
ENDIF
CALL FM_SQRT_R1(M_2)
KROUND = -1
CALL FMC(MA%LEFT,MTFM)
CALL FMC(M_2%MFM,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(4)) == 0) THEN
CALL FM_ADDI(M_3,1)
ELSE IF (MOD(M_3,TO_FM(4)) == 2) THEN
CALL FM_ADDI(M_3,3)
ELSE IF (MOD(M_3,TO_FM(4)) == 3) THEN
CALL FM_ADDI(M_3,2)
ENDIF
CALL FM_SQRT_R1(M_3)
KROUND = 2
CALL FMC(MA%LEFT,MTFM)
CALL FMC(M_3%MFM,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
IF (3*MWK(START(MA%LEFT)+2) >= NDIG) THEN
CALL FM_PI(M_2)
KROUND = -1
CALL FM_EQ(TO_FM(1)/2 - 1/(M_2*LEFT_ENDPOINT(MA)),M_3)
CALL FMEQ(MB%LEFT,M_4%MFM)
IF (IS_UNKNOWN(M_4)) THEN
CALL FMEQ(M_3%MFM,MB%LEFT)
ELSE
CALL FMMIN(M_3%MFM,M_4%MFM,MB%LEFT)
ENDIF
KROUND = 2
CALL FM_EQ(TO_FM(1)/2 + 1/(M_2*LEFT_ENDPOINT(MA)),M_3)
CALL FMEQ(MB%RIGHT,M_4%MFM)
IF (IS_UNKNOWN(M_4)) THEN
CALL FMEQ(M_3%MFM,MB%RIGHT)
ELSE
CALL FMMAX(M_3%MFM,M_4%MFM,MB%RIGHT)
ENDIF
ENDIF
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMC_INTERVAL_POS
! FRESNEL_S
FUNCTION FMFRESNEL_S_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMFRESNEL_S_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
IF (LEFT_ENDPOINT(MA) >= 0) THEN
CALL FMS_INTERVAL_POS(MA,FMFRESNEL_S_INTERVAL_FM)
ELSE IF (RIGHT_ENDPOINT(MA) <= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMS_INTERVAL_POS(M6FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,FMFRESNEL_S_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMS_INTERVAL_POS(M6FM_I,M4FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMS_INTERVAL_POS(M3FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(-RIGHT_ENDPOINT(M4FM_I),RIGHT_ENDPOINT(M5FM_I)), &
FMFRESNEL_S_INTERVAL_FM)
ENDIF
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_S_INTERVAL_FM
SUBROUTINE FMS_INTERVAL_POS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA)**2 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA)**2 ) , M_3 )
IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 0 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 1 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 0 ) ) THEN
KROUND = -1
CALL FMS(MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMS(MA%RIGHT,MB%RIGHT)
ELSE IF ( ( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 2 ) .OR. &
( M_3 == M_2 .AND. MOD(M_2,TO_FM(4)) == 3 ) .OR. &
( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(4)) == 2 ) ) THEN
KROUND = -1
CALL FMS(MA%RIGHT,MB%LEFT)
KROUND = 2
CALL FMS(MA%LEFT,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 1 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 0 ) ) THEN
KROUND = -1
CALL FMS(MA%LEFT,MTFM)
CALL FMS(MA%RIGHT,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(4)) == 2) THEN
CALL FM_EQ( SQRT(M_3) , M_4 )
ELSE
CALL FM_EQ( SQRT(M_3-1) , M_4 )
ENDIF
KROUND = 2
CALL FMS(M_4%MFM,MB%RIGHT)
ELSE IF ( ( M_3 <= M_2 + 2 .AND. MOD(M_2,TO_FM(4)) == 3 ) .OR. &
( M_3 <= M_2 + 3 .AND. MOD(M_2,TO_FM(4)) == 2 ) ) THEN
IF (MOD(M_3,TO_FM(4)) == 0) THEN
CALL FM_EQ( SQRT(M_3) , M_4 )
ELSE
CALL FM_EQ( SQRT(M_3-1) , M_4 )
ENDIF
KROUND = -1
CALL FMS(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMS(MA%LEFT,MTFM)
CALL FMS(MA%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ELSE
CALL FM_EQ( CEILING( LEFT_ENDPOINT(MA)**2 ) , M_2 )
CALL FM_EQ(M_2,M_3)
IF (M_2 == 0) THEN
CALL FM_ADDI(M_2,4)
ELSE IF (MOD(M_2,TO_FM(4)) == 1) THEN
CALL FM_ADDI(M_2,3)
ELSE IF (MOD(M_2,TO_FM(4)) == 2) THEN
CALL FM_ADDI(M_2,2)
ELSE IF (MOD(M_2,TO_FM(4)) == 3) THEN
CALL FM_ADDI(M_2,1)
ENDIF
CALL FM_SQRT_R1(M_2)
KROUND = -1
CALL FMS(MA%LEFT,MTFM)
CALL FMS(M_2%MFM,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (M_3 == 0) THEN
CALL FM_ADDI(M_3,2)
ELSE IF (MOD(M_3,TO_FM(4)) == 1) THEN
CALL FM_ADDI(M_3,1)
ELSE IF (MOD(M_3,TO_FM(4)) == 3) THEN
CALL FM_ADDI(M_3,3)
ELSE IF (MOD(M_3,TO_FM(4)) == 0) THEN
CALL FM_ADDI(M_3,2)
ENDIF
CALL FM_SQRT_R1(M_3)
KROUND = 2
CALL FMS(MA%LEFT,MTFM)
CALL FMS(M_3%MFM,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
IF (3*MWK(START(MA%LEFT)+2) >= NDIG) THEN
CALL FM_PI(M_2)
KROUND = -1
CALL FM_EQ(TO_FM(1)/2 - 1/(M_2*LEFT_ENDPOINT(MA)),M_3)
CALL FMEQ(MB%LEFT,M_4%MFM)
IF (IS_UNKNOWN(M_4)) THEN
CALL FMEQ(M_3%MFM,MB%LEFT)
ELSE
CALL FMMIN(M_3%MFM,M_4%MFM,MB%LEFT)
ENDIF
KROUND = 2
CALL FM_EQ(TO_FM(1)/2 + 1/(M_2*LEFT_ENDPOINT(MA)),M_3)
CALL FMEQ(MB%RIGHT,M_4%MFM)
IF (IS_UNKNOWN(M_4)) THEN
CALL FMEQ(M_3%MFM,MB%RIGHT)
ELSE
CALL FMMAX(M_3%MFM,M_4%MFM,MB%RIGHT)
ENDIF
ENDIF
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMS_INTERVAL_POS
! ERF
FUNCTION FMERF_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMERF_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KRSAVE = KROUND
KWRNSV = KWARN
KWARN = 0
KROUND = -1
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
IF (LEFT_ENDPOINT(MA) > 0) THEN
CALL FMST2M("+UNDERFLOW",FMERF_INTERVAL_FM%LEFT)
ELSE
CALL FMTINY(M_1%MFM)
MWK(START(M_1%MFM)) = -MWK(START(M_1%MFM))
CALL FMERF(M_1%MFM,FMERF_INTERVAL_FM%LEFT)
ENDIF
ELSE
CALL FMERF(MA%LEFT,FMERF_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) > 0) THEN
CALL FMTINY(M_1%MFM)
CALL FMERF(M_1%MFM,FMERF_INTERVAL_FM%RIGHT)
ELSE
CALL FMST2M("-UNDERFLOW",FMERF_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FMERF(MA%RIGHT,FMERF_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERF_INTERVAL_FM
! ERFC
FUNCTION FMERFC_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMERFC_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
KROUND = -1
CALL FMERFC(MA%RIGHT,FMERFC_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMERFC(MA%LEFT,FMERFC_INTERVAL_FM%RIGHT)
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_INTERVAL_FM
! LOG_ERFC
FUNCTION FMLOG_ERFC_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMLOG_ERFC_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
KROUND = -1
IF (IS_UNDERFLOW(RIGHT_ENDPOINT(MA))) THEN
IF (RIGHT_ENDPOINT(MA) > 0) THEN
CALL FM_EQ( TINY(TO_FM(1)) , M_5 )
CALL FMLERC(M_5%MFM,FMLOG_ERFC_INTERVAL_FM%LEFT)
ELSE
CALL FMST2M('UNDERFLOW',FMLOG_ERFC_INTERVAL_FM%LEFT)
ENDIF
ELSE
CALL FMLERC(MA%RIGHT,FMLOG_ERFC_INTERVAL_FM%LEFT)
ENDIF
KROUND = 2
IF (IS_UNDERFLOW(LEFT_ENDPOINT(MA))) THEN
IF (LEFT_ENDPOINT(MA) < 0) THEN
CALL FM_EQ( -TINY(TO_FM(1)) , M_5 )
CALL FMLERC(M_5%MFM,FMLOG_ERFC_INTERVAL_FM%RIGHT)
ELSE
CALL FMST2M('-UNDERFLOW',FMLOG_ERFC_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FMLERC(MA%LEFT,FMLOG_ERFC_INTERVAL_FM%RIGHT)
ENDIF
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ERFC_INTERVAL_FM
! LOG_INTEGRAL
FUNCTION FMLOG_INTEGRAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMLOG_INTEGRAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',FMLOG_INTEGRAL_INTERVAL_FM%LEFT)
CALL FMST2M('UNKNOWN',FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
KROUND = -1
CALL FM_EQ( HUGE(TO_FM(1)) , M_5 )
CALL FMLI(M_5%MFM,FMLOG_INTEGRAL_INTERVAL_FM%LEFT)
CALL FMST2M('OVERFLOW',FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
GO TO 110
ENDIF
IF (LEFT_ENDPOINT(MA) > 1) THEN
KROUND = -1
CALL FMLI(MA%LEFT,FMLOG_INTEGRAL_INTERVAL_FM%LEFT)
KROUND = 2
IF (IS_OVERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMST2M('OVERFLOW',FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
ELSE
CALL FMLI(MA%RIGHT,FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
ENDIF
ELSE IF (RIGHT_ENDPOINT(MA) < 1) THEN
KROUND = -1
CALL FMLI(MA%RIGHT,FMLOG_INTEGRAL_INTERVAL_FM%LEFT)
KROUND = 2
IF (LEFT_ENDPOINT(MA) > 0) THEN
CALL FMLI(MA%LEFT,FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
ELSE
CALL FMI2M(0,FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
ENDIF
ELSE
CALL FMST2M('-OVERFLOW',FMLOG_INTEGRAL_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMST2M('-OVERFLOW',M_1%MFM)
IF (LEFT_ENDPOINT(MA) <= 0) CALL FMI2M(0,M_1%MFM)
IF (LEFT_ENDPOINT(MA) > 0 .AND. LEFT_ENDPOINT(MA) < 1) CALL FMLI(MA%LEFT,M_1%MFM)
CALL FMST2M('-OVERFLOW',M_2%MFM)
IF (RIGHT_ENDPOINT(MA) > 1) THEN
IF (IS_OVERFLOW(RIGHT_ENDPOINT(MA))) THEN
CALL FMST2M('OVERFLOW',M_2%MFM)
ELSE
CALL FMLI(MA%RIGHT,M_2%MFM)
ENDIF
ENDIF
CALL FMMAX(M_1%MFM,M_2%MFM,FMLOG_INTEGRAL_INTERVAL_FM%RIGHT)
ENDIF
110 KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_INTEGRAL_INTERVAL_FM
! SIN_INTEGRAL
FUNCTION FMSIN_INTEGRAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSIN_INTEGRAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
IF (LEFT_ENDPOINT(MA) >= 0) THEN
CALL FMSI_INTERVAL_POS(MA,FMSIN_INTEGRAL_INTERVAL_FM)
ELSE IF (RIGHT_ENDPOINT(MA) <= 0) THEN
CALL FMABS_INTERVAL(MA,M6FM_I)
CALL FMSI_INTERVAL_POS(M6FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(0),M7FM_I)
CALL FMSUB_INTERVAL(M7FM_I,M5FM_I,FMSIN_INTEGRAL_INTERVAL_FM)
ELSE
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(LEFT_ENDPOINT(MA),TO_FM(0)),M3FM_I)
CALL FMABS_INTERVAL(M3FM_I,M6FM_I)
CALL FMSI_INTERVAL_POS(M6FM_I,M4FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(TO_FM(0),RIGHT_ENDPOINT(MA)),M3FM_I)
CALL FMSI_INTERVAL_POS(M3FM_I,M5FM_I)
CALL FMEQ_INTERVAL(TO_FM_INTERVAL(-RIGHT_ENDPOINT(M4FM_I),RIGHT_ENDPOINT(M5FM_I)), &
FMSIN_INTEGRAL_INTERVAL_FM)
ENDIF
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_INTEGRAL_INTERVAL_FM
SUBROUTINE FMSI_INTERVAL_POS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: KRSAVE,KRAD_SAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = 1
CALL FM_PI(M_1)
IF (IS_OVERFLOW(LEFT_ENDPOINT(MA))) THEN
KROUND = -1
KRAD_SAVE = KRAD
KRAD = 1
CALL FM_I2M(1,M_1)
CALL FMASIN(M_1%MFM,MB%LEFT)
KROUND = 2
CALL FMASIN(M_1%MFM,MB%RIGHT)
KRAD = KRAD_SAVE
GO TO 110
ENDIF
CALL FM_EQ( FLOOR( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ( FLOOR( RIGHT_ENDPOINT(MA) / M_1 ) , M_3 )
IF ( M_3 == M_2 .AND. MOD(M_2,TO_FM(2)) == 0 ) THEN
KROUND = -1
CALL FMSI(MA%LEFT,MB%LEFT)
KROUND = 2
CALL FMSI(MA%RIGHT,MB%RIGHT)
ELSE IF ( M_3 == M_2 .AND. MOD(M_2,TO_FM(2)) == 1 ) THEN
KROUND = -1
CALL FMSI(MA%RIGHT,MB%LEFT)
KROUND = 2
CALL FMSI(MA%LEFT,MB%RIGHT)
ELSE IF ( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(2)) == 0 ) THEN
KROUND = -1
CALL FMSI(MA%LEFT,MTFM)
CALL FMSI(MA%RIGHT,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
CALL FM_EQ( M_1*M_3 , M_4 )
KROUND = 2
CALL FMSI(M_4%MFM,MB%RIGHT)
ELSE IF ( M_3 == M_2 + 1 .AND. MOD(M_2,TO_FM(2)) == 1 ) THEN
CALL FM_EQ( M_1*M_3 , M_4 )
KROUND = -1
CALL FMSI(M_4%MFM,MB%LEFT)
KROUND = 2
CALL FMSI(MA%LEFT,MTFM)
CALL FMSI(MA%RIGHT,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ELSE
CALL FM_EQ( CEILING( LEFT_ENDPOINT(MA) / M_1 ) , M_2 )
CALL FM_EQ(M_2,M_3)
IF (MOD(M_2,TO_FM(2)) == 1) THEN
CALL FM_ADDI(M_2,1)
ENDIF
CALL FM_MPY_R1(M_2,M_1)
KROUND = -1
CALL FMSI(MA%LEFT,MTFM)
CALL FMSI(M_2%MFM,MUFM)
CALL FMMIN(MTFM,MUFM,MB%LEFT)
KROUND = 1
IF (MOD(M_3,TO_FM(2)) == 0) THEN
CALL FM_ADDI(M_3,1)
ENDIF
CALL FM_MPY_R1(M_3,M_1)
KROUND = 2
CALL FMSI(MA%LEFT,MTFM)
CALL FMSI(M_3%MFM,MUFM)
CALL FMMAX(MTFM,MUFM,MB%RIGHT)
ENDIF
110 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMSI_INTERVAL_POS
! SINH_INTEGRAL
FUNCTION FMSINH_INTEGRAL_INTERVAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,FMSINH_INTEGRAL_INTERVAL_FM
INTENT (IN) :: MA
INTEGER :: KRSAVE,KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
KWRNSV = KWARN
KWARN = 0
KRSAVE = KROUND
KROUND = -1
CALL FMSHI(MA%LEFT,FMSINH_INTEGRAL_INTERVAL_FM%LEFT)
KROUND = 2
CALL FMSHI(MA%RIGHT,FMSINH_INTEGRAL_INTERVAL_FM%RIGHT)
KROUND = KRSAVE
KWARN = KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_INTEGRAL_INTERVAL_FM
END MODULE FM_INTERVAL_ARITHMETIC_9
MODULE FM_INTERVAL_ARITHMETIC_10
USE FM_INTERVAL_ARITHMETIC_1
CONTAINS
! Interface routines for calling with the FM_INTERVAL derived type.
SUBROUTINE FM_INTERVAL_ADD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MC)
CALL FMADD_INTERVAL(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ADD
SUBROUTINE FM_INTERVAL_ADD_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMADD_INTERVAL_R1(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ADD_R1
SUBROUTINE FM_INTERVAL_ADD_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMADD_INTERVAL_R2(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ADD_R2
SUBROUTINE FM_INTERVAL_ADDI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMADDI_INTERVAL(MA,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ADDI
SUBROUTINE FM_INTERVAL_DIV(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MC)
CALL FMDIV_INTERVAL(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DIV
SUBROUTINE FM_INTERVAL_DIV_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDIV_INTERVAL_R1(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DIV_R1
SUBROUTINE FM_INTERVAL_DIV_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMDIV_INTERVAL_R2(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DIV_R2
SUBROUTINE FM_INTERVAL_DIVI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMDIVI_INTERVAL(MA,IVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DIVI
SUBROUTINE FM_INTERVAL_DIVI_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDIVI_INTERVAL_R1(MA,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DIVI_R1
SUBROUTINE FM_INTERVAL_DP2M(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
DOUBLE PRECISION :: X
INTENT (IN) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMDP2M_INTERVAL(X,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_DP2M
SUBROUTINE FM_INTERVAL_EPSILON(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMI2M_INTERVAL(1,MTFM_I)
CALL FMULP_INTERVAL(MTFM_I,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_EPSILON
SUBROUTINE FM_INTERVAL_EQ(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMEQ_INTERVAL(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_EQ
SUBROUTINE FM_INTERVAL_EQU(MA,MB,NA,NB)
USE FMVALS
IMPLICIT NONE
INTEGER :: KA,KB,NA,NB,NDSAVE
INTENT (IN) :: NA,NB
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
KA = NA
KB = NB
NDSAVE = NDIG
NDIG = KA
CALL FMEQU_INTERVAL(MA,MB,KA,KB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_EQU
SUBROUTINE FM_INTERVAL_FORM(FORM,MA,STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM,STRING
INTENT (IN) :: FORM
INTENT (INOUT) :: STRING
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMFORM_INTERVAL(FORM,MA,STRING)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_FORM
SUBROUTINE FM_INTERVAL_MPY(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MC)
CALL FMMPY_INTERVAL(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_MPY
SUBROUTINE FM_INTERVAL_MPY_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMMPY_INTERVAL_R1(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_MPY_R1
SUBROUTINE FM_INTERVAL_MPY_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMMPY_INTERVAL_R2(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_MPY_R2
SUBROUTINE FM_INTERVAL_MPYI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMMPYI_INTERVAL(MA,IVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_MPYI
SUBROUTINE FM_INTERVAL_MPYI_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMMPYI_INTERVAL_R1(MA,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_MPYI_R1
SUBROUTINE FM_INTERVAL_READ(KREAD,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KREAD
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: KREAD
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMREAD_INTERVAL(KREAD,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_READ
SUBROUTINE FM_INTERVAL_WRITE(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: KWRITE
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMWRITE_INTERVAL(KWRITE,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_WRITE
SUBROUTINE FM_INTERVAL_RPWR(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: IVAL,JVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMRPWR_INTERVAL(MA,IVAL,JVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_RPWR
SUBROUTINE FM_INTERVAL_SP2M(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
REAL :: X
INTENT (IN) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSP2M_INTERVAL(X,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SP2M
SUBROUTINE FM_INTERVAL_SQRT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMSQRT_INTERVAL(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SQRT
SUBROUTINE FM_INTERVAL_SQRT_R1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSQRT_INTERVAL_R1(MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SQRT_R1
SUBROUTINE FM_INTERVAL_ST2M(STRING,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (INOUT) :: MA
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMST2M_INTERVAL(STRING,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ST2M
SUBROUTINE FM_INTERVAL_SUB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MC)
CALL FMSUB_INTERVAL(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SUB
SUBROUTINE FM_INTERVAL_SUB_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MA)
CALL FMSUB_INTERVAL_R1(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SUB_R1
SUBROUTINE FM_INTERVAL_SUB_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMSUB_INTERVAL_R2(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_SUB_R2
SUBROUTINE FM_INTERVAL_ULP(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FMULP_INTERVAL(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_ULP
SUBROUTINE IM_INTERVAL_FM2I(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
TYPE (IM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMFM2I_INTERVAL(MA,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_INTERVAL_FM2I
SUBROUTINE IM_INTERVAL_I2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
TYPE (FM_INTERVAL) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL IMI2FM_INTERVAL(MA%MIM,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_INTERVAL_I2FM
SUBROUTINE ZM_INTERVAL_CMPX(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTENT (IN) :: MA,MB
TYPE (ZM) :: MC
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FM_INTERVAL_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMCMPX_INTERVAL(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_INTERVAL_CMPX
SUBROUTINE FM_INTERVAL_RATIONAL_POWER(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: MA,IVAL,JVAL
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MA)
CALL FMEQ_INDEX_INTERVAL(MB)
CALL FM_INTERVAL_RPWR(MA,IVAL,JVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INTERVAL_RATIONAL_POWER
SUBROUTINE ZM_INTERVAL_COMPLEX(MAFM,MBFM,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MAFM,MBFM
TYPE (ZM) :: MC
INTENT (IN) :: MAFM,MBFM
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_INTERVAL_UNDEF_INP(MAFM)
CALL FM_INTERVAL_UNDEF_INP(MBFM)
CALL FMEQ_INDEX(MC)
CALL ZM_INTERVAL_CMPX(MAFM,MBFM,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_INTERVAL_COMPLEX
SUBROUTINE FMADDI_INTERVAL(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMI2M(IVAL,MTFM_I%LEFT)
CALL FMI2M(IVAL,MTFM_I%RIGHT)
CALL FMADD_INTERVAL(MA,MTFM_I,MUFM_I)
CALL FMEQ(MUFM_I%LEFT,MA%LEFT)
CALL FMEQ(MUFM_I%RIGHT,MA%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMADDI_INTERVAL
FUNCTION FMFORMAT2(FMT,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FMT
INTEGER :: MA
CHARACTER(200) :: FMFORMAT2
INTENT (IN) :: FMT,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMFORM(FMT,MA,FMFORMAT2)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFORMAT2
SUBROUTINE FMFORM_INTERVAL(FORM,MA,STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM,STRING
INTENT (IN) :: FORM
INTENT (INOUT) :: STRING
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
STRING = ' [' // TRIM(FMFORMAT2(FORM,MA%LEFT)) // &
' ,' // TRIM(FMFORMAT2(FORM,MA%RIGHT)) // ' ]'
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMFORM_INTERVAL
SUBROUTINE FMREAD_INTERVAL(KREAD,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KREAD
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: KREAD
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMREAD(KREAD,MA%LEFT)
CALL FMREAD(KREAD,MA%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMREAD_INTERVAL
SUBROUTINE FMPRINT_INTERVAL(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: MA
INTEGER :: KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
KROUND = -1
CALL FMPRINT(MA%LEFT)
KROUND = 2
CALL FMPRINT(MA%RIGHT)
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMPRINT_INTERVAL
SUBROUTINE FMWRITE_INTERVAL(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
TYPE (FM_INTERVAL) :: MA
INTENT (IN) :: KWRITE,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMWRITE(KWRITE,MA%LEFT)
CALL FMWRITE(KWRITE,MA%RIGHT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMWRITE_INTERVAL
SUBROUTINE FMRPWR_INTERVAL(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM_INTERVAL) :: MA,MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: IVAL,JVAL,MA
INTENT (INOUT) :: MB
INTEGER :: IV,JV,IJ_SIGN,KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
KRSAVE = KROUND
IV = ABS(IVAL)
JV = ABS(JVAL)
CALL FMGCDI(IV,JV)
IJ_SIGN = 1
IF (DBLE(IVAL)*DBLE(JVAL) < 0) IJ_SIGN = -1
IF (IJ_SIGN >= 0 .AND. MWK(START(MA%LEFT)) >= 0) THEN
KROUND = -1
CALL FMRPWR(MA%LEFT,IVAL,JVAL,MB%LEFT)
KROUND = 2
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%RIGHT)
GO TO 110
ENDIF
IF (IJ_SIGN < 0 .AND. MWK(START(MA%LEFT)) >= 0) THEN
KROUND = -1
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%LEFT)
KROUND = 2
CALL FMRPWR(MA%LEFT,IVAL,JVAL,MB%RIGHT)
GO TO 110
ENDIF
IF (IJ_SIGN >= 0 .AND. MOD(JV,2) == 1) THEN
KROUND = -1
CALL FMRPWR(MA%LEFT,IVAL,JVAL,MB%LEFT)
KROUND = 2
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%RIGHT)
GO TO 110
ENDIF
IF (IJ_SIGN < 0 .AND. MOD(JV,2) == 1) THEN
IF (MWK(START(MA%LEFT)) < 0 .AND. MWK(START(MA%RIGHT)) >= 0) THEN
CALL FMST2M('-OVERFLOW',MB%LEFT)
CALL FMST2M(' OVERFLOW',MB%RIGHT)
GO TO 110
ENDIF
KROUND = -1
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%LEFT)
KROUND = 2
CALL FMRPWR(MA%LEFT,IVAL,JVAL,MB%RIGHT)
GO TO 110
ENDIF
IF (MWK(START(MA%RIGHT)) < 0 .OR. MWK(START(MA%RIGHT)+3) == 0) THEN
CALL FMST2M('UNKNOWN',MB%LEFT)
CALL FMST2M('UNKNOWN',MB%RIGHT)
GO TO 110
ENDIF
IF (IJ_SIGN >= 0) THEN
CALL FMI2M(0,MB%LEFT)
KROUND = 2
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%RIGHT)
ELSE
CALL FMST2M(' OVERFLOW',MB%RIGHT)
KROUND = -1
CALL FMRPWR(MA%RIGHT,IVAL,JVAL,MB%LEFT)
ENDIF
110 KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMRPWR_INTERVAL
END MODULE FM_INTERVAL_ARITHMETIC_10
MODULE FM_INTERVAL_ARITHMETIC
USE FM_INTERVAL_ARITHMETIC_1
USE FM_INTERVAL_ARITHMETIC_2
USE FM_INTERVAL_ARITHMETIC_3
USE FM_INTERVAL_ARITHMETIC_4
USE FM_INTERVAL_ARITHMETIC_5
USE FM_INTERVAL_ARITHMETIC_6
USE FM_INTERVAL_ARITHMETIC_7
USE FM_INTERVAL_ARITHMETIC_8
USE FM_INTERVAL_ARITHMETIC_9
USE FM_INTERVAL_ARITHMETIC_10
END MODULE FM_INTERVAL_ARITHMETIC
c4science · Help