Homec4science
Diffusion COSOlver (improved_sugama) Browse

cosolver/FM/FMquad/fm_quadreal.f95
cd1286e2d410improved_sugama

Last Change
Raw File

fm_quadreal.f95
View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
MODULE FM_QUAD_REAL
! FM_quadreal 1.3 David M. Smith Quadruple Precision Real and Complex Support
! This module extends the definition of basic FM types (FM), (IM), and (ZM) so they can interact
! with quadruple precision real and complex variables.
! Warning: This module is needed only when the user's program explicitly declares quadruple
! precision variables. If quad precision is obtained by using a compiler switch
! to change the default real size for the entire program (such as with gfortran's
! -fdefault-real-8 option), then compiling the basic FM package with the same option
! means this module is not needed.
! Not all compilers might support quadruple precision floating-point, 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
! floats as single precision and 64-bits as double precision. Some compilers offered 128-bit
! quadruple precision implemented in software. This format used 113 bits for the fraction
! part of a floating-point number, giving about 34 significant digits of precision.
! So SELECTED_REAL_KIND(30) could be used to select this quad 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 functions TO_QUAD and TO_QUAD_Z
! will take FM, IM, or ZM inputs and convert to quad real or complex.
! 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 :: QUAD_FP = SELECTED_REAL_KIND(30)
REAL (QUAD_FP), PARAMETER :: Q_ZERO = 0, Q_ONE = 1
INTERFACE TO_FM
MODULE PROCEDURE FM_Q
MODULE PROCEDURE FM_ZQ
MODULE PROCEDURE FM_Q1
MODULE PROCEDURE FM_ZQ1
MODULE PROCEDURE FM_Q2
MODULE PROCEDURE FM_ZQ2
END INTERFACE
INTERFACE TO_IM
MODULE PROCEDURE IM_Q
MODULE PROCEDURE IM_ZQ
MODULE PROCEDURE IM_Q1
MODULE PROCEDURE IM_ZQ1
MODULE PROCEDURE IM_Q2
MODULE PROCEDURE IM_ZQ2
END INTERFACE
INTERFACE TO_ZM
MODULE PROCEDURE ZM_Q
MODULE PROCEDURE ZM2_Q
MODULE PROCEDURE ZM_ZQ
MODULE PROCEDURE ZM_Q1
MODULE PROCEDURE ZM_ZQ1
MODULE PROCEDURE ZM_Q2
MODULE PROCEDURE ZM_ZQ2
END INTERFACE
INTERFACE TO_QUAD
MODULE PROCEDURE FM_2QUAD
MODULE PROCEDURE IM_2QUAD
MODULE PROCEDURE ZM_2QUAD
MODULE PROCEDURE FM_2QUAD1
MODULE PROCEDURE IM_2QUAD1
MODULE PROCEDURE ZM_2QUAD1
MODULE PROCEDURE FM_2QUAD2
MODULE PROCEDURE IM_2QUAD2
MODULE PROCEDURE ZM_2QUAD2
END INTERFACE
INTERFACE TO_QUAD_Z
MODULE PROCEDURE FM_2QUADZ
MODULE PROCEDURE IM_2QUADZ
MODULE PROCEDURE ZM_2QUADZ
MODULE PROCEDURE FM_2QUADZ1
MODULE PROCEDURE IM_2QUADZ1
MODULE PROCEDURE ZM_2QUADZ1
MODULE PROCEDURE FM_2QUADZ2
MODULE PROCEDURE IM_2QUADZ2
MODULE PROCEDURE ZM_2QUADZ2
END INTERFACE
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE FMEQ_QFM
MODULE PROCEDURE FMEQ_QIM
MODULE PROCEDURE FMEQ_QZM
MODULE PROCEDURE FMEQ_ZQFM
MODULE PROCEDURE FMEQ_ZQIM
MODULE PROCEDURE FMEQ_ZQZM
MODULE PROCEDURE FMEQ_FMQ
MODULE PROCEDURE FMEQ_FMZQ
MODULE PROCEDURE FMEQ_IMQ
MODULE PROCEDURE FMEQ_IMZQ
MODULE PROCEDURE FMEQ_ZMQ
MODULE PROCEDURE FMEQ_ZMZQ
MODULE PROCEDURE FMEQ_FM1Q
MODULE PROCEDURE FMEQ_FM1ZQ
MODULE PROCEDURE FMEQ_Q1FM
MODULE PROCEDURE FMEQ_ZQ1FM
MODULE PROCEDURE FMEQ_FM1Q1
MODULE PROCEDURE FMEQ_FM1ZQ1
MODULE PROCEDURE FMEQ_Q1FM1
MODULE PROCEDURE FMEQ_ZQ1FM1
MODULE PROCEDURE FMEQ_IM1Q
MODULE PROCEDURE FMEQ_IM1ZQ
MODULE PROCEDURE FMEQ_Q1IM
MODULE PROCEDURE FMEQ_ZQ1IM
MODULE PROCEDURE FMEQ_IM1Q1
MODULE PROCEDURE FMEQ_IM1ZQ1
MODULE PROCEDURE FMEQ_Q1IM1
MODULE PROCEDURE FMEQ_ZQ1IM1
MODULE PROCEDURE FMEQ_ZM1Q
MODULE PROCEDURE FMEQ_ZM1ZQ
MODULE PROCEDURE FMEQ_Q1ZM
MODULE PROCEDURE FMEQ_ZQ1ZM
MODULE PROCEDURE FMEQ_ZM1Q1
MODULE PROCEDURE FMEQ_ZM1ZQ1
MODULE PROCEDURE FMEQ_Q1ZM1
MODULE PROCEDURE FMEQ_ZQ1ZM1
MODULE PROCEDURE FMEQ_FM2Q
MODULE PROCEDURE FMEQ_FM2ZQ
MODULE PROCEDURE FMEQ_Q2FM
MODULE PROCEDURE FMEQ_ZQ2FM
MODULE PROCEDURE FMEQ_FM2Q2
MODULE PROCEDURE FMEQ_FM2ZQ2
MODULE PROCEDURE FMEQ_Q2FM2
MODULE PROCEDURE FMEQ_ZQ2FM2
MODULE PROCEDURE FMEQ_IM2Q
MODULE PROCEDURE FMEQ_IM2ZQ
MODULE PROCEDURE FMEQ_Q2IM
MODULE PROCEDURE FMEQ_ZQ2IM
MODULE PROCEDURE FMEQ_IM2Q2
MODULE PROCEDURE FMEQ_IM2ZQ2
MODULE PROCEDURE FMEQ_Q2IM2
MODULE PROCEDURE FMEQ_ZQ2IM2
MODULE PROCEDURE FMEQ_ZM2Q
MODULE PROCEDURE FMEQ_ZM2ZQ
MODULE PROCEDURE FMEQ_Q2ZM
MODULE PROCEDURE FMEQ_ZQ2ZM
MODULE PROCEDURE FMEQ_ZM2Q2
MODULE PROCEDURE FMEQ_ZM2ZQ2
MODULE PROCEDURE FMEQ_Q2ZM2
MODULE PROCEDURE FMEQ_ZQ2ZM2
END INTERFACE
INTERFACE OPERATOR (==)
MODULE PROCEDURE FMLEQ_QFM
MODULE PROCEDURE FMLEQ_QIM
MODULE PROCEDURE FMLEQ_QZM
MODULE PROCEDURE FMLEQ_ZQFM
MODULE PROCEDURE FMLEQ_ZQIM
MODULE PROCEDURE FMLEQ_ZQZM
MODULE PROCEDURE FMLEQ_FMQ
MODULE PROCEDURE FMLEQ_FMZQ
MODULE PROCEDURE FMLEQ_IMQ
MODULE PROCEDURE FMLEQ_IMZQ
MODULE PROCEDURE FMLEQ_ZMQ
MODULE PROCEDURE FMLEQ_ZMZQ
END INTERFACE
INTERFACE OPERATOR (/=)
MODULE PROCEDURE FMLNE_QFM
MODULE PROCEDURE FMLNE_QIM
MODULE PROCEDURE FMLNE_QZM
MODULE PROCEDURE FMLNE_ZQFM
MODULE PROCEDURE FMLNE_ZQIM
MODULE PROCEDURE FMLNE_ZQZM
MODULE PROCEDURE FMLNE_FMQ
MODULE PROCEDURE FMLNE_FMZQ
MODULE PROCEDURE FMLNE_IMQ
MODULE PROCEDURE FMLNE_IMZQ
MODULE PROCEDURE FMLNE_ZMQ
MODULE PROCEDURE FMLNE_ZMZQ
END INTERFACE
INTERFACE OPERATOR (>)
MODULE PROCEDURE FMLGT_QFM
MODULE PROCEDURE FMLGT_QIM
MODULE PROCEDURE FMLGT_FMQ
MODULE PROCEDURE FMLGT_IMQ
END INTERFACE
INTERFACE OPERATOR (>=)
MODULE PROCEDURE FMLGE_QFM
MODULE PROCEDURE FMLGE_QIM
MODULE PROCEDURE FMLGE_FMQ
MODULE PROCEDURE FMLGE_IMQ
END INTERFACE
INTERFACE OPERATOR (<)
MODULE PROCEDURE FMLLT_QFM
MODULE PROCEDURE FMLLT_QIM
MODULE PROCEDURE FMLLT_FMQ
MODULE PROCEDURE FMLLT_IMQ
END INTERFACE
INTERFACE OPERATOR (<=)
MODULE PROCEDURE FMLLE_QFM
MODULE PROCEDURE FMLLE_QIM
MODULE PROCEDURE FMLLE_FMQ
MODULE PROCEDURE FMLLE_IMQ
END INTERFACE
INTERFACE OPERATOR (+)
MODULE PROCEDURE FMADD_QFM
MODULE PROCEDURE FMADD_QIM
MODULE PROCEDURE FMADD_QZM
MODULE PROCEDURE FMADD_ZQFM
MODULE PROCEDURE FMADD_ZQIM
MODULE PROCEDURE FMADD_ZQZM
MODULE PROCEDURE FMADD_FMQ
MODULE PROCEDURE FMADD_FMZQ
MODULE PROCEDURE FMADD_IMQ
MODULE PROCEDURE FMADD_IMZQ
MODULE PROCEDURE FMADD_ZMQ
MODULE PROCEDURE FMADD_ZMZQ
MODULE PROCEDURE FMADD_QFM1
MODULE PROCEDURE FMADD_ZQFM1
MODULE PROCEDURE FMADD_FMQ1
MODULE PROCEDURE FMADD_FMZQ1
MODULE PROCEDURE FMADD_FM1Q
MODULE PROCEDURE FMADD_FM1ZQ
MODULE PROCEDURE FMADD_Q1FM
MODULE PROCEDURE FMADD_ZQ1FM
MODULE PROCEDURE FMADD_Q1FM1
MODULE PROCEDURE FMADD_ZQ1FM1
MODULE PROCEDURE FMADD_FM1Q1
MODULE PROCEDURE FMADD_FM1ZQ1
MODULE PROCEDURE FMADD_QIM1
MODULE PROCEDURE FMADD_ZQIM1
MODULE PROCEDURE FMADD_IMQ1
MODULE PROCEDURE FMADD_IMZQ1
MODULE PROCEDURE FMADD_IM1Q
MODULE PROCEDURE FMADD_IM1ZQ
MODULE PROCEDURE FMADD_Q1IM
MODULE PROCEDURE FMADD_ZQ1IM
MODULE PROCEDURE FMADD_Q1IM1
MODULE PROCEDURE FMADD_ZQ1IM1
MODULE PROCEDURE FMADD_IM1Q1
MODULE PROCEDURE FMADD_IM1ZQ1
MODULE PROCEDURE FMADD_QZM1
MODULE PROCEDURE FMADD_ZQZM1
MODULE PROCEDURE FMADD_ZMQ1
MODULE PROCEDURE FMADD_ZMZQ1
MODULE PROCEDURE FMADD_ZM1Q
MODULE PROCEDURE FMADD_ZM1ZQ
MODULE PROCEDURE FMADD_Q1ZM
MODULE PROCEDURE FMADD_ZQ1ZM
MODULE PROCEDURE FMADD_Q1ZM1
MODULE PROCEDURE FMADD_ZQ1ZM1
MODULE PROCEDURE FMADD_ZM1Q1
MODULE PROCEDURE FMADD_ZM1ZQ1
MODULE PROCEDURE FMADD_QFM2
MODULE PROCEDURE FMADD_ZQFM2
MODULE PROCEDURE FMADD_FMQ2
MODULE PROCEDURE FMADD_FMZQ2
MODULE PROCEDURE FMADD_FM2Q
MODULE PROCEDURE FMADD_FM2ZQ
MODULE PROCEDURE FMADD_Q2FM
MODULE PROCEDURE FMADD_ZQ2FM
MODULE PROCEDURE FMADD_Q2FM2
MODULE PROCEDURE FMADD_ZQ2FM2
MODULE PROCEDURE FMADD_FM2Q2
MODULE PROCEDURE FMADD_FM2ZQ2
MODULE PROCEDURE FMADD_QIM2
MODULE PROCEDURE FMADD_ZQIM2
MODULE PROCEDURE FMADD_IMQ2
MODULE PROCEDURE FMADD_IMZQ2
MODULE PROCEDURE FMADD_IM2Q
MODULE PROCEDURE FMADD_IM2ZQ
MODULE PROCEDURE FMADD_Q2IM
MODULE PROCEDURE FMADD_ZQ2IM
MODULE PROCEDURE FMADD_Q2IM2
MODULE PROCEDURE FMADD_ZQ2IM2
MODULE PROCEDURE FMADD_IM2Q2
MODULE PROCEDURE FMADD_IM2ZQ2
MODULE PROCEDURE FMADD_QZM2
MODULE PROCEDURE FMADD_ZQZM2
MODULE PROCEDURE FMADD_ZMQ2
MODULE PROCEDURE FMADD_ZMZQ2
MODULE PROCEDURE FMADD_ZM2Q
MODULE PROCEDURE FMADD_ZM2ZQ
MODULE PROCEDURE FMADD_Q2ZM
MODULE PROCEDURE FMADD_ZQ2ZM
MODULE PROCEDURE FMADD_Q2ZM2
MODULE PROCEDURE FMADD_ZQ2ZM2
MODULE PROCEDURE FMADD_ZM2Q2
MODULE PROCEDURE FMADD_ZM2ZQ2
END INTERFACE
INTERFACE OPERATOR (-)
MODULE PROCEDURE FMSUB_QFM
MODULE PROCEDURE FMSUB_QIM
MODULE PROCEDURE FMSUB_QZM
MODULE PROCEDURE FMSUB_ZQFM
MODULE PROCEDURE FMSUB_ZQIM
MODULE PROCEDURE FMSUB_ZQZM
MODULE PROCEDURE FMSUB_FMQ
MODULE PROCEDURE FMSUB_FMZQ
MODULE PROCEDURE FMSUB_IMQ
MODULE PROCEDURE FMSUB_IMZQ
MODULE PROCEDURE FMSUB_ZMQ
MODULE PROCEDURE FMSUB_ZMZQ
MODULE PROCEDURE FMSUB_QFM1
MODULE PROCEDURE FMSUB_ZQFM1
MODULE PROCEDURE FMSUB_FMQ1
MODULE PROCEDURE FMSUB_FMZQ1
MODULE PROCEDURE FMSUB_FM1Q
MODULE PROCEDURE FMSUB_FM1ZQ
MODULE PROCEDURE FMSUB_Q1FM
MODULE PROCEDURE FMSUB_ZQ1FM
MODULE PROCEDURE FMSUB_Q1FM1
MODULE PROCEDURE FMSUB_ZQ1FM1
MODULE PROCEDURE FMSUB_FM1Q1
MODULE PROCEDURE FMSUB_FM1ZQ1
MODULE PROCEDURE FMSUB_QIM1
MODULE PROCEDURE FMSUB_ZQIM1
MODULE PROCEDURE FMSUB_IMQ1
MODULE PROCEDURE FMSUB_IMZQ1
MODULE PROCEDURE FMSUB_IM1Q
MODULE PROCEDURE FMSUB_IM1ZQ
MODULE PROCEDURE FMSUB_Q1IM
MODULE PROCEDURE FMSUB_ZQ1IM
MODULE PROCEDURE FMSUB_Q1IM1
MODULE PROCEDURE FMSUB_ZQ1IM1
MODULE PROCEDURE FMSUB_IM1Q1
MODULE PROCEDURE FMSUB_IM1ZQ1
MODULE PROCEDURE FMSUB_QZM1
MODULE PROCEDURE FMSUB_ZQZM1
MODULE PROCEDURE FMSUB_ZMQ1
MODULE PROCEDURE FMSUB_ZMZQ1
MODULE PROCEDURE FMSUB_ZM1Q
MODULE PROCEDURE FMSUB_ZM1ZQ
MODULE PROCEDURE FMSUB_Q1ZM
MODULE PROCEDURE FMSUB_ZQ1ZM
MODULE PROCEDURE FMSUB_Q1ZM1
MODULE PROCEDURE FMSUB_ZQ1ZM1
MODULE PROCEDURE FMSUB_ZM1Q1
MODULE PROCEDURE FMSUB_ZM1ZQ1
MODULE PROCEDURE FMSUB_QFM2
MODULE PROCEDURE FMSUB_ZQFM2
MODULE PROCEDURE FMSUB_FMQ2
MODULE PROCEDURE FMSUB_FMZQ2
MODULE PROCEDURE FMSUB_FM2Q
MODULE PROCEDURE FMSUB_FM2ZQ
MODULE PROCEDURE FMSUB_Q2FM
MODULE PROCEDURE FMSUB_ZQ2FM
MODULE PROCEDURE FMSUB_Q2FM2
MODULE PROCEDURE FMSUB_ZQ2FM2
MODULE PROCEDURE FMSUB_FM2Q2
MODULE PROCEDURE FMSUB_FM2ZQ2
MODULE PROCEDURE FMSUB_QIM2
MODULE PROCEDURE FMSUB_ZQIM2
MODULE PROCEDURE FMSUB_IMQ2
MODULE PROCEDURE FMSUB_IMZQ2
MODULE PROCEDURE FMSUB_IM2Q
MODULE PROCEDURE FMSUB_IM2ZQ
MODULE PROCEDURE FMSUB_Q2IM
MODULE PROCEDURE FMSUB_ZQ2IM
MODULE PROCEDURE FMSUB_Q2IM2
MODULE PROCEDURE FMSUB_ZQ2IM2
MODULE PROCEDURE FMSUB_IM2Q2
MODULE PROCEDURE FMSUB_IM2ZQ2
MODULE PROCEDURE FMSUB_QZM2
MODULE PROCEDURE FMSUB_ZQZM2
MODULE PROCEDURE FMSUB_ZMQ2
MODULE PROCEDURE FMSUB_ZMZQ2
MODULE PROCEDURE FMSUB_ZM2Q
MODULE PROCEDURE FMSUB_ZM2ZQ
MODULE PROCEDURE FMSUB_Q2ZM
MODULE PROCEDURE FMSUB_ZQ2ZM
MODULE PROCEDURE FMSUB_Q2ZM2
MODULE PROCEDURE FMSUB_ZQ2ZM2
MODULE PROCEDURE FMSUB_ZM2Q2
MODULE PROCEDURE FMSUB_ZM2ZQ2
END INTERFACE
INTERFACE OPERATOR (*)
MODULE PROCEDURE FMMPY_QFM
MODULE PROCEDURE FMMPY_QIM
MODULE PROCEDURE FMMPY_QZM
MODULE PROCEDURE FMMPY_ZQFM
MODULE PROCEDURE FMMPY_ZQIM
MODULE PROCEDURE FMMPY_ZQZM
MODULE PROCEDURE FMMPY_FMQ
MODULE PROCEDURE FMMPY_FMZQ
MODULE PROCEDURE FMMPY_IMQ
MODULE PROCEDURE FMMPY_IMZQ
MODULE PROCEDURE FMMPY_ZMQ
MODULE PROCEDURE FMMPY_ZMZQ
MODULE PROCEDURE FMMPY_QFM1
MODULE PROCEDURE FMMPY_ZQFM1
MODULE PROCEDURE FMMPY_FMQ1
MODULE PROCEDURE FMMPY_FMZQ1
MODULE PROCEDURE FMMPY_FM1Q
MODULE PROCEDURE FMMPY_FM1ZQ
MODULE PROCEDURE FMMPY_Q1FM
MODULE PROCEDURE FMMPY_ZQ1FM
MODULE PROCEDURE FMMPY_Q1FM1
MODULE PROCEDURE FMMPY_ZQ1FM1
MODULE PROCEDURE FMMPY_FM1Q1
MODULE PROCEDURE FMMPY_FM1ZQ1
MODULE PROCEDURE FMMPY_QIM1
MODULE PROCEDURE FMMPY_ZQIM1
MODULE PROCEDURE FMMPY_IMQ1
MODULE PROCEDURE FMMPY_IMZQ1
MODULE PROCEDURE FMMPY_IM1Q
MODULE PROCEDURE FMMPY_IM1ZQ
MODULE PROCEDURE FMMPY_Q1IM
MODULE PROCEDURE FMMPY_ZQ1IM
MODULE PROCEDURE FMMPY_Q1IM1
MODULE PROCEDURE FMMPY_ZQ1IM1
MODULE PROCEDURE FMMPY_IM1Q1
MODULE PROCEDURE FMMPY_IM1ZQ1
MODULE PROCEDURE FMMPY_QZM1
MODULE PROCEDURE FMMPY_ZQZM1
MODULE PROCEDURE FMMPY_ZMQ1
MODULE PROCEDURE FMMPY_ZMZQ1
MODULE PROCEDURE FMMPY_ZM1Q
MODULE PROCEDURE FMMPY_ZM1ZQ
MODULE PROCEDURE FMMPY_Q1ZM
MODULE PROCEDURE FMMPY_ZQ1ZM
MODULE PROCEDURE FMMPY_Q1ZM1
MODULE PROCEDURE FMMPY_ZQ1ZM1
MODULE PROCEDURE FMMPY_ZM1Q1
MODULE PROCEDURE FMMPY_ZM1ZQ1
MODULE PROCEDURE FMMPY_QFM2
MODULE PROCEDURE FMMPY_ZQFM2
MODULE PROCEDURE FMMPY_FMQ2
MODULE PROCEDURE FMMPY_FMZQ2
MODULE PROCEDURE FMMPY_FM2Q
MODULE PROCEDURE FMMPY_FM2ZQ
MODULE PROCEDURE FMMPY_Q2FM
MODULE PROCEDURE FMMPY_ZQ2FM
MODULE PROCEDURE FMMPY_Q2FM2
MODULE PROCEDURE FMMPY_ZQ2FM2
MODULE PROCEDURE FMMPY_FM2Q2
MODULE PROCEDURE FMMPY_FM2ZQ2
MODULE PROCEDURE FMMPY_QIM2
MODULE PROCEDURE FMMPY_ZQIM2
MODULE PROCEDURE FMMPY_IMQ2
MODULE PROCEDURE FMMPY_IMZQ2
MODULE PROCEDURE FMMPY_IM2Q
MODULE PROCEDURE FMMPY_IM2ZQ
MODULE PROCEDURE FMMPY_Q2IM
MODULE PROCEDURE FMMPY_ZQ2IM
MODULE PROCEDURE FMMPY_Q2IM2
MODULE PROCEDURE FMMPY_ZQ2IM2
MODULE PROCEDURE FMMPY_IM2Q2
MODULE PROCEDURE FMMPY_IM2ZQ2
MODULE PROCEDURE FMMPY_QZM2
MODULE PROCEDURE FMMPY_ZQZM2
MODULE PROCEDURE FMMPY_ZMQ2
MODULE PROCEDURE FMMPY_ZMZQ2
MODULE PROCEDURE FMMPY_ZM2Q
MODULE PROCEDURE FMMPY_ZM2ZQ
MODULE PROCEDURE FMMPY_Q2ZM
MODULE PROCEDURE FMMPY_ZQ2ZM
MODULE PROCEDURE FMMPY_Q2ZM2
MODULE PROCEDURE FMMPY_ZQ2ZM2
MODULE PROCEDURE FMMPY_ZM2Q2
MODULE PROCEDURE FMMPY_ZM2ZQ2
END INTERFACE
INTERFACE OPERATOR (/)
MODULE PROCEDURE FMDIV_QFM
MODULE PROCEDURE FMDIV_QIM
MODULE PROCEDURE FMDIV_QZM
MODULE PROCEDURE FMDIV_ZQFM
MODULE PROCEDURE FMDIV_ZQIM
MODULE PROCEDURE FMDIV_ZQZM
MODULE PROCEDURE FMDIV_FMQ
MODULE PROCEDURE FMDIV_FMZQ
MODULE PROCEDURE FMDIV_IMQ
MODULE PROCEDURE FMDIV_IMZQ
MODULE PROCEDURE FMDIV_ZMQ
MODULE PROCEDURE FMDIV_ZMZQ
MODULE PROCEDURE FMDIV_QFM1
MODULE PROCEDURE FMDIV_ZQFM1
MODULE PROCEDURE FMDIV_FMQ1
MODULE PROCEDURE FMDIV_FMZQ1
MODULE PROCEDURE FMDIV_FM1Q
MODULE PROCEDURE FMDIV_FM1ZQ
MODULE PROCEDURE FMDIV_Q1FM
MODULE PROCEDURE FMDIV_ZQ1FM
MODULE PROCEDURE FMDIV_Q1FM1
MODULE PROCEDURE FMDIV_ZQ1FM1
MODULE PROCEDURE FMDIV_FM1Q1
MODULE PROCEDURE FMDIV_FM1ZQ1
MODULE PROCEDURE FMDIV_QIM1
MODULE PROCEDURE FMDIV_ZQIM1
MODULE PROCEDURE FMDIV_IMQ1
MODULE PROCEDURE FMDIV_IMZQ1
MODULE PROCEDURE FMDIV_IM1Q
MODULE PROCEDURE FMDIV_IM1ZQ
MODULE PROCEDURE FMDIV_Q1IM
MODULE PROCEDURE FMDIV_ZQ1IM
MODULE PROCEDURE FMDIV_Q1IM1
MODULE PROCEDURE FMDIV_ZQ1IM1
MODULE PROCEDURE FMDIV_IM1Q1
MODULE PROCEDURE FMDIV_IM1ZQ1
MODULE PROCEDURE FMDIV_QZM1
MODULE PROCEDURE FMDIV_ZQZM1
MODULE PROCEDURE FMDIV_ZMQ1
MODULE PROCEDURE FMDIV_ZMZQ1
MODULE PROCEDURE FMDIV_ZM1Q
MODULE PROCEDURE FMDIV_ZM1ZQ
MODULE PROCEDURE FMDIV_Q1ZM
MODULE PROCEDURE FMDIV_ZQ1ZM
MODULE PROCEDURE FMDIV_Q1ZM1
MODULE PROCEDURE FMDIV_ZQ1ZM1
MODULE PROCEDURE FMDIV_ZM1Q1
MODULE PROCEDURE FMDIV_ZM1ZQ1
MODULE PROCEDURE FMDIV_QFM2
MODULE PROCEDURE FMDIV_ZQFM2
MODULE PROCEDURE FMDIV_FMQ2
MODULE PROCEDURE FMDIV_FMZQ2
MODULE PROCEDURE FMDIV_FM2Q
MODULE PROCEDURE FMDIV_FM2ZQ
MODULE PROCEDURE FMDIV_Q2FM
MODULE PROCEDURE FMDIV_ZQ2FM
MODULE PROCEDURE FMDIV_Q2FM2
MODULE PROCEDURE FMDIV_ZQ2FM2
MODULE PROCEDURE FMDIV_FM2Q2
MODULE PROCEDURE FMDIV_FM2ZQ2
MODULE PROCEDURE FMDIV_QIM2
MODULE PROCEDURE FMDIV_ZQIM2
MODULE PROCEDURE FMDIV_IMQ2
MODULE PROCEDURE FMDIV_IMZQ2
MODULE PROCEDURE FMDIV_IM2Q
MODULE PROCEDURE FMDIV_IM2ZQ
MODULE PROCEDURE FMDIV_Q2IM
MODULE PROCEDURE FMDIV_ZQ2IM
MODULE PROCEDURE FMDIV_Q2IM2
MODULE PROCEDURE FMDIV_ZQ2IM2
MODULE PROCEDURE FMDIV_IM2Q2
MODULE PROCEDURE FMDIV_IM2ZQ2
MODULE PROCEDURE FMDIV_QZM2
MODULE PROCEDURE FMDIV_ZQZM2
MODULE PROCEDURE FMDIV_ZMQ2
MODULE PROCEDURE FMDIV_ZMZQ2
MODULE PROCEDURE FMDIV_ZM2Q
MODULE PROCEDURE FMDIV_ZM2ZQ
MODULE PROCEDURE FMDIV_Q2ZM
MODULE PROCEDURE FMDIV_ZQ2ZM
MODULE PROCEDURE FMDIV_Q2ZM2
MODULE PROCEDURE FMDIV_ZQ2ZM2
MODULE PROCEDURE FMDIV_ZM2Q2
MODULE PROCEDURE FMDIV_ZM2ZQ2
END INTERFACE
INTERFACE OPERATOR (**)
MODULE PROCEDURE FMPWR_QFM
MODULE PROCEDURE FMPWR_QIM
MODULE PROCEDURE FMPWR_QZM
MODULE PROCEDURE FMPWR_ZQFM
MODULE PROCEDURE FMPWR_ZQIM
MODULE PROCEDURE FMPWR_ZQZM
MODULE PROCEDURE FMPWR_FMQ
MODULE PROCEDURE FMPWR_FMZQ
MODULE PROCEDURE FMPWR_IMQ
MODULE PROCEDURE FMPWR_IMZQ
MODULE PROCEDURE FMPWR_ZMQ
MODULE PROCEDURE FMPWR_ZMZQ
END INTERFACE
CONTAINS
SUBROUTINE FMQ2M(X,MA)
! Convert quadruple precision X to multiple precision MA.
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP) :: X
INTEGER :: MA
REAL (QUAD_FP) :: F1,F2,Y,Y1,Y2,TWO20
INTEGER :: J,J1,J2,JD,JEXP,K,KEXP,L,NDSAVE
INTENT (IN) :: X
INTENT (INOUT) :: MA
INTEGER :: MXY(5),NUMBER_USED_SAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
MXY = -2
IF (MA <= 0) THEN
CALL FMDEFINE(MA)
ELSE IF (SIZE_OF(MA) < NDIG+3) THEN
CALL FMDEFINE(MA)
ENDIF
NUMBER_USED_SAVE = NUMBER_USED
! Increase the working precision.
NDSAVE = NDIG
IF (NCALL == 1) THEN
K = MAX(NGRD21,1)
NDIG = MAX(NDIG+K,2)
ENDIF
IF (MBLOGS /= MBASE) CALL FMCONS
KFLAG = 0
! Special case for X = 0.
IF (X == 0) THEN
DO J = 1, NDSAVE+1
MWK(START(MA)+J+1) = 0
ENDDO
GO TO 240
ENDIF
! Check for X = + or - Infinity, or NaN. Return unknown if so.
IF (X > HUGE(X) .OR. X < -HUGE(X) .OR. (.NOT.(X == X))) THEN
DO J = 2, NDSAVE
MWK(START(MA)+J+2) = 0
ENDDO
KFLAG = -4
MWK(START(MA)+2) = MUNKNO
MWK(START(MA)+3) = 1
MWK(START(MA)+1) = NINT(NDSAVE*ALOGM2)
MWK(START(MA)) = 1
CALL FMWARN
NDIG = NDSAVE
NUMBER_USED = NUMBER_USED_SAVE
IF (TEMPV_CALL_STACK == 1) THEN
IF (TEMPV(MA) == -1) TEMPV(MA) = -2
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
! Special case for MBASE = 2.
IF (MBASE == 2 .AND. RADIX(X) == 2) THEN
NDIG = MAX(NDIG,DIGITS(X))
Y = FRACTION(ABS(X))
CALL FMI2M(0,MXY(5))
DO J = 1, MIN(DIGITS(X),NDIG)
Y = Y + Y
MWK(START(MXY(5))+J+2) = INT(Y)
Y = Y - INT(Y)
ENDDO
MWK(START(MXY(5))+2) = EXPONENT(X)
CALL FMEQU(MXY(5),MA,NDIG,NDSAVE)
GO TO 240
ENDIF
! Special case for MBASE = 10**L.
K = MBASE
L = 0
DO
IF (MOD(K,10) == 0) THEN
L = L + 1
K = K/10
IF (K == 1) EXIT
ELSE
L = 0
EXIT
ENDIF
ENDDO
IF (L > 0) THEN
NDIG = MAX(NDIG,INT(DIGITS(X)*0.30103/L)+1)
Y = FRACTION(ABS(X))
CALL FMI2M(0,MXY(5))
DO J = 1, NDIG
! Multiply by 10**L to get the next digit in base MBASE.
! To avoid any rounding errors in quad precision, do each multiply by 10 as
! one multiply by 8 and one by 2, and keep two integer and two fraction results.
! So 10*y is broken into 8*y + 2*y, since there will be no rounding with either
! term in quad precision on a binary machine.
JD = 0
DO K = 1, L
Y1 = 8*Y
Y2 = 2*Y
J1 = Y1
J2 = Y2
F1 = Y1 - J1
F2 = Y2 - J2
JD = 10*JD + J1 + J2
Y = F1 + F2
IF (Y >= 1) THEN
JD = JD + 1
Y = Y - 1
ENDIF
ENDDO
MWK(START(MXY(5))+J+2) = JD
IF (Y == 0) EXIT
ENDDO
K = INTMAX
IF (MAXINT/MBASE < K) K = MAXINT/MBASE
K = K/2
J2 = 1
JEXP = EXPONENT(X)
DO J = 1, ABS(JEXP)
J2 = 2*J2
IF (J2 >= K .OR. J == ABS(JEXP)) THEN
IF (JEXP > 0) THEN
CALL FMMPYI_R1(MXY(5),J2)
ELSE
CALL FMDIVI_R1(MXY(5),J2)
ENDIF
J2 = 1
ENDIF
ENDDO
CALL FMEQU(MXY(5),MA,NDIG,NDSAVE)
GO TO 240
ENDIF
Y = ABS(X)
TWO20 = 1048576.0D0
! If this power of two is not representable at the current base and precision, use a
! smaller one.
IF (INT(NDIG*ALOGM2) < 20) THEN
K = INT(NDIG*ALOGM2)
TWO20 = 1
DO J = 1, K
TWO20 = TWO20*2.0D0
ENDDO
ENDIF
KEXP = 0
IF (Y > TWO20) THEN
130 Y = Y/TWO20
KEXP = KEXP + 1
IF (Y > TWO20) GO TO 130
ELSE IF (Y < 1) THEN
140 Y = Y*TWO20
KEXP = KEXP - 1
IF (Y < 1) GO TO 140
ENDIF
K = INT(TWO20)
CALL FMI2M(K,MXY(3))
K = INT(Y)
CALL FMI2M(K,MXY(1))
Y = (Y-DBLE(K))*TWO20
JEXP = 0
160 K = INT(Y)
CALL FMI2M(K,MXY(2))
CALL FMMPY_R1(MXY(1),MXY(3))
JEXP = JEXP + 1
CALL FMADD_R1(MXY(1),MXY(2))
Y = (Y-DBLE(K))*TWO20
IF (JEXP <= 1000 .AND. Y /= 0) GO TO 160
K = KEXP - JEXP
IF (K >= 0) THEN
IF (K == 0) THEN
CALL FMEQ(MXY(1),MXY(5))
ELSE IF (K == 1) THEN
CALL FMMPY(MXY(1),MXY(3),MXY(5))
ELSE IF (K == 2) THEN
CALL FMSQR(MXY(3),MXY(2))
CALL FMMPY(MXY(1),MXY(2),MXY(5))
ELSE
CALL FMIPWR(MXY(3),K,MXY(2))
CALL FMMPY(MXY(1),MXY(2),MXY(5))
ENDIF
ELSE
IF (K == -1) THEN
CALL FMDIV(MXY(1),MXY(3),MXY(5))
ELSE IF (K == -2) THEN
CALL FMSQR(MXY(3),MXY(2))
CALL FMDIV(MXY(1),MXY(2),MXY(5))
ELSE
CALL FMIPWR(MXY(3),-K,MXY(2))
CALL FMDIV(MXY(1),MXY(2),MXY(5))
ENDIF
ENDIF
CALL FMEQU(MXY(5),MA,NDIG,NDSAVE)
240 MWK(START(MA)) = 1
IF (X < 0.0 .AND. MWK(START(MA)+2) /= MUNKNO .AND. MWK(START(MA)+3) /= 0) MWK(START(MA)) = -1
MWK(START(MA)+1) = NINT((NDSAVE-1)*ALOGM2 + LOG(REAL(ABS(MWK(START(MA)+3))+1))/0.69315)
NDIG = NDSAVE
NUMBER_USED = NUMBER_USED_SAVE
IF (TEMPV_CALL_STACK == 1) THEN
IF (TEMPV(MA) == -1) TEMPV(MA) = -2
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
END SUBROUTINE FMQ2M
SUBROUTINE FMM2Q(MA,X)
! Convert multiple precision MA to quadruple precision X.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
REAL (QUAD_FP) :: X
REAL (QUAD_FP) :: AQ(2),XQ(2),YQ(2),Y1(2),Y2(2),XBASE,PMAX,DLOGDP, &
A1,A2,C,C1,C2,C21,C22,Q1,Q2,T,Z1,Z2
REAL (KIND(1.0D0)) :: MA1,MAS
INTEGER :: J,K,KWRNSV,NCASE
INTENT (IN) :: MA
INTENT (INOUT) :: X
! Check to see if MA is in range for quadruple precision.
IF (MBLOGS /= MBASE) CALL FMCONS
PMAX = HUGE(X) / 5
DLOGDP = LOG(PMAX)
MA1 = MWK(START(MA)+2)
NCASE = 0
IF (DBLE(MWK(START(MA)+2)-1)*DLOGMB > DLOGDP) THEN
KFLAG = -4
X = -1.01*(HUGE(X)/3.0)
CALL FMWARN
RETURN
ELSE IF (DBLE(MWK(START(MA)+2)+1)*DLOGMB > DLOGDP) THEN
MA1 = MA1 - 2
NCASE = 1
ELSE IF (DBLE(MWK(START(MA)+2)+1)*DLOGMB < -DLOGDP) THEN
KFLAG = -10
X = 0
CALL FMWARN
RETURN
ELSE IF (DBLE(MWK(START(MA)+2)-1)*DLOGMB < -DLOGDP) THEN
MA1 = MA1 + 2
NCASE = 2
ENDIF
! Try FMMI first so that small integers will be converted quickly.
KWRNSV = KWARN
KWARN = 0
CALL FMMI(MA,J)
KWARN = KWRNSV
IF (KFLAG == 0) THEN
X = J
RETURN
ENDIF
KFLAG = 0
! General case.
! In order to get the correctly rounded X, the arithmetic for computing X is done
! with twice quadruple precision using the arrays of length 2.
MAS = MWK(START(MA))
XBASE = MBASE
XQ = (/ 0 , 0 /)
YQ = (/ 1 , 0 /)
C = RADIX(X)
K = DIGITS(X) - DIGITS(X)/2
C = C ** K
K = (LOG(DBLE(RADIX(X)))/DLOGMB)*DIGITS(X) + NGRD52
DO J = 2, MIN(K+1,NDIG+1)
Z1 = YQ(1) / XBASE
T = XBASE*C
A1 = (XBASE - T) + T
A2 = XBASE - A1
T = Z1*C
C1 = (Z1 - T) + T
C2 = Z1 - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = XBASE*Z1
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = ((((YQ(1)-Q1) - Q2) + YQ(2))) / XBASE
YQ(1) = Z1 + Z2
YQ(2) = (Z1-YQ(1)) + Z2
T = YQ(1)*C
A1 = (YQ(1) - T) + T
A2 = YQ(1) - A1
T = DBLE(MWK(START(MA)+J+1))*C
C1 = (DBLE(MWK(START(MA)+J+1)) - T) + T
C2 = DBLE(MWK(START(MA)+J+1)) - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = YQ(1)*DBLE(MWK(START(MA)+J+1))
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = YQ(2)*DBLE(MWK(START(MA)+J+1)) + Q2
AQ(1) = Q1 + Z2
AQ(2) = (Q1-AQ(1)) + Z2
Z1 = XQ(1) + AQ(1)
Q1 = XQ(1) - Z1
Z2 = (((Q1+AQ(1)) + (XQ(1)-(Q1+Z1))) + XQ(2)) + AQ(2)
XQ(1) = Z1 + Z2
XQ(2) = (Z1-XQ(1)) + Z2
ENDDO
Y1 = (/ XBASE , Q_ZERO /)
K = ABS(MA1)
IF (MOD(K,2) == 0) THEN
Y2 = (/ 1 , 0 /)
ELSE
Y2 = (/ XBASE , Q_ZERO /)
ENDIF
120 K = K/2
T = Y1(1)*C
A1 = (Y1(1) - T) + T
A2 = Y1(1) - A1
T = Y1(1)*C
C1 = (Y1(1) - T) + T
C2 = Y1(1) - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = Y1(1)*Y1(1)
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = ((Y1(1) + Y1(2))*Y1(2) + Y1(2)*Y1(1)) + Q2
Y1(1) = Q1 + Z2
Y1(2) = (Q1-Y1(1)) + Z2
IF (MOD(K,2) == 1) THEN
T = Y1(1)*C
A1 = (Y1(1) - T) + T
A2 = Y1(1) - A1
T = Y2(1)*C
C1 = (Y2(1) - T) + T
C2 = Y2(1) - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = Y1(1)*Y2(1)
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = ((Y1(1) + Y1(2))*Y2(2) + Y1(2)*Y2(1)) + Q2
Y2(1) = Q1 + Z2
Y2(2) = (Q1-Y2(1)) + Z2
ENDIF
IF (K > 1) GO TO 120
IF (MA1 < 0) THEN
Z1 = XQ(1) / Y2(1)
T = Y2(1)*C
A1 = (Y2(1) - T) + T
A2 = Y2(1) - A1
T = Z1*C
C1 = (Z1 - T) + T
C2 = Z1 - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = Y2(1)*Z1
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = ((((XQ(1)-Q1) - Q2) + XQ(2)) - Z1*Y2(2)) / (Y2(1) + Y2(2))
AQ(1) = Z1 + Z2
AQ(2) = (Z1-AQ(1)) + Z2
ELSE
T = XQ(1)*C
A1 = (XQ(1) - T) + T
A2 = XQ(1) - A1
T = Y2(1)*C
C1 = (Y2(1) - T) + T
C2 = Y2(1) - C1
T = C2*C
C21 = (C2 - T) + T
C22 = C2 - C21
Q1 = XQ(1)*Y2(1)
Q2 = ((((A1*C1 - Q1) + A1*C2) + C1*A2) + C21*A2) + C22*A2
Z2 = ((XQ(1) + XQ(2))*Y2(2) + XQ(2)*Y2(1)) + Q2
AQ(1) = Q1 + Z2
AQ(2) = (Q1-AQ(1)) + Z2
ENDIF
X = AQ(1) + AQ(2)
IF (MAS < 0) X = -X
! Check the result if it is near overflow or underflow.
IF (NCASE == 1) THEN
IF (X <= PMAX/(XBASE*XBASE)) THEN
X = X*XBASE*XBASE
ELSE
KFLAG = -4
X = -1.01*(HUGE(X)/3.0)
CALL FMWARN
ENDIF
ELSE IF (NCASE == 2) THEN
IF (X >= (1/PMAX)*XBASE*XBASE) THEN
X = X/(XBASE*XBASE)
ELSE
KFLAG = -10
X = 0
CALL FMWARN
ENDIF
ENDIF
RETURN
END SUBROUTINE FMM2Q
SUBROUTINE IMM2Q(MA,X)
! X = MA
! Convert an IM number to quadruple precision.
USE FMVALS
IMPLICIT NONE
INTEGER :: MA
REAL (QUAD_FP) :: X
INTEGER :: ND2,NDSAVE
INTENT (IN) :: MA
INTENT (INOUT) :: X
NDSAVE = NDIG
NDIG = MAX(2,INT(MWK(START(MA)+2)))
ND2 = 2 - LOG(EPSILON(Q_ONE))/DLOGMB
IF (NDIG >= ND2) NDIG = ND2
CALL FMM2Q(MA,X)
NDIG = NDSAVE
RETURN
END SUBROUTINE IMM2Q
FUNCTION FM_Q(D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_Q
REAL (QUAD_FP) :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMQ2M(D,FM_Q%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Q
FUNCTION FM_ZQ(C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_ZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMQ2M(REAL(C,QUAD_FP),FM_ZQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZQ
FUNCTION FM_Q1(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FM_Q1
INTEGER :: J,N
INTENT (IN) :: D
FM_Q1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),FM_Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Q1
FUNCTION FM_ZQ1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (FM), DIMENSION(SIZE(C)) :: FM_ZQ1
INTEGER :: J,N
INTENT (IN) :: C
FM_ZQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),FM_ZQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZQ1
FUNCTION FM_Q2(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FM_Q2
INTEGER :: J,K
INTENT (IN) :: D
FM_Q2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),FM_Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Q2
FUNCTION FM_ZQ2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (FM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FM_ZQ2
INTEGER :: J,K
INTENT (IN) :: C
FM_ZQ2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),FM_ZQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZQ2
FUNCTION IM_Q(D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_Q
REAL (QUAD_FP) :: D
CHARACTER(50) :: ST
INTEGER :: IVAL
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_Q%MIM)
ELSE
WRITE (ST,'(E50.39)') D
CALL IMST2M(ST,IM_Q%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Q
FUNCTION IM_ZQ(C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_ZQ
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
CHARACTER(50) :: ST
INTEGER :: IVAL
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
D = REAL(C,QUAD_FP)
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_ZQ%MIM)
ELSE
WRITE (ST,'(E50.39)') D
CALL IMST2M(ST,IM_ZQ%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZQ
FUNCTION IM_Q1(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: IM_Q1
CHARACTER(50) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: D
IM_Q1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
IF (ABS(D(J)) < HUGE(1)) THEN
IVAL = INT(D(J))
CALL IMI2M(IVAL,IM_Q1(J)%MIM)
ELSE
WRITE (ST,'(E50.39)') D(J)
CALL IMST2M(ST,IM_Q1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Q1
FUNCTION IM_ZQ1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (IM), DIMENSION(SIZE(C)) :: IM_ZQ1
REAL (QUAD_FP) :: D
CHARACTER(50) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: C
IM_ZQ1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
D = REAL(C(J),QUAD_FP)
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_ZQ1(J)%MIM)
ELSE
WRITE (ST,'(E50.39)') D
CALL IMST2M(ST,IM_ZQ1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZQ1
FUNCTION IM_Q2(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: IM_Q2
CHARACTER(50) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: D
IM_Q2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
IF (ABS(D(J,K)) < HUGE(1)) THEN
IVAL = INT(D(J,K))
CALL IMI2M(IVAL,IM_Q2(J,K)%MIM)
ELSE
WRITE (ST,'(E50.39)') D(J,K)
CALL IMST2M(ST,IM_Q2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Q2
FUNCTION IM_ZQ2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (IM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: IM_ZQ2
REAL (QUAD_FP) :: D
CHARACTER(50) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: C
IM_ZQ2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
D = REAL(C(J,K),QUAD_FP)
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_ZQ2(J,K)%MIM)
ELSE
WRITE (ST,'(E50.39)') D
CALL IMST2M(ST,IM_ZQ2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZQ2
FUNCTION ZM_Q(D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_Q
REAL (QUAD_FP) :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_Q%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Q
FUNCTION ZM2_Q(D1,D2)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM2_Q
REAL (QUAD_FP) :: D1,D2
INTENT (IN) :: D1,D2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMQ2M(D1,MTFM)
CALL FMQ2M(D2,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM2_Q%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM2_Q
FUNCTION ZM_ZQ(C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_ZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_ZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZQ
FUNCTION ZM_Q1(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: ZM_Q1
INTEGER :: J,N
INTENT (IN) :: D
ZM_Q1%MZM(1) = -1
ZM_Q1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Q1
FUNCTION ZM_ZQ1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: ZM_ZQ1
INTEGER :: J,N
INTENT (IN) :: C
ZM_ZQ1%MZM(1) = -1
ZM_ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZQ1
FUNCTION ZM_Q2(D)
USE FMVALS
IMPLICIT NONE
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: ZM_Q2
INTEGER :: J,K
INTENT (IN) :: D
ZM_Q2%MZM(1) = -1
ZM_Q2%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_Q2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Q2
FUNCTION ZM_ZQ2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: ZM_ZQ2
INTEGER :: J,K
INTENT (IN) :: C
ZM_ZQ2%MZM(1) = -1
ZM_ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZQ2
FUNCTION FM_2QUAD(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP) :: FM_2QUAD
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(MA%MFM,FM_2QUAD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUAD
FUNCTION IM_2QUAD(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP) :: IM_2QUAD
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2Q(MTFM,IM_2QUAD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUAD
FUNCTION ZM_2QUAD(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP) :: ZM_2QUAD
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2Q(MTFM,ZM_2QUAD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUAD
FUNCTION FM_2QUAD1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA)) :: FM_2QUAD1
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 FMM2Q(MA(J)%MFM,FM_2QUAD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUAD1
FUNCTION IM_2QUAD1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA)) :: IM_2QUAD1
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 IMM2Q(MA(J)%MIM,IM_2QUAD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUAD1
FUNCTION ZM_2QUAD1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA)) :: ZM_2QUAD1
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 FMM2Q(MA(J)%MZM(1),ZM_2QUAD1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUAD1
FUNCTION FM_2QUAD2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2QUAD2
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 FMM2Q(MA(J,K)%MFM,FM_2QUAD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUAD2
FUNCTION IM_2QUAD2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2QUAD2
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 IMM2Q(MA(J,K)%MIM,IM_2QUAD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUAD2
FUNCTION ZM_2QUAD2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2QUAD2
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 FMM2Q(MA(J,K)%MZM(1),ZM_2QUAD2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUAD2
FUNCTION FM_2QUADZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: FM_2QUADZ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(MA%MFM,D)
FM_2QUADZ = CMPLX( D , Q_ZERO , QUAD_FP )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUADZ
FUNCTION IM_2QUADZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: IM_2QUADZ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2Q(MA%MIM,D)
IM_2QUADZ = CMPLX( D , Q_ZERO , QUAD_FP )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUADZ
FUNCTION ZM_2QUADZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: ZM_2QUADZ
REAL (QUAD_FP) :: D1,D2
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D1)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
ZM_2QUADZ = CMPLX( D1 , D2 , QUAD_FP )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUADZ
FUNCTION FM_2QUADZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA)) :: FM_2QUADZ1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2Q(MA(J)%MFM,D)
FM_2QUADZ1(J) = CMPLX( D , Q_ZERO , QUAD_FP )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUADZ1
FUNCTION IM_2QUADZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA)) :: IM_2QUADZ1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMM2Q(MTFM,D)
IM_2QUADZ1(J) = CMPLX( D , Q_ZERO , QUAD_FP )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUADZ1
FUNCTION ZM_2QUADZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA)) :: ZM_2QUADZ1
INTEGER :: J,N
REAL (QUAD_FP) :: D1,D2
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL(MA(J)%MZM,MTFM)
CALL FMM2Q(MTFM,D1)
CALL ZMIMAG(MA(J)%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
ZM_2QUADZ1(J) = CMPLX( D1 , D2 , QUAD_FP )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUADZ1
FUNCTION FM_2QUADZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2QUADZ2
INTEGER :: J,K
REAL (QUAD_FP) :: D
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 FMM2Q(MA(J,K)%MFM,D)
FM_2QUADZ2(J,K) = CMPLX( D , Q_ZERO , QUAD_FP )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2QUADZ2
FUNCTION IM_2QUADZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2QUADZ2
INTEGER :: J,K
REAL (QUAD_FP) :: D
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 IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMM2Q(MTFM,D)
IM_2QUADZ2(J,K) = CMPLX( D , Q_ZERO , QUAD_FP )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2QUADZ2
FUNCTION ZM_2QUADZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2QUADZ2
INTEGER :: J,K
REAL (QUAD_FP) :: D1,D2
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 ZMREAL(MA(J,K)%MZM,MTFM)
CALL FMM2Q(MTFM,D1)
CALL ZMIMAG(MA(J,K)%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
ZM_2QUADZ2(J,K) = CMPLX( D1 , D2 , QUAD_FP )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2QUADZ2
SUBROUTINE FMEQ_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(MA%MFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_QFM
SUBROUTINE FMEQ_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2Q(MA%MIM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_QIM
SUBROUTINE FMEQ_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP) :: 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 FMM2Q(MTFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_QZM
SUBROUTINE FMEQ_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(MA%MFM,D)
C = CMPLX( D , Q_ZERO , QUAD_FP )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQFM
SUBROUTINE FMEQ_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2Q(MA%MIM,D)
C = CMPLX( D , Q_ZERO , QUAD_FP )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQIM
SUBROUTINE FMEQ_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D1,D2
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D1)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
C = CMPLX( D1 , D2 , QUAD_FP )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQZM
SUBROUTINE FMEQ_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(D,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMQ
SUBROUTINE FMEQ_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,QUAD_FP)
CALL FMQ2M(D,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMZQ
SUBROUTINE FMEQ_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
REAL (QUAD_FP) :: 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,'(E50.39)') D
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMQ
SUBROUTINE FMEQ_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
CHARACTER(50) :: ST
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,QUAD_FP)
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,MA%MIM)
ELSE
WRITE (ST,'(E50.39)') D
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMZQ
SUBROUTINE FMEQ_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(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_ZMQ
SUBROUTINE FMEQ_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,QUAD_FP)
CALL FMQ2M(D,MTFM)
D = AIMAG(C)
CALL FMQ2M(D,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_ZMZQ
SUBROUTINE FMEQ_FM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(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_FM1Q
SUBROUTINE FMEQ_FM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),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_FM1ZQ
SUBROUTINE FMEQ_Q1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
REAL (QUAD_FP) :: 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 FMM2Q(MA%MFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1FM
SUBROUTINE FMEQ_ZQ1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL FMM2Q(MA%MFM,D2)
DO J = 1, N
C(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1FM
SUBROUTINE FMEQ_FM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP), 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 FMQ2M(D(J),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1Q1
SUBROUTINE FMEQ_FM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(C)) 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 FMQ2M(REAL(C(J),QUAD_FP),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1ZQ1
SUBROUTINE FMEQ_Q1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), 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 FMM2Q(MA(J)%MFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1FM1
SUBROUTINE FMEQ_ZQ1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(C)
D = RUNKNO
C(J) = CMPLX(D,D , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMM2Q(MA(J)%MFM,D)
C(J) = CMPLX(D,Q_ZERO , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1FM1
SUBROUTINE FMEQ_FM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(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_FM2Q
SUBROUTINE FMEQ_FM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(REAL(C,QUAD_FP),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_FM2ZQ
SUBROUTINE FMEQ_Q2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
REAL (QUAD_FP) :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(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_Q2FM
SUBROUTINE FMEQ_ZQ2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2Q(MA%MFM,D2)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
C(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2FM
SUBROUTINE FMEQ_FM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP), 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 FMQ2M(D(J,K),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2Q2
SUBROUTINE FMEQ_FM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,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 FMQ2M(REAL(C(J,K),QUAD_FP),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2ZQ2
SUBROUTINE FMEQ_Q2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), 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 FMM2Q(MA(J,K)%MFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q2FM2
SUBROUTINE FMEQ_ZQ2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
D = RUNKNO
C(J,K) = CMPLX(D,D , QUAD_FP)
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 FMM2Q(MA(J,K)%MFM,D)
C(J,K) = CMPLX(D,Q_ZERO , QUAD_FP)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2FM2
SUBROUTINE FMEQ_IM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL IMFM2I(MTFM,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_IM1Q
SUBROUTINE FMEQ_IM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMFM2I(MTFM,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_IM1ZQ
SUBROUTINE FMEQ_Q1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
REAL (QUAD_FP) :: 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 IMI2FM(MA%MIM,MTFM)
CALL FMM2Q(MTFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1IM
SUBROUTINE FMEQ_ZQ1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2Q(MTFM,D2)
DO J = 1, N
C(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1IM
SUBROUTINE FMEQ_IM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP), 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 FMQ2M(D(J),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1Q1
SUBROUTINE FMEQ_IM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(C)) 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 FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1ZQ1
SUBROUTINE FMEQ_Q1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), 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 IMI2FM(MA(J)%MIM,MTFM)
CALL FMM2Q(MTFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1IM1
SUBROUTINE FMEQ_ZQ1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
D = RUNKNO
C(J) = CMPLX(D,D , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMM2Q(MTFM,D)
C(J) = CMPLX(D,Q_ZERO , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1IM1
SUBROUTINE FMEQ_IM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(D,MTFM)
CALL IMFM2I(MTFM,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_IM2Q
SUBROUTINE FMEQ_IM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMFM2I(MTFM,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_IM2ZQ
SUBROUTINE FMEQ_Q2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
REAL (QUAD_FP) :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2Q(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_Q2IM
SUBROUTINE FMEQ_ZQ2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2Q(MTFM,D2)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
C(J,K) = D2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2IM
SUBROUTINE FMEQ_IM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP), 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 FMQ2M(D(J,K),MTFM)
CALL IMFM2I(MTFM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2Q2
SUBROUTINE FMEQ_IM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL IMFM2I(MTFM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2ZQ2
SUBROUTINE FMEQ_Q2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), 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 IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMM2Q(MTFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q2IM2
SUBROUTINE FMEQ_ZQ2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
D = RUNKNO
C(J,K) = CMPLX(D,D , QUAD_FP)
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 IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMM2Q(MTFM,D)
C(J,K) = CMPLX(D,Q_ZERO , QUAD_FP)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2IM2
SUBROUTINE FMEQ_ZM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(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_ZM1Q
SUBROUTINE FMEQ_ZM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
D = AIMAG(C)
CALL FMQ2M(D,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_ZM1ZQ
SUBROUTINE FMEQ_Q1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
REAL (QUAD_FP) :: 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 FMM2Q(MTFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1ZM
SUBROUTINE FMEQ_ZQ1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D2,D3
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D3)
DO J = 1, N
C(J) = CMPLX(D2,D3, QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1ZM
SUBROUTINE FMEQ_ZM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL (QUAD_FP), 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 FMQ2M(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_ZM1Q1
SUBROUTINE FMEQ_ZM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(C)) 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)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
D = AIMAG(C(J))
CALL FMQ2M(D,MUFM)
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_ZM1ZQ1
SUBROUTINE FMEQ_Q1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), 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 FMM2Q(MTFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q1ZM1
SUBROUTINE FMEQ_ZQ1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
REAL (QUAD_FP) :: D,D1,D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
D = RUNKNO
C(J) = CMPLX(D,D , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL ZMREAL(MA(J)%MZM,MTFM)
CALL FMM2Q(MTFM,D1)
CALL ZMIMAG(MA(J)%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
C(J) = CMPLX(D1,D2 , QUAD_FP)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ1ZM1
SUBROUTINE FMEQ_ZM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(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_ZM2Q
SUBROUTINE FMEQ_ZM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
D = AIMAG(C)
CALL FMQ2M(D,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_ZM2ZQ
SUBROUTINE FMEQ_Q2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
REAL (QUAD_FP) :: 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 FMM2Q(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_Q2ZM
SUBROUTINE FMEQ_ZQ2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D2,D3
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2Q(MTFM,D3)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
C(J,K) = CMPLX(D2,D3, QUAD_FP)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2ZM
SUBROUTINE FMEQ_ZM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL (QUAD_FP), 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 FMQ2M(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_ZM2Q2
SUBROUTINE FMEQ_ZM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,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
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
D = AIMAG(C(J,K))
CALL FMQ2M(D,MUFM)
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_ZM2ZQ2
SUBROUTINE FMEQ_Q2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), 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 FMM2Q(MTFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Q2ZM2
SUBROUTINE FMEQ_ZQ2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
REAL (QUAD_FP) :: D,D1,D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
D = RUNKNO
C(J,K) = CMPLX(D,D , QUAD_FP)
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 FMM2Q(MTFM,D1)
CALL ZMIMAG(MA(J,K)%MZM,MTFM)
CALL FMM2Q(MTFM,D2)
C(J,K) = CMPLX(D1,D2 , QUAD_FP)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZQ2ZM2
FUNCTION FMLEQ_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLEQ_QFM = FMCOMP(MTFM,'EQ',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_QFM
FUNCTION FMLEQ_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_QIM = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_QIM
FUNCTION FMLEQ_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_QZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_QZM
FUNCTION FMLEQ_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZQFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
L1 = FMCOMP(MTFM,'EQ',MA%MFM)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_ZQFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZQFM
FUNCTION FMLEQ_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZQIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTEGER :: KA,NDSAVE
INTENT (IN) :: C,MA
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 FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_ZQIM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZQIM
FUNCTION FMLEQ_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZQZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMQ2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZQZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZQZM
FUNCTION FMLEQ_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLEQ_FMQ = FMCOMP(MA%MFM,'EQ',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMQ
FUNCTION FMLEQ_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
L1 = FMCOMP(MA%MFM,'EQ',MTFM)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_FMZQ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMZQ
FUNCTION FMLEQ_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_IMQ = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMQ
FUNCTION FMLEQ_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,C
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 FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_IMZQ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMZQ
FUNCTION FMLEQ_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZMQ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMQ
FUNCTION FMLEQ_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMQ2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZMZQ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMZQ
FUNCTION FMLNE_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLNE_QFM = FMCOMP(MTFM,'NE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_QFM
FUNCTION FMLNE_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_QIM = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_QIM
FUNCTION FMLNE_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_QZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_QZM
FUNCTION FMLNE_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZQFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
L1 = FMCOMP(MTFM,'NE',MA%MFM)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_ZQFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZQFM
FUNCTION FMLNE_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZQIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTEGER :: KA,NDSAVE
INTENT (IN) :: C,MA
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 FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_ZQIM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZQIM
FUNCTION FMLNE_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZQZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMQ2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZQZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZQZM
FUNCTION FMLNE_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLNE_FMQ = FMCOMP(MA%MFM,'NE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMQ
FUNCTION FMLNE_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
L1 = FMCOMP(MA%MFM,'NE',MTFM)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_FMZQ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMZQ
FUNCTION FMLNE_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_IMQ = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMQ
FUNCTION FMLNE_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,C
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 FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_IMZQ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMZQ
FUNCTION FMLNE_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZMQ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMQ
FUNCTION FMLNE_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMZQ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMQ2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZMZQ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMZQ
FUNCTION FMLGT_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLGT_QFM = FMCOMP(MTFM,'GT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_QFM
FUNCTION FMLGT_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_QIM = FMCOMP(MTFM,'GT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_QIM
FUNCTION FMLGT_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLGT_FMQ = FMCOMP(MA%MFM,'GT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMQ
FUNCTION FMLGT_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_IMQ = FMCOMP(MUFM,'GT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMQ
FUNCTION FMLGE_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLGE_QFM = FMCOMP(MTFM,'GE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_QFM
FUNCTION FMLGE_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_QIM = FMCOMP(MTFM,'GE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_QIM
FUNCTION FMLGE_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLGE_FMQ = FMCOMP(MA%MFM,'GE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMQ
FUNCTION FMLGE_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_IMQ = FMCOMP(MUFM,'GE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMQ
FUNCTION FMLLT_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLLT_QFM = FMCOMP(MTFM,'LT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_QFM
FUNCTION FMLLT_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_QIM = FMCOMP(MTFM,'LT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_QIM
FUNCTION FMLLT_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLLT_FMQ = FMCOMP(MA%MFM,'LT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMQ
FUNCTION FMLLT_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_IMQ = FMCOMP(MUFM,'LT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMQ
FUNCTION FMLLE_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_QFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLLE_QFM = FMCOMP(MTFM,'LE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_QFM
FUNCTION FMLLE_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_QIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTEGER :: KA,NDSAVE
INTENT (IN) :: D,MA
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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_QIM = FMCOMP(MTFM,'LE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_QIM
FUNCTION FMLLE_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
FMLLE_FMQ = FMCOMP(MA%MFM,'LE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMQ
FUNCTION FMLLE_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMQ
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL (QUAD_FP) :: 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 FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_IMQ = FMCOMP(MUFM,'LE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMQ
FUNCTION FMADD_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_QFM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_QFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QFM
FUNCTION FMADD_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_QIM
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_QIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QIM
FUNCTION FMADD_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_QZM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_QZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QZM
FUNCTION FMADD_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_ZQFM
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQFM
FUNCTION FMADD_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_ZQIM
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQIM
FUNCTION FMADD_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZQZM
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_ZQZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQZM
FUNCTION FMADD_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMQ
FUNCTION FMADD_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_FMZQ
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZQ
FUNCTION FMADD_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_IMQ
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MUFM,MTFM,FMADD_IMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMQ
FUNCTION FMADD_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_IMZQ
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZQ
FUNCTION FMADD_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMQ
FUNCTION FMADD_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZQ
FUNCTION FMADD_QFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_QFM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MA(J)%MFM,FMADD_QFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QFM1
FUNCTION FMADD_ZQFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZQFM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQFM1%MZM(1) = -1
FMADD_ZQFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQFM1
FUNCTION FMADD_FMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_FMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_FMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMQ1
FUNCTION FMADD_FMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_FMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_FMZQ1%MZM(1) = -1
FMADD_FMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZQ1
FUNCTION FMADD_FM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_FM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1Q
FUNCTION FMADD_FM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_FM1ZQ%MZM(1) = -1
FMADD_FM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1ZQ
FUNCTION FMADD_Q1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_Q1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_Q1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1FM
FUNCTION FMADD_ZQ1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1FM%MZM(1) = -1
FMADD_ZQ1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1FM
FUNCTION FMADD_FM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_FM1Q1%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_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1Q1
FUNCTION FMADD_FM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_FM1ZQ1%MZM(1) = -1
FMADD_FM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1ZQ1
FUNCTION FMADD_Q1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_Q1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1FM1%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_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MTFM,MA(J)%MFM,FMADD_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1FM1
FUNCTION FMADD_ZQ1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1FM1%MZM(1) = -1
FMADD_ZQ1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1FM1
FUNCTION FMADD_QFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_QFM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_QFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QFM2
FUNCTION FMADD_ZQFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZQFM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQFM2%MZM(1) = -1
FMADD_ZQFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQFM2
FUNCTION FMADD_FMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_FMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_FMQ2%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 FMQ2M(D(J,K),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMQ2
FUNCTION FMADD_FMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_FMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_FMZQ2%MZM(1) = -1
FMADD_FMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZQ2
FUNCTION FMADD_FM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_FM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2Q
FUNCTION FMADD_FM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_FM2ZQ%MZM(1) = -1
FMADD_FM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2ZQ
FUNCTION FMADD_Q2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2FM%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 FMQ2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_Q2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2FM
FUNCTION FMADD_ZQ2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2FM%MZM(1) = -1
FMADD_ZQ2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2FM
FUNCTION FMADD_FM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_FM2Q2%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_FM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2Q2
FUNCTION FMADD_FM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_FM2ZQ2%MZM(1) = -1
FMADD_FM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2ZQ2
FUNCTION FMADD_Q2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2FM2%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_Q2FM2(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 FMQ2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_Q2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2FM2
FUNCTION FMADD_ZQ2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2FM2%MZM(1) = -1
FMADD_ZQ2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ2FM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2FM2
FUNCTION FMADD_QIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_QIM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_QIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QIM1
FUNCTION FMADD_ZQIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZQIM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQIM1%MZM(1) = -1
FMADD_ZQIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQIM1
FUNCTION FMADD_IMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_IMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_IMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMQ1
FUNCTION FMADD_IMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_IMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_IMZQ1%MZM(1) = -1
FMADD_IMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZQ1
FUNCTION FMADD_IM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_IM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMADD(MVFM,MTFM,FMADD_IM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1Q
FUNCTION FMADD_IM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_IM1ZQ%MZM(1) = -1
FMADD_IM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1ZQ
FUNCTION FMADD_Q1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_Q1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_Q1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1IM
FUNCTION FMADD_ZQ1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1IM%MZM(1) = -1
FMADD_ZQ1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1IM
FUNCTION FMADD_IM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_IM1Q1%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_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1Q1
FUNCTION FMADD_IM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_IM1ZQ1%MZM(1) = -1
FMADD_IM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1ZQ1
FUNCTION FMADD_Q1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_Q1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1IM1%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_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(D(J),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1IM1
FUNCTION FMADD_ZQ1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1IM1%MZM(1) = -1
FMADD_ZQ1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1IM1
FUNCTION FMADD_QIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_QIM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_QIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QIM2
FUNCTION FMADD_ZQIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZQIM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQIM2%MZM(1) = -1
FMADD_ZQIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQIM2
FUNCTION FMADD_IMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_IMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_IMQ2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMQ2
FUNCTION FMADD_IMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_IMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_IMZQ2%MZM(1) = -1
FMADD_IMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZQ2
FUNCTION FMADD_IM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_IM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL FMADD(MVFM,MTFM,FMADD_IM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2Q
FUNCTION FMADD_IM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_IM2ZQ%MZM(1) = -1
FMADD_IM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2ZQ
FUNCTION FMADD_Q2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_Q2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2IM
FUNCTION FMADD_ZQ2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2IM%MZM(1) = -1
FMADD_ZQ2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2IM
FUNCTION FMADD_IM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_IM2Q2%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_IM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2Q2
FUNCTION FMADD_IM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_IM2ZQ2%MZM(1) = -1
FMADD_IM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2ZQ2
FUNCTION FMADD_Q2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2IM2%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_Q2IM2(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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(D(J,K),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_Q2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2IM2
FUNCTION FMADD_ZQ2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2IM2%MZM(1) = -1
FMADD_ZQ2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ2IM2(J,K)%MZM)
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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZQ2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2IM2
FUNCTION FMADD_QZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_QZM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QZM1%MZM(1) = -1
FMADD_QZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_QZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QZM1
FUNCTION FMADD_ZQZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZQZM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQZM1%MZM(1) = -1
FMADD_ZQZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_ZQZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQZM1
FUNCTION FMADD_ZMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_ZMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_ZMQ1%MZM(1) = -1
FMADD_ZMQ1%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMQ1
FUNCTION FMADD_ZMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZMZQ1%MZM(1) = -1
FMADD_ZMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZQ1
FUNCTION FMADD_ZM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_ZM1Q%MZM(1) = -1
FMADD_ZM1Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1Q(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1Q
FUNCTION FMADD_ZM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZM1ZQ%MZM(1) = -1
FMADD_ZM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1ZQ
FUNCTION FMADD_Q1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_Q1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1ZM%MZM(1) = -1
FMADD_Q1ZM%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_Q1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1ZM
FUNCTION FMADD_ZQ1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1ZM%MZM(1) = -1
FMADD_ZQ1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_ZQ1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1ZM
FUNCTION FMADD_ZM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_ZM1Q1%MZM(1) = -1
FMADD_ZM1Q1%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_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1Q1
FUNCTION FMADD_ZM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_ZM1ZQ1%MZM(1) = -1
FMADD_ZM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1ZQ1
FUNCTION FMADD_Q1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_Q1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_Q1ZM1%MZM(1) = -1
FMADD_Q1ZM1%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_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q1ZM1
FUNCTION FMADD_ZQ1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZQ1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZQ1ZM1%MZM(1) = -1
FMADD_ZQ1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ1ZM1
FUNCTION FMADD_QZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_QZM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_QZM2%MZM(1) = -1
FMADD_QZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_QZM2
FUNCTION FMADD_ZQZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZQZM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZQZM2%MZM(1) = -1
FMADD_ZQZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZQZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQZM2
FUNCTION FMADD_ZMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_ZMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_ZMQ2%MZM(1) = -1
FMADD_ZMQ2%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMQ2
FUNCTION FMADD_ZMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZMZQ2%MZM(1) = -1
FMADD_ZMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZQ2
FUNCTION FMADD_ZM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMADD_ZM2Q%MZM(1) = -1
FMADD_ZM2Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZM2Q(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2Q
FUNCTION FMADD_ZM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMADD_ZM2ZQ%MZM(1) = -1
FMADD_ZM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2ZQ
FUNCTION FMADD_Q2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2ZM%MZM(1) = -1
FMADD_Q2ZM%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_Q2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2ZM
FUNCTION FMADD_ZQ2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2ZM%MZM(1) = -1
FMADD_ZQ2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_ZQ2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2ZM
FUNCTION FMADD_ZM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_ZM2Q2%MZM(1) = -1
FMADD_ZM2Q2%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_ZM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2Q2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2Q2
FUNCTION FMADD_ZM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_ZM2ZQ2%MZM(1) = -1
FMADD_ZM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2ZQ2
FUNCTION FMADD_Q2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_Q2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_Q2ZM2%MZM(1) = -1
FMADD_Q2ZM2%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_Q2ZM2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_Q2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Q2ZM2
FUNCTION FMADD_ZQ2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZQ2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZQ2ZM2%MZM(1) = -1
FMADD_ZQ2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZQ2ZM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_ZQ2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZQ2ZM2
FUNCTION FMSUB_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_QFM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_QFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QFM
FUNCTION FMSUB_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_QIM
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_QIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QIM
FUNCTION FMSUB_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_QZM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_QZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QZM
FUNCTION FMSUB_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_ZQFM
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQFM
FUNCTION FMSUB_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_ZQIM
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQIM
FUNCTION FMSUB_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZQZM
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_ZQZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQZM
FUNCTION FMSUB_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMQ
FUNCTION FMSUB_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_FMZQ
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZQ
FUNCTION FMSUB_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_IMQ
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMQ
FUNCTION FMSUB_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_IMZQ
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZQ
FUNCTION FMSUB_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMQ
FUNCTION FMSUB_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZQ
FUNCTION FMSUB_QFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_QFM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_QFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QFM1
FUNCTION FMSUB_ZQFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZQFM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQFM1%MZM(1) = -1
FMSUB_ZQFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQFM1
FUNCTION FMSUB_FMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_FMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_FMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMQ1
FUNCTION FMSUB_FMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_FMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_FMZQ1%MZM(1) = -1
FMSUB_FMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZQ1
FUNCTION FMSUB_FM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_FM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1Q
FUNCTION FMSUB_FM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_FM1ZQ%MZM(1) = -1
FMSUB_FM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1ZQ
FUNCTION FMSUB_Q1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_Q1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_Q1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1FM
FUNCTION FMSUB_ZQ1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1FM%MZM(1) = -1
FMSUB_ZQ1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1FM
FUNCTION FMSUB_FM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_FM1Q1%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_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1Q1
FUNCTION FMSUB_FM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_FM1ZQ1%MZM(1) = -1
FMSUB_FM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1ZQ1
FUNCTION FMSUB_Q1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_Q1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1FM1%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_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1FM1
FUNCTION FMSUB_ZQ1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1FM1%MZM(1) = -1
FMSUB_ZQ1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1FM1
FUNCTION FMSUB_QFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_QFM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_QFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QFM2
FUNCTION FMSUB_ZQFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZQFM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQFM2%MZM(1) = -1
FMSUB_ZQFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQFM2
FUNCTION FMSUB_FMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_FMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_FMQ2%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 FMQ2M(D(J,K),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMQ2
FUNCTION FMSUB_FMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_FMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_FMZQ2%MZM(1) = -1
FMSUB_FMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZQ2
FUNCTION FMSUB_FM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_FM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2Q
FUNCTION FMSUB_FM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_FM2ZQ%MZM(1) = -1
FMSUB_FM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2ZQ
FUNCTION FMSUB_Q2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2FM%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 FMQ2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_Q2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2FM
FUNCTION FMSUB_ZQ2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2FM%MZM(1) = -1
FMSUB_ZQ2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2FM
FUNCTION FMSUB_FM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_FM2Q2%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_FM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2Q2
FUNCTION FMSUB_FM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_FM2ZQ2%MZM(1) = -1
FMSUB_FM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2ZQ2
FUNCTION FMSUB_Q2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2FM2%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_Q2FM2(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 FMQ2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_Q2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2FM2
FUNCTION FMSUB_ZQ2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2FM2%MZM(1) = -1
FMSUB_ZQ2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ2FM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2FM2
FUNCTION FMSUB_QIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_QIM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_QIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QIM1
FUNCTION FMSUB_ZQIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZQIM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQIM1%MZM(1) = -1
FMSUB_ZQIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQIM1
FUNCTION FMSUB_IMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_IMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_IMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMQ1
FUNCTION FMSUB_IMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_IMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_IMZQ1%MZM(1) = -1
FMSUB_IMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZQ1
FUNCTION FMSUB_IM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_IM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMSUB(MVFM,MTFM,FMSUB_IM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1Q
FUNCTION FMSUB_IM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_IM1ZQ%MZM(1) = -1
FMSUB_IM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1ZQ
FUNCTION FMSUB_Q1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_Q1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_Q1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1IM
FUNCTION FMSUB_ZQ1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1IM%MZM(1) = -1
FMSUB_ZQ1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1IM
FUNCTION FMSUB_IM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_IM1Q1%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_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1Q1
FUNCTION FMSUB_IM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_IM1ZQ1%MZM(1) = -1
FMSUB_IM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1ZQ1
FUNCTION FMSUB_Q1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_Q1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1IM1%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_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(D(J),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1IM1
FUNCTION FMSUB_ZQ1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1IM1%MZM(1) = -1
FMSUB_ZQ1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1IM1
FUNCTION FMSUB_QIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_QIM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_QIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QIM2
FUNCTION FMSUB_ZQIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZQIM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQIM2%MZM(1) = -1
FMSUB_ZQIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQIM2
FUNCTION FMSUB_IMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_IMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_IMQ2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMQ2
FUNCTION FMSUB_IMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_IMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_IMZQ2%MZM(1) = -1
FMSUB_IMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZQ2
FUNCTION FMSUB_IM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_IM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL FMSUB(MVFM,MTFM,FMSUB_IM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2Q
FUNCTION FMSUB_IM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_IM2ZQ%MZM(1) = -1
FMSUB_IM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2ZQ
FUNCTION FMSUB_Q2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_Q2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2IM
FUNCTION FMSUB_ZQ2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2IM%MZM(1) = -1
FMSUB_ZQ2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2IM
FUNCTION FMSUB_IM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_IM2Q2%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_IM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2Q2
FUNCTION FMSUB_IM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_IM2ZQ2%MZM(1) = -1
FMSUB_IM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2ZQ2
FUNCTION FMSUB_Q2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2IM2%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_Q2IM2(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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(D(J,K),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_Q2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2IM2
FUNCTION FMSUB_ZQ2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2IM2%MZM(1) = -1
FMSUB_ZQ2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ2IM2(J,K)%MZM)
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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZQ2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2IM2
FUNCTION FMSUB_QZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_QZM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QZM1%MZM(1) = -1
FMSUB_QZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_QZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QZM1
FUNCTION FMSUB_ZQZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZQZM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQZM1%MZM(1) = -1
FMSUB_ZQZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_ZQZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQZM1
FUNCTION FMSUB_ZMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_ZMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_ZMQ1%MZM(1) = -1
FMSUB_ZMQ1%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMQ1
FUNCTION FMSUB_ZMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZMZQ1%MZM(1) = -1
FMSUB_ZMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZQ1
FUNCTION FMSUB_ZM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_ZM1Q%MZM(1) = -1
FMSUB_ZM1Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1Q(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1Q
FUNCTION FMSUB_ZM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZM1ZQ%MZM(1) = -1
FMSUB_ZM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1ZQ
FUNCTION FMSUB_Q1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_Q1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1ZM%MZM(1) = -1
FMSUB_Q1ZM%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_Q1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1ZM
FUNCTION FMSUB_ZQ1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1ZM%MZM(1) = -1
FMSUB_ZQ1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_ZQ1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1ZM
FUNCTION FMSUB_ZM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM1Q1%MZM(1) = -1
FMSUB_ZM1Q1%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_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1Q1
FUNCTION FMSUB_ZM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_ZM1ZQ1%MZM(1) = -1
FMSUB_ZM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1ZQ1
FUNCTION FMSUB_Q1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_Q1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_Q1ZM1%MZM(1) = -1
FMSUB_Q1ZM1%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_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q1ZM1
FUNCTION FMSUB_ZQ1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZQ1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZQ1ZM1%MZM(1) = -1
FMSUB_ZQ1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ1ZM1
FUNCTION FMSUB_QZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_QZM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_QZM2%MZM(1) = -1
FMSUB_QZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_QZM2
FUNCTION FMSUB_ZQZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZQZM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZQZM2%MZM(1) = -1
FMSUB_ZQZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZQZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQZM2
FUNCTION FMSUB_ZMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_ZMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_ZMQ2%MZM(1) = -1
FMSUB_ZMQ2%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMQ2
FUNCTION FMSUB_ZMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZMZQ2%MZM(1) = -1
FMSUB_ZMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZQ2
FUNCTION FMSUB_ZM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMSUB_ZM2Q%MZM(1) = -1
FMSUB_ZM2Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZM2Q(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2Q
FUNCTION FMSUB_ZM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMSUB_ZM2ZQ%MZM(1) = -1
FMSUB_ZM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2ZQ
FUNCTION FMSUB_Q2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2ZM%MZM(1) = -1
FMSUB_Q2ZM%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_Q2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2ZM
FUNCTION FMSUB_ZQ2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2ZM%MZM(1) = -1
FMSUB_ZQ2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_ZQ2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2ZM
FUNCTION FMSUB_ZM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM2Q2%MZM(1) = -1
FMSUB_ZM2Q2%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_ZM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2Q2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2Q2
FUNCTION FMSUB_ZM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_ZM2ZQ2%MZM(1) = -1
FMSUB_ZM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2ZQ2
FUNCTION FMSUB_Q2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_Q2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_Q2ZM2%MZM(1) = -1
FMSUB_Q2ZM2%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_Q2ZM2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_Q2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Q2ZM2
FUNCTION FMSUB_ZQ2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZQ2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZQ2ZM2%MZM(1) = -1
FMSUB_ZQ2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZQ2ZM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_ZQ2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZQ2ZM2
FUNCTION FMMPY_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_QFM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_QFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QFM
FUNCTION FMMPY_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_QIM
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_QIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QIM
FUNCTION FMMPY_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_QZM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_QZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QZM
FUNCTION FMMPY_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_ZQFM
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQFM
FUNCTION FMMPY_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_ZQIM
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQIM
FUNCTION FMMPY_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZQZM
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_ZQZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQZM
FUNCTION FMMPY_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMQ
FUNCTION FMMPY_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_FMZQ
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZQ
FUNCTION FMMPY_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_IMQ
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMQ
FUNCTION FMMPY_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_IMZQ
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZQ
FUNCTION FMMPY_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMQ
FUNCTION FMMPY_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZQ
FUNCTION FMMPY_QFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_QFM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_QFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QFM1
FUNCTION FMMPY_ZQFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZQFM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQFM1%MZM(1) = -1
FMMPY_ZQFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQFM1
FUNCTION FMMPY_FMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_FMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_FMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMQ1
FUNCTION FMMPY_FMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_FMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_FMZQ1%MZM(1) = -1
FMMPY_FMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZQ1
FUNCTION FMMPY_FM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_FM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1Q
FUNCTION FMMPY_FM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_FM1ZQ%MZM(1) = -1
FMMPY_FM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1ZQ
FUNCTION FMMPY_Q1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_Q1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_Q1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1FM
FUNCTION FMMPY_ZQ1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1FM%MZM(1) = -1
FMMPY_ZQ1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1FM
FUNCTION FMMPY_FM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_FM1Q1%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_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1Q1
FUNCTION FMMPY_FM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_FM1ZQ1%MZM(1) = -1
FMMPY_FM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1ZQ1
FUNCTION FMMPY_Q1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_Q1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1FM1%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_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1FM1
FUNCTION FMMPY_ZQ1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1FM1%MZM(1) = -1
FMMPY_ZQ1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1FM1
FUNCTION FMMPY_QFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_QFM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_QFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QFM2
FUNCTION FMMPY_ZQFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZQFM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQFM2%MZM(1) = -1
FMMPY_ZQFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQFM2
FUNCTION FMMPY_FMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_FMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_FMQ2%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 FMQ2M(D(J,K),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMQ2
FUNCTION FMMPY_FMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_FMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_FMZQ2%MZM(1) = -1
FMMPY_FMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZQ2
FUNCTION FMMPY_FM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_FM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2Q
FUNCTION FMMPY_FM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_FM2ZQ%MZM(1) = -1
FMMPY_FM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2ZQ
FUNCTION FMMPY_Q2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2FM%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 FMQ2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_Q2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2FM
FUNCTION FMMPY_ZQ2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2FM%MZM(1) = -1
FMMPY_ZQ2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2FM
FUNCTION FMMPY_FM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_FM2Q2%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_FM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2Q2
FUNCTION FMMPY_FM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_FM2ZQ2%MZM(1) = -1
FMMPY_FM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2ZQ2
FUNCTION FMMPY_Q2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2FM2%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_Q2FM2(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 FMQ2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_Q2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2FM2
FUNCTION FMMPY_ZQ2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2FM2%MZM(1) = -1
FMMPY_ZQ2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ2FM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2FM2
FUNCTION FMMPY_QIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_QIM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_QIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QIM1
FUNCTION FMMPY_ZQIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZQIM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQIM1%MZM(1) = -1
FMMPY_ZQIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQIM1
FUNCTION FMMPY_IMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_IMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_IMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMQ1
FUNCTION FMMPY_IMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_IMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_IMZQ1%MZM(1) = -1
FMMPY_IMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZQ1
FUNCTION FMMPY_IM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_IM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMMPY(MVFM,MTFM,FMMPY_IM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1Q
FUNCTION FMMPY_IM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_IM1ZQ%MZM(1) = -1
FMMPY_IM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1ZQ
FUNCTION FMMPY_Q1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_Q1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_Q1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1IM
FUNCTION FMMPY_ZQ1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1IM%MZM(1) = -1
FMMPY_ZQ1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1IM
FUNCTION FMMPY_IM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_IM1Q1%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_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1Q1
FUNCTION FMMPY_IM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_IM1ZQ1%MZM(1) = -1
FMMPY_IM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1ZQ1
FUNCTION FMMPY_Q1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_Q1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1IM1%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_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(D(J),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1IM1
FUNCTION FMMPY_ZQ1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1IM1%MZM(1) = -1
FMMPY_ZQ1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1IM1
FUNCTION FMMPY_QIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_QIM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_QIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QIM2
FUNCTION FMMPY_ZQIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZQIM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQIM2%MZM(1) = -1
FMMPY_ZQIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQIM2
FUNCTION FMMPY_IMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_IMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_IMQ2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMQ2
FUNCTION FMMPY_IMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_IMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_IMZQ2%MZM(1) = -1
FMMPY_IMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZQ2
FUNCTION FMMPY_IM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_IM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL FMMPY(MVFM,MTFM,FMMPY_IM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2Q
FUNCTION FMMPY_IM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_IM2ZQ%MZM(1) = -1
FMMPY_IM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2ZQ
FUNCTION FMMPY_Q2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_Q2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2IM
FUNCTION FMMPY_ZQ2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2IM%MZM(1) = -1
FMMPY_ZQ2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2IM
FUNCTION FMMPY_IM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_IM2Q2%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_IM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2Q2
FUNCTION FMMPY_IM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_IM2ZQ2%MZM(1) = -1
FMMPY_IM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2ZQ2
FUNCTION FMMPY_Q2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2IM2%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_Q2IM2(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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(D(J,K),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_Q2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2IM2
FUNCTION FMMPY_ZQ2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2IM2%MZM(1) = -1
FMMPY_ZQ2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ2IM2(J,K)%MZM)
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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZQ2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2IM2
FUNCTION FMMPY_QZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_QZM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QZM1%MZM(1) = -1
FMMPY_QZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_QZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QZM1
FUNCTION FMMPY_ZQZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZQZM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQZM1%MZM(1) = -1
FMMPY_ZQZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_ZQZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQZM1
FUNCTION FMMPY_ZMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_ZMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_ZMQ1%MZM(1) = -1
FMMPY_ZMQ1%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMQ1
FUNCTION FMMPY_ZMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZMZQ1%MZM(1) = -1
FMMPY_ZMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZQ1
FUNCTION FMMPY_ZM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_ZM1Q%MZM(1) = -1
FMMPY_ZM1Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1Q(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1Q
FUNCTION FMMPY_ZM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZM1ZQ%MZM(1) = -1
FMMPY_ZM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1ZQ
FUNCTION FMMPY_Q1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_Q1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1ZM%MZM(1) = -1
FMMPY_Q1ZM%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_Q1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1ZM
FUNCTION FMMPY_ZQ1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1ZM%MZM(1) = -1
FMMPY_ZQ1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_ZQ1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1ZM
FUNCTION FMMPY_ZM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM1Q1%MZM(1) = -1
FMMPY_ZM1Q1%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_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1Q1
FUNCTION FMMPY_ZM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_ZM1ZQ1%MZM(1) = -1
FMMPY_ZM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1ZQ1
FUNCTION FMMPY_Q1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_Q1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_Q1ZM1%MZM(1) = -1
FMMPY_Q1ZM1%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_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q1ZM1
FUNCTION FMMPY_ZQ1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZQ1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZQ1ZM1%MZM(1) = -1
FMMPY_ZQ1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ1ZM1
FUNCTION FMMPY_QZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_QZM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_QZM2%MZM(1) = -1
FMMPY_QZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_QZM2
FUNCTION FMMPY_ZQZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZQZM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZQZM2%MZM(1) = -1
FMMPY_ZQZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZQZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQZM2
FUNCTION FMMPY_ZMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_ZMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_ZMQ2%MZM(1) = -1
FMMPY_ZMQ2%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMQ2
FUNCTION FMMPY_ZMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZMZQ2%MZM(1) = -1
FMMPY_ZMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZQ2
FUNCTION FMMPY_ZM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMMPY_ZM2Q%MZM(1) = -1
FMMPY_ZM2Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZM2Q(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2Q
FUNCTION FMMPY_ZM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMMPY_ZM2ZQ%MZM(1) = -1
FMMPY_ZM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2ZQ
FUNCTION FMMPY_Q2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2ZM%MZM(1) = -1
FMMPY_Q2ZM%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_Q2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2ZM
FUNCTION FMMPY_ZQ2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2ZM%MZM(1) = -1
FMMPY_ZQ2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_ZQ2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2ZM
FUNCTION FMMPY_ZM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM2Q2%MZM(1) = -1
FMMPY_ZM2Q2%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_ZM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2Q2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2Q2
FUNCTION FMMPY_ZM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_ZM2ZQ2%MZM(1) = -1
FMMPY_ZM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2ZQ2
FUNCTION FMMPY_Q2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_Q2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_Q2ZM2%MZM(1) = -1
FMMPY_Q2ZM2%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_Q2ZM2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_Q2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Q2ZM2
FUNCTION FMMPY_ZQ2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZQ2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZQ2ZM2%MZM(1) = -1
FMMPY_ZQ2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZQ2ZM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_ZQ2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZQ2ZM2
FUNCTION FMDIV_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_QFM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_QFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QFM
FUNCTION FMDIV_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_QIM
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_QIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QIM
FUNCTION FMDIV_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_QZM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_QZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QZM
FUNCTION FMDIV_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_ZQFM
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQFM
FUNCTION FMDIV_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_ZQIM
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQIM
FUNCTION FMDIV_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZQZM
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_ZQZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQZM
FUNCTION FMDIV_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMQ
FUNCTION FMDIV_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_FMZQ
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZQ
FUNCTION FMDIV_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_IMQ
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMQ
FUNCTION FMDIV_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_IMZQ
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZQ
FUNCTION FMDIV_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMQ
FUNCTION FMDIV_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZQ
FUNCTION FMDIV_QFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_QFM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_QFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QFM1
FUNCTION FMDIV_ZQFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZQFM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQFM1%MZM(1) = -1
FMDIV_ZQFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQFM1
FUNCTION FMDIV_FMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_FMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_FMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMQ1
FUNCTION FMDIV_FMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_FMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_FMZQ1%MZM(1) = -1
FMDIV_FMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZQ1
FUNCTION FMDIV_FM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_FM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1Q
FUNCTION FMDIV_FM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_FM1ZQ%MZM(1) = -1
FMDIV_FM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1ZQ
FUNCTION FMDIV_Q1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_Q1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_Q1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1FM
FUNCTION FMDIV_ZQ1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1FM%MZM(1) = -1
FMDIV_ZQ1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1FM
FUNCTION FMDIV_FM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_FM1Q1%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_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1Q1
FUNCTION FMDIV_FM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_FM1ZQ1%MZM(1) = -1
FMDIV_FM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1ZQ1
FUNCTION FMDIV_Q1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_Q1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1FM1%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_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_Q1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1FM1
FUNCTION FMDIV_ZQ1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1FM1%MZM(1) = -1
FMDIV_ZQ1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1FM1
FUNCTION FMDIV_QFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_QFM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_QFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QFM2
FUNCTION FMDIV_ZQFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZQFM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQFM2%MZM(1) = -1
FMDIV_ZQFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQFM2
FUNCTION FMDIV_FMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_FMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_FMQ2%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 FMQ2M(D(J,K),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMQ2
FUNCTION FMDIV_FMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_FMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_FMZQ2%MZM(1) = -1
FMDIV_FMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZQ2
FUNCTION FMDIV_FM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_FM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2Q
FUNCTION FMDIV_FM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_FM2ZQ%MZM(1) = -1
FMDIV_FM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2ZQ
FUNCTION FMDIV_Q2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2FM%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 FMQ2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_Q2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2FM
FUNCTION FMDIV_ZQ2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2FM%MZM(1) = -1
FMDIV_ZQ2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2FM
FUNCTION FMDIV_FM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_FM2Q2%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_FM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2Q2
FUNCTION FMDIV_FM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_FM2ZQ2%MZM(1) = -1
FMDIV_FM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2ZQ2
FUNCTION FMDIV_Q2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2FM2%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_Q2FM2(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 FMQ2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_Q2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2FM2
FUNCTION FMDIV_ZQ2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2FM2%MZM(1) = -1
FMDIV_ZQ2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ2FM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2FM2
FUNCTION FMDIV_QIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_QIM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_QIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QIM1
FUNCTION FMDIV_ZQIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZQIM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQIM1%MZM(1) = -1
FMDIV_ZQIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQIM1
FUNCTION FMDIV_IMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_IMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_IMQ1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMQ1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMQ1
FUNCTION FMDIV_IMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_IMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_IMZQ1%MZM(1) = -1
FMDIV_IMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZQ1
FUNCTION FMDIV_IM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_IM1Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMDIV(MVFM,MTFM,FMDIV_IM1Q(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1Q
FUNCTION FMDIV_IM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_IM1ZQ%MZM(1) = -1
FMDIV_IM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1ZQ
FUNCTION FMDIV_Q1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_Q1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_Q1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1IM
FUNCTION FMDIV_ZQ1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1IM%MZM(1) = -1
FMDIV_ZQ1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1IM
FUNCTION FMDIV_IM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_IM1Q1%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_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM1Q1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1Q1
FUNCTION FMDIV_IM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_IM1ZQ1%MZM(1) = -1
FMDIV_IM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1ZQ1
FUNCTION FMDIV_Q1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_Q1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1IM1%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_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(D(J),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_Q1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1IM1
FUNCTION FMDIV_ZQ1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1IM1%MZM(1) = -1
FMDIV_ZQ1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1IM1
FUNCTION FMDIV_QIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_QIM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_QIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QIM2
FUNCTION FMDIV_ZQIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZQIM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQIM2%MZM(1) = -1
FMDIV_ZQIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQIM2
FUNCTION FMDIV_IMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_IMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_IMQ2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMQ2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMQ2
FUNCTION FMDIV_IMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_IMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_IMZQ2%MZM(1) = -1
FMDIV_IMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZQ2
FUNCTION FMDIV_IM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_IM2Q%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL FMDIV(MVFM,MTFM,FMDIV_IM2Q(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2Q
FUNCTION FMDIV_IM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_IM2ZQ%MZM(1) = -1
FMDIV_IM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2ZQ
FUNCTION FMDIV_Q2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMQ2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_Q2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2IM
FUNCTION FMDIV_ZQ2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2IM%MZM(1) = -1
FMDIV_ZQ2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,M1FM)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2IM
FUNCTION FMDIV_IM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_IM2Q2%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_IM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM2Q2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2Q2
FUNCTION FMDIV_IM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_IM2ZQ2%MZM(1) = -1
FMDIV_IM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2ZQ2
FUNCTION FMDIV_Q2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2IM2%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_Q2IM2(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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(D(J,K),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_Q2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2IM2
FUNCTION FMDIV_ZQ2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2IM2%MZM(1) = -1
FMDIV_ZQ2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ2IM2(J,K)%MZM)
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 IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZQ2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2IM2
FUNCTION FMDIV_QZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_QZM1
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QZM1%MZM(1) = -1
FMDIV_QZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_QZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QZM1
FUNCTION FMDIV_ZQZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZQZM1
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQZM1%MZM(1) = -1
FMDIV_ZQZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_ZQZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQZM1
FUNCTION FMDIV_ZMQ1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_ZMQ1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_ZMQ1%MZM(1) = -1
FMDIV_ZMQ1%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMQ1
FUNCTION FMDIV_ZMZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZMZQ1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZMZQ1%MZM(1) = -1
FMDIV_ZMZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZQ1
FUNCTION FMDIV_ZM1Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1Q
INTEGER :: J,N
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_ZM1Q%MZM(1) = -1
FMDIV_ZM1Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1Q(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1Q
FUNCTION FMDIV_ZM1ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1ZQ
INTEGER :: J,N
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZM1ZQ%MZM(1) = -1
FMDIV_ZM1ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1ZQ(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1ZQ
FUNCTION FMDIV_Q1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_Q1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1ZM%MZM(1) = -1
FMDIV_Q1ZM%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 FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_Q1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1ZM
FUNCTION FMDIV_ZQ1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1ZM%MZM(1) = -1
FMDIV_ZQ1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_ZQ1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1ZM
FUNCTION FMDIV_ZM1Q1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1Q1
INTEGER :: J,N
REAL (QUAD_FP), DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM1Q1%MZM(1) = -1
FMDIV_ZM1Q1%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_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1Q1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1Q1
FUNCTION FMDIV_ZM1ZQ1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1ZQ1
INTEGER :: J,N
COMPLEX (QUAD_FP), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_ZM1ZQ1%MZM(1) = -1
FMDIV_ZM1ZQ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1ZQ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1ZQ1
FUNCTION FMDIV_Q1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL (QUAD_FP), DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_Q1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_Q1ZM1%MZM(1) = -1
FMDIV_Q1ZM1%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_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMQ2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_Q1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q1ZM1
FUNCTION FMDIV_ZQ1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZQ1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZQ1ZM1%MZM(1) = -1
FMDIV_ZQ1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMQ2M(REAL(C(J),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_ZQ1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ1ZM1
FUNCTION FMDIV_QZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_QZM2
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_QZM2%MZM(1) = -1
FMDIV_QZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_QZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_QZM2
FUNCTION FMDIV_ZQZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZQZM2
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZQZM2%MZM(1) = -1
FMDIV_ZQZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZQZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQZM2
FUNCTION FMDIV_ZMQ2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_ZMQ2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_ZMQ2%MZM(1) = -1
FMDIV_ZMQ2%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMQ2
FUNCTION FMDIV_ZMZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZMZQ2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZMZQ2%MZM(1) = -1
FMDIV_ZMZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZQ2
FUNCTION FMDIV_ZM2Q(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2Q
INTEGER :: J,K
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
FMDIV_ZM2Q%MZM(1) = -1
FMDIV_ZM2Q%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(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_ZM2Q(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2Q
FUNCTION FMDIV_ZM2ZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2ZQ
INTEGER :: J,K
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
FMDIV_ZM2ZQ%MZM(1) = -1
FMDIV_ZM2ZQ%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),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_ZM2ZQ(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2ZQ
FUNCTION FMDIV_Q2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2ZM%MZM(1) = -1
FMDIV_Q2ZM%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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_Q2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2ZM
FUNCTION FMDIV_ZQ2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2ZM%MZM(1) = -1
FMDIV_ZQ2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_ZQ2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2ZM
FUNCTION FMDIV_ZM2Q2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2Q2
INTEGER :: J,K
REAL (QUAD_FP), DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM2Q2%MZM(1) = -1
FMDIV_ZM2Q2%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_ZM2Q2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2Q2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2Q2
FUNCTION FMDIV_ZM2ZQ2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2ZQ2
INTEGER :: J,K
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_ZM2ZQ2%MZM(1) = -1
FMDIV_ZM2ZQ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2ZQ2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2ZQ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2ZQ2
FUNCTION FMDIV_Q2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL (QUAD_FP), DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_Q2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_Q2ZM2%MZM(1) = -1
FMDIV_Q2ZM2%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_Q2ZM2(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 FMQ2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_Q2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Q2ZM2
FUNCTION FMDIV_ZQ2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (QUAD_FP), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZQ2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZQ2ZM2%MZM(1) = -1
FMDIV_ZQ2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZQ2ZM2(J,K)%MZM)
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 FMQ2M(REAL(C(J,K),QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_ZQ2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZQ2ZM2
FUNCTION FMPWR_QFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_QFM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMPWR(MTFM,MA%MFM,FMPWR_QFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_QFM
FUNCTION FMPWR_QIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_QIM
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MTFM,MUFM,FMPWR_QIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_QIM
FUNCTION FMPWR_QZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_QZM
REAL (QUAD_FP) :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_QZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_QZM
FUNCTION FMPWR_ZQFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_ZQFM
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MTZM,MUZM,FMPWR_ZQFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZQFM
FUNCTION FMPWR_ZQIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_ZQIM
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MTZM,MUZM,FMPWR_ZQIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZQIM
FUNCTION FMPWR_ZQZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZQZM
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_ZQZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZQZM
FUNCTION FMPWR_FMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMPWR(MA%MFM,MTFM,FMPWR_FMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMQ
FUNCTION FMPWR_FMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_FMZQ
TYPE (FM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MTZM,FMPWR_FMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMZQ
FUNCTION FMPWR_IMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_IMQ
TYPE (IM) :: MA
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MUFM,MTFM,FMPWR_IMQ%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMQ
FUNCTION FMPWR_IMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_IMZQ
TYPE (IM) :: MA
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MTZM,FMPWR_IMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMZQ
FUNCTION FMPWR_ZMQ(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMQ
REAL (QUAD_FP) :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMQ
FUNCTION FMPWR_ZMZQ(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMZQ
COMPLEX (QUAD_FP) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMQ2M(REAL(C,QUAD_FP),MTFM)
CALL FMQ2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMZQ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMZQ
END MODULE FM_QUAD_REAL
c4science · Help