Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/basis_transformation/FMlib/FMquad/fm_doubleint.f95
cd1286e2d410improved_sugama

Last Change
Raw File

fm_doubleint.f95
View Options

MODULE FM_DOUBLE_INT
! FM_doubleint 1.3 David M. Smith Double Length Integer Support
! This module extends the definition of basic FM types (FM), (IM), and (ZM) so they can interact
! with double length integer variables.
! Warning: This module is needed only when the user's program explicitly declares double length
! integer variables. If double length integers are obtained by using a compiler switch
! to change the default integer size for the entire program (such as with gfortran's
! -fdefault-integer-8 option), then compiling the basic FM package with the same option
! means this module is not needed.
! Not all compilers might support double length integers, but for those that do, variables can be
! declared via the SELECTED_REAL_KIND function.
! For example, when this module was first written, typical computer hardware supported 32-bit
! integers as default precision and 64-bits as double precision. 64-bit integers allowed values
! up to 2**63 - 1, which has 19 decimal digits.
! So SELECTED_INT_KIND(15) could be used to select this 64-bit format.
! The routines in this interface extend basic functions like TO_FM, TO_IM, TO_ZM so they can be
! used with quad real or complex arguments. New conversion function TO_DOUBLE_INT will take FM,
! IM, or ZM inputs and convert to double integers.
! Other mixed-mode operations, such as assignment ( a = b ), logical comparisons, and arithmetic
! are also provided. As with the basic FMZM module, assignments and arithmetic may also involve
! 1 or 2-dimensional arrays.
USE FMZM
INTEGER, PARAMETER :: DOUBLE_INT = SELECTED_INT_KIND(15)
INTERFACE TO_FM
MODULE PROCEDURE FM_DI
MODULE PROCEDURE FM_DI1
MODULE PROCEDURE FM_DI2
END INTERFACE
INTERFACE TO_IM
MODULE PROCEDURE IM_DI
MODULE PROCEDURE IM_DI1
MODULE PROCEDURE IM_DI2
END INTERFACE
INTERFACE TO_ZM
MODULE PROCEDURE ZM_DI
MODULE PROCEDURE ZM2_DI
MODULE PROCEDURE ZM_DI1
MODULE PROCEDURE ZM_DI2
END INTERFACE
INTERFACE TO_DOUBLE_INT
MODULE PROCEDURE FM_2DI
MODULE PROCEDURE IM_2DI
MODULE PROCEDURE ZM_2DI
MODULE PROCEDURE FM_2DI1
MODULE PROCEDURE IM_2DI1
MODULE PROCEDURE ZM_2DI1
MODULE PROCEDURE FM_2DI2
MODULE PROCEDURE IM_2DI2
MODULE PROCEDURE ZM_2DI2
END INTERFACE
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE FMEQ_DIFM
MODULE PROCEDURE FMEQ_DIIM
MODULE PROCEDURE FMEQ_DIZM
MODULE PROCEDURE FMEQ_FMDI
MODULE PROCEDURE FMEQ_IMDI
MODULE PROCEDURE FMEQ_ZMDI
MODULE PROCEDURE FMEQ_FM1DI
MODULE PROCEDURE FMEQ_DI1FM
MODULE PROCEDURE FMEQ_FM1DI1
MODULE PROCEDURE FMEQ_DI1FM1
MODULE PROCEDURE FMEQ_IM1DI
MODULE PROCEDURE FMEQ_DI1IM
MODULE PROCEDURE FMEQ_IM1DI1
MODULE PROCEDURE FMEQ_DI1IM1
MODULE PROCEDURE FMEQ_ZM1DI
MODULE PROCEDURE FMEQ_DI1ZM
MODULE PROCEDURE FMEQ_ZM1DI1
MODULE PROCEDURE FMEQ_DI1ZM1
MODULE PROCEDURE FMEQ_FM2DI
MODULE PROCEDURE FMEQ_DI2FM
MODULE PROCEDURE FMEQ_FM2DI2
MODULE PROCEDURE FMEQ_DI2FM2
MODULE PROCEDURE FMEQ_IM2DI
MODULE PROCEDURE FMEQ_DI2IM
MODULE PROCEDURE FMEQ_IM2DI2
MODULE PROCEDURE FMEQ_DI2IM2
MODULE PROCEDURE FMEQ_ZM2DI
MODULE PROCEDURE FMEQ_DI2ZM
MODULE PROCEDURE FMEQ_ZM2DI2
MODULE PROCEDURE FMEQ_DI2ZM2
END INTERFACE
INTERFACE OPERATOR (==)
MODULE PROCEDURE FMLEQ_DIFM
MODULE PROCEDURE FMLEQ_DIIM
MODULE PROCEDURE FMLEQ_DIZM
MODULE PROCEDURE FMLEQ_FMDI
MODULE PROCEDURE FMLEQ_IMDI
MODULE PROCEDURE FMLEQ_ZMDI
END INTERFACE
INTERFACE OPERATOR (/=)
MODULE PROCEDURE FMLNE_DIFM
MODULE PROCEDURE FMLNE_DIIM
MODULE PROCEDURE FMLNE_DIZM
MODULE PROCEDURE FMLNE_FMDI
MODULE PROCEDURE FMLNE_IMDI
MODULE PROCEDURE FMLNE_ZMDI
END INTERFACE
INTERFACE OPERATOR (>)
MODULE PROCEDURE FMLGT_DIFM
MODULE PROCEDURE FMLGT_DIIM
MODULE PROCEDURE FMLGT_FMDI
MODULE PROCEDURE FMLGT_IMDI
END INTERFACE
INTERFACE OPERATOR (>=)
MODULE PROCEDURE FMLGE_DIFM
MODULE PROCEDURE FMLGE_DIIM
MODULE PROCEDURE FMLGE_FMDI
MODULE PROCEDURE FMLGE_IMDI
END INTERFACE
INTERFACE OPERATOR (<)
MODULE PROCEDURE FMLLT_DIFM
MODULE PROCEDURE FMLLT_DIIM
MODULE PROCEDURE FMLLT_FMDI
MODULE PROCEDURE FMLLT_IMDI
END INTERFACE
INTERFACE OPERATOR (<=)
MODULE PROCEDURE FMLLE_DIFM
MODULE PROCEDURE FMLLE_DIIM
MODULE PROCEDURE FMLLE_FMDI
MODULE PROCEDURE FMLLE_IMDI
END INTERFACE
INTERFACE OPERATOR (+)
MODULE PROCEDURE FMADD_DIFM
MODULE PROCEDURE FMADD_DIIM
MODULE PROCEDURE FMADD_DIZM
MODULE PROCEDURE FMADD_FMDI
MODULE PROCEDURE FMADD_IMDI
MODULE PROCEDURE FMADD_ZMDI
MODULE PROCEDURE FMADD_DIFM1
MODULE PROCEDURE FMADD_DIIM1
MODULE PROCEDURE FMADD_FMDI1
MODULE PROCEDURE FMADD_FM1DI
MODULE PROCEDURE FMADD_DI1FM
MODULE PROCEDURE FMADD_DI1FM1
MODULE PROCEDURE FMADD_FM1DI1
MODULE PROCEDURE FMADD_IMDI1
MODULE PROCEDURE FMADD_IM1DI
MODULE PROCEDURE FMADD_DI1IM
MODULE PROCEDURE FMADD_DI1IM1
MODULE PROCEDURE FMADD_IM1DI1
MODULE PROCEDURE FMADD_DIZM1
MODULE PROCEDURE FMADD_ZMDI1
MODULE PROCEDURE FMADD_ZM1DI
MODULE PROCEDURE FMADD_DI1ZM
MODULE PROCEDURE FMADD_DI1ZM1
MODULE PROCEDURE FMADD_ZM1DI1
MODULE PROCEDURE FMADD_DIFM2
MODULE PROCEDURE FMADD_DIIM2
MODULE PROCEDURE FMADD_FMDI2
MODULE PROCEDURE FMADD_FM2DI
MODULE PROCEDURE FMADD_DI2FM
MODULE PROCEDURE FMADD_DI2FM2
MODULE PROCEDURE FMADD_FM2DI2
MODULE PROCEDURE FMADD_IMDI2
MODULE PROCEDURE FMADD_IM2DI
MODULE PROCEDURE FMADD_DI2IM
MODULE PROCEDURE FMADD_DI2IM2
MODULE PROCEDURE FMADD_IM2DI2
MODULE PROCEDURE FMADD_DIZM2
MODULE PROCEDURE FMADD_ZMDI2
MODULE PROCEDURE FMADD_ZM2DI
MODULE PROCEDURE FMADD_DI2ZM
MODULE PROCEDURE FMADD_DI2ZM2
MODULE PROCEDURE FMADD_ZM2DI2
END INTERFACE
INTERFACE OPERATOR (-)
MODULE PROCEDURE FMSUB_DIFM
MODULE PROCEDURE FMSUB_DIIM
MODULE PROCEDURE FMSUB_DIZM
MODULE PROCEDURE FMSUB_FMDI
MODULE PROCEDURE FMSUB_IMDI
MODULE PROCEDURE FMSUB_ZMDI
MODULE PROCEDURE FMSUB_DIFM1
MODULE PROCEDURE FMSUB_DIIM1
MODULE PROCEDURE FMSUB_FMDI1
MODULE PROCEDURE FMSUB_FM1DI
MODULE PROCEDURE FMSUB_DI1FM
MODULE PROCEDURE FMSUB_DI1FM1
MODULE PROCEDURE FMSUB_FM1DI1
MODULE PROCEDURE FMSUB_IMDI1
MODULE PROCEDURE FMSUB_IM1DI
MODULE PROCEDURE FMSUB_DI1IM
MODULE PROCEDURE FMSUB_DI1IM1
MODULE PROCEDURE FMSUB_IM1DI1
MODULE PROCEDURE FMSUB_DIZM1
MODULE PROCEDURE FMSUB_ZMDI1
MODULE PROCEDURE FMSUB_ZM1DI
MODULE PROCEDURE FMSUB_DI1ZM
MODULE PROCEDURE FMSUB_DI1ZM1
MODULE PROCEDURE FMSUB_ZM1DI1
MODULE PROCEDURE FMSUB_DIFM2
MODULE PROCEDURE FMSUB_DIIM2
MODULE PROCEDURE FMSUB_FMDI2
MODULE PROCEDURE FMSUB_FM2DI
MODULE PROCEDURE FMSUB_DI2FM
MODULE PROCEDURE FMSUB_DI2FM2
MODULE PROCEDURE FMSUB_FM2DI2
MODULE PROCEDURE FMSUB_IMDI2
MODULE PROCEDURE FMSUB_IM2DI
MODULE PROCEDURE FMSUB_DI2IM
MODULE PROCEDURE FMSUB_DI2IM2
MODULE PROCEDURE FMSUB_IM2DI2
MODULE PROCEDURE FMSUB_DIZM2
MODULE PROCEDURE FMSUB_ZMDI2
MODULE PROCEDURE FMSUB_ZM2DI
MODULE PROCEDURE FMSUB_DI2ZM
MODULE PROCEDURE FMSUB_DI2ZM2
MODULE PROCEDURE FMSUB_ZM2DI2
END INTERFACE
INTERFACE OPERATOR (*)
MODULE PROCEDURE FMMPY_DIFM
MODULE PROCEDURE FMMPY_DIIM
MODULE PROCEDURE FMMPY_DIZM
MODULE PROCEDURE FMMPY_FMDI
MODULE PROCEDURE FMMPY_IMDI
MODULE PROCEDURE FMMPY_ZMDI
MODULE PROCEDURE FMMPY_DIFM1
MODULE PROCEDURE FMMPY_DIIM1
MODULE PROCEDURE FMMPY_FMDI1
MODULE PROCEDURE FMMPY_FM1DI
MODULE PROCEDURE FMMPY_DI1FM
MODULE PROCEDURE FMMPY_DI1FM1
MODULE PROCEDURE FMMPY_FM1DI1
MODULE PROCEDURE FMMPY_IMDI1
MODULE PROCEDURE FMMPY_IM1DI
MODULE PROCEDURE FMMPY_DI1IM
MODULE PROCEDURE FMMPY_DI1IM1
MODULE PROCEDURE FMMPY_IM1DI1
MODULE PROCEDURE FMMPY_DIZM1
MODULE PROCEDURE FMMPY_ZMDI1
MODULE PROCEDURE FMMPY_ZM1DI
MODULE PROCEDURE FMMPY_DI1ZM
MODULE PROCEDURE FMMPY_DI1ZM1
MODULE PROCEDURE FMMPY_ZM1DI1
MODULE PROCEDURE FMMPY_DIFM2
MODULE PROCEDURE FMMPY_DIIM2
MODULE PROCEDURE FMMPY_FMDI2
MODULE PROCEDURE FMMPY_FM2DI
MODULE PROCEDURE FMMPY_DI2FM
MODULE PROCEDURE FMMPY_DI2FM2
MODULE PROCEDURE FMMPY_FM2DI2
MODULE PROCEDURE FMMPY_IMDI2
MODULE PROCEDURE FMMPY_IM2DI
MODULE PROCEDURE FMMPY_DI2IM
MODULE PROCEDURE FMMPY_DI2IM2
MODULE PROCEDURE FMMPY_IM2DI2
MODULE PROCEDURE FMMPY_DIZM2
MODULE PROCEDURE FMMPY_ZMDI2
MODULE PROCEDURE FMMPY_ZM2DI
MODULE PROCEDURE FMMPY_DI2ZM
MODULE PROCEDURE FMMPY_DI2ZM2
MODULE PROCEDURE FMMPY_ZM2DI2
END INTERFACE
INTERFACE OPERATOR (/)
MODULE PROCEDURE FMDIV_DIFM
MODULE PROCEDURE FMDIV_DIIM
MODULE PROCEDURE FMDIV_DIZM
MODULE PROCEDURE FMDIV_FMDI
MODULE PROCEDURE FMDIV_IMDI
MODULE PROCEDURE FMDIV_ZMDI
MODULE PROCEDURE FMDIV_DIFM1
MODULE PROCEDURE FMDIV_DIIM1
MODULE PROCEDURE FMDIV_FMDI1
MODULE PROCEDURE FMDIV_FM1DI
MODULE PROCEDURE FMDIV_DI1FM
MODULE PROCEDURE FMDIV_DI1FM1
MODULE PROCEDURE FMDIV_FM1DI1
MODULE PROCEDURE FMDIV_IMDI1
MODULE PROCEDURE FMDIV_IM1DI
MODULE PROCEDURE FMDIV_DI1IM
MODULE PROCEDURE FMDIV_DI1IM1
MODULE PROCEDURE FMDIV_IM1DI1
MODULE PROCEDURE FMDIV_DIZM1
MODULE PROCEDURE FMDIV_ZMDI1
MODULE PROCEDURE FMDIV_ZM1DI
MODULE PROCEDURE FMDIV_DI1ZM
MODULE PROCEDURE FMDIV_DI1ZM1
MODULE PROCEDURE FMDIV_ZM1DI1
MODULE PROCEDURE FMDIV_DIFM2
MODULE PROCEDURE FMDIV_DIIM2
MODULE PROCEDURE FMDIV_FMDI2
MODULE PROCEDURE FMDIV_FM2DI
MODULE PROCEDURE FMDIV_DI2FM
MODULE PROCEDURE FMDIV_DI2FM2
MODULE PROCEDURE FMDIV_FM2DI2
MODULE PROCEDURE FMDIV_IMDI2
MODULE PROCEDURE FMDIV_IM2DI
MODULE PROCEDURE FMDIV_DI2IM
MODULE PROCEDURE FMDIV_DI2IM2
MODULE PROCEDURE FMDIV_IM2DI2
MODULE PROCEDURE FMDIV_DIZM2
MODULE PROCEDURE FMDIV_ZMDI2
MODULE PROCEDURE FMDIV_ZM2DI
MODULE PROCEDURE FMDIV_DI2ZM
MODULE PROCEDURE FMDIV_DI2ZM2
MODULE PROCEDURE FMDIV_ZM2DI2
END INTERFACE
INTERFACE OPERATOR (**)
MODULE PROCEDURE FMPWR_DIFM
MODULE PROCEDURE FMPWR_DIIM
MODULE PROCEDURE FMPWR_DIZM
MODULE PROCEDURE FMPWR_FMDI
MODULE PROCEDURE FMPWR_IMDI
MODULE PROCEDURE FMPWR_ZMDI
END INTERFACE
CONTAINS
SUBROUTINE FMDI2M(IVAL,MA)
! Convert double length integer IVAL to multiple precision MA.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
INTEGER (DOUBLE_INT) :: IVAL
REAL (KIND(1.0D0)) :: MK,ML,MVAL
INTEGER (DOUBLE_INT) :: J,JM2,KB,KB1,N1,NMVAL,NV2
CHARACTER(50) :: STR
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA <= 0) THEN
CALL FMDEFINE(MA)
ELSE IF (SIZE_OF(MA) < NDIG+3) THEN
CALL FMDEFINE(MA)
ENDIF
IF (MBLOGS /= MBASE) CALL FMCONS
KFLAG = 0
N1 = NDIG + 1
IF (ABS(IVAL) > MXBASE) THEN
WRITE (STR,"(I50)") IVAL
CALL FMST2M(STR,MA)
GO TO 150
ELSE
MVAL = ABS(IVAL)
NMVAL = MVAL
NV2 = NMVAL - 1
IF (NMVAL /= ABS(IVAL) .OR. NV2 /= ABS(IVAL)-1) THEN
WRITE (STR,"(I50)") IVAL
CALL FMST2M(STR,MA)
GO TO 150
ENDIF
ENDIF
! Check for small IVAL.
IF (MVAL < MBASE) THEN
DO J = 3, N1
MWK(START(MA)+J+1) = 0
ENDDO
IF (IVAL >= 0) THEN
MWK(START(MA)+3) = IVAL
MWK(START(MA)) = 1
ELSE
MWK(START(MA)+3) = -IVAL
MWK(START(MA)) = -1
ENDIF
IF (IVAL == 0) THEN
MWK(START(MA)+2) = 0
ELSE
MWK(START(MA)+2) = 1
ENDIF
GO TO 150
ENDIF
! Compute and store the digits, right to left.
MWK(START(MA)+2) = 0
J = NDIG + 1
120 MK = AINT (MVAL/MBASE)
ML = MVAL - MK*MBASE
MWK(START(MA)+2) = MWK(START(MA)+2) + 1
MWK(START(MA)+J+1) = ML
IF (MK > 0) THEN
MVAL = MK
J = J - 1
IF (J >= 2) GO TO 120
! Here IVAL cannot be expressed exactly.
WRITE (STR,"(I50)") IVAL
CALL FMST2M(STR,MA)
IF (TEMPV_CALL_STACK == 1) THEN
IF (TEMPV(MA) == -1) TEMPV(MA) = -2
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
! Normalize MA.
KB = N1 - J + 2
JM2 = J - 2
DO J = 2, KB
MWK(START(MA)+J+1) = MWK(START(MA)+J+JM2+1)
ENDDO
KB1 = KB + 1
IF (KB1 <= N1) THEN
DO J = KB1, N1
MWK(START(MA)+J+1) = 0
ENDDO
ENDIF
MWK(START(MA)) = 1
IF (IVAL < 0 .AND. MWK(START(MA)+2) /= MUNKNO .AND. MWK(START(MA)+3) /= 0) MWK(START(MA)) = -1
150 MWK(START(MA)+1) = NINT(NDIG*ALOGM2)
IF (TEMPV_CALL_STACK == 1) THEN
IF (TEMPV(MA) == -1) TEMPV(MA) = -2
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
END SUBROUTINE FMDI2M
SUBROUTINE FMM2DI(MA,IVAL)
! Convert multiple precision MA to double length integer IVAL.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
INTEGER (DOUBLE_INT) :: IVAL
INTEGER (DOUBLE_INT) :: IBASE,J,KA,KB,LARGE,N1
INTENT (IN) :: MA
INTENT (INOUT) :: IVAL
KFLAG = 0
N1 = NDIG + 1
LARGE = HUGE(IVAL)/MBASE
IBASE = MBASE
IVAL = 0
IF (MWK(START(MA)+2) <= 0) THEN
IF (MWK(START(MA)+3) /= 0) KFLAG = 2
RETURN
ENDIF
KB = MWK(START(MA)+2) + 1
IVAL = ABS(MWK(START(MA)+3))
IF (KB >= 3) THEN
DO J = 3, KB
IF (IVAL > LARGE) THEN
KFLAG = -4
IF (MWK(START(MA)+2) /= MUNKNO) CALL FMWARN
IVAL = IUNKNO
RETURN
ENDIF
IF (J <= N1) THEN
IVAL = IVAL*IBASE
IF (IVAL > HUGE(IVAL)-MWK(START(MA)+J+1)) THEN
KFLAG = -4
IF (MWK(START(MA)+2) /= MUNKNO) CALL FMWARN
IVAL = IUNKNO
RETURN
ELSE
IVAL = IVAL + INT(MWK(START(MA)+J+1))
ENDIF
ELSE
IVAL = IVAL*IBASE
ENDIF
ENDDO
ENDIF
IF (MWK(START(MA)) < 0) IVAL = -IVAL
! Check to see if MA is an integer.
KA = KB + 1
IF (KA <= N1) THEN
DO J = KA, N1
IF (MWK(START(MA)+J+1) /= 0) THEN
KFLAG = 2
RETURN
ENDIF
ENDDO
ENDIF
RETURN
END SUBROUTINE FMM2DI
SUBROUTINE IMDI2M(IVAL,MA)
! MA = IVAL
! Convert a double length integer to an IM number.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
INTEGER (DOUBLE_INT) :: IVAL
INTEGER :: ND2,NDSAVE
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
CALL FMDI2M(IVAL,MTFM)
IF (INT(MWK(START(MTFM)+2)) > NDIG) THEN
NDSAVE = NDIG
NDIG = MAX(2,INT(MWK(START(MTFM)+2)))
CALL FMDI2M(IVAL,MTFM)
CALL IMFM2I(MTFM,MA)
NDIG = NDSAVE
ELSE
CALL IMFM2I(MTFM,MA)
ENDIF
RETURN
END SUBROUTINE IMDI2M
SUBROUTINE IMM2DI(MA,IVAL)
! IVAL = MA
! Convert an IM number to double length integer.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
INTEGER (DOUBLE_INT) :: IVAL
INTEGER :: ND2,NDSAVE
INTENT (IN) :: MA
INTENT (INOUT) :: IVAL
NDSAVE = NDIG
NDIG = MAX(2,INT(MWK(START(MA)+2)))
CALL IMI2FM(MA,MTFM)
CALL FMM2DI(MTFM,IVAL)
NDIG = NDSAVE
RETURN
END SUBROUTINE IMM2DI
FUNCTION FM_DI(D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_DI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDI2M(D,FM_DI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_DI
FUNCTION FM_DI1(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FM_DI1
INTEGER :: J,N
INTENT (IN) :: D
FM_DI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),FM_DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_DI1
FUNCTION FM_DI2(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FM_DI2
INTEGER :: J,K
INTENT (IN) :: D
FM_DI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),FM_DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_DI2
FUNCTION IM_DI(D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_DI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL IMDI2M(D,IM_DI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_DI
FUNCTION IM_DI1(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: IM_DI1
INTEGER :: J,N
INTENT (IN) :: D
IM_DI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),IM_DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_DI1
FUNCTION IM_DI2(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: IM_DI2
INTEGER :: J,K
INTENT (IN) :: D
IM_DI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),IM_DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_DI2
FUNCTION ZM_DI(D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_DI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_DI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_DI
FUNCTION ZM2_DI(D1,D2)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM2_DI
INTEGER (DOUBLE_INT) :: D1,D2
INTENT (IN) :: D1,D2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDI2M(D1,MTFM)
CALL FMDI2M(D2,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM2_DI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM2_DI
FUNCTION ZM_DI1(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: ZM_DI1
INTEGER :: J,N
INTENT (IN) :: D
ZM_DI1%MZM(1) = -1
ZM_DI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_DI1
FUNCTION ZM_DI2(D)
USE FMVALS
IMPLICIT NONE
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: ZM_DI2
INTEGER :: J,K
INTENT (IN) :: D
ZM_DI2%MZM(1) = -1
ZM_DI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_DI2
FUNCTION FM_2DI(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: FM_2DI
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DI(MA%MFM,FM_2DI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DI
FUNCTION IM_2DI(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: IM_2DI
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DI(MA%MIM,IM_2DI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DI
FUNCTION ZM_2DI(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: ZM_2DI
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DI(MTFM,ZM_2DI)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DI
FUNCTION FM_2DI1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA)) :: FM_2DI1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2DI(MA(J)%MFM,FM_2DI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DI1
FUNCTION IM_2DI1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA)) :: IM_2DI1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMM2DI(MA(J)%MIM,IM_2DI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DI1
FUNCTION ZM_2DI1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA)) :: ZM_2DI1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2DI(MA(J)%MZM(1),ZM_2DI1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DI1
FUNCTION FM_2DI2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2DI2
INTEGER :: J,K
INTENT (IN) :: MA
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 FMM2DI(MA(J,K)%MFM,FM_2DI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DI2
FUNCTION IM_2DI2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2DI2
INTEGER :: J,K
INTENT (IN) :: MA
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 IMM2DI(MA(J,K)%MIM,IM_2DI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DI2
FUNCTION ZM_2DI2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2DI2
INTEGER :: J,K
INTENT (IN) :: MA
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 FMM2DI(MA(J,K)%MZM(1),ZM_2DI2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DI2
SUBROUTINE FMEQ_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DI(MA%MFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DIFM
SUBROUTINE FMEQ_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DI(MA%MIM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DIIM
SUBROUTINE FMEQ_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DI(MTFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DIZM
SUBROUTINE FMEQ_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDI2M(D,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMDI
SUBROUTINE FMEQ_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
INTEGER (DOUBLE_INT) :: D
CHARACTER(50) :: ST
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,MA%MIM)
ELSE
WRITE (ST,'(I50)') D
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMDI
SUBROUTINE FMEQ_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MA%MZM)
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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZMDI
SUBROUTINE FMEQ_FM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1DI
SUBROUTINE FMEQ_DI1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMM2DI(MA%MFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1FM
SUBROUTINE FMEQ_FM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA)
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDI2M(D(J),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1DI1
SUBROUTINE FMEQ_DI1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(D)
D(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMM2DI(MA(J)%MFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1FM1
SUBROUTINE FMEQ_FM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MTFM,MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2DI
SUBROUTINE FMEQ_DI2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DI(MA%MFM,D2)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
D(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2FM
SUBROUTINE FMEQ_FM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,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
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2DI2
SUBROUTINE FMEQ_DI2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMM2DI(MA(J,K)%MFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2FM2
SUBROUTINE FMEQ_IM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1DI
SUBROUTINE FMEQ_DI1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMM2DI(MA%MIM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1IM
SUBROUTINE FMEQ_IM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
CALL IMST2M(' UNKNOWN ',MTIM)
DO J = 1, SIZE(MA)
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDI2M(D(J),MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1DI1
SUBROUTINE FMEQ_DI1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
D(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMM2DI(MA(J)%MIM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1IM1
SUBROUTINE FMEQ_IM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMDI2M(D,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2DI
SUBROUTINE FMEQ_DI2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DI(MA%MIM,D2)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
D(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2IM
SUBROUTINE FMEQ_IM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
CALL IMST2M(' UNKNOWN ',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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2DI2
SUBROUTINE FMEQ_DI2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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)
D(J,K) = RUNKNO
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMM2DI(MA(J,K)%MIM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2IM2
SUBROUTINE FMEQ_ZM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMEQ(MTZM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM1DI
SUBROUTINE FMEQ_DI1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DI(MTFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1ZM
SUBROUTINE FMEQ_ZM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',MTZM)
DO J = 1, SIZE(MA)
CALL ZMEQ(MTZM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM1DI1
SUBROUTINE FMEQ_DI1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
D(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL ZMREAL(MA(J)%MZM,MTFM)
CALL FMM2DI(MTFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI1ZM1
SUBROUTINE FMEQ_ZM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MTZM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM2DI
SUBROUTINE FMEQ_DI2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER (DOUBLE_INT) :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DI(MTFM,D2)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
D(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2ZM
SUBROUTINE FMEQ_ZM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(D,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(D,DIM=2)) THEN
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MTZM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,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_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM2DI2
SUBROUTINE FMEQ_DI2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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)
D(J,K) = RUNKNO
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMREAL(MA(J,K)%MZM,MTFM)
CALL FMM2DI(MTFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DI2ZM2
FUNCTION FMLEQ_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLEQ_DIFM = FMCOMP(MTFM,'EQ',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DIFM
FUNCTION FMLEQ_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLEQ_DIIM = IMCOMP(MTIM,'EQ',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DIIM
FUNCTION FMLEQ_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DIZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMI2M(0,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_DIZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DIZM
FUNCTION FMLEQ_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLEQ_FMDI = FMCOMP(MA%MFM,'EQ',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMDI
FUNCTION FMLEQ_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_IMDI = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMDI
FUNCTION FMLEQ_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMDI,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMI2M(0,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZMDI = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMDI
FUNCTION FMLNE_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLNE_DIFM = FMCOMP(MTFM,'NE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DIFM
FUNCTION FMLNE_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLNE_DIIM = IMCOMP(MTIM,'NE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DIIM
FUNCTION FMLNE_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DIZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMI2M(0,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_DIZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DIZM
FUNCTION FMLNE_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLNE_FMDI = FMCOMP(MA%MFM,'NE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMDI
FUNCTION FMLNE_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_IMDI = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMDI
FUNCTION FMLNE_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMDI,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMI2M(0,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZMDI = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMDI
FUNCTION FMLGT_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLGT_DIFM = FMCOMP(MTFM,'GT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_DIFM
FUNCTION FMLGT_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLGT_DIIM = IMCOMP(MTIM,'GT',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_DIIM
FUNCTION FMLGT_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLGT_FMDI = FMCOMP(MA%MFM,'GT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMDI
FUNCTION FMLGT_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_IMDI = FMCOMP(MUFM,'GT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMDI
FUNCTION FMLGE_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLGE_DIFM = FMCOMP(MTFM,'GE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_DIFM
FUNCTION FMLGE_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLGE_DIIM = IMCOMP(MTIM,'GE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_DIIM
FUNCTION FMLGE_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLGE_FMDI = FMCOMP(MA%MFM,'GE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMDI
FUNCTION FMLGE_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_IMDI = FMCOMP(MUFM,'GE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMDI
FUNCTION FMLLT_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLLT_DIFM = FMCOMP(MTFM,'LT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_DIFM
FUNCTION FMLLT_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLLT_DIIM = IMCOMP(MTIM,'LT',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_DIIM
FUNCTION FMLLT_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLLT_FMDI = FMCOMP(MA%MFM,'LT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMDI
FUNCTION FMLLT_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_IMDI = FMCOMP(MUFM,'LT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMDI
FUNCTION FMLLE_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_DIFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLLE_DIFM = FMCOMP(MTFM,'LE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_DIFM
FUNCTION FMLLE_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_DIIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
FMLLE_DIIM = IMCOMP(MTIM,'LE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_DIIM
FUNCTION FMLLE_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
FMLLE_FMDI = FMCOMP(MA%MFM,'LE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMDI
FUNCTION FMLLE_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMDI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL FMDI2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_IMDI = FMCOMP(MUFM,'LE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMDI
FUNCTION FMADD_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_DIFM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_DIFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIFM
FUNCTION FMADD_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMADD_DIIM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_DIIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIIM
FUNCTION FMADD_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_DIZM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_DIZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIZM
FUNCTION FMADD_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMDI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMDI
FUNCTION FMADD_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMADD_IMDI
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMDI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMDI
FUNCTION FMADD_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMDI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMDI
FUNCTION FMADD_DIFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_DIFM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MA(J)%MFM,FMADD_DIFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIFM1
FUNCTION FMADD_DIIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_DIIM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMADD(MTIM,MA(J)%MIM,FMADD_DIIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIIM1
FUNCTION FMADD_FMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_FMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_FMDI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMDI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMDI1
FUNCTION FMADD_FM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_FM1DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1DI(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1DI
FUNCTION FMADD_DI1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_DI1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_DI1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1FM
FUNCTION FMADD_FM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_FM1DI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1DI1
FUNCTION FMADD_DI1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_DI1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMADD(MTFM,MA(J)%MFM,FMADD_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1FM1
FUNCTION FMADD_DIFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DIFM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_DIFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIFM2
FUNCTION FMADD_DIIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DIIM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MTIM,MA(J,K)%MIM,FMADD_DIIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIIM2
FUNCTION FMADD_FMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_FMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_FMDI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMDI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMDI2
FUNCTION FMADD_FM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_FM2DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2DI(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2DI
FUNCTION FMADD_DI2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_DI2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2FM
FUNCTION FMADD_FM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_FM2DI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMADD_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2DI2
FUNCTION FMADD_DI2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMADD_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2FM2
FUNCTION FMADD_IMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMADD_IMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_IMDI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMDI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMDI1
FUNCTION FMADD_IM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_IM1DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMADD(MA(J)%MIM,MTIM,FMADD_IM1DI(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1DI
FUNCTION FMADD_DI1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMADD_DI1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_DI1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1IM
FUNCTION FMADD_IM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_IM1DI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMADD_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMADD(MA(J)%MIM,MTIM,FMADD_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1DI1
FUNCTION FMADD_DI1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMADD_DI1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMADD_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMADD(MTIM,MA(J)%MIM,FMADD_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1IM1
FUNCTION FMADD_IMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_IMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_IMDI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMDI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMDI2
FUNCTION FMADD_IM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_IM2DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MA(J,K)%MIM,MTIM,FMADD_IM2DI(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2DI
FUNCTION FMADD_DI2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_DI2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2IM
FUNCTION FMADD_IM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_IM2DI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMADD_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMADD(MA(J,K)%MIM,MTIM,FMADD_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2DI2
FUNCTION FMADD_DI2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMADD_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMADD(MTIM,MA(J,K)%MIM,FMADD_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2IM2
FUNCTION FMADD_DIZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_DIZM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIZM1%MZM(1) = -1
FMADD_DIZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_DIZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIZM1
FUNCTION FMADD_ZMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_ZMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_ZMDI1%MZM(1) = -1
FMADD_ZMDI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMDI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMDI1
FUNCTION FMADD_ZM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_ZM1DI%MZM(1) = -1
FMADD_ZM1DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1DI(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1DI
FUNCTION FMADD_DI1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_DI1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1ZM%MZM(1) = -1
FMADD_DI1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_DI1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1ZM
FUNCTION FMADD_ZM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_ZM1DI1%MZM(1) = -1
FMADD_ZM1DI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1DI1
FUNCTION FMADD_DI1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_DI1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_DI1ZM1%MZM(1) = -1
FMADD_DI1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI1ZM1
FUNCTION FMADD_DIZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DIZM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_DIZM2%MZM(1) = -1
FMADD_DIZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_DIZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIZM2
FUNCTION FMADD_ZMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_ZMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_ZMDI2%MZM(1) = -1
FMADD_ZMDI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMDI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMDI2
FUNCTION FMADD_ZM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMADD_ZM2DI%MZM(1) = -1
FMADD_ZM2DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2DI(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2DI
FUNCTION FMADD_DI2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2ZM%MZM(1) = -1
FMADD_DI2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_DI2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2ZM
FUNCTION FMADD_ZM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_ZM2DI2%MZM(1) = -1
FMADD_ZM2DI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2DI2
FUNCTION FMADD_DI2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_DI2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_DI2ZM2%MZM(1) = -1
FMADD_DI2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DI2ZM2
FUNCTION FMSUB_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_DIFM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_DIFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIFM
FUNCTION FMSUB_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMSUB_DIIM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
CALL IMSUB(MTFM,MA%MIM,FMSUB_DIIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIIM
FUNCTION FMSUB_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_DIZM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_DIZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIZM
FUNCTION FMSUB_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMDI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMDI
FUNCTION FMSUB_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMSUB_IMDI
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMDI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMDI
FUNCTION FMSUB_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMDI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMDI
FUNCTION FMSUB_DIFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_DIFM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_DIFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIFM1
FUNCTION FMSUB_DIIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_DIIM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, N
CALL IMSUB(MTFM,MA(J)%MIM,FMSUB_DIIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIIM1
FUNCTION FMSUB_FMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_FMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_FMDI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMDI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMDI1
FUNCTION FMSUB_FM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_FM1DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1DI(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1DI
FUNCTION FMSUB_DI1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_DI1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_DI1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1FM
FUNCTION FMSUB_FM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_FM1DI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1DI1
FUNCTION FMSUB_DI1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_DI1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1FM1
FUNCTION FMSUB_DIFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DIFM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_DIFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIFM2
FUNCTION FMSUB_DIIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DIIM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MTFM,MA(J,K)%MIM,FMSUB_DIIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIIM2
FUNCTION FMSUB_FMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_FMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_FMDI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMDI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMDI2
FUNCTION FMSUB_FM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_FM2DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2DI(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2DI
FUNCTION FMSUB_DI2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_DI2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2FM
FUNCTION FMSUB_FM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_FM2DI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMSUB_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2DI2
FUNCTION FMSUB_DI2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMSUB_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2FM2
FUNCTION FMSUB_IMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMSUB_IMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_IMDI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMDI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMDI1
FUNCTION FMSUB_IM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_IM1DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMSUB(MA(J)%MIM,MTIM,FMSUB_IM1DI(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1DI
FUNCTION FMSUB_DI1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMSUB_DI1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMSUB(MTIM,MA%MIM,FMSUB_DI1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1IM
FUNCTION FMSUB_IM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_IM1DI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMSUB_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMSUB(MA(J)%MIM,MTIM,FMSUB_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1DI1
FUNCTION FMSUB_DI1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMSUB_DI1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMSUB_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMSUB(MTIM,MA(J)%MIM,FMSUB_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1IM1
FUNCTION FMSUB_IMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_IMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_IMDI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMDI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMDI2
FUNCTION FMSUB_IM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_IM2DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MA(J,K)%MIM,MTIM,FMSUB_IM2DI(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2DI
FUNCTION FMSUB_DI2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMSUB(MTIM,MA%MIM,FMSUB_DI2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2IM
FUNCTION FMSUB_IM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_IM2DI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMSUB_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMSUB(MA(J,K)%MIM,MTIM,FMSUB_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2DI2
FUNCTION FMSUB_DI2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMSUB_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMSUB(MTIM,MA(J,K)%MIM,FMSUB_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2IM2
FUNCTION FMSUB_DIZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_DIZM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIZM1%MZM(1) = -1
FMSUB_DIZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_DIZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIZM1
FUNCTION FMSUB_ZMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_ZMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_ZMDI1%MZM(1) = -1
FMSUB_ZMDI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMDI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMDI1
FUNCTION FMSUB_ZM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_ZM1DI%MZM(1) = -1
FMSUB_ZM1DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1DI(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1DI
FUNCTION FMSUB_DI1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_DI1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1ZM%MZM(1) = -1
FMSUB_DI1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_DI1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1ZM
FUNCTION FMSUB_ZM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM1DI1%MZM(1) = -1
FMSUB_ZM1DI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1DI1
FUNCTION FMSUB_DI1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_DI1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_DI1ZM1%MZM(1) = -1
FMSUB_DI1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI1ZM1
FUNCTION FMSUB_DIZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DIZM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_DIZM2%MZM(1) = -1
FMSUB_DIZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_DIZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIZM2
FUNCTION FMSUB_ZMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_ZMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_ZMDI2%MZM(1) = -1
FMSUB_ZMDI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMDI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMDI2
FUNCTION FMSUB_ZM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMSUB_ZM2DI%MZM(1) = -1
FMSUB_ZM2DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2DI(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2DI
FUNCTION FMSUB_DI2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2ZM%MZM(1) = -1
FMSUB_DI2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_DI2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2ZM
FUNCTION FMSUB_ZM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM2DI2%MZM(1) = -1
FMSUB_ZM2DI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2DI2
FUNCTION FMSUB_DI2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_DI2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_DI2ZM2%MZM(1) = -1
FMSUB_DI2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DI2ZM2
FUNCTION FMMPY_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_DIFM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_DIFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIFM
FUNCTION FMMPY_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMMPY_DIIM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
CALL IMMPY(MTFM,MA%MIM,FMMPY_DIIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIIM
FUNCTION FMMPY_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_DIZM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_DIZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIZM
FUNCTION FMMPY_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMDI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMDI
FUNCTION FMMPY_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMMPY_IMDI
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMMPY(MA%MIM,MTIM,FMMPY_IMDI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMDI
FUNCTION FMMPY_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMDI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMDI
FUNCTION FMMPY_DIFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_DIFM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_DIFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIFM1
FUNCTION FMMPY_DIIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_DIIM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, N
CALL IMMPY(MTFM,MA(J)%MIM,FMMPY_DIIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIIM1
FUNCTION FMMPY_FMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_FMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_FMDI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMDI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMDI1
FUNCTION FMMPY_FM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_FM1DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1DI(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1DI
FUNCTION FMMPY_DI1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_DI1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_DI1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1FM
FUNCTION FMMPY_FM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_FM1DI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1DI1
FUNCTION FMMPY_DI1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_DI1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1FM1
FUNCTION FMMPY_DIFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DIFM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_DIFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIFM2
FUNCTION FMMPY_DIIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DIIM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MTFM,MA(J,K)%MIM,FMMPY_DIIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIIM2
FUNCTION FMMPY_FMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_FMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_FMDI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMDI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMDI2
FUNCTION FMMPY_FM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_FM2DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2DI(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2DI
FUNCTION FMMPY_DI2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_DI2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2FM
FUNCTION FMMPY_FM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_FM2DI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMMPY_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2DI2
FUNCTION FMMPY_DI2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMMPY_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2FM2
FUNCTION FMMPY_IMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMMPY_IMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_IMDI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMMPY(MA%MIM,MTIM,FMMPY_IMDI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMDI1
FUNCTION FMMPY_IM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_IM1DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMMPY(MA(J)%MIM,MTIM,FMMPY_IM1DI(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1DI
FUNCTION FMMPY_DI1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMMPY_DI1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMMPY(MTIM,MA%MIM,FMMPY_DI1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1IM
FUNCTION FMMPY_IM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_IM1DI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMMPY_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMMPY(MA(J)%MIM,MTIM,FMMPY_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1DI1
FUNCTION FMMPY_DI1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMMPY_DI1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMMPY_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMMPY(MTIM,MA(J)%MIM,FMMPY_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1IM1
FUNCTION FMMPY_IMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_IMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_IMDI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMMPY(MA%MIM,MTIM,FMMPY_IMDI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMDI2
FUNCTION FMMPY_IM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_IM2DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MA(J,K)%MIM,MTIM,FMMPY_IM2DI(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2DI
FUNCTION FMMPY_DI2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMMPY(MTIM,MA%MIM,FMMPY_DI2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2IM
FUNCTION FMMPY_IM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_IM2DI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMMPY_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMMPY(MA(J,K)%MIM,MTIM,FMMPY_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2DI2
FUNCTION FMMPY_DI2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMMPY_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMMPY(MTIM,MA(J,K)%MIM,FMMPY_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2IM2
FUNCTION FMMPY_DIZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_DIZM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIZM1%MZM(1) = -1
FMMPY_DIZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_DIZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIZM1
FUNCTION FMMPY_ZMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_ZMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_ZMDI1%MZM(1) = -1
FMMPY_ZMDI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMDI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMDI1
FUNCTION FMMPY_ZM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_ZM1DI%MZM(1) = -1
FMMPY_ZM1DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1DI(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1DI
FUNCTION FMMPY_DI1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_DI1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1ZM%MZM(1) = -1
FMMPY_DI1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_DI1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1ZM
FUNCTION FMMPY_ZM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM1DI1%MZM(1) = -1
FMMPY_ZM1DI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1DI1
FUNCTION FMMPY_DI1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_DI1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_DI1ZM1%MZM(1) = -1
FMMPY_DI1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI1ZM1
FUNCTION FMMPY_DIZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DIZM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_DIZM2%MZM(1) = -1
FMMPY_DIZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_DIZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIZM2
FUNCTION FMMPY_ZMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_ZMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_ZMDI2%MZM(1) = -1
FMMPY_ZMDI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMDI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMDI2
FUNCTION FMMPY_ZM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMMPY_ZM2DI%MZM(1) = -1
FMMPY_ZM2DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2DI(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2DI
FUNCTION FMMPY_DI2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2ZM%MZM(1) = -1
FMMPY_DI2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_DI2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2ZM
FUNCTION FMMPY_ZM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM2DI2%MZM(1) = -1
FMMPY_ZM2DI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2DI2
FUNCTION FMMPY_DI2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_DI2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_DI2ZM2%MZM(1) = -1
FMMPY_DI2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DI2ZM2
FUNCTION FMDIV_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_DIFM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_DIFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIFM
FUNCTION FMDIV_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMDIV_DIIM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
CALL IMDIV(MTFM,MA%MIM,FMDIV_DIIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIIM
FUNCTION FMDIV_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_DIZM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_DIZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIZM
FUNCTION FMDIV_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMDI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMDI
FUNCTION FMDIV_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMDIV_IMDI
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMDIV(MA%MIM,MTIM,FMDIV_IMDI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMDI
FUNCTION FMDIV_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMDI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMDI
FUNCTION FMDIV_DIFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_DIFM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_DIFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIFM1
FUNCTION FMDIV_DIIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_DIIM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, N
CALL IMDIV(MTFM,MA(J)%MIM,FMDIV_DIIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIIM1
FUNCTION FMDIV_FMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_FMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_FMDI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMDI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMDI1
FUNCTION FMDIV_FM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_FM1DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1DI(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1DI
FUNCTION FMDIV_DI1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_DI1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_DI1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1FM
FUNCTION FMDIV_FM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_FM1DI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1DI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1DI1
FUNCTION FMDIV_DI1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_DI1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_DI1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1FM1
FUNCTION FMDIV_DIFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DIFM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_DIFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIFM2
FUNCTION FMDIV_DIIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DIIM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MTFM,MA(J,K)%MIM,FMDIV_DIIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIIM2
FUNCTION FMDIV_FMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_FMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_FMDI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMDI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMDI2
FUNCTION FMDIV_FM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_FM2DI%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2DI(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2DI
FUNCTION FMDIV_DI2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_DI2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2FM
FUNCTION FMDIV_FM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_FM2DI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMDIV_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2DI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2DI2
FUNCTION FMDIV_DI2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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(' UNKNOWN ',FMDIV_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_DI2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2FM2
FUNCTION FMDIV_IMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMDIV_IMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_IMDI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMDIV(MA%MIM,MTIM,FMDIV_IMDI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMDI1
FUNCTION FMDIV_IM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_IM1DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, N
CALL IMDIV(MA(J)%MIM,MTIM,FMDIV_IM1DI(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1DI
FUNCTION FMDIV_DI1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMDIV_DI1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMDIV(MTIM,MA%MIM,FMDIV_DI1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1IM
FUNCTION FMDIV_IM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_IM1DI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMDIV_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMDIV(MA(J)%MIM,MTIM,FMDIV_IM1DI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1DI1
FUNCTION FMDIV_DI1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: FMDIV_DI1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMDIV_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMDI2M(D(J),MTIM)
CALL IMDIV(MTIM,MA(J)%MIM,FMDIV_DI1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1IM1
FUNCTION FMDIV_IMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_IMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_IMDI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMDIV(MA%MIM,MTIM,FMDIV_IMDI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMDI2
FUNCTION FMDIV_IM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_IM2DI%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MA(J,K)%MIM,MTIM,FMDIV_IM2DI(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2DI
FUNCTION FMDIV_DI2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMDIV(MTIM,MA%MIM,FMDIV_DI2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2IM
FUNCTION FMDIV_IM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_IM2DI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMDIV_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMDIV(MA(J,K)%MIM,MTIM,FMDIV_IM2DI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2DI2
FUNCTION FMDIV_DI2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 IMST2M(' UNKNOWN ',FMDIV_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDI2M(D(J,K),MTIM)
CALL IMDIV(MTIM,MA(J,K)%MIM,FMDIV_DI2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2IM2
FUNCTION FMDIV_DIZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_DIZM1
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIZM1%MZM(1) = -1
FMDIV_DIZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_DIZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIZM1
FUNCTION FMDIV_ZMDI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_ZMDI1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_ZMDI1%MZM(1) = -1
FMDIV_ZMDI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMDI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMDI1
FUNCTION FMDIV_ZM1DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1DI
INTEGER :: J,N
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_ZM1DI%MZM(1) = -1
FMDIV_ZM1DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1DI(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1DI
FUNCTION FMDIV_DI1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_DI1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1ZM%MZM(1) = -1
FMDIV_DI1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_DI1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1ZM
FUNCTION FMDIV_ZM1DI1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1DI1
INTEGER :: J,N
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM1DI1%MZM(1) = -1
FMDIV_ZM1DI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1DI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1DI1
FUNCTION FMDIV_DI1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_DI1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_DI1ZM1%MZM(1) = -1
FMDIV_DI1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(D)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDI2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_DI1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI1ZM1
FUNCTION FMDIV_DIZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DIZM2
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_DIZM2%MZM(1) = -1
FMDIV_DIZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_DIZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIZM2
FUNCTION FMDIV_ZMDI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_ZMDI2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_ZMDI2%MZM(1) = -1
FMDIV_ZMDI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMDI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMDI2
FUNCTION FMDIV_ZM2DI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2DI
INTEGER :: J,K
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
FMDIV_ZM2DI%MZM(1) = -1
FMDIV_ZM2DI%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2DI(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2DI
FUNCTION FMDIV_DI2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2ZM%MZM(1) = -1
FMDIV_DI2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_DI2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2ZM
FUNCTION FMDIV_ZM2DI2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2DI2
INTEGER :: J,K
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM2DI2%MZM(1) = -1
FMDIV_ZM2DI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2DI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2DI2
FUNCTION FMDIV_DI2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER (DOUBLE_INT), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_DI2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_DI2ZM2%MZM(1) = -1
FMDIV_DI2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDI2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_DI2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DI2ZM2
FUNCTION FMPWR_DIFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_DIFM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMPWR(MTFM,MA%MFM,FMPWR_DIFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DIFM
FUNCTION FMPWR_DIIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMPWR_DIIM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTFM)
CALL IMPWR(MTFM,MA%MIM,FMPWR_DIIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DIIM
FUNCTION FMPWR_DIZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_DIZM
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_DIZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DIZM
FUNCTION FMPWR_FMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMPWR(MA%MFM,MTFM,FMPWR_FMDI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMDI
FUNCTION FMPWR_IMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMPWR_IMDI
TYPE (IM) :: MA
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDI2M(D,MTIM)
CALL IMPWR(MA%MIM,MTIM,FMPWR_IMDI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMDI
FUNCTION FMPWR_ZMDI(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMDI
INTEGER (DOUBLE_INT) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDI2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMDI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMDI
END MODULE FM_DOUBLE_INT
c4science · Help