Homec4science
Diffusion COSOlver (llechot) Browse

cosolver/basis_transformation/MPI_T5/FM/src/fmzm90.f90
df55999e752fllechot

Last Change
Raw File

fmzm90.f90
View Options

This file is larger than 256 KB, so syntax highlighting was skipped.
MODULE FMZM_1
! FMZM 1.3 David M. Smith
! This module extends the definition of the basic Fortran arithmetic and function operations so
! they also apply to multiple precision numbers, using version 1.3 of FM.
! There are three multiple precision data types:
! FM (multiple precision real)
! IM (multiple precision integer)
! ZM (multiple precision complex)
! For some examples and general advice about using these multiple-precision data types, see the
! program SampleFM.f95.
! Most of the functions defined in this module are multiple precision versions of standard Fortran
! functions. In addition, there are functions for direct conversion, formatting, and some
! mathematical special functions.
! TO_FM is a function for converting other types of numbers to type FM. Note that TO_FM(3.12)
! converts the REAL constant to FM, but it is accurate only to single precision, since the number
! 3.12 cannot be represented exactly in binary and has already been rounded to single precision.
! Similarly, TO_FM(3.12D0) agrees with 3.12 to double precision accuracy, and TO_FM('3.12') or
! TO_FM(312)/TO_FM(100) agrees to full FM accuracy.
! TO_IM converts to type IM, and TO_ZM converts to type ZM.
! Functions are also supplied for converting the three multiple precision types to the other
! numeric data types:
! TO_INT converts to machine precision integer
! TO_SP converts to single precision
! TO_DP converts to double precision
! TO_SPZ converts to single precision complex
! TO_DPZ converts to double precision complex
! WARNING: When multiple precision type declarations are inserted in an existing program, take
! care in converting functions like DBLE(X), where X has been declared as a multiple
! precision type. If X was single precision in the original program, then replacing
! the DBLE(X) by TO_DP(X) in the new version could lose accuracy. For this reason, the
! Fortran type-conversion functions defined in this module assume that results should
! be multiple precision whenever inputs are. Examples:
! DBLE(TO_FM('1.23E+123456')) is type FM
! REAL(TO_FM('1.23E+123456')) is type FM
! REAL(TO_ZM('3.12+4.56i')) is type FM = TO_FM('3.12')
! INT(TO_FM('1.23')) is type IM = TO_IM(1)
! INT(TO_IM('1E+23')) is type IM
! CMPLX(TO_FM('1.23'),TO_FM('4.56')) is type ZM
! IS_OVERFLOW, IS_UNDERFLOW, and IS_UNKNOWN are logical functions for checking whether a multiple
! precision number is in one of the exception categories. Testing to see if a type FM number is
! in the +overflow category by directly using an IF can be tricky. When MAFM is +overflow, the
! statement
! IF (MAFM == TO_FM(' +OVERFLOW ')) THEN
! will return false, since the comparison routine cannot be sure that two different overflowed
! results would have been equal if the overflow threshold had been higher. Instead, use
! IF (IS_OVERFLOW(MAFM)) THEN
! which will be true if MAFM is + or - overflow.
! Programs using this module may sometimes need to call FM, IM, or ZM routines directly. This
! is normally the case when routines are needed that are not Fortran intrinsics, such as the
! formatting subroutine FM_FORM. In a program using this module, suppose MAFM has been declared
! with TYPE (FM) :: MAFM. To convert the number to a character string with F65.60 format, use
! CALL FM_FORM('F65.60',MAFM,ST1)
! WARNING: To be safe, all multiple precision variables in a user's program should be declared
! as type (FM), (IM), or (ZM), and any direct calls to subroutines should be the kind
! with the underscore. Subroutines that define one or more multiple precision output
! values, such as computing pi using
! CALL FM_PI(PI)
! automatically cause PI to be put into the FM saved variable area of storage. Calling
! the low-level routine ( CALL FMPI(PI%MFM) ) would cause PI to be treated as an FM
! temporary variable if PI had not been previously defined in the program. Then the
! value of PI could be discarded before the program is finished using it.
! In subroutine or function subprograms all multiple precision variables that are local to that
! routine should be declared with the SAVE attribute. It is not an error to omit SAVE, but if
! the compiler creates new copies of the variables for each call to the routine, then the program
! will leak memory.
! Type (FM), (IM), or (ZM) variables cannot have their multiple precision values initialized in
! the declaration statement, as can ordinary variables. If the original program had
! DOUBLE PRECISION :: X = 2.3D0
! then the corresponding FM version would have
! TYPE (FM), SAVE :: X
! ... (other declarations) ...
! X = TO_FM( '2.3' )
!
! An attempt to use a multiple precision variable that has not been defined will be detected by
! the routines in this module and an error message printed.
!
! For each of the operations =, == , /= , < , <= , > , >= , +, -, *, /, and **, the interface
! module defines all mixed mode variations involving one of the three multiple precision derived
! types and another argument having one of the types: { integer, real, double, complex, complex
! double, FM, IM, ZM }. So mixed mode expressions such as
! MAFM = 12
! MAFM = MAFM + 1
! IF (ABS(MAFM) > 1.0D-23) THEN
! are handled correctly.
! Not all the named functions are defined for all three multiple precision derived types, so the
! list below shows which can be used. The labels "real", "integer", and "complex" refer to types
! FM, IM, and ZM respectively, "string" means the function accepts character strings (e.g.,
! TO_FM('3.45')), and "other" means the function can accept any of the machine precision data
! types integer, real, double, complex, or complex double. For functions that accept two or more
! arguments, like ATAN2 or MAX, all the arguments must be of the same type.
! Note that TO_ZM also has a 2-argument form: TO_ZM(2,3) for getting 2 + 3*i.
! CMPLX can be used for that, as in CMPLX( TO_FM(2) , TO_FM(3) ), but the 2-argument form is
! more concise. The 2-argument form is available for machine precision integer, single and
! double precision real pairs. For others, such as X and Y being type(fm), just use CMPLX(X,Y).
! Fortran's 2-argument version of atan(x,y) is also provided. It is the same as the older atan2.
! AVAILABLE FUNCTIONS:
! =
! +
! -
! *
! /
! **
! ==
! /=
! <
! <=
! >
! >=
! ABS real integer complex
! ACOS real complex
! ACOSH real complex
! AIMAG complex
! AINT real complex
! ANINT real complex
! ASIN real complex
! ASINH real complex
! ATAN real complex
! ATAN2 real
! ATANH real complex
! BTEST integer
! CEILING real integer complex
! CMPLX real integer
! CONJG complex
! COS real complex
! COSH real complex
! DBLE real integer complex
! DIGITS real integer complex
! DIM real integer
! DINT real complex
! EPSILON real
! EXP real complex
! EXPONENT real
! FLOOR real integer complex
! FRACTION real complex
! HUGE real integer complex
! HYPOT real
! INT real integer complex
! LOG real complex
! LOG10 real complex
! MAX real integer
! MAXEXPONENT real
! MIN real integer
! MINEXPONENT real
! MOD real integer
! MODULO real integer
! NEAREST real
! NINT real integer complex
! NORM2 real
! PRECISION real complex
! RADIX real integer complex
! RANGE real integer complex
! REAL real integer complex
! RRSPACING real
! SCALE real complex
! SETEXPONENT real
! SIGN real integer
! SIN real complex
! SINH real complex
! SPACING real
! SQRT real complex
! TAN real complex
! TANH real complex
! TINY real integer complex
! TO_FM real integer complex string other
! TO_IM real integer complex string other
! TO_ZM real integer complex string other
! TO_INT real integer complex
! TO_SP real integer complex
! TO_DP real integer complex
! TO_SPZ real integer complex
! TO_DPZ real integer complex
! IS_OVERFLOW real integer complex
! IS_UNDERFLOW real integer complex
! IS_UNKNOWN real integer complex
! SUBROUTINES THAT DO NOT CORRESPOND TO ANY FUNCTION ABOVE:
! 1. Type (FM). MA, MB, MC refer to type (FM) numbers.
! FM_COSH_SINH(MA,MB,MC) MB = COSH(MA), MC = SINH(MA)
! Faster than making two separate calls.
! FM_COS_SIN(MA,MB,MC) MB = COS(MA), MC = SIN(MA)
! Faster than making two separate calls.
! FM_EULER(MA) MA = Euler's constant ( 0.5772156649... )
! FM_FLAG(K) K = KFLAG get the value of the FM condition flag -- stored in
! the internal FM variable KFLAG in module FMVALS.
! FM_FORM(FORM,MA,STRING) MA is converted to a character string using format FORM and
! returned in STRING. FORM can represent I, F, E, or ES formats.
! Example:
! CALL FMFORM('F60.40',MA,STRING)
! FM_FPRINT(FORM,MA) Print MA on unit KW using FORM format.
! FM_PI(MA) MA = pi
! FM_PRINT(MA) Print MA on unit KW using current format.
! FM_RANDOM_NUMBER(X) X is returned as a double precision random number, uniformly
! distributed on the open interval (0,1). It is a high-quality,
! long-period generator based on 49-digit prime numbers.
! Note that X is double precision, unlike the similar Fortran
! intrinsic random number routine, which returns a single-precision
! result. A default initial seed is used if FM_RANDOM_NUMBER is
! called without calling FM_RANDOM_SEED_PUT first.
! FM_RANDOM_SEED_GET(SEED) returns the seven integers SEED(1) through SEED(7) as the current
! seed for the FM_RANDOM_NUMBER generator.
! FM_RANDOM_SEED_PUT(SEED) initializes the FM_RANDOM_NUMBER generator using the seven integers
! SEED(1) through SEED(7). These get and put functions are slower
! than FM_RANDOM_NUMBER, so FM_RANDOM_NUMBER should be called many
! times between FM_RANDOM_SEED_PUT calls. Also, some generators that
! used a 9-digit modulus have failed randomness tests when used with
! only a few numbers being generated between calls to re-start with
! a new seed.
! FM_RANDOM_SEED_SIZE(SIZE) returns integer SIZE as the size of the SEED array used by the
! FM_RANDOM_NUMBER generator. Currently, SIZE = 7.
! FM_RATIONAL_POWER(MA,K,J,MB)
! MB = MA**(K/J) Rational power.
! Faster than MB = MA**(TO_FM(K)/J) for functions like the cube root.
! FM_READ(KREAD,MA) MA is returned after reading one (possibly multi-line) FM number
! on unit KREAD. This routine reads numbers written by FM_WRITE.
! FM_SET(NPREC) Set the internal FM variables so that the precision is at least
! NPREC base 10 digits plus three base 10 guard digits.
! FM_SETVAR(STRING) Define a new value for one of the internal FM variables in module
! FMVALS that controls one of the FM options. STRING has the form
! variable = value.
! Example: To change the screen width for FM output:
! CALL FM_SETVAR(' KSWIDE = 120 ')
! The variables that can be changed and the options they control are
! listed in sections 2 through 6 of the comments at the top of the
! FM.f95 file. Only one variable can be set per call. The variable
! name in STRING must have no embedded blanks. The value part of
! STRING can be in any numerical format, except in the case of
! variable CMCHAR, which is character type. To set CMCHAR to 'E',
! don't use any quotes in STRING:
! CALL FM_SETVAR(' CMCHAR = E ')
! FM_ULP(MA,MB) MB = One Unit in the Last Place of MA. For positive MA this is the
! same as the Fortran function SPACING, but MB < 0 if MA < 0.
! Examples: If MBASE = 10 and NDIG = 30, then ulp(1.0) =
! 1.0E-29, ulp(-4.5E+67) = -1.0E+38.
!
! FM_VARS Write the current values of the internal FM variables on unit KW.
! FM_WRITE(KWRITE,MA) Write MA on unit KWRITE.
! Multi-line numbers will have '&' as the last nonblank character
! on all but the last line. These numbers can then be read easily
! using FM_READ.
! 2. Type (IM). MA, MB, MC refer to type (IM) numbers.
! IM_DIVR(MA,MB,MC,MD) MC = int(MA/MB), MD = MA mod MB
! When both the quotient and remainder are needed, this routine
! is twice as fast as doing MC = MA/MB and MD = MOD(MA,MB)
! separately.
! IM_DVIR(MA,IVAL,MB,IREM) MB = int(MA/IVAL), IREM = MA mod IVAL
! IVAL and IREM are one word integers. Faster than doing separately.
! IM_FORM(FORM,MA,STRING) MA is converted to a character string using format FORM and
! returned in STRING. FORM can represent I, F, E, or ES formats.
! Example: CALL IMFORM('I70',MA,STRING)
! IM_FPRINT(FORM,MA) Print MA on unit KW using FORM format.
! IM_PRINT(MA) Print MA on unit KW.
! IM_READ(KREAD,MA) MA is returned after reading one (possibly multi-line) IM number
! on unit KREAD. This routine reads numbers written by IM_WRITE.
! IM_WRITE(KWRITE,MA) Write MA on unit KWRITE. Multi-line numbers will have '&' as the
! last nonblank character on all but the last line.
! These numbers can then be read easily using IM_READ.
! 3. Type (ZM). MA, MB, MC refer to type (ZM) numbers. MBFM is type (FM).
! ZM_ARG(MA,MBFM) MBFM = complex argument of MA. MBFM is the (real) angle in the
! interval ( -pi , pi ] from the positive real axis to the
! point (x,y) when MA = x + y*i.
! ZM_COSH_SINH(MA,MB,MC) MB = COSH(MA), MC = SINH(MA).
! Faster than 2 calls.
! ZM_COS_SIN(MA,MB,MC) MB = COS(MA), MC = SIN(MA).
! Faster than 2 calls.
! ZM_FORM(FORM1,FORM2,MA,STRING)
! STRING = MA
! MA is converted to a character string using format FORM1 for the
! real part and FORM2 for the imaginary part. The result is returned
! in STRING. FORM1 and FORM2 can represent I, F, E, or ES formats.
! Example:
! CALL ZMFORM('F20.10','F15.10',MA,STRING)
! ZM_FPRINT(FORM1,FORM2,MA) Print MA on unit KW using formats FORM1 and FORM2.
! ZM_PRINT(MA) Print MA on unit KW using current format.
! ZM_READ(KREAD,MA) MA is returned after reading one (possibly multi-line) ZM number
! on unit KREAD. This routine reads numbers written by ZMWRITE.
! ZM_RATIONAL_POWER(MA,IVAL,JVAL,MB)
! MB = MA ** (IVAL/JVAL)
! Faster than MB = MA**(TO_FM(K)/J) for functions like the cube root.
! ZM_WRITE(KWRITE,MA) Write MA on unit KWRITE. Multi-line numbers are formatted for
! automatic reading with ZMREAD.
! Some other functions are defined that do not correspond to machine precision intrinsic
! functions. These include formatting functions, integer modular functions and GCD, and some
! mathematical special functions.
! N, K below are machine precision integers, J1, J2, J3 are TYPE (IM), FMT, FMTR, FMTI are
! character strings, A, B, X are TYPE (FM), and Z is TYPE (ZM).
! The three formatting functions return a character string containing the formatted number, the
! three TYPE (IM) functions return a TYPE (IM) result, and the 12 special functions return
! TYPE (FM) results.
! Formatting functions:
! FM_FORMAT(FMT,A) Put A into FMT (real) format
! IM_FORMAT(FMT,J1) Put J1 into FMT (integer) format
! ZM_FORMAT(FMTR,FMTI,Z) Put Z into (complex) format, FMTR for the real
! part and FMTI for the imaginary part
! Examples:
! ST = FM_FORMAT('F65.60',A)
! WRITE (*,*) ' A = ',TRIM(ST)
! ST = FM_FORMAT('E75.60',B)
! WRITE (*,*) ' B = ',ST(1:75)
! ST = IM_FORMAT('I50',J1)
! WRITE (*,*) ' J1 = ',ST(1:50)
! ST = ZM_FORMAT('F35.30','F30.25',Z)
! WRITE (*,*) ' Z = ',ST(1:70)
! These functions are used for one-line output. The returned character strings are of
! length 200.
! For higher precision numbers, the output can be broken onto multiple lines automatically by
! calling subroutines FM_PRINT, IM_PRINT, ZM_PRINT, or the line breaks can be done by hand after
! calling one of the subroutines FM_FORM, IM_FORM, ZM_FORM.
! For ZM_FORMAT the length of the output is 5 more than the sum of the two field widths.
! Integer functions:
! BINOMIAL(N,K) Binomial coefficient N choose K. Returns the exact result as a
! type IM value.
! BINOMIAL(J1,J2) Binomial coefficient J1 choose J2. Like factorial below, the result
! might be too large unless min(J2,J1-J2) is fairly small,
! FACTORIAL(N) N! Returns the exact result as a type IM value.
! FACTORIAL(J1) J1! Note that the factorial function grows so rapidly that if type IM
! variable J1 is larger than the largest machine precision integer,
! then J1! has over 10 billion digits and the calculation would
! likely fail due to memory or time constraints. This version is
! provided for convenience, and will return UNKNOWN if J1 cannot
! be represented as a machine precision integer.
! GCD(J1,J2) Greatest Common Divisor of J1 and J2.
! MULTIPLY_MOD(J1,J2,J3) J1 * J2 mod J3
! POWER_MOD(J1,J2,J3) J1 ** J2 mod J3
! Special functions:
! BERNOULLI(N) Nth Bernoulli number
! BESSEL_J(N,X) Bessel function of the first kind J_n(x)
! BESSEL_J0(X) Fortran-08 name for J_0(x)
! BESSEL_J1(X) Fortran-08 name for J_1(x)
! BESSEL_JN(N,X) Fortran-08 name for J_n(x)
! BESSEL_JN(N1,N2,X) Returns array (/ J_n1(x) , ... , J_n2(x) /)
! BESSEL_Y(N,X) Bessel function of the second kind Y_n(x)
! BESSEL_Y0(X) Fortran-08 name for Y_0(x)
! BESSEL_Y1(X) Fortran-08 name for Y_1(x)
! BESSEL_YN(N,X) Fortran-08 name for Y_n(x)
! BESSEL_YN(N1,N2,X) Returns array (/ Y_n1(x) , ... , Y_n2(x) /)
! BETA(A,B) Integral (0 to 1) t**(a-1) * (1-t)**(b-1) dt
! BINOMIAL(A,B) Binomial Coefficient a! / ( b! (a-b)! )
! COS_INTEGRAL(X) Cosine Integral Ci(x)
! COSH_INTEGRAL(X) Hyperbolic Cosine Integral Chi(x)
! ERF(X) Error function Erf(x)
! ERFC(X) Complimentary error function Erfc(x)
! ERFC_SCALED(X) Exp(x^2) * Erfc(x)
! EXP_INTEGRAL_EI(X) Exponential Integral Ei(x)
! EXP_INTEGRAL_EN(N,X) Exponential Integral E_n(x)
! FACTORIAL(X) x! = Gamma(x+1)
! FRESNEL_C(X) Fresnel Cosine Integral C(x)
! FRESNEL_S(X) Fresnel Sine Integral S(x)
! GAMMA(X) Integral (0 to infinity) t**(x-1) * exp(-t) dt
! INCOMPLETE_BETA(X,A,B) Integral (0 to x) t**(a-1) * (1-t)**(b-1) dt
! INCOMPLETE_GAMMA1(A,X) Integral (0 to x) t**(a-1) * exp(-t) dt
! INCOMPLETE_GAMMA2(A,X) Integral (x to infinity) t**(a-1) * exp(-t) dt
! LOG_ERFC(X) Ln( Erfc(x) )
! LOG_GAMMA(X) Ln( Gamma(x) )
! LOG_INTEGRAL(X) Logarithmic Integral Li(x)
! POLYGAMMA(N,X) Nth derivative of Psi(x)
! POCHHAMMER(X,N) x*(x+1)*(x+2)*...*(x+n-1)
! PSI(X) Derivative of Ln(Gamma(x))
! SIN_INTEGRAL(X) Sine Integral Si(x)
! SINH_INTEGRAL(X) Hyperbolic Sine Integral Shi(x)
! Array operations:
! Arithmetic operations and functions on arrays of dimension (rank) one or two are supported for
! each of the three multiple-precision types. Binary operations (+-*/) require both arguments to
! have the same rank and shape.
! Examples:
! TYPE (FM), SAVE, DIMENSION(10) :: A, B
! TYPE (FM), SAVE, DIMENSION(3,3) :: C
! TYPE (IM), SAVE, DIMENSION(10) :: J, K
! TYPE (IM), SAVE, DIMENSION(3,3) :: L
! ...
! A = 0 ! Set the whole array to zero
! J = J * K ! Set J(i) = J(i) * K(i) for i = 1, ..., 10
! B = A - K ! Mixed-mode operations are ok
! C = 7.3D0 * C - ( C + 2*L )/3
! Array functions:
! DOT_PRODUCT(X,Y) Dot product of rank 1 vectors of the same type.
! Note that when X and Y are complex, the result is not just the sum
! of the products of the corresponding array elements, as it is for
! types FM and IM. For ZM the formula is the sum of
! conjg(X(j)) * Y(j).
! IS_OVERFLOW(X) Returns true if any element is + or - overflow.
! IS_UNDERFLOW(X) Returns true if any element is + or - underflow.
! IS_UNKNOWN(X) Returns true if any element is unknown.
! MATMUL(X,Y) Matrix multiplication of arrays of the same type
! Cases for valid argument shapes:
! (1) (n,m) * (m,k) --> (n,k)
! (2) (m) * (m,k) --> (k)
! (3) (n,m) * (m) --> (n)
! MAXLOC(X) Location of the maximum value in the array
! MAXVAL(X) Maximum value in the array
! MINLOC(X) Location of the minimum value in the array
! MINVAL(X) Minimum value in the array
! PRODUCT(X) Product of all values in the array
! SUM(X) Sum of all values in the array
! TRANSPOSE(X) Matrix transposition. If X is a rank 2 array with shape (n,m), then
! Y = TRANSPOSE(X) has shape (m,n) with Y(i,j) = X(j,i).
! TO_FM(X) Rank 1 or 2 arrays are converted to similar type (fm) arrays.
! TO_IM(X) Rank 1 or 2 arrays are converted to similar type (im) arrays.
! TO_ZM(X) Rank 1 or 2 arrays are converted to similar type (zm) arrays.
! TO_INT(X) Rank 1 or 2 arrays are converted to similar integer arrays.
! TO_SP(X) Rank 1 or 2 arrays are converted to similar single precision arrays.
! TO_DP(X) Rank 1 or 2 arrays are converted to similar double precision arrays.
! TO_SPZ(X) Rank 1 or 2 arrays are converted to similar single complex arrays.
! TO_DPZ(X) Rank 1 or 2 arrays are converted to similar double complex arrays.
! The arithmetic array functions DOT_PRODUCT, MATMUL, PRODUCT, and SUM work like the other
! functions in the FM package in that they raise precision and compute the sums and/or products
! at the higher precision, then round the final result back to the user's precision to provide
! a more accurate result.
! Fortran's optional [,mask] argument for these functions is not provided.
! Many of the 1-argument functions can be used with array arguments, with the result being an
! array of the same size and shape where the function has been applied to each element.
! Examples:
! TYPE (FM), SAVE, DIMENSION(10) :: A, B, C
! ...
! A = ABS(B) ! Set A(i) = ABS(B(i)) for i = 1, ..., 10
! C = SQRT(A+4+B*B) ! Set C(i) = SQRT(A(i)+4+B(i)*B(i)) for i = 1, ..., 10
! Functions that can have array arguments. As above, "real", "integer", and "complex" refer
! to types FM, IM, and ZM respectively.
! ABS real integer complex
! ACOS real complex
! ACOSH real complex
! AIMAG complex
! AINT real complex
! ANINT real complex
! ASIN real complex
! ASINH real complex
! ATAN real complex
! ATANH real complex
! CEILING real integer complex
! CONJG complex
! COS real complex
! COSH real complex
! EXP real complex
! FLOOR real integer complex
! FRACTION real complex
! INT real integer complex
! LOG real complex
! LOG10 real complex
! NINT real integer complex
! SIN real complex
! SINH real complex
! SQRT real complex
! TAN real complex
! TANH real complex
! COS_INTEGRAL real
! COSH_INTEGRAL real
! ERF real
! ERFC real
! ERFC_SCALED real
! EXP_INTEGRAL_EI real
! FACTORIAL real integer machine-precision integer
! FRESNEL_C real
! FRESNEL_S real
! GAMMA real
! LOG_ERFC real
! LOG_GAMMA real
! LOG_INTEGRAL real
! PSI real
! SIN_INTEGRAL real
! SINH_INTEGRAL real
TYPE FM
INTEGER :: MFM = -1
END TYPE
TYPE IM
INTEGER :: MIM = -1
END TYPE
TYPE ZM
INTEGER :: MZM(2) = -1
END TYPE
! Work variables for derived type operations.
INTEGER, SAVE :: MTFM = -3
INTEGER, SAVE :: MUFM = -3
INTEGER, SAVE :: MVFM = -3
INTEGER, SAVE :: M1FM = -3
INTEGER, SAVE :: M2FM = -3
INTEGER, SAVE :: M3FM = -3
INTEGER, SAVE :: MTIM = -3
INTEGER, SAVE :: MUIM = -3
INTEGER, SAVE :: MVIM = -3
INTEGER, SAVE :: M1IM = -3
INTEGER, SAVE :: M2IM = -3
INTEGER, SAVE :: M3IM = -3
INTEGER, SAVE :: M01 = -3
INTEGER, SAVE :: MTZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: MUZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: MVZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: M1ZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: M2ZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: M3ZM(2) = (/ -3, -3 /)
INTEGER, SAVE :: MZ01(2) = (/ -3, -3 /)
INTEGER, SAVE :: MZ02(2) = (/ -3, -3 /)
TYPE(FM), SAVE :: MT_FM = FM(-3)
TYPE(IM), SAVE :: MT_IM = IM(-3)
TYPE(ZM), SAVE :: MT_ZM = ZM( (/ -3, -3 /) )
INTERFACE TO_FM
MODULE PROCEDURE FM_I
MODULE PROCEDURE FM_R
MODULE PROCEDURE FM_D
MODULE PROCEDURE FM_Z
MODULE PROCEDURE FM_ZD
MODULE PROCEDURE FM_FM
MODULE PROCEDURE FM_IM
MODULE PROCEDURE FM_ZM
MODULE PROCEDURE FM_ST
MODULE PROCEDURE FM_I1
MODULE PROCEDURE FM_R1
MODULE PROCEDURE FM_D1
MODULE PROCEDURE FM_Z1
MODULE PROCEDURE FM_ZD1
MODULE PROCEDURE FM_FM1
MODULE PROCEDURE FM_IM1
MODULE PROCEDURE FM_ZM1
MODULE PROCEDURE FM_ST1
MODULE PROCEDURE FM_I2
MODULE PROCEDURE FM_R2
MODULE PROCEDURE FM_D2
MODULE PROCEDURE FM_Z2
MODULE PROCEDURE FM_ZD2
MODULE PROCEDURE FM_FM2
MODULE PROCEDURE FM_IM2
MODULE PROCEDURE FM_ZM2
MODULE PROCEDURE FM_ST2
END INTERFACE
INTERFACE TO_IM
MODULE PROCEDURE IM_I
MODULE PROCEDURE IM_R
MODULE PROCEDURE IM_D
MODULE PROCEDURE IM_Z
MODULE PROCEDURE IM_C
MODULE PROCEDURE IM_FM
MODULE PROCEDURE IM_IM
MODULE PROCEDURE IM_ZM
MODULE PROCEDURE IM_ST
MODULE PROCEDURE IM_I1
MODULE PROCEDURE IM_R1
MODULE PROCEDURE IM_D1
MODULE PROCEDURE IM_Z1
MODULE PROCEDURE IM_C1
MODULE PROCEDURE IM_FM1
MODULE PROCEDURE IM_IM1
MODULE PROCEDURE IM_ZM1
MODULE PROCEDURE IM_ST1
MODULE PROCEDURE IM_I2
MODULE PROCEDURE IM_R2
MODULE PROCEDURE IM_D2
MODULE PROCEDURE IM_Z2
MODULE PROCEDURE IM_C2
MODULE PROCEDURE IM_FM2
MODULE PROCEDURE IM_IM2
MODULE PROCEDURE IM_ZM2
MODULE PROCEDURE IM_ST2
END INTERFACE
INTERFACE TO_ZM
MODULE PROCEDURE ZM_I
MODULE PROCEDURE ZM2_I
MODULE PROCEDURE ZM_R
MODULE PROCEDURE ZM2_R
MODULE PROCEDURE ZM_D
MODULE PROCEDURE ZM2_D
MODULE PROCEDURE ZM_Z
MODULE PROCEDURE ZM_C
MODULE PROCEDURE ZM_FM
MODULE PROCEDURE ZM_IM
MODULE PROCEDURE ZM_ZM
MODULE PROCEDURE ZM_ST
MODULE PROCEDURE ZM_I1
MODULE PROCEDURE ZM_R1
MODULE PROCEDURE ZM_D1
MODULE PROCEDURE ZM_Z1
MODULE PROCEDURE ZM_C1
MODULE PROCEDURE ZM_FM1
MODULE PROCEDURE ZM_IM1
MODULE PROCEDURE ZM_ZM1
MODULE PROCEDURE ZM_ST1
MODULE PROCEDURE ZM_I2
MODULE PROCEDURE ZM_R2
MODULE PROCEDURE ZM_D2
MODULE PROCEDURE ZM_Z2
MODULE PROCEDURE ZM_C2
MODULE PROCEDURE ZM_FM2
MODULE PROCEDURE ZM_IM2
MODULE PROCEDURE ZM_ZM2
MODULE PROCEDURE ZM_ST2
END INTERFACE
INTERFACE TO_INT
MODULE PROCEDURE FM_2INT
MODULE PROCEDURE IM_2INT
MODULE PROCEDURE ZM_2INT
MODULE PROCEDURE FM_2INT1
MODULE PROCEDURE IM_2INT1
MODULE PROCEDURE ZM_2INT1
MODULE PROCEDURE FM_2INT2
MODULE PROCEDURE IM_2INT2
MODULE PROCEDURE ZM_2INT2
END INTERFACE
INTERFACE TO_SP
MODULE PROCEDURE FM_2SP
MODULE PROCEDURE IM_2SP
MODULE PROCEDURE ZM_2SP
MODULE PROCEDURE FM_2SP1
MODULE PROCEDURE IM_2SP1
MODULE PROCEDURE ZM_2SP1
MODULE PROCEDURE FM_2SP2
MODULE PROCEDURE IM_2SP2
MODULE PROCEDURE ZM_2SP2
END INTERFACE
INTERFACE TO_DP
MODULE PROCEDURE FM_2DP
MODULE PROCEDURE IM_2DP
MODULE PROCEDURE ZM_2DP
MODULE PROCEDURE FM_2DP1
MODULE PROCEDURE IM_2DP1
MODULE PROCEDURE ZM_2DP1
MODULE PROCEDURE FM_2DP2
MODULE PROCEDURE IM_2DP2
MODULE PROCEDURE ZM_2DP2
END INTERFACE
INTERFACE TO_SPZ
MODULE PROCEDURE FM_2SPZ
MODULE PROCEDURE IM_2SPZ
MODULE PROCEDURE ZM_2SPZ
MODULE PROCEDURE FM_2SPZ1
MODULE PROCEDURE IM_2SPZ1
MODULE PROCEDURE ZM_2SPZ1
MODULE PROCEDURE FM_2SPZ2
MODULE PROCEDURE IM_2SPZ2
MODULE PROCEDURE ZM_2SPZ2
END INTERFACE
INTERFACE TO_DPZ
MODULE PROCEDURE FM_2DPZ
MODULE PROCEDURE IM_2DPZ
MODULE PROCEDURE ZM_2DPZ
MODULE PROCEDURE FM_2DPZ1
MODULE PROCEDURE IM_2DPZ1
MODULE PROCEDURE ZM_2DPZ1
MODULE PROCEDURE FM_2DPZ2
MODULE PROCEDURE IM_2DPZ2
MODULE PROCEDURE ZM_2DPZ2
END INTERFACE
INTERFACE IS_OVERFLOW
MODULE PROCEDURE FM_IS_OVERFLOW
MODULE PROCEDURE IM_IS_OVERFLOW
MODULE PROCEDURE ZM_IS_OVERFLOW
MODULE PROCEDURE FM_IS_OVERFLOW1
MODULE PROCEDURE IM_IS_OVERFLOW1
MODULE PROCEDURE ZM_IS_OVERFLOW1
MODULE PROCEDURE FM_IS_OVERFLOW2
MODULE PROCEDURE IM_IS_OVERFLOW2
MODULE PROCEDURE ZM_IS_OVERFLOW2
END INTERFACE
INTERFACE IS_UNDERFLOW
MODULE PROCEDURE FM_IS_UNDERFLOW
MODULE PROCEDURE IM_IS_UNDERFLOW
MODULE PROCEDURE ZM_IS_UNDERFLOW
MODULE PROCEDURE FM_IS_UNDERFLOW1
MODULE PROCEDURE IM_IS_UNDERFLOW1
MODULE PROCEDURE ZM_IS_UNDERFLOW1
MODULE PROCEDURE FM_IS_UNDERFLOW2
MODULE PROCEDURE IM_IS_UNDERFLOW2
MODULE PROCEDURE ZM_IS_UNDERFLOW2
END INTERFACE
INTERFACE IS_UNKNOWN
MODULE PROCEDURE FM_IS_UNKNOWN
MODULE PROCEDURE IM_IS_UNKNOWN
MODULE PROCEDURE ZM_IS_UNKNOWN
MODULE PROCEDURE FM_IS_UNKNOWN1
MODULE PROCEDURE IM_IS_UNKNOWN1
MODULE PROCEDURE ZM_IS_UNKNOWN1
MODULE PROCEDURE FM_IS_UNKNOWN2
MODULE PROCEDURE IM_IS_UNKNOWN2
MODULE PROCEDURE ZM_IS_UNKNOWN2
END INTERFACE
INTERFACE FMEQ_INDEX
MODULE PROCEDURE FMEQ_INDEX_FM0
MODULE PROCEDURE FMEQ_INDEX_FM1
MODULE PROCEDURE FMEQ_INDEX_FM2
MODULE PROCEDURE FMEQ_INDEX_IM0
MODULE PROCEDURE FMEQ_INDEX_IM1
MODULE PROCEDURE FMEQ_INDEX_IM2
MODULE PROCEDURE FMEQ_INDEX_ZM0
MODULE PROCEDURE FMEQ_INDEX_ZM1
MODULE PROCEDURE FMEQ_INDEX_ZM2
END INTERFACE
INTERFACE FM_UNDEF_INP
MODULE PROCEDURE FM_UNDEF_INP_FM0
MODULE PROCEDURE FM_UNDEF_INP_IM0
MODULE PROCEDURE FM_UNDEF_INP_ZM0
MODULE PROCEDURE FM_UNDEF_INP_FM1
MODULE PROCEDURE FM_UNDEF_INP_IM1
MODULE PROCEDURE FM_UNDEF_INP_ZM1
MODULE PROCEDURE FM_UNDEF_INP_FM2
MODULE PROCEDURE FM_UNDEF_INP_IM2
MODULE PROCEDURE FM_UNDEF_INP_ZM2
END INTERFACE
INTERFACE FM_DEALLOCATE
MODULE PROCEDURE FM_DEALLOCATE_FM1
MODULE PROCEDURE FM_DEALLOCATE_IM1
MODULE PROCEDURE FM_DEALLOCATE_ZM1
MODULE PROCEDURE FM_DEALLOCATE_FM2
MODULE PROCEDURE FM_DEALLOCATE_IM2
MODULE PROCEDURE FM_DEALLOCATE_ZM2
END INTERFACE
CONTAINS
! TO_FM
FUNCTION FM_I(IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_I
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMI2M(IVAL,FM_I%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_I
FUNCTION FM_R(R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_R
REAL :: R
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M(R,FM_R%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_R
FUNCTION FM_D(D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_D
DOUBLE PRECISION :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M(D,FM_D%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_D
FUNCTION FM_Z(Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_Z
COMPLEX :: Z
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M(REAL(Z),FM_Z%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Z
FUNCTION FM_ZD(C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_ZD
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M(REAL(C,KIND(0.0D0)),FM_ZD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZD
FUNCTION FM_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_FM,MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,FM_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM
FUNCTION FM_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_IM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,FM_IM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IM
FUNCTION FM_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,FM_ZM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZM
FUNCTION FM_ST(ST)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FM_ST
CHARACTER(*) :: ST
INTENT (IN) :: ST
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMST2M(ST,FM_ST%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ST
FUNCTION FM_I1(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FM_I1
INTEGER :: J,N
INTENT (IN) :: IVAL
FM_I1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),FM_I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_I1
FUNCTION FM_R1(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FM_R1
INTEGER :: J,N
INTENT (IN) :: R
FM_R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),FM_R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_R1
FUNCTION FM_D1(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FM_D1
INTEGER :: J,N
INTENT (IN) :: D
FM_D1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),FM_D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_D1
FUNCTION FM_Z1(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:) :: Z
TYPE (FM), DIMENSION(SIZE(Z)) :: FM_Z1
INTEGER :: J,N
INTENT (IN) :: Z
FM_Z1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(Z)
DO J = 1, N
CALL FMSP2M(REAL(Z(J)),FM_Z1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Z1
FUNCTION FM_ZD1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (FM), DIMENSION(SIZE(C)) :: FM_ZD1
INTEGER :: J,N
INTENT (IN) :: C
FM_ZD1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),FM_ZD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZD1
FUNCTION FM_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FM_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ(MA(J)%MFM,FM_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM1
FUNCTION FM_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FM_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,FM_IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IM1
FUNCTION FM_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FM_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FM_ZM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL(MA(J)%MZM,FM_ZM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZM1
FUNCTION FM_ST1(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:) :: ST
TYPE (FM), DIMENSION(SIZE(ST)) :: FM_ST1
INTEGER :: J,N
INTENT (IN) :: ST
FM_ST1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(ST)
DO J = 1, N
CALL FMST2M(ST(J),FM_ST1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ST1
FUNCTION FM_I2(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FM_I2
INTEGER :: J,K
INTENT (IN) :: IVAL
FM_I2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),FM_I2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_I2
FUNCTION FM_R2(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FM_R2
INTEGER :: J,K
INTENT (IN) :: R
FM_R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),FM_R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_R2
FUNCTION FM_D2(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FM_D2
INTEGER :: J,K
INTENT (IN) :: D
FM_D2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(D,DIM=1)
DO K = 1, SIZE(D,DIM=2)
CALL FMDP2M(D(J,K),FM_D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_D2
FUNCTION FM_Z2(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:,:) :: Z
TYPE (FM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FM_Z2
INTEGER :: J,K
INTENT (IN) :: Z
FM_Z2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL FMSP2M(REAL(Z(J,K)),FM_Z2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_Z2
FUNCTION FM_ZD2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (FM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FM_ZD2
INTEGER :: J,K
INTENT (IN) :: C
FM_ZD2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
CALL FMDP2M(REAL(C(J,K),KIND(0.0D0)),FM_ZD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZD2
FUNCTION FM_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MA(J,K)%MFM,FM_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_FM2
FUNCTION FM_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,FM_IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IM2
FUNCTION FM_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FM_ZM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMREAL(MA(J,K)%MZM,FM_ZM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ZM2
FUNCTION FM_ST2(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:,:) :: ST
TYPE (FM), DIMENSION(SIZE(ST,DIM=1),SIZE(ST,DIM=2)) :: FM_ST2
INTEGER :: J,K
INTENT (IN) :: ST
FM_ST2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(ST,DIM=1)
DO K = 1, SIZE(ST,DIM=2)
CALL FMST2M(ST(J,K),FM_ST2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_ST2
! TO_IM
FUNCTION IM_I(IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_I
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL IMI2M(IVAL,IM_I%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_I
FUNCTION IM_R(R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_R
REAL :: R
CHARACTER(25) :: ST
INTEGER :: IVAL
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,IM_R%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,IM_R%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_R
FUNCTION IM_D(D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_D
DOUBLE PRECISION :: D
CHARACTER(25) :: 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_D%MIM)
ELSE
WRITE (ST,'(E25.16)') D
CALL IMST2M(ST,IM_D%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_D
FUNCTION IM_Z(Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_Z
COMPLEX :: Z
REAL :: R
CHARACTER(25) :: ST
INTEGER :: IVAL
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
R = REAL(Z)
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,IM_Z%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,IM_Z%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Z
FUNCTION IM_C(C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_C
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
CHARACTER(25) :: ST
INTEGER :: IVAL
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
D = REAL(C,KIND(0.0D0))
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_C%MIM)
ELSE
WRITE (ST,'(E25.16)') D
CALL IMST2M(ST,IM_C%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_C
FUNCTION IM_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_FM
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMFM2I(MA%MFM,IM_FM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM
FUNCTION IM_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_IM,MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,IM_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IM
FUNCTION IM_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL IMFM2I(MTFM,IM_ZM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZM
FUNCTION IM_ST(ST)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: IM_ST
CHARACTER(*) :: ST
INTENT (IN) :: ST
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL IMST2M(ST,IM_ST%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ST
FUNCTION IM_I1(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: IM_I1
INTEGER :: J,N
INTENT (IN) :: IVAL
IM_I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),IM_I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_I1
FUNCTION IM_R1(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:) :: R
TYPE (IM), DIMENSION(SIZE(R)) :: IM_R1
CHARACTER(25) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: R
IM_R1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(R)
DO J = 1, N
IF (ABS(R(J)) < HUGE(1)) THEN
IVAL = INT(R(J))
CALL IMI2M(IVAL,IM_R1(J)%MIM)
ELSE
WRITE (ST,'(E25.16)') R(J)
CALL IMST2M(ST,IM_R1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_R1
FUNCTION IM_D1(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (IM), DIMENSION(SIZE(D)) :: IM_D1
CHARACTER(25) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: D
IM_D1%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_D1(J)%MIM)
ELSE
WRITE (ST,'(E25.16)') D(J)
CALL IMST2M(ST,IM_D1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_D1
FUNCTION IM_Z1(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:) :: Z
TYPE (IM), DIMENSION(SIZE(Z)) :: IM_Z1
REAL :: R
CHARACTER(25) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: Z
IM_Z1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(Z)
DO J = 1, N
R = REAL(Z(J))
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,IM_Z1(J)%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,IM_Z1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Z1
FUNCTION IM_C1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (IM), DIMENSION(SIZE(C)) :: IM_C1
DOUBLE PRECISION :: D
CHARACTER(25) :: ST
INTEGER :: IVAL,J,N
INTENT (IN) :: C
IM_C1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
D = REAL(C(J),KIND(0.0D0))
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_C1(J)%MIM)
ELSE
WRITE (ST,'(E25.16)') D
CALL IMST2M(ST,IM_C1(J)%MIM)
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_C1
FUNCTION IM_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: IM_FM1
INTEGER :: J,N
INTENT (IN) :: MA
IM_FM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMFM2I(MA(J)%MFM,IM_FM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM1
FUNCTION IM_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: IM_IM1
INTEGER :: J,N
INTENT (IN) :: MA
IM_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMEQ(MA(J)%MIM,IM_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IM1
FUNCTION IM_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: IM_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
IM_ZM1%MIM = -1
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 IMFM2I(MTFM,IM_ZM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZM1
FUNCTION IM_ST1(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:) :: ST
TYPE (IM), DIMENSION(SIZE(ST)) :: IM_ST1
INTEGER :: J,N
INTENT (IN) :: ST
IM_ST1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(ST)
DO J = 1, N
CALL IMST2M(ST(J),IM_ST1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ST1
FUNCTION IM_I2(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: IM_I2
INTEGER :: J,K
INTENT (IN) :: IVAL
IM_I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),IM_I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_I2
FUNCTION IM_R2(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:,:) :: R
TYPE (IM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: IM_R2
CHARACTER(25) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: R
IM_R2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
IF (ABS(R(J,K)) < HUGE(1)) THEN
IVAL = INT(R(J,K))
CALL IMI2M(IVAL,IM_R2(J,K)%MIM)
ELSE
WRITE (ST,'(E25.16)') R(J,K)
CALL IMST2M(ST,IM_R2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_R2
FUNCTION IM_D2(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (IM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: IM_D2
CHARACTER(25) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: D
IM_D2%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_D2(J,K)%MIM)
ELSE
WRITE (ST,'(E25.16)') D(J,K)
CALL IMST2M(ST,IM_D2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_D2
FUNCTION IM_Z2(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:,:) :: Z
TYPE (IM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: IM_Z2
REAL :: R
CHARACTER(25) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: Z
IM_Z2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
R = REAL(Z(J,K))
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,IM_Z2(J,K)%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,IM_Z2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_Z2
FUNCTION IM_C2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (IM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: IM_C2
DOUBLE PRECISION :: D
CHARACTER(25) :: ST
INTEGER :: IVAL,J,K
INTENT (IN) :: C
IM_C2%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),KIND(0.0D0))
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,IM_C2(J,K)%MIM)
ELSE
WRITE (ST,'(E25.16)') D
CALL IMST2M(ST,IM_C2(J,K)%MIM)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_C2
FUNCTION IM_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_FM2
INTEGER :: J,K
INTENT (IN) :: MA
IM_FM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMFM2I(MA(J,K)%MFM,IM_FM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_FM2
FUNCTION IM_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_IM2
INTEGER :: J,K
INTENT (IN) :: MA
IM_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(MA(J,K)%MIM,IM_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IM2
FUNCTION IM_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
IM_ZM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMREAL(MA(J,K)%MZM,MTFM)
CALL IMFM2I(MTFM,IM_ZM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ZM2
FUNCTION IM_ST2(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:,:) :: ST
TYPE (IM), DIMENSION(SIZE(ST,DIM=1),SIZE(ST,DIM=2)) :: IM_ST2
INTEGER :: J,K
INTENT (IN) :: ST
IM_ST2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(ST,DIM=1)
DO K = 1, SIZE(ST,DIM=2)
CALL IMST2M(ST(J,K),IM_ST2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_ST2
! TO_ZM
FUNCTION ZM_I(IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_I
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZMI2M(IVAL,ZM_I%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_I
FUNCTION ZM2_I(I1,I2)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM2_I
INTEGER :: I1,I2
INTENT (IN) :: I1,I2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZM2I2M(I1,I2,ZM2_I%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM2_I
FUNCTION ZM_R(R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_R
REAL :: R
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_R%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_R
FUNCTION ZM2_R(R1,R2)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM2_R
REAL :: R1,R2
INTENT (IN) :: R1,R2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMSP2M(R1,MTFM)
CALL FMSP2M(R2,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM2_R%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM2_R
FUNCTION ZM_D(D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_D
DOUBLE PRECISION :: D
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_D%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_D
FUNCTION ZM2_D(D1,D2)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM2_D
DOUBLE PRECISION :: D1,D2
INTENT (IN) :: D1,D2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M(D1,MTFM)
CALL FMDP2M(D2,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM2_D%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM2_D
FUNCTION ZM_Z(Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_Z
COMPLEX :: Z
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZMZ2M(Z,ZM_Z%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Z
FUNCTION ZM_C(C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_C
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_C%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_C
FUNCTION ZM_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_FM
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,ZM_FM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM
FUNCTION ZM_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_IM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_IM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IM
FUNCTION ZM_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_ZM,MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEQ(MA%MZM,ZM_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZM
FUNCTION ZM_ST(ST)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: ZM_ST
CHARACTER(*) :: ST
INTENT (IN) :: ST
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL ZMST2M(ST,ZM_ST%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ST
FUNCTION ZM_I1(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: ZM_I1
INTEGER :: J,N
INTENT (IN) :: IVAL
ZM_I1%MZM(1) = -1
ZM_I1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),ZM_I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_I1
FUNCTION ZM_R1(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: ZM_R1
INTEGER :: J,N
INTENT (IN) :: R
ZM_R1%MZM(1) = -1
ZM_R1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_R1
FUNCTION ZM_D1(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: ZM_D1
INTEGER :: J,N
INTENT (IN) :: D
ZM_D1%MZM(1) = -1
ZM_D1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_D1
FUNCTION ZM_Z1(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: ZM_Z1
INTEGER :: J,N
INTENT (IN) :: Z
ZM_Z1%MZM(1) = -1
ZM_Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),ZM_Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Z1
FUNCTION ZM_C1(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: ZM_C1
INTEGER :: J,N
INTENT (IN) :: C
ZM_C1%MZM(1) = -1
ZM_C1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_C1
FUNCTION ZM_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: ZM_FM1
INTEGER :: J,N
INTENT (IN) :: MA
ZM_FM1%MZM(1) = -1
ZM_FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,ZM_FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM1
FUNCTION ZM_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: ZM_IM1
INTEGER :: J,N
INTENT (IN) :: MA
ZM_IM1%MZM(1) = -1
ZM_IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IM1
FUNCTION ZM_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: ZM_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
ZM_ZM1%MZM(1) = -1
ZM_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMEQ(MA(J)%MZM,ZM_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZM1
FUNCTION ZM_ST1(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:) :: ST
TYPE (ZM), DIMENSION(SIZE(ST)) :: ZM_ST1
INTEGER :: J,N
INTENT (IN) :: ST
ZM_ST1%MZM(1) = -1
ZM_ST1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(ST)
DO J = 1, N
CALL ZMST2M(ST(J),ZM_ST1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ST1
FUNCTION ZM_I2(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: ZM_I2
INTEGER :: J,K
INTENT (IN) :: IVAL
ZM_I2%MZM(1) = -1
ZM_I2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),ZM_I2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_I2
FUNCTION ZM_R2(R)
USE FMVALS
IMPLICIT NONE
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: ZM_R2
INTEGER :: J,K
INTENT (IN) :: R
ZM_R2%MZM(1) = -1
ZM_R2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_R2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_R2
FUNCTION ZM_D2(D)
USE FMVALS
IMPLICIT NONE
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: ZM_D2
INTEGER :: J,K
INTENT (IN) :: D
ZM_D2%MZM(1) = -1
ZM_D2%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,ZM_D2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_D2
FUNCTION ZM_Z2(Z)
USE FMVALS
IMPLICIT NONE
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: ZM_Z2
INTEGER :: J,K
INTENT (IN) :: Z
ZM_Z2%MZM(1) = -1
ZM_Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),ZM_Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_Z2
FUNCTION ZM_C2(C)
USE FMVALS
IMPLICIT NONE
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: ZM_C2
INTEGER :: J,K
INTENT (IN) :: C
ZM_C2%MZM(1) = -1
ZM_C2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,ZM_C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_C2
FUNCTION ZM_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_FM2
INTEGER :: J,K
INTENT (IN) :: MA
ZM_FM2%MZM(1) = -1
ZM_FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
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,ZM_FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_FM2
FUNCTION ZM_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_IM2
INTEGER :: J,K
INTENT (IN) :: MA
ZM_IM2%MZM(1) = -1
ZM_IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
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,ZM_IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IM2
FUNCTION ZM_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
ZM_ZM2%MZM(1) = -1
ZM_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MA(J,K)%MZM,ZM_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ZM2
FUNCTION ZM_ST2(ST)
USE FMVALS
IMPLICIT NONE
CHARACTER(*), DIMENSION(:,:) :: ST
TYPE (ZM), DIMENSION(SIZE(ST,DIM=1),SIZE(ST,DIM=2)) :: ZM_ST2
INTEGER :: J,K
INTENT (IN) :: ST
ZM_ST2%MZM(1) = -1
ZM_ST2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(ST,DIM=1)
DO K = 1, SIZE(ST,DIM=2)
CALL ZMST2M(ST(J,K),ZM_ST2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_ST2
! TO_INT
FUNCTION FM_2INT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FM_2INT
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2I(MA%MFM,FM_2INT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2INT
FUNCTION IM_2INT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IM_2INT
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2I(MA%MIM,IM_2INT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2INT
FUNCTION ZM_2INT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: ZM_2INT
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2I(MA%MZM,ZM_2INT)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2INT
FUNCTION FM_2INT1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(SIZE(MA)) :: FM_2INT1
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 FMM2I(MA(J)%MFM,FM_2INT1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2INT1
FUNCTION IM_2INT1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(SIZE(MA)) :: IM_2INT1
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 IMM2I(MA(J)%MIM,IM_2INT1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2INT1
FUNCTION ZM_2INT1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(SIZE(MA)) :: ZM_2INT1
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 FMM2I(MA(J)%MZM(1),ZM_2INT1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2INT1
FUNCTION FM_2INT2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2INT2
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 FMM2I(MA(J,K)%MFM,FM_2INT2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2INT2
FUNCTION IM_2INT2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2INT2
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 IMM2I(MA(J,K)%MIM,IM_2INT2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2INT2
FUNCTION ZM_2INT2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2INT2
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 FMM2I(MA(J,K)%MZM(1),ZM_2INT2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2INT2
! TO_SP
FUNCTION FM_2SP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL :: FM_2SP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,FM_2SP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SP
FUNCTION IM_2SP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL :: IM_2SP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,IM_2SP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SP
FUNCTION ZM_2SP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL :: ZM_2SP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2SP(MTFM,ZM_2SP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SP
FUNCTION FM_2SP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(SIZE(MA)) :: FM_2SP1
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 FMM2SP(MA(J)%MFM,FM_2SP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SP1
FUNCTION IM_2SP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(SIZE(MA)) :: IM_2SP1
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 IMM2SP(MA(J)%MIM,IM_2SP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SP1
FUNCTION ZM_2SP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(SIZE(MA)) :: ZM_2SP1
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 FMM2SP(MA(J)%MZM(1),ZM_2SP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SP1
FUNCTION FM_2SP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2SP2
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 FMM2SP(MA(J,K)%MFM,FM_2SP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SP2
FUNCTION IM_2SP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2SP2
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 IMM2SP(MA(J,K)%MIM,IM_2SP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SP2
FUNCTION ZM_2SP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2SP2
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 FMM2SP(MA(J,K)%MZM(1),ZM_2SP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SP2
! TO_DP
FUNCTION FM_2DP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION :: FM_2DP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(MA%MFM,FM_2DP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DP
FUNCTION IM_2DP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION :: IM_2DP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2DP(MTFM,IM_2DP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DP
FUNCTION ZM_2DP(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION :: ZM_2DP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DP(MTFM,ZM_2DP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DP
FUNCTION FM_2DP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA)) :: FM_2DP1
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 FMM2DP(MA(J)%MFM,FM_2DP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DP1
FUNCTION IM_2DP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA)) :: IM_2DP1
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 IMM2DP(MA(J)%MIM,IM_2DP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DP1
FUNCTION ZM_2DP1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA)) :: ZM_2DP1
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 FMM2DP(MA(J)%MZM(1),ZM_2DP1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DP1
FUNCTION FM_2DP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2DP2
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 FMM2DP(MA(J,K)%MFM,FM_2DP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DP2
FUNCTION IM_2DP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2DP2
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 IMM2DP(MA(J,K)%MIM,IM_2DP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DP2
FUNCTION ZM_2DP2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2DP2
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 FMM2DP(MA(J,K)%MZM(1),ZM_2DP2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DP2
! TO_SPZ
FUNCTION FM_2SPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX FM_2SPZ
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,R)
FM_2SPZ = CMPLX( R , 0.0 )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SPZ
FUNCTION IM_2SPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX IM_2SPZ
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R)
IM_2SPZ = CMPLX( R , 0.0 )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SPZ
FUNCTION ZM_2SPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX :: ZM_2SPZ
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2Z(MA%MZM,ZM_2SPZ)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SPZ
FUNCTION FM_2SPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(SIZE(MA)) :: FM_2SPZ1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2SP(MA(J)%MFM,R)
FM_2SPZ1(J) = CMPLX( R , 0.0 )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SPZ1
FUNCTION IM_2SPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(SIZE(MA)) :: IM_2SPZ1
INTEGER :: J,N
REAL :: R
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 FMM2SP(MTFM,R)
IM_2SPZ1(J) = CMPLX( R , 0.0 )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SPZ1
FUNCTION ZM_2SPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(SIZE(MA)) :: ZM_2SPZ1
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 ZMM2Z(MA(J)%MZM,ZM_2SPZ1(J))
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SPZ1
FUNCTION FM_2SPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2SPZ2
INTEGER :: J,K
REAL :: R
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 FMM2SP(MA(J,K)%MFM,R)
FM_2SPZ2(J,K) = CMPLX( R , 0.0 )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2SPZ2
FUNCTION IM_2SPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2SPZ2
INTEGER :: J,K
REAL :: R
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 FMM2SP(MTFM,R)
IM_2SPZ2(J,K) = CMPLX( R , 0.0 )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2SPZ2
FUNCTION ZM_2SPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2SPZ2
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 ZMM2Z(MA(J,K)%MZM,ZM_2SPZ2(J,K))
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2SPZ2
! TO_DPZ
FUNCTION FM_2DPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: FM_2DPZ
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(MA%MFM,D)
FM_2DPZ = CMPLX( D , 0.0D0 , KIND(0.0D0) )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DPZ
FUNCTION IM_2DPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: IM_2DPZ
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DP(MA%MIM,D)
IM_2DPZ = CMPLX( D , 0.0D0 , KIND(0.0D0) )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DPZ
FUNCTION ZM_2DPZ(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: ZM_2DPZ
DOUBLE PRECISION :: D1,D2
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D1)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
ZM_2DPZ = CMPLX( D1 , D2 , KIND(0.0D0) )
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DPZ
FUNCTION FM_2DPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA)) :: FM_2DPZ1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMM2DP(MA(J)%MFM,D)
FM_2DPZ1(J) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DPZ1
FUNCTION IM_2DPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA)) :: IM_2DPZ1
INTEGER :: J,N
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D)
IM_2DPZ1(J) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DPZ1
FUNCTION ZM_2DPZ1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA)) :: ZM_2DPZ1
INTEGER :: J,N
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D1)
CALL ZMIMAG(MA(J)%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
ZM_2DPZ1(J) = CMPLX( D1 , D2 , KIND(0.0D0) )
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DPZ1
FUNCTION FM_2DPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FM_2DPZ2
INTEGER :: J,K
DOUBLE PRECISION :: 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 FMM2DP(MA(J,K)%MFM,D)
FM_2DPZ2(J,K) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_2DPZ2
FUNCTION IM_2DPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: IM_2DPZ2
INTEGER :: J,K
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D)
IM_2DPZ2(J,K) = CMPLX( D , 0.0D0 , KIND(0.0D0) )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_2DPZ2
FUNCTION ZM_2DPZ2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: ZM_2DPZ2
INTEGER :: J,K
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D1)
CALL ZMIMAG(MA(J,K)%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
ZM_2DPZ2(J,K) = CMPLX( D1 , D2 , KIND(0.0D0) )
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_2DPZ2
SUBROUTINE FM_EQ(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EQ
SUBROUTINE IM_EQ(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMEQ(MA%MIM,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_EQ
SUBROUTINE ZM_EQ(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMEQ(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_EQ
! IS_OVERFLOW
FUNCTION FM_IS_OVERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
LOGICAL :: FM_IS_OVERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_OVERFLOW = .FALSE.
IF (MWK(START(MA%MFM)+2) == MEXPOV) FM_IS_OVERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_OVERFLOW
FUNCTION IM_IS_OVERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
LOGICAL :: IM_IS_OVERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_OVERFLOW = .FALSE.
IF (MWK(START(MA%MIM)+2) == MEXPOV) IM_IS_OVERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_OVERFLOW
FUNCTION ZM_IS_OVERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
LOGICAL :: ZM_IS_OVERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_OVERFLOW = .FALSE.
IF (MWK(START(MA%MZM(1))+2) == MEXPOV) ZM_IS_OVERFLOW = .TRUE.
IF (MWK(START(MA%MZM(2))+2) == MEXPOV) ZM_IS_OVERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_OVERFLOW
FUNCTION FM_IS_OVERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
LOGICAL :: FM_IS_OVERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
FM_IS_OVERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MFM)+2) == MEXPOV) FM_IS_OVERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_OVERFLOW1
FUNCTION IM_IS_OVERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
LOGICAL :: IM_IS_OVERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
IM_IS_OVERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MIM)+2) == MEXPOV) IM_IS_OVERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_OVERFLOW1
FUNCTION ZM_IS_OVERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
LOGICAL :: ZM_IS_OVERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
ZM_IS_OVERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MZM(1))+2) == MEXPOV) ZM_IS_OVERFLOW1 = .TRUE.
IF (MWK(START(MA(J)%MZM(2))+2) == MEXPOV) ZM_IS_OVERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_OVERFLOW1
FUNCTION FM_IS_OVERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
LOGICAL :: FM_IS_OVERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_OVERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MFM)+2) == MEXPOV) FM_IS_OVERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_OVERFLOW2
FUNCTION IM_IS_OVERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
LOGICAL :: IM_IS_OVERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_OVERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MIM)+2) == MEXPOV) IM_IS_OVERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_OVERFLOW2
FUNCTION ZM_IS_OVERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
LOGICAL :: ZM_IS_OVERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_OVERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MZM(1))+2) == MEXPOV) ZM_IS_OVERFLOW2 = .TRUE.
IF (MWK(START(MA(J,K)%MZM(2))+2) == MEXPOV) ZM_IS_OVERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_OVERFLOW2
! IS_UNDERFLOW
FUNCTION FM_IS_UNDERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
LOGICAL :: FM_IS_UNDERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_UNDERFLOW = .FALSE.
IF (MWK(START(MA%MFM)+2) == MEXPUN) FM_IS_UNDERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNDERFLOW
! The integer versions are included for completeness, but type (im) numbers can't underflow.
FUNCTION IM_IS_UNDERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
LOGICAL :: IM_IS_UNDERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_UNDERFLOW = .FALSE.
IF (MWK(START(MA%MIM)+2) == MEXPUN) IM_IS_UNDERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNDERFLOW
FUNCTION ZM_IS_UNDERFLOW(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
LOGICAL :: ZM_IS_UNDERFLOW
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_UNDERFLOW = .FALSE.
IF (MWK(START(MA%MZM(1))+2) == MEXPUN) ZM_IS_UNDERFLOW = .TRUE.
IF (MWK(START(MA%MZM(2))+2) == MEXPUN) ZM_IS_UNDERFLOW = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNDERFLOW
FUNCTION FM_IS_UNDERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
LOGICAL :: FM_IS_UNDERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
FM_IS_UNDERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MFM)+2) == MEXPUN) FM_IS_UNDERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNDERFLOW1
FUNCTION IM_IS_UNDERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
LOGICAL :: IM_IS_UNDERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
IM_IS_UNDERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MIM)+2) == MEXPUN) IM_IS_UNDERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNDERFLOW1
FUNCTION ZM_IS_UNDERFLOW1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
LOGICAL :: ZM_IS_UNDERFLOW1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
ZM_IS_UNDERFLOW1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MZM(1))+2) == MEXPUN) ZM_IS_UNDERFLOW1 = .TRUE.
IF (MWK(START(MA(J)%MZM(2))+2) == MEXPUN) ZM_IS_UNDERFLOW1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNDERFLOW1
FUNCTION FM_IS_UNDERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
LOGICAL :: FM_IS_UNDERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_UNDERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MFM)+2) == MEXPUN) FM_IS_UNDERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNDERFLOW2
FUNCTION IM_IS_UNDERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
LOGICAL :: IM_IS_UNDERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_UNDERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MIM)+2) == MEXPUN) IM_IS_UNDERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNDERFLOW2
FUNCTION ZM_IS_UNDERFLOW2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
LOGICAL :: ZM_IS_UNDERFLOW2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_UNDERFLOW2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MZM(1))+2) == MEXPUN) ZM_IS_UNDERFLOW2 = .TRUE.
IF (MWK(START(MA(J,K)%MZM(2))+2) == MEXPUN) ZM_IS_UNDERFLOW2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNDERFLOW2
! IS_UNKNOWN
FUNCTION FM_IS_UNKNOWN(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
LOGICAL :: FM_IS_UNKNOWN
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_UNKNOWN = .FALSE.
IF (MWK(START(MA%MFM)+2) == MUNKNO) FM_IS_UNKNOWN = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNKNOWN
FUNCTION IM_IS_UNKNOWN(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
LOGICAL :: IM_IS_UNKNOWN
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_UNKNOWN = .FALSE.
IF (MWK(START(MA%MIM)+2) == MUNKNO) IM_IS_UNKNOWN = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNKNOWN
FUNCTION ZM_IS_UNKNOWN(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
LOGICAL :: ZM_IS_UNKNOWN
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_UNKNOWN = .FALSE.
IF (MWK(START(MA%MZM(1))+2) == MUNKNO) ZM_IS_UNKNOWN = .TRUE.
IF (MWK(START(MA%MZM(2))+2) == MUNKNO) ZM_IS_UNKNOWN = .TRUE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNKNOWN
FUNCTION FM_IS_UNKNOWN1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
LOGICAL :: FM_IS_UNKNOWN1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
FM_IS_UNKNOWN1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MFM)+2) == MUNKNO) FM_IS_UNKNOWN1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNKNOWN1
FUNCTION IM_IS_UNKNOWN1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
LOGICAL :: IM_IS_UNKNOWN1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
IM_IS_UNKNOWN1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MIM)+2) == MUNKNO) IM_IS_UNKNOWN1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNKNOWN1
FUNCTION ZM_IS_UNKNOWN1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
LOGICAL :: ZM_IS_UNKNOWN1
INTEGER :: J,N
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
ZM_IS_UNKNOWN1 = .FALSE.
DO J = 1, N
IF (MWK(START(MA(J)%MZM(1))+2) == MUNKNO) ZM_IS_UNKNOWN1 = .TRUE.
IF (MWK(START(MA(J)%MZM(2))+2) == MUNKNO) ZM_IS_UNKNOWN1 = .TRUE.
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNKNOWN1
FUNCTION FM_IS_UNKNOWN2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
LOGICAL :: FM_IS_UNKNOWN2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FM_IS_UNKNOWN2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MFM)+2) == MUNKNO) FM_IS_UNKNOWN2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_IS_UNKNOWN2
FUNCTION IM_IS_UNKNOWN2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
LOGICAL :: IM_IS_UNKNOWN2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IM_IS_UNKNOWN2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MIM)+2) == MUNKNO) IM_IS_UNKNOWN2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_IS_UNKNOWN2
FUNCTION ZM_IS_UNKNOWN2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
LOGICAL :: ZM_IS_UNKNOWN2
INTEGER :: J,K
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
ZM_IS_UNKNOWN2 = .FALSE.
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MWK(START(MA(J,K)%MZM(1))+2) == MUNKNO) ZM_IS_UNKNOWN2 = .TRUE.
IF (MWK(START(MA(J,K)%MZM(2))+2) == MUNKNO) ZM_IS_UNKNOWN2 = .TRUE.
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZM_IS_UNKNOWN2
! FMEQ_INDEX
! Check to see if the multiple precision number MA being defined is previously undefined
! and has a default index value of -1. If so, since it is a user variable and not a
! compiler-generated temporary number, change the index to -3 so that the variable is
! stored in the saved area in MWK and not treated as a temporary variable.
SUBROUTINE FMEQ_INDEX_FM0(MA)
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
IF (MA%MFM == -1) MA%MFM = -3
END SUBROUTINE FMEQ_INDEX_FM0
SUBROUTINE FMEQ_INDEX_IM0(MA)
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
IF (MA%MIM == -1) MA%MIM = -3
END SUBROUTINE FMEQ_INDEX_IM0
SUBROUTINE FMEQ_INDEX_ZM0(MA)
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
IF (MA%MZM(1) == -1) MA%MZM(1) = -3
IF (MA%MZM(2) == -1) MA%MZM(2) = -3
END SUBROUTINE FMEQ_INDEX_ZM0
SUBROUTINE FMEQ_INDEX_FM1(MA)
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MFM == -1) MA(J)%MFM = -3
ENDDO
END SUBROUTINE FMEQ_INDEX_FM1
SUBROUTINE FMEQ_INDEX_IM1(MA)
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MIM == -1) MA(J)%MIM = -3
ENDDO
END SUBROUTINE FMEQ_INDEX_IM1
SUBROUTINE FMEQ_INDEX_ZM1(MA)
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MZM(1) == -1) MA(J)%MZM(1) = -3
IF (MA(J)%MZM(2) == -1) MA(J)%MZM(2) = -3
ENDDO
END SUBROUTINE FMEQ_INDEX_ZM1
SUBROUTINE FMEQ_INDEX_FM2(MA)
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MFM == -1) MA(J,K)%MFM = -3
ENDDO
ENDDO
END SUBROUTINE FMEQ_INDEX_FM2
SUBROUTINE FMEQ_INDEX_IM2(MA)
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MIM == -1) MA(J,K)%MIM = -3
ENDDO
ENDDO
END SUBROUTINE FMEQ_INDEX_IM2
SUBROUTINE FMEQ_INDEX_ZM2(MA)
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MZM(1) == -1) MA(J,K)%MZM(1) = -3
IF (MA(J,K)%MZM(2) == -1) MA(J,K)%MZM(2) = -3
ENDDO
ENDDO
END SUBROUTINE FMEQ_INDEX_ZM2
SUBROUTINE FM_UNDEF_INP_FM0(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
IF (MA%MFM <= 0) CALL FM_INPUT_ERROR
IF (MA%MFM > NUMBER_USED .AND. &
MA%MFM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%MFM > SIZE_OF_START) CALL FM_INPUT_ERROR
END SUBROUTINE FM_UNDEF_INP_FM0
SUBROUTINE FM_UNDEF_INP_IM0(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
IF (MA%MIM <= 0) CALL FM_INPUT_ERROR
IF (MA%MIM > NUMBER_USED .AND. &
MA%MIM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%MIM > SIZE_OF_START) CALL FM_INPUT_ERROR
END SUBROUTINE FM_UNDEF_INP_IM0
SUBROUTINE FM_UNDEF_INP_ZM0(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
IF (MA%MZM(1) <= 0) CALL FM_INPUT_ERROR
IF (MA%MZM(1) > NUMBER_USED .AND. &
MA%MZM(1) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%MZM(1) > SIZE_OF_START) CALL FM_INPUT_ERROR
IF (MA%MZM(2) <= 0) CALL FM_INPUT_ERROR
IF (MA%MZM(2) > NUMBER_USED .AND. &
MA%MZM(2) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR
IF (MA%MZM(2) > SIZE_OF_START) CALL FM_INPUT_ERROR
END SUBROUTINE FM_UNDEF_INP_ZM0
SUBROUTINE FM_UNDEF_INP_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (IN) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MFM <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MFM > NUMBER_USED .AND. &
MA(J)%MFM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MFM > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
ENDDO
END SUBROUTINE FM_UNDEF_INP_FM1
SUBROUTINE FM_UNDEF_INP_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (IN) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MIM <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MIM > NUMBER_USED .AND. &
MA(J)%MIM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MIM > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
ENDDO
END SUBROUTINE FM_UNDEF_INP_IM1
SUBROUTINE FM_UNDEF_INP_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (IN) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MZM(1) <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MZM(1) > NUMBER_USED .AND. &
MA(J)%MZM(1) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MZM(1) > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MZM(2) <= 0) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MZM(2) > NUMBER_USED .AND. &
MA(J)%MZM(2) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR1(J)
IF (MA(J)%MZM(2) > SIZE_OF_START) CALL FM_INPUT_ERROR1(J)
ENDDO
END SUBROUTINE FM_UNDEF_INP_ZM1
SUBROUTINE FM_UNDEF_INP_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (IN) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MFM <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MFM > NUMBER_USED .AND. &
MA(J,K)%MFM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MFM > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
ENDDO
ENDDO
END SUBROUTINE FM_UNDEF_INP_FM2
SUBROUTINE FM_UNDEF_INP_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (IN) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MIM <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MIM > NUMBER_USED .AND. &
MA(J,K)%MIM < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MIM > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
ENDDO
ENDDO
END SUBROUTINE FM_UNDEF_INP_IM2
SUBROUTINE FM_UNDEF_INP_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (IN) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MZM(1) <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MZM(1) > NUMBER_USED .AND. &
MA(J,K)%MZM(1) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MZM(1) > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MZM(2) <= 0) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MZM(2) > NUMBER_USED .AND. &
MA(J,K)%MZM(2) < LOWEST_SAVED_AREA_INDEX) CALL FM_INPUT_ERROR2(J,K)
IF (MA(J,K)%MZM(2) > SIZE_OF_START) CALL FM_INPUT_ERROR2(J,K)
ENDDO
ENDDO
END SUBROUTINE FM_UNDEF_INP_ZM2
SUBROUTINE FM_DEALLOCATE_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MFM >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J)%MFM) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J)%MFM
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J)%MFM
ENDIF
ENDIF
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_FM1
SUBROUTINE FM_DEALLOCATE_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MIM >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J)%MIM) = -6
TOTAL_IMTEMP6 = TOTAL_IMTEMP6 + 1
IF (NMAX_IMTEMP6 >= SIZE_OF_TEMP6) THEN
N_IMTEMP6 = MOD( TOTAL_IMTEMP6, SIZE_OF_TEMP6 ) + 1
IMTEMP6(N_IMTEMP6) = MA(J)%MIM
ELSE
NMAX_IMTEMP6 = NMAX_IMTEMP6 + 1
IMTEMP6(NMAX_IMTEMP6) = MA(J)%MIM
ENDIF
ENDIF
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_IM1
SUBROUTINE FM_DEALLOCATE_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA)
IF (MA(J)%MZM(1) >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J)%MZM(1)) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J)%MZM(1)
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J)%MZM(1)
ENDIF
ENDIF
IF (MA(J)%MZM(2) >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J)%MZM(2)) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J)%MZM(2)
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J)%MZM(2)
ENDIF
ENDIF
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_ZM1
SUBROUTINE FM_DEALLOCATE_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MFM >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J,K)%MFM) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J,K)%MFM
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J,K)%MFM
ENDIF
ENDIF
ENDDO
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_FM2
SUBROUTINE FM_DEALLOCATE_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MIM >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J,K)%MIM) = -6
TOTAL_IMTEMP6 = TOTAL_IMTEMP6 + 1
IF (NMAX_IMTEMP6 >= SIZE_OF_TEMP6) THEN
N_IMTEMP6 = MOD( TOTAL_IMTEMP6, SIZE_OF_TEMP6 ) + 1
IMTEMP6(N_IMTEMP6) = MA(J,K)%MIM
ELSE
NMAX_IMTEMP6 = NMAX_IMTEMP6 + 1
IMTEMP6(NMAX_IMTEMP6) = MA(J,K)%MIM
ENDIF
ENDIF
ENDDO
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_IM2
SUBROUTINE FM_DEALLOCATE_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
INTENT (INOUT) :: MA
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IF (MA(J,K)%MZM(1) >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J,K)%MZM(1)) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J,K)%MZM(1)
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J,K)%MZM(1)
ENDIF
ENDIF
IF (MA(J,K)%MZM(2) >= LOWEST_SAVED_AREA_INDEX) THEN
TEMPV(MA(J,K)%MZM(2)) = -6
TOTAL_FMTEMP6 = TOTAL_FMTEMP6 + 1
IF (NMAX_FMTEMP6 >= SIZE_OF_TEMP6) THEN
N_FMTEMP6 = MOD( TOTAL_FMTEMP6, SIZE_OF_TEMP6 ) + 1
FMTEMP6(N_FMTEMP6) = MA(J,K)%MZM(2)
ELSE
NMAX_FMTEMP6 = NMAX_FMTEMP6 + 1
FMTEMP6(NMAX_FMTEMP6) = MA(J,K)%MZM(2)
ENDIF
ENDIF
ENDDO
ENDDO
CALL FMDEFINE_RESIZE(0)
END SUBROUTINE FM_DEALLOCATE_ZM2
SUBROUTINE FM_INPUT_ERROR
USE FMVALS
IMPLICIT NONE
WRITE (*,*) ' '
WRITE (*,*) ' '
WRITE (*,*) ' *** Error in a program using the FM package ***'
WRITE (*,*) ' '
WRITE (*,*) ' A multiple precision number is undefined in an expression or as an input'
WRITE (*,*) ' argument to a subprogram.'
WRITE (*,*) ' '
WRITE (*,*) ' To help isolate the code that caused this error, this error message is followed'
WRITE (*,*) ' by an illegal out-of-range array reference. Many compilers have an option for'
WRITE (*,*) ' checking array bounds and will give a traceback with the line number in the'
WRITE (*,*) ' calling program where the error originated.'
WRITE (*,*) ' '
WRITE (*,*) ' The program has been stopped.'
WRITE (*,*) ' '
IF (MWK(-NDIG) > -314159) WRITE (*,*) ' Negative array subscript.'
STOP
END SUBROUTINE FM_INPUT_ERROR
SUBROUTINE FM_INPUT_ERROR1(J)
USE FMVALS
IMPLICIT NONE
INTEGER :: J
INTENT (IN) :: J
WRITE (*,*) ' '
WRITE (*,*) ' '
WRITE (*,*) ' *** Error in a program using the FM package ***'
WRITE (*,*) ' '
WRITE (*,*) ' Element (',J,') of a multiple precision one-dimensional array'
WRITE (*,*) ' is undefined in an expression.'
WRITE (*,*) ' '
WRITE (*,*) ' Note that if an array section is being used, like A(6:10), then if A(7) is'
WRITE (*,*) ' undefined it will be listed as element (2) here.'
WRITE (*,*) ' '
WRITE (*,*) ' To help isolate the code that caused this error, this error message is followed'
WRITE (*,*) ' by an illegal out-of-range array reference. Many compilers have an option for'
WRITE (*,*) ' checking array bounds and will give a traceback with the line number in the'
WRITE (*,*) ' calling program where the error originated.'
WRITE (*,*) ' '
WRITE (*,*) ' The program has been stopped.'
WRITE (*,*) ' '
IF (MWK(-NDIG) > -314159) WRITE (*,*) ' Negative array subscript.'
STOP
END SUBROUTINE FM_INPUT_ERROR1
SUBROUTINE FM_INPUT_ERROR2(J,K)
USE FMVALS
IMPLICIT NONE
INTEGER :: J,K
INTENT (IN) :: J,K
WRITE (*,*) ' '
WRITE (*,*) ' '
WRITE (*,*) ' *** Error in a program using the FM package ***'
WRITE (*,*) ' '
WRITE (*,*) ' Element (',J,',',K,') of a multiple precision two-dimensional array'
WRITE (*,*) ' is undefined in an expression.'
WRITE (*,*) ' '
WRITE (*,*) ' Note that if an array section is being used, like A(6:10), then if A(7) is'
WRITE (*,*) ' undefined it will be listed as element (2) here.'
WRITE (*,*) ' '
WRITE (*,*) ' To help isolate the code that caused this error, this error message is followed'
WRITE (*,*) ' by an illegal out-of-range array reference. Many compilers have an option for'
WRITE (*,*) ' checking array bounds and will give a traceback with the line number in the'
WRITE (*,*) ' calling program where the error originated.'
WRITE (*,*) ' '
WRITE (*,*) ' The program has been stopped.'
WRITE (*,*) ' '
IF (MWK(-NDIG) > -314159) WRITE (*,*) ' Negative array subscript.'
STOP
END SUBROUTINE FM_INPUT_ERROR2
END MODULE FMZM_1
MODULE FMZM_2
USE FMZM_1
! These abbreviations are used for operations on the various data types.
! I Integer
! R Real
! D Double Precision
! Z Complex
! C Complex Double Precision
! FM Multiple precision real
! IM Multiple precision integer
! ZM Multiple precision complex
! For example, the "=" procedure FMEQ_FMD is for statements like X = A, where X is type FM
! and A is type Double Precision.
! Digits refer to the number of dimensions (rank) for an array.
! FMEQ_FM1R handles statements like A = 1.0, where A is a 1-dimensional array of type FM and the
! right side (1.0) is real. Like the ordinary Fortran array syntax, this sets all the elements
! of array A to 1.0.
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE FMEQ_IFM
MODULE PROCEDURE FMEQ_IIM
MODULE PROCEDURE FMEQ_IZM
MODULE PROCEDURE FMEQ_RFM
MODULE PROCEDURE FMEQ_RIM
MODULE PROCEDURE FMEQ_RZM
MODULE PROCEDURE FMEQ_DFM
MODULE PROCEDURE FMEQ_DIM
MODULE PROCEDURE FMEQ_DZM
MODULE PROCEDURE FMEQ_ZFM
MODULE PROCEDURE FMEQ_ZIM
MODULE PROCEDURE FMEQ_ZZM
MODULE PROCEDURE FMEQ_CFM
MODULE PROCEDURE FMEQ_CIM
MODULE PROCEDURE FMEQ_CZM
MODULE PROCEDURE FMEQ_FMI
MODULE PROCEDURE FMEQ_FMR
MODULE PROCEDURE FMEQ_FMD
MODULE PROCEDURE FMEQ_FMZ
MODULE PROCEDURE FMEQ_FMC
MODULE PROCEDURE FMEQ_FMFM
MODULE PROCEDURE FMEQ_FMIM
MODULE PROCEDURE FMEQ_FMZM
MODULE PROCEDURE FMEQ_IMI
MODULE PROCEDURE FMEQ_IMR
MODULE PROCEDURE FMEQ_IMD
MODULE PROCEDURE FMEQ_IMZ
MODULE PROCEDURE FMEQ_IMC
MODULE PROCEDURE FMEQ_IMFM
MODULE PROCEDURE FMEQ_IMIM
MODULE PROCEDURE FMEQ_IMZM
MODULE PROCEDURE FMEQ_ZMI
MODULE PROCEDURE FMEQ_ZMR
MODULE PROCEDURE FMEQ_ZMD
MODULE PROCEDURE FMEQ_ZMZ
MODULE PROCEDURE FMEQ_ZMC
MODULE PROCEDURE FMEQ_ZMFM
MODULE PROCEDURE FMEQ_ZMIM
MODULE PROCEDURE FMEQ_ZMZM
MODULE PROCEDURE FMEQ_FM1I
MODULE PROCEDURE FMEQ_FM1R
MODULE PROCEDURE FMEQ_FM1D
MODULE PROCEDURE FMEQ_FM1Z
MODULE PROCEDURE FMEQ_FM1C
MODULE PROCEDURE FMEQ_I1FM
MODULE PROCEDURE FMEQ_R1FM
MODULE PROCEDURE FMEQ_D1FM
MODULE PROCEDURE FMEQ_Z1FM
MODULE PROCEDURE FMEQ_C1FM
MODULE PROCEDURE FMEQ_FM1FM
MODULE PROCEDURE FMEQ_FM1IM
MODULE PROCEDURE FMEQ_FM1ZM
MODULE PROCEDURE FMEQ_IM1FM
MODULE PROCEDURE FMEQ_ZM1FM
MODULE PROCEDURE FMEQ_FM1I1
MODULE PROCEDURE FMEQ_FM1R1
MODULE PROCEDURE FMEQ_FM1D1
MODULE PROCEDURE FMEQ_FM1Z1
MODULE PROCEDURE FMEQ_FM1C1
MODULE PROCEDURE FMEQ_I1FM1
MODULE PROCEDURE FMEQ_R1FM1
MODULE PROCEDURE FMEQ_D1FM1
MODULE PROCEDURE FMEQ_Z1FM1
MODULE PROCEDURE FMEQ_C1FM1
MODULE PROCEDURE FMEQ_FM1FM1
MODULE PROCEDURE FMEQ_FM1IM1
MODULE PROCEDURE FMEQ_FM1ZM1
MODULE PROCEDURE FMEQ_IM1FM1
MODULE PROCEDURE FMEQ_ZM1FM1
MODULE PROCEDURE FMEQ_IM1I
MODULE PROCEDURE FMEQ_IM1R
MODULE PROCEDURE FMEQ_IM1D
MODULE PROCEDURE FMEQ_IM1Z
MODULE PROCEDURE FMEQ_IM1C
MODULE PROCEDURE FMEQ_I1IM
MODULE PROCEDURE FMEQ_R1IM
MODULE PROCEDURE FMEQ_D1IM
MODULE PROCEDURE FMEQ_Z1IM
MODULE PROCEDURE FMEQ_C1IM
MODULE PROCEDURE FMEQ_IM1IM
MODULE PROCEDURE FMEQ_IM1ZM
MODULE PROCEDURE FMEQ_ZM1IM
MODULE PROCEDURE FMEQ_IM1I1
MODULE PROCEDURE FMEQ_IM1R1
MODULE PROCEDURE FMEQ_IM1D1
MODULE PROCEDURE FMEQ_IM1Z1
MODULE PROCEDURE FMEQ_IM1C1
MODULE PROCEDURE FMEQ_I1IM1
MODULE PROCEDURE FMEQ_R1IM1
MODULE PROCEDURE FMEQ_D1IM1
MODULE PROCEDURE FMEQ_Z1IM1
MODULE PROCEDURE FMEQ_C1IM1
MODULE PROCEDURE FMEQ_IM1IM1
MODULE PROCEDURE FMEQ_IM1ZM1
MODULE PROCEDURE FMEQ_ZM1IM1
MODULE PROCEDURE FMEQ_ZM1I
MODULE PROCEDURE FMEQ_ZM1R
MODULE PROCEDURE FMEQ_ZM1D
MODULE PROCEDURE FMEQ_ZM1Z
MODULE PROCEDURE FMEQ_ZM1C
MODULE PROCEDURE FMEQ_I1ZM
MODULE PROCEDURE FMEQ_R1ZM
MODULE PROCEDURE FMEQ_D1ZM
MODULE PROCEDURE FMEQ_Z1ZM
MODULE PROCEDURE FMEQ_C1ZM
MODULE PROCEDURE FMEQ_ZM1ZM
MODULE PROCEDURE FMEQ_ZM1I1
MODULE PROCEDURE FMEQ_ZM1R1
MODULE PROCEDURE FMEQ_ZM1D1
MODULE PROCEDURE FMEQ_ZM1Z1
MODULE PROCEDURE FMEQ_ZM1C1
MODULE PROCEDURE FMEQ_I1ZM1
MODULE PROCEDURE FMEQ_R1ZM1
MODULE PROCEDURE FMEQ_D1ZM1
MODULE PROCEDURE FMEQ_Z1ZM1
MODULE PROCEDURE FMEQ_C1ZM1
MODULE PROCEDURE FMEQ_ZM1ZM1
MODULE PROCEDURE FMEQ_FM2I
MODULE PROCEDURE FMEQ_FM2R
MODULE PROCEDURE FMEQ_FM2D
MODULE PROCEDURE FMEQ_FM2Z
MODULE PROCEDURE FMEQ_FM2C
MODULE PROCEDURE FMEQ_I2FM
MODULE PROCEDURE FMEQ_R2FM
MODULE PROCEDURE FMEQ_D2FM
MODULE PROCEDURE FMEQ_Z2FM
MODULE PROCEDURE FMEQ_C2FM
MODULE PROCEDURE FMEQ_FM2FM
MODULE PROCEDURE FMEQ_FM2IM
MODULE PROCEDURE FMEQ_FM2ZM
MODULE PROCEDURE FMEQ_IM2FM
MODULE PROCEDURE FMEQ_ZM2FM
MODULE PROCEDURE FMEQ_FM2I2
MODULE PROCEDURE FMEQ_FM2R2
MODULE PROCEDURE FMEQ_FM2D2
MODULE PROCEDURE FMEQ_FM2Z2
MODULE PROCEDURE FMEQ_FM2C2
MODULE PROCEDURE FMEQ_I2FM2
MODULE PROCEDURE FMEQ_R2FM2
MODULE PROCEDURE FMEQ_D2FM2
MODULE PROCEDURE FMEQ_Z2FM2
MODULE PROCEDURE FMEQ_C2FM2
MODULE PROCEDURE FMEQ_FM2FM2
MODULE PROCEDURE FMEQ_FM2IM2
MODULE PROCEDURE FMEQ_FM2ZM2
MODULE PROCEDURE FMEQ_IM2FM2
MODULE PROCEDURE FMEQ_ZM2FM2
MODULE PROCEDURE FMEQ_IM2I
MODULE PROCEDURE FMEQ_IM2R
MODULE PROCEDURE FMEQ_IM2D
MODULE PROCEDURE FMEQ_IM2Z
MODULE PROCEDURE FMEQ_IM2C
MODULE PROCEDURE FMEQ_I2IM
MODULE PROCEDURE FMEQ_R2IM
MODULE PROCEDURE FMEQ_D2IM
MODULE PROCEDURE FMEQ_Z2IM
MODULE PROCEDURE FMEQ_C2IM
MODULE PROCEDURE FMEQ_IM2IM
MODULE PROCEDURE FMEQ_IM2ZM
MODULE PROCEDURE FMEQ_ZM2IM
MODULE PROCEDURE FMEQ_IM2I2
MODULE PROCEDURE FMEQ_IM2R2
MODULE PROCEDURE FMEQ_IM2D2
MODULE PROCEDURE FMEQ_IM2Z2
MODULE PROCEDURE FMEQ_IM2C2
MODULE PROCEDURE FMEQ_I2IM2
MODULE PROCEDURE FMEQ_R2IM2
MODULE PROCEDURE FMEQ_D2IM2
MODULE PROCEDURE FMEQ_Z2IM2
MODULE PROCEDURE FMEQ_C2IM2
MODULE PROCEDURE FMEQ_IM2IM2
MODULE PROCEDURE FMEQ_IM2ZM2
MODULE PROCEDURE FMEQ_ZM2IM2
MODULE PROCEDURE FMEQ_ZM2I
MODULE PROCEDURE FMEQ_ZM2R
MODULE PROCEDURE FMEQ_ZM2D
MODULE PROCEDURE FMEQ_ZM2Z
MODULE PROCEDURE FMEQ_ZM2C
MODULE PROCEDURE FMEQ_I2ZM
MODULE PROCEDURE FMEQ_R2ZM
MODULE PROCEDURE FMEQ_D2ZM
MODULE PROCEDURE FMEQ_Z2ZM
MODULE PROCEDURE FMEQ_C2ZM
MODULE PROCEDURE FMEQ_ZM2ZM
MODULE PROCEDURE FMEQ_ZM2I2
MODULE PROCEDURE FMEQ_ZM2R2
MODULE PROCEDURE FMEQ_ZM2D2
MODULE PROCEDURE FMEQ_ZM2Z2
MODULE PROCEDURE FMEQ_ZM2C2
MODULE PROCEDURE FMEQ_I2ZM2
MODULE PROCEDURE FMEQ_R2ZM2
MODULE PROCEDURE FMEQ_D2ZM2
MODULE PROCEDURE FMEQ_Z2ZM2
MODULE PROCEDURE FMEQ_C2ZM2
MODULE PROCEDURE FMEQ_ZM2ZM2
END INTERFACE
INTERFACE OPERATOR (==)
MODULE PROCEDURE FMLEQ_IFM
MODULE PROCEDURE FMLEQ_IIM
MODULE PROCEDURE FMLEQ_IZM
MODULE PROCEDURE FMLEQ_RFM
MODULE PROCEDURE FMLEQ_RIM
MODULE PROCEDURE FMLEQ_RZM
MODULE PROCEDURE FMLEQ_DFM
MODULE PROCEDURE FMLEQ_DIM
MODULE PROCEDURE FMLEQ_DZM
MODULE PROCEDURE FMLEQ_ZFM
MODULE PROCEDURE FMLEQ_ZIM
MODULE PROCEDURE FMLEQ_ZZM
MODULE PROCEDURE FMLEQ_CFM
MODULE PROCEDURE FMLEQ_CIM
MODULE PROCEDURE FMLEQ_CZM
MODULE PROCEDURE FMLEQ_FMI
MODULE PROCEDURE FMLEQ_FMR
MODULE PROCEDURE FMLEQ_FMD
MODULE PROCEDURE FMLEQ_FMZ
MODULE PROCEDURE FMLEQ_FMC
MODULE PROCEDURE FMLEQ_FMFM
MODULE PROCEDURE FMLEQ_FMIM
MODULE PROCEDURE FMLEQ_FMZM
MODULE PROCEDURE FMLEQ_IMI
MODULE PROCEDURE FMLEQ_IMR
MODULE PROCEDURE FMLEQ_IMD
MODULE PROCEDURE FMLEQ_IMZ
MODULE PROCEDURE FMLEQ_IMC
MODULE PROCEDURE FMLEQ_IMFM
MODULE PROCEDURE FMLEQ_IMIM
MODULE PROCEDURE FMLEQ_IMZM
MODULE PROCEDURE FMLEQ_ZMI
MODULE PROCEDURE FMLEQ_ZMR
MODULE PROCEDURE FMLEQ_ZMD
MODULE PROCEDURE FMLEQ_ZMZ
MODULE PROCEDURE FMLEQ_ZMC
MODULE PROCEDURE FMLEQ_ZMFM
MODULE PROCEDURE FMLEQ_ZMIM
MODULE PROCEDURE FMLEQ_ZMZM
END INTERFACE
! The enter routines are called to let the FMEQ_ subroutines know that a function subprogram
! has been called in the user's program. That means temporary FM, IM, or ZM variables created
! by this interface should not be discarded until the user's function ends and one of the FMEQ_
! routines is called elsewhere in the user's program.
INTERFACE FM_ENTER_USER_FUNCTION
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_FM
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_FM1
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_FM2
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_IM
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_IM1
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_IM2
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_ZM
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_ZM1
MODULE PROCEDURE FM_ENTER_USER_FUNCTION_ZM2
END INTERFACE
INTERFACE FM_EXIT_USER_FUNCTION
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_FM
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_FM1
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_FM2
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_IM
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_IM1
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_IM2
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_ZM
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_ZM1
MODULE PROCEDURE FM_EXIT_USER_FUNCTION_ZM2
END INTERFACE
CONTAINS
SUBROUTINE FM_ENTER_USER_FUNCTION_FM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: F_NAME
IN_USER_FUNCTION = .TRUE.
CALL FMDEFINE(F_NAME%MFM)
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
TEMPV(NUMBER_USED) = -2
END SUBROUTINE FM_ENTER_USER_FUNCTION_FM
SUBROUTINE FM_ENTER_USER_FUNCTION_FM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: F_NAME
INTEGER :: J
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME)
F_NAME(J)%MFM = -1
CALL FMDEFINE(F_NAME(J)%MFM)
TEMPV(NUMBER_USED) = -2
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_FM1
SUBROUTINE FM_ENTER_USER_FUNCTION_FM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: F_NAME
INTEGER :: J,K
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME,DIM=1)
DO K = 1, SIZE(F_NAME,DIM=2)
F_NAME(J,K)%MFM = -1
CALL FMDEFINE(F_NAME(J,K)%MFM)
TEMPV(NUMBER_USED) = -2
ENDDO
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_FM2
SUBROUTINE FM_ENTER_USER_FUNCTION_IM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: F_NAME
IN_USER_FUNCTION = .TRUE.
CALL IMDEFINE(F_NAME%MIM,5)
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
TEMPV(NUMBER_USED) = -2
END SUBROUTINE FM_ENTER_USER_FUNCTION_IM
SUBROUTINE FM_ENTER_USER_FUNCTION_IM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: F_NAME
INTEGER :: J
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME)
F_NAME(J)%MIM = -1
CALL IMDEFINE(F_NAME(J)%MIM,5)
TEMPV(NUMBER_USED) = -2
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_IM1
SUBROUTINE FM_ENTER_USER_FUNCTION_IM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: F_NAME
INTEGER :: J,K
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME,DIM=1)
DO K = 1, SIZE(F_NAME,DIM=2)
F_NAME(J,K)%MIM = -1
CALL IMDEFINE(F_NAME(J,K)%MIM,5)
TEMPV(NUMBER_USED) = -2
ENDDO
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_IM2
SUBROUTINE FM_ENTER_USER_FUNCTION_ZM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: F_NAME
IN_USER_FUNCTION = .TRUE.
CALL FMDEFINE(F_NAME%MZM(1))
CALL FMDEFINE(F_NAME%MZM(2))
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
TEMPV(NUMBER_USED-1) = -2
TEMPV(NUMBER_USED) = -2
END SUBROUTINE FM_ENTER_USER_FUNCTION_ZM
SUBROUTINE FM_ENTER_USER_FUNCTION_ZM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: F_NAME
INTEGER :: J
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME)
F_NAME(J)%MZM(1) = -1
CALL FMDEFINE(F_NAME(J)%MZM(1))
TEMPV(NUMBER_USED) = -2
F_NAME(J)%MZM(2) = -1
CALL FMDEFINE(F_NAME(J)%MZM(2))
TEMPV(NUMBER_USED) = -2
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_ZM1
SUBROUTINE FM_ENTER_USER_FUNCTION_ZM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: F_NAME
INTEGER :: J,K
IN_USER_FUNCTION = .TRUE.
DO J = 1, SIZE(F_NAME,DIM=1)
DO K = 1, SIZE(F_NAME,DIM=2)
F_NAME(J,K)%MZM(1) = -1
CALL FMDEFINE(F_NAME(J,K)%MZM(1))
TEMPV(NUMBER_USED) = -2
F_NAME(J,K)%MZM(2) = -1
CALL FMDEFINE(F_NAME(J,K)%MZM(2))
TEMPV(NUMBER_USED) = -2
ENDDO
ENDDO
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_FUNCTION_ZM2
! The exit routines for functions record the fact that a user function has finished, and
! also check to see if the multiple precision value associated with the function name has
! been moved during the function. This most commonly happens for type (im) functions where
! the value increases in size during the execution of the function and runs out of the space
! reserved for it at the top of the function. Now that any temporaries can be deleted, the
! function value can be moved back to its original spot and its size adjusted to the correct
! value.
SUBROUTINE FM_EXIT_USER_FUNCTION_FM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: F_NAME
INTEGER :: J,K,NEW_K
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
IF (F_NAME%MFM > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
J = F_NAME%MFM
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%MFM = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%MFM) = SIZE_OF(J)
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ENDIF
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) = -1
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_FM
SUBROUTINE FM_EXIT_USER_FUNCTION_FM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: F_NAME
INTEGER :: J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO J = 1, SIZE(F_NAME)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%MFM)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%MFM)
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%MFM)
DO K = 1, SIZE_OF(F_NAME(J)%MFM)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%MFM)+K-1)
ENDDO
ENDDO
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - SIZE(F_NAME) + J
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%MFM) = -1
F_NAME(J)%MFM = NPT
TEMPV(F_NAME(J)%MFM) = -1
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO J = 1, SIZE(F_NAME)
TEMPV(F_NAME(J)%MFM) = -1
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_FM1
SUBROUTINE FM_EXIT_USER_FUNCTION_FM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: F_NAME
INTEGER :: I,J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%MFM)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%MFM)
ENDDO
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%MFM)
DO K = 1, SIZE_OF(F_NAME(I,J)%MFM)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%MFM)+K-1)
ENDDO
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - SIZE(F_NAME)
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%MFM) = -1
F_NAME(I,J)%MFM = NPT
TEMPV(F_NAME(I,J)%MFM) = -1
ENDDO
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
TEMPV(F_NAME(I,J)%MFM) = -1
ENDDO
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_FM2
SUBROUTINE FM_EXIT_USER_FUNCTION_IM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: F_NAME
INTEGER :: J,K,NEW_K
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
IF (F_NAME%MIM > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
J = F_NAME%MIM
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%MIM = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%MIM) = SIZE_OF(J)
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ENDIF
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) = -1
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_IM
SUBROUTINE FM_EXIT_USER_FUNCTION_IM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: F_NAME
INTEGER :: J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO J = 1, SIZE(F_NAME)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%MIM)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%MIM)
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%MIM)
DO K = 1, SIZE_OF(F_NAME(J)%MIM)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%MIM)+K-1)
ENDDO
ENDDO
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - SIZE(F_NAME) + J
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%MIM) = -1
F_NAME(J)%MIM = NPT
TEMPV(F_NAME(J)%MIM) = -1
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO J = 1, SIZE(F_NAME)
TEMPV(F_NAME(J)%MIM) = -1
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_IM1
SUBROUTINE FM_EXIT_USER_FUNCTION_IM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: F_NAME
INTEGER :: I,J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%MIM)
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%MIM)
ENDDO
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%MIM)
DO K = 1, SIZE_OF(F_NAME(I,J)%MIM)
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%MIM)+K-1)
ENDDO
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - SIZE(F_NAME)
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%MIM) = -1
F_NAME(I,J)%MIM = NPT
TEMPV(F_NAME(I,J)%MIM) = -1
ENDDO
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
TEMPV(F_NAME(I,J)%MIM) = -1
ENDDO
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_IM2
SUBROUTINE FM_EXIT_USER_FUNCTION_ZM(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: F_NAME
INTEGER :: J,K,NEW_K
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
IF (F_NAME%MZM(1) > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1 .OR. &
F_NAME%MZM(2) > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
IF (F_NAME%MZM(1) < F_NAME%MZM(2)) THEN
J = F_NAME%MZM(1)
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%MZM(1) = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 1
SIZE_OF(F_NAME%MZM(1)) = SIZE_OF(J)
START(F_NAME%MZM(1)) = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1)
J = F_NAME%MZM(2)
F_NAME%MZM(2) = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%MZM(2)) = SIZE_OF(J)
START(F_NAME%MZM(2)) = NEW_K + 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1, NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ELSE
J = F_NAME%MZM(2)
NEW_K = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) - 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
F_NAME%MZM(2) = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 1
SIZE_OF(F_NAME%MZM(2)) = SIZE_OF(J)
START(F_NAME%MZM(2)) = START(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1)
J = F_NAME%MZM(1)
F_NAME%MZM(1) = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)
SIZE_OF(F_NAME%MZM(1)) = SIZE_OF(J)
START(F_NAME%MZM(1)) = NEW_K + 1
DO K = START(J), START(J)+SIZE_OF(J)-1
NEW_K = NEW_K + 1
MWK(NEW_K) = MWK(K)
ENDDO
TEMPV(J) = -1
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1, NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
ENDIF
ENDIF
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)-1) = -1
TEMPV(NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) = -1
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_ZM
SUBROUTINE FM_EXIT_USER_FUNCTION_ZM1(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: F_NAME
INTEGER :: J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO J = 1, SIZE(F_NAME)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%MZM(1))
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%MZM(1))
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(J)%MZM(2))
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(J)%MZM(2))
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+2*SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO J = 1, SIZE(F_NAME)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%MZM(1))
DO K = 1, SIZE_OF(F_NAME(J)%MZM(1))
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%MZM(1))+K-1)
ENDDO
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(J)%MZM(2))
DO K = 1, SIZE_OF(F_NAME(J)%MZM(2))
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(J)%MZM(2))+K-1)
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 2*SIZE(F_NAME)
DO J = 1, SIZE(F_NAME)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%MZM(1)) = -1
F_NAME(J)%MZM(1) = NPT
TEMPV(F_NAME(J)%MZM(1)) = -1
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(J)%MZM(2)) = -1
F_NAME(J)%MZM(2) = NPT
TEMPV(F_NAME(J)%MZM(2)) = -1
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO J = 1, SIZE(F_NAME)
TEMPV(F_NAME(J)%MZM(1)) = -1
TEMPV(F_NAME(J)%MZM(2)) = -1
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_ZM1
SUBROUTINE FM_EXIT_USER_FUNCTION_ZM2(F_NAME)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: F_NAME
INTEGER :: I,J,K,KL,L,NEW_MAX_F,NPT,TOTAL_SIZE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_FUNCTION.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_FUNCTION'
WRITE (KW,*) ' on entry and FM_EXIT_USER_FUNCTION before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
NEW_MAX_F = 0
TOTAL_SIZE = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%MZM(1))
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%MZM(1))
NEW_MAX_F = MAX(NEW_MAX_F,F_NAME(I,J)%MZM(2))
TOTAL_SIZE = TOTAL_SIZE + SIZE_OF(F_NAME(I,J)%MZM(2))
ENDDO
ENDDO
IF (NEW_MAX_F > NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL)) THEN
ALLOCATE(MOVE_F(TOTAL_SIZE+2*SIZE(F_NAME)),STAT=J)
IF (J /= 0) THEN
CALL FMDEFINE_ERROR(1)
ENDIF
L = 0
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%MZM(1))
DO K = 1, SIZE_OF(F_NAME(I,J)%MZM(1))
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%MZM(1))+K-1)
ENDDO
L = L + 1
MOVE_F(L) = SIZE_OF(F_NAME(I,J)%MZM(2))
DO K = 1, SIZE_OF(F_NAME(I,J)%MZM(2))
L = L + 1
MOVE_F(L) = MWK(START(F_NAME(I,J)%MZM(2))+K-1)
ENDDO
ENDDO
ENDDO
L = 0
NPT = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) - 2*SIZE(F_NAME)
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%MZM(1)) = -1
F_NAME(I,J)%MZM(1) = NPT
TEMPV(F_NAME(I,J)%MZM(1)) = -1
L = L + 1
NPT = NPT + 1
SIZE_OF(NPT) = MOVE_F(L)
IF (NPT > 1) THEN
START(NPT) = START(NPT-1) + SIZE_OF(NPT-1)
ELSE
START(NPT) = 1
ENDIF
KL = MOVE_F(L)
DO K = 1, KL
L = L + 1
MWK(START(NPT)+K-1) = MOVE_F(L)
ENDDO
TEMPV(F_NAME(I,J)%MZM(2)) = -1
F_NAME(I,J)%MZM(2) = NPT
TEMPV(F_NAME(I,J)%MZM(2)) = -1
ENDDO
ENDDO
DO J = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL), NUMBER_USED
IF (TEMPV(J) == -6) TEMPV(J) = -1
ENDDO
DEALLOCATE(MOVE_F)
ELSE
DO I = 1, SIZE(F_NAME,DIM=1)
DO J = 1, SIZE(F_NAME,DIM=2)
TEMPV(F_NAME(I,J)%MZM(1)) = -1
TEMPV(F_NAME(I,J)%MZM(2)) = -1
ENDDO
ENDDO
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_FUNCTION_ZM2
! These two routines are called to let the FMEQ_ subroutines know that a subprogram has been
! called in the user's program. That means temporary FM, IM, or ZM variables created by this
! interface should not be discarded until the user's routine ends and one of the FMEQ_ routines
! is called elsewhere in the user's program.
SUBROUTINE FM_ENTER_USER_ROUTINE
USE FMVALS
IMPLICIT NONE
IN_USER_FUNCTION = .TRUE.
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) = NUMBER_USED
END SUBROUTINE FM_ENTER_USER_ROUTINE
SUBROUTINE FM_EXIT_USER_ROUTINE
USE FMVALS
IMPLICIT NONE
IF (USER_FUNCTION_LEVEL <= 0) THEN
WRITE (KW,*) ' '
WRITE (KW,*) ' Error in routine FM_EXIT_USER_ROUTINE.'
WRITE (KW,*) ' USER_FUNCTION_LEVEL is not positive.'
WRITE (KW,*) ' Check that all user function subprograms call FM_ENTER_USER_ROUTINE'
WRITE (KW,*) ' on entry and FM_EXIT_USER_ROUTINE before any RETURN or END statement.'
WRITE (KW,*) ' '
STOP
ENDIF
CALL FMEQ_TEMP
USER_FUNCTION_LEVEL = USER_FUNCTION_LEVEL - 1
IF (USER_FUNCTION_LEVEL == 0) IN_USER_FUNCTION = .FALSE.
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXIT_USER_ROUTINE
SUBROUTINE FMEQ_TEMP
! Check to see if the last few FM numbers are temporaries.
! If so, re-set NUMBER_USED so that space in MWK can be re-claimed.
USE FMVALS
IMPLICIT NONE
INTEGER :: J,K,L
IF (USER_FUNCTION_LEVEL == 0) THEN
L = 1
ELSE
L = NUMBER_USED_AT_LEVEL(USER_FUNCTION_LEVEL) + 1
ENDIF
K = NUMBER_USED
DO J = K, L, -1
IF (TEMPV(J) == -1 .OR. TEMPV(J) <= -6) THEN
NUMBER_USED = NUMBER_USED - 1
TEMPV(J) = -2
ELSE
EXIT
ENDIF
ENDDO
END SUBROUTINE FMEQ_TEMP
! =
SUBROUTINE FMEQ_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2I(MA%MFM,IVAL)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IFM
SUBROUTINE FMEQ_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2I(MA%MIM,IVAL)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IIM
SUBROUTINE FMEQ_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2I(MA%MZM,IVAL)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IZM
SUBROUTINE FMEQ_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL :: R
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,R)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_RFM
SUBROUTINE FMEQ_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL :: R
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_RIM
SUBROUTINE FMEQ_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL :: R
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2SP(MTFM,R)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_RZM
SUBROUTINE FMEQ_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(MA%MFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DFM
SUBROUTINE FMEQ_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DP(MA%MIM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DIM
SUBROUTINE FMEQ_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_DZM
SUBROUTINE FMEQ_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX :: Z
REAL :: R
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,R)
Z = CMPLX( R , 0.0 )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZFM
SUBROUTINE FMEQ_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX :: Z
DOUBLE PRECISION :: D
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DP(MA%MIM,D)
Z = CMPLX( REAL(D) , 0.0 )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZIM
SUBROUTINE FMEQ_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2Z(MA%MZM,Z)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZZM
SUBROUTINE FMEQ_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(MA%MFM,D)
C = CMPLX( D , 0.0D0 , KIND(0.0D0) )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_CFM
SUBROUTINE FMEQ_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DP(MA%MIM,D)
C = CMPLX( D , 0.0D0 , KIND(0.0D0) )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_CIM
SUBROUTINE FMEQ_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D1)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
C = CMPLX( D1 , D2 , KIND(0.0D0) )
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_CZM
SUBROUTINE FMEQ_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMI2M(IVAL,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMI
SUBROUTINE FMEQ_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(R,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMR
SUBROUTINE FMEQ_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(D,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMD
SUBROUTINE FMEQ_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX :: Z
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
R = REAL(Z)
CALL FMEQ_INDEX(MA)
CALL FMSP2M(R,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMZ
SUBROUTINE FMEQ_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,KIND(0.0D0))
CALL FMDP2M(D,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMC
SUBROUTINE FMEQ_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ(MB%MFM,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMFM
SUBROUTINE FMEQ_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMIM
SUBROUTINE FMEQ_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MA%MFM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FMZM
SUBROUTINE FMEQ_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMI2M(IVAL,MA%MIM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMI
SUBROUTINE FMEQ_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
REAL :: R
CHARACTER(25) :: ST
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,MA%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMR
SUBROUTINE FMEQ_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
DOUBLE PRECISION :: D
CHARACTER(25) :: 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,'(E25.16)') D
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMD
SUBROUTINE FMEQ_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX :: Z
REAL :: R
CHARACTER(25) :: ST
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
R = REAL(Z)
CALL FMEQ_INDEX(MA)
IF (ABS(R) < HUGE(1)) THEN
IVAL = INT(R)
CALL IMI2M(IVAL,MA%MIM)
ELSE
WRITE (ST,'(E25.16)') R
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMZ
SUBROUTINE FMEQ_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
CHARACTER(25) :: ST
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,KIND(0.0D0))
IF (ABS(D) < HUGE(1)) THEN
IVAL = INT(D)
CALL IMI2M(IVAL,MA%MIM)
ELSE
WRITE (ST,'(E25.16)') D
CALL IMST2M(ST,MA%MIM)
ENDIF
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMC
SUBROUTINE FMEQ_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMFM2I(MB%MFM,MA%MIM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMFM
SUBROUTINE FMEQ_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMEQ(MB%MIM,MA%MIM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMIM
SUBROUTINE FMEQ_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MTFM)
CALL IMFM2I(MTFM,MA%MIM)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IMZM
SUBROUTINE FMEQ_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMI2M(IVAL,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_ZMI
SUBROUTINE FMEQ_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL :: R
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
Z = CMPLX(R,0.0)
CALL ZMZ2M(Z,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_ZMR
SUBROUTINE FMEQ_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(D,MTFM)
CALL FMDP2M(0.0D0,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_ZMD
SUBROUTINE FMEQ_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMZ2M(Z,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_ZMZ
SUBROUTINE FMEQ_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
D = REAL(C,KIND(0.0D0))
CALL FMDP2M(D,MTFM)
D = AIMAG(C)
CALL FMDP2M(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_ZMC
SUBROUTINE FMEQ_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ(MB%MFM,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_ZMFM
SUBROUTINE FMEQ_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,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_ZMIM
SUBROUTINE FMEQ_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMEQ(MB%MZM,MTZM)
CALL ZMEQ(MTZM,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_ZMZM
! Array equal assignments for FM.
! (1) rank 1 = rank 0
SUBROUTINE FMEQ_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: IVAL,J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,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_FM1I
SUBROUTINE FMEQ_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMSP2M(R,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_FM1R
SUBROUTINE FMEQ_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(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_FM1D
SUBROUTINE FMEQ_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMSP2M(REAL(Z),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_FM1Z
SUBROUTINE FMEQ_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),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_FM1C
SUBROUTINE FMEQ_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,K,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
CALL FMM2I(MA%MFM,K)
DO J = 1, N
IVAL(J) = K
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1FM
SUBROUTINE FMEQ_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMM2SP(MA%MFM,R2)
DO J = 1, N
R(J) = R2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1FM
SUBROUTINE FMEQ_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL FMM2DP(MA%MFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1FM
SUBROUTINE FMEQ_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMM2SP(MA%MFM,R2)
DO J = 1, N
Z(J) = R2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1FM
SUBROUTINE FMEQ_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL FMM2DP(MA%MFM,D2)
DO J = 1, N
C(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1FM
SUBROUTINE FMEQ_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMEQ(MB%MFM,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_FM1FM
SUBROUTINE FMEQ_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,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_FM1IM
SUBROUTINE FMEQ_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL ZMREAL(MB%MZM,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_FM1ZM
SUBROUTINE FMEQ_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMFM2I(MB%MFM,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_IM1FM
SUBROUTINE FMEQ_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,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_ZM1FM
! (2) rank 1 = rank 1
SUBROUTINE FMEQ_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(IVAL)) 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 FMI2M(IVAL(J),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1I1
SUBROUTINE FMEQ_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(R)) 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 FMSP2M(R(J),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1R1
SUBROUTINE FMEQ_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(D(J),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1D1
SUBROUTINE FMEQ_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(Z)) 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 FMSP2M(REAL(Z(J)),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1Z1
SUBROUTINE FMEQ_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1C1
SUBROUTINE FMEQ_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(IVAL)
IVAL(J) = IUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMM2I(MA(J)%MFM,IVAL(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1FM1
SUBROUTINE FMEQ_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(R)
R(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMM2SP(MA(J)%MFM,R(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1FM1
SUBROUTINE FMEQ_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MA(J)%MFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1FM1
SUBROUTINE FMEQ_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(Z)
Z(J) = CMPLX(RUNKNO,RUNKNO)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL FMM2SP(MA(J)%MFM,R)
Z(J) = CMPLX(R,0.0)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1FM1
SUBROUTINE FMEQ_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(C)
D = RUNKNO
C(J) = CMPLX(D,D , KIND(0.0D0))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMM2DP(MA(J)%MFM,D)
C(J) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1FM1
SUBROUTINE FMEQ_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), ALLOCATABLE, DIMENSION(:) :: TEMP
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA)
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(N))
CALL FMEQ_INDEX(TEMP)
DO J = 1, N
CALL FMEQ(MB(J)%MFM,TEMP(J)%MFM)
ENDDO
DO J = 1, N
CALL FMEQ(TEMP(J)%MFM,MA(J)%MFM)
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1FM1
SUBROUTINE FMEQ_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA)
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1IM1
SUBROUTINE FMEQ_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL FMST2M(' UNKNOWN ',MTFM)
DO J = 1, SIZE(MA)
CALL FMEQ(MTFM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL(MB(J)%MZM,MA(J)%MFM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM1ZM1
SUBROUTINE FMEQ_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL IMST2M(' UNKNOWN ',MTIM)
DO J = 1, SIZE(MA)
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMFM2I(MB(J)%MFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1FM1
SUBROUTINE FMEQ_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) 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,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,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_ZM1FM1
! (3) rank 2 = rank 0
SUBROUTINE FMEQ_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: IVAL,J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMI2M(IVAL,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_FM2I
SUBROUTINE FMEQ_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(R,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_FM2R
SUBROUTINE FMEQ_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(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_FM2D
SUBROUTINE FMEQ_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(REAL(Z),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_FM2Z
SUBROUTINE FMEQ_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),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_FM2C
SUBROUTINE FMEQ_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K,L
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2I(MA%MFM,L)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = L
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2FM
SUBROUTINE FMEQ_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,R2)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2FM
SUBROUTINE FMEQ_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(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_D2FM
SUBROUTINE FMEQ_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,R2)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2FM
SUBROUTINE FMEQ_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(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_C2FM
SUBROUTINE FMEQ_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ(MB%MFM,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_FM2FM
SUBROUTINE FMEQ_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,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_FM2IM
SUBROUTINE FMEQ_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,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_FM2ZM
SUBROUTINE FMEQ_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMFM2I(MB%MFM,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_IM2FM
SUBROUTINE FMEQ_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,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_ZM2FM
! (4) rank 2 = rank 2
SUBROUTINE FMEQ_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,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 FMI2M(IVAL(J,K),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2I2
SUBROUTINE FMEQ_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,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 FMSP2M(R(J,K),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2R2
SUBROUTINE FMEQ_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(D(J,K),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2D2
SUBROUTINE FMEQ_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,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 FMSP2M(REAL(Z(J,K)),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2Z2
SUBROUTINE FMEQ_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2C2
SUBROUTINE FMEQ_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = IUNKNO
ENDDO
ENDDO
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 FMM2I(MA(J,K)%MFM,IVAL(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2FM2
SUBROUTINE FMEQ_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = RUNKNO
ENDDO
ENDDO
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 FMM2SP(MA(J,K)%MFM,R(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2FM2
SUBROUTINE FMEQ_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MA(J,K)%MFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D2FM2
SUBROUTINE FMEQ_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = CMPLX(RUNKNO,RUNKNO)
ENDDO
ENDDO
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 FMM2SP(MA(J,K)%MFM,R)
Z(J,K) = CMPLX(R,0.0)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2FM2
SUBROUTINE FMEQ_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(C,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(C,DIM=2)) THEN
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
D = RUNKNO
C(J,K) = CMPLX(D,D , KIND(0.0D0))
ENDDO
ENDDO
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 FMM2DP(MA(J,K)%MFM,D)
C(J,K) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C2FM2
SUBROUTINE FMEQ_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), ALLOCATABLE, DIMENSION(:,:) :: TEMP
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M(' 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
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(SIZE(MA,DIM=1),SIZE(MA,DIM=2)))
CALL FMEQ_INDEX(TEMP)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MB(J,K)%MFM,TEMP(J,K)%MFM)
ENDDO
ENDDO
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(TEMP(J,K)%MFM,MA(J,K)%MFM)
ENDDO
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2FM2
SUBROUTINE FMEQ_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M(' 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 IMI2FM(MB(J,K)%MIM,MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2IM2
SUBROUTINE FMEQ_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL FMST2M(' 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 ZMREAL(MB(J,K)%MZM,MA(J,K)%MFM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_FM2ZM2
SUBROUTINE FMEQ_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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 IMFM2I(MB(J,K)%MFM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2FM2
SUBROUTINE FMEQ_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,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_ZM2FM2
! Array equal assignments for IM.
! (1) rank 1 = rank 0
SUBROUTINE FMEQ_IM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: IVAL,J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,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_IM1I
SUBROUTINE FMEQ_IM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMSP2M(R,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_IM1R
SUBROUTINE FMEQ_IM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(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_IM1D
SUBROUTINE FMEQ_IM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMSP2M(REAL(Z),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_IM1Z
SUBROUTINE FMEQ_IM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),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_IM1C
SUBROUTINE FMEQ_I1IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,K,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
CALL IMM2I(MA%MIM,K)
DO J = 1, N
IVAL(J) = K
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1IM
SUBROUTINE FMEQ_R1IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, N
R(J) = R2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1IM
SUBROUTINE FMEQ_D1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2DP(MTFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1IM
SUBROUTINE FMEQ_Z1IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, N
Z(J) = R2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1IM
SUBROUTINE FMEQ_C1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2DP(MTFM,D2)
DO J = 1, N
C(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1IM
SUBROUTINE FMEQ_IM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMEQ(MB%MIM,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_IM1IM
SUBROUTINE FMEQ_IM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL ZMREAL(MB%MZM,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_IM1ZM
SUBROUTINE FMEQ_ZM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,MUFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MUFM,MTFM,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_ZM1IM
! (2) rank 1 = rank 1
SUBROUTINE FMEQ_IM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(IVAL)) 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 IMI2M(IVAL(J),MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1I1
SUBROUTINE FMEQ_IM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(R)) 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 FMSP2M(R(J),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1R1
SUBROUTINE FMEQ_IM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(D(J),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1D1
SUBROUTINE FMEQ_IM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(Z)) 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 FMSP2M(REAL(Z(J)),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1Z1
SUBROUTINE FMEQ_IM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1C1
SUBROUTINE FMEQ_I1IM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
IVAL(J) = IUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL IMM2I(MA(J)%MIM,IVAL(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1IM1
SUBROUTINE FMEQ_R1IM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
R(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMM2SP(MTFM,R(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1IM1
SUBROUTINE FMEQ_D1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MTFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1IM1
SUBROUTINE FMEQ_Z1IM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
REAL :: R
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
Z(J) = CMPLX(RUNKNO,RUNKNO)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMM2SP(MTFM,R)
Z(J) = CMPLX(R,0.0)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1IM1
SUBROUTINE FMEQ_C1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,N
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(C)) THEN
DO J = 1, SIZE(MA)
D = RUNKNO
C(J) = CMPLX(D,D , KIND(0.0D0))
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 FMM2DP(MTFM,D)
C(J) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1IM1
SUBROUTINE FMEQ_IM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), ALLOCATABLE, DIMENSION(:) :: TEMP
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL IMST2M(' UNKNOWN ',MTIM)
DO J = 1, SIZE(MA)
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(N))
CALL FMEQ_INDEX(TEMP)
DO J = 1, N
CALL IMEQ(MB(J)%MIM,TEMP(J)%MIM)
ENDDO
DO J = 1, N
CALL IMEQ(TEMP(J)%MIM,MA(J)%MIM)
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1IM1
SUBROUTINE FMEQ_IM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
CALL IMST2M(' UNKNOWN ',MTIM)
DO J = 1, SIZE(MA)
CALL IMEQ(MTIM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMREAL(MB(J)%MZM,MTFM)
CALL IMFM2I(MTFM,MA(J)%MIM)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM1ZM1
SUBROUTINE FMEQ_ZM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) 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,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MUFM)
CALL ZMCMPX(MUFM,MTFM,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_ZM1IM1
! (3) rank 2 = rank 0
SUBROUTINE FMEQ_IM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: IVAL,J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMI2M(IVAL,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_IM2I
SUBROUTINE FMEQ_IM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(R,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_IM2R
SUBROUTINE FMEQ_IM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(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_IM2D
SUBROUTINE FMEQ_IM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(REAL(Z),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_IM2Z
SUBROUTINE FMEQ_IM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),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_IM2C
SUBROUTINE FMEQ_I2IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K,L
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2I(MA%MIM,L)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = L
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2IM
SUBROUTINE FMEQ_R2IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2IM
SUBROUTINE FMEQ_D2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2DP(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_D2IM
SUBROUTINE FMEQ_Z2IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2IM
SUBROUTINE FMEQ_C2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMM2DP(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_C2IM
SUBROUTINE FMEQ_IM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMEQ(MB%MIM,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_IM2IM
SUBROUTINE FMEQ_IM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,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_IM2ZM
SUBROUTINE FMEQ_ZM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MUFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MUFM,MTFM,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_ZM2IM
! (4) rank 2 = rank 2
SUBROUTINE FMEQ_IM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,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 IMI2M(IVAL(J,K),MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2I2
SUBROUTINE FMEQ_IM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,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 FMSP2M(R(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_IM2R2
SUBROUTINE FMEQ_IM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(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_IM2D2
SUBROUTINE FMEQ_IM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,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 FMSP2M(REAL(Z(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_IM2Z2
SUBROUTINE FMEQ_IM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL IMFM2I(MTFM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2C2
SUBROUTINE FMEQ_I2IM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IVAL(J,K) = IUNKNO
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 IMM2I(MA(J,K)%MIM,IVAL(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2IM2
SUBROUTINE FMEQ_R2IM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
R(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 FMM2SP(MTFM,R(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2IM2
SUBROUTINE FMEQ_D2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MTFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D2IM2
SUBROUTINE FMEQ_Z2IM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
REAL :: R
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
Z(J,K) = CMPLX(RUNKNO,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 FMM2SP(MTFM,R)
Z(J,K) = CMPLX(R,0.0)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2IM2
SUBROUTINE FMEQ_C2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
REAL (KIND(0.0D0)) :: D
INTEGER :: J,K
INTENT (INOUT) :: C
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_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 , KIND(0.0D0))
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 FMM2DP(MTFM,D)
C(J,K) = CMPLX(D,0.0D0 , KIND(0.0D0))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C2IM2
SUBROUTINE FMEQ_IM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), ALLOCATABLE, DIMENSION(:,:) :: TEMP
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(SIZE(MA,DIM=1),SIZE(MA,DIM=2)))
CALL FMEQ_INDEX(TEMP)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(MB(J,K)%MIM,TEMP(J,K)%MIM)
ENDDO
ENDDO
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(TEMP(J,K)%MIM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2IM2
SUBROUTINE FMEQ_IM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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 ZMREAL(MB(J,K)%MZM,MTFM)
CALL IMFM2I(MTFM,MA(J,K)%MIM)
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_IM2ZM2
SUBROUTINE FMEQ_ZM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MUFM)
CALL ZMCMPX(MUFM,MTFM,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_ZM2IM2
! Array equal assignments for ZM.
! (1) rank 1 = rank 0
SUBROUTINE FMEQ_ZM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: IVAL,J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL ZMI2M(IVAL,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_ZM1I
SUBROUTINE FMEQ_ZM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMSP2M(R,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_ZM1R
SUBROUTINE FMEQ_ZM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(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_ZM1D
SUBROUTINE FMEQ_ZM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_ZM1Z
SUBROUTINE FMEQ_ZM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
D = AIMAG(C)
CALL FMDP2M(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_ZM1C
SUBROUTINE FMEQ_I1ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,K,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
CALL ZMM2I(MA%MZM,K)
DO J = 1, N
IVAL(J) = K
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1ZM
SUBROUTINE FMEQ_R1ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
REAL :: R2
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, N
R(J) = R2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1ZM
SUBROUTINE FMEQ_D1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,N
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
DO J = 1, N
D(J) = D2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1ZM
SUBROUTINE FMEQ_Z1ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
COMPLEX :: Z2
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL ZMM2Z(MA%MZM,Z2)
DO J = 1, N
Z(J) = Z2
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1ZM
SUBROUTINE FMEQ_C1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D2)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D3)
DO J = 1, N
C(J) = CMPLX(D2,D3, KIND(0.0D0))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1ZM
SUBROUTINE FMEQ_ZM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL ZMEQ(MB%MZM,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_ZM1ZM
! (2) rank 1 = rank 1
SUBROUTINE FMEQ_ZM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(IVAL)) 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 ZMI2M(IVAL(J),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_ZM1I1
SUBROUTINE FMEQ_ZM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(R)) 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 FMSP2M(R(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_ZM1R1
SUBROUTINE FMEQ_ZM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(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_ZM1D1
SUBROUTINE FMEQ_ZM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA) /= SIZE(Z)) 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 ZMZ2M(Z(J),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_ZM1Z1
SUBROUTINE FMEQ_ZM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
DOUBLE PRECISION :: 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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
D = AIMAG(C(J))
CALL FMDP2M(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_ZM1C1
SUBROUTINE FMEQ_I1ZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
IVAL(J) = IUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL ZMM2I(MA(J)%MZM,IVAL(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I1ZM1
SUBROUTINE FMEQ_R1ZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
INTEGER :: J,N
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
R(J) = RUNKNO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL ZMREAL(MA(J)%MZM,MTFM)
CALL FMM2SP(MTFM,R(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R1ZM1
SUBROUTINE FMEQ_D1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MTFM,D(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D1ZM1
SUBROUTINE FMEQ_Z1ZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
INTEGER :: J,N
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
Z(J) = CMPLX(RUNKNO,RUNKNO)
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL ZMM2Z(MA(J)%MZM,Z(J))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z1ZM1
SUBROUTINE FMEQ_C1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
REAL (KIND(0.0D0)) :: 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 , KIND(0.0D0))
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 FMM2DP(MTFM,D1)
CALL ZMIMAG(MA(J)%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
C(J) = CMPLX(D1,D2 , KIND(0.0D0))
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C1ZM1
SUBROUTINE FMEQ_ZM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), ALLOCATABLE, DIMENSION(:) :: TEMP
INTEGER :: J,N
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) 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)
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(N))
CALL FMEQ_INDEX(TEMP)
DO J = 1, N
CALL ZMEQ(MB(J)%MZM,TEMP(J)%MZM)
ENDDO
DO J = 1, N
CALL ZMEQ(TEMP(J)%MZM,MA(J)%MZM)
IF (TEMPV(MA(J)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J)%MZM(1)) = -2
TEMPV(MA(J)%MZM(2)) = -2
ENDIF
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM1ZM1
! (3) rank 2 = rank 0
SUBROUTINE FMEQ_ZM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: IVAL,J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMI2M(IVAL,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_ZM2I
SUBROUTINE FMEQ_ZM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(R,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_ZM2R
SUBROUTINE FMEQ_ZM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(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_ZM2D
SUBROUTINE FMEQ_ZM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMZ2M(Z,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_ZM2Z
SUBROUTINE FMEQ_ZM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
DOUBLE PRECISION :: D
INTENT (INOUT) :: MA
INTENT (IN) :: C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
D = AIMAG(C)
CALL FMDP2M(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_ZM2C
SUBROUTINE FMEQ_I2ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K,L
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2I(MA%MZM,L)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
IVAL(J,K) = L
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2ZM
SUBROUTINE FMEQ_R2ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
REAL :: R2
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2SP(MTFM,R2)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
R(J,K) = R2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2ZM
SUBROUTINE FMEQ_D2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
DOUBLE PRECISION :: D2
INTEGER :: J,K
INTENT (INOUT) :: D
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMM2DP(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_D2ZM
SUBROUTINE FMEQ_Z2ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
COMPLEX :: Z2
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2Z(MA%MZM,Z2)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
Z(J,K) = Z2
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2ZM
SUBROUTINE FMEQ_C2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
DOUBLE PRECISION :: 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 FMM2DP(MTFM,D2)
CALL ZMIMAG(MA%MZM,MTFM)
CALL FMM2DP(MTFM,D3)
DO J = 1, SIZE(C,DIM=1)
DO K = 1, SIZE(C,DIM=2)
C(J,K) = CMPLX(D2,D3, KIND(0.0D0))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C2ZM
SUBROUTINE FMEQ_ZM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMEQ(MB%MZM,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_ZM2ZM
! (4) rank 2 = rank 2
SUBROUTINE FMEQ_ZM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,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 ZMI2M(IVAL(J,K),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_ZM2I2
SUBROUTINE FMEQ_ZM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (INOUT) :: MA
INTENT (IN) :: R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,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 FMSP2M(R(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_ZM2R2
SUBROUTINE FMEQ_ZM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (INOUT) :: MA
INTENT (IN) :: D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(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 FMDP2M(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_ZM2D2
SUBROUTINE FMEQ_ZM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (INOUT) :: MA
INTENT (IN) :: Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,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 ZMZ2M(Z(J,K),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_ZM2Z2
SUBROUTINE FMEQ_ZM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
DOUBLE PRECISION :: 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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
D = AIMAG(C(J,K))
CALL FMDP2M(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_ZM2C2
SUBROUTINE FMEQ_I2ZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (INOUT) :: IVAL
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
IVAL(J,K) = IUNKNO
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 ZMM2I(MA(J,K)%MZM,IVAL(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_I2ZM2
SUBROUTINE FMEQ_R2ZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
INTEGER :: J,K
INTENT (INOUT) :: R
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
R(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 FMM2SP(MTFM,R(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_R2ZM2
SUBROUTINE FMEQ_D2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, 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 FMM2DP(MTFM,D(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_D2ZM2
SUBROUTINE FMEQ_Z2ZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
INTEGER :: J,K
INTENT (INOUT) :: Z
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
Z(J,K) = CMPLX(RUNKNO,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 ZMM2Z(MA(J,K)%MZM,Z(J,K))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_Z2ZM2
SUBROUTINE FMEQ_C2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
REAL (KIND(0.0D0)) :: 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 , KIND(0.0D0))
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 FMM2DP(MTFM,D1)
CALL ZMIMAG(MA(J,K)%MZM,MTFM)
CALL FMM2DP(MTFM,D2)
C(J,K) = CMPLX(D1,D2 , KIND(0.0D0))
ENDDO
ENDDO
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_C2ZM2
SUBROUTINE FMEQ_ZM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), ALLOCATABLE, DIMENSION(:,:) :: TEMP
INTEGER :: J,K
INTENT (INOUT) :: MA
INTENT (IN) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
CALL 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
! To avoid problems when lhs and rhs are overlapping parts of the same array, move MB
! to a temporary array before re-defining any of MA.
ALLOCATE(TEMP(SIZE(MA,DIM=1),SIZE(MA,DIM=2)))
CALL FMEQ_INDEX(TEMP)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MB(J,K)%MZM,TEMP(J,K)%MZM)
ENDDO
ENDDO
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(TEMP(J,K)%MZM,MA(J,K)%MZM)
IF (TEMPV(MA(J,K)%MZM(1))==-1 .AND. .NOT.IN_USER_FUNCTION) THEN
TEMPV(MA(J,K)%MZM(1)) = -2
TEMPV(MA(J,K)%MZM(2)) = -2
ENDIF
ENDDO
ENDDO
CALL FM_DEALLOCATE(TEMP)
DEALLOCATE(TEMP)
CALL FMEQ_TEMP
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FMEQ_ZM2ZM2
! ==
FUNCTION FMLEQ_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLEQ_IFM = FMCOMP(MTFM,'EQ',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IFM
FUNCTION FMLEQ_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLEQ_IIM = IMCOMP(MTIM,'EQ',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IIM
FUNCTION FMLEQ_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_IZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IZM
FUNCTION FMLEQ_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLEQ_RFM = FMCOMP(MTFM,'EQ',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_RFM
FUNCTION FMLEQ_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_RIM = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_RIM
FUNCTION FMLEQ_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_RZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_RZM
FUNCTION FMLEQ_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLEQ_DFM = FMCOMP(MTFM,'EQ',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DFM
FUNCTION FMLEQ_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_DIM = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DIM
FUNCTION FMLEQ_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_DZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_DZM
FUNCTION FMLEQ_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(REAL(Z),MTFM)
L1 = FMCOMP(MTFM,'EQ',MA%MFM)
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_ZFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZFM
FUNCTION FMLEQ_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX :: Z
INTEGER :: KA,NDSAVE
INTENT (IN) :: Z,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 FMSP2M(REAL(Z),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_ZIM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZIM
FUNCTION FMLEQ_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMREAL(MTZM,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL ZMIMAG(MTZM,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZZM
FUNCTION FMLEQ_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_CFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
L1 = FMCOMP(MTFM,'EQ',MA%MFM)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_CFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_CFM
FUNCTION FMLEQ_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_CIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: 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 FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_CIM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_CIM
FUNCTION FMLEQ_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_CZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMDP2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_CZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_CZM
FUNCTION FMLEQ_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLEQ_FMI = FMCOMP(MA%MFM,'EQ',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMI
FUNCTION FMLEQ_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLEQ_FMR = FMCOMP(MA%MFM,'EQ',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMR
FUNCTION FMLEQ_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLEQ_FMD = FMCOMP(MA%MFM,'EQ',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMD
FUNCTION FMLEQ_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(REAL(Z),MTFM)
L1 = FMCOMP(MA%MFM,'EQ',MTFM)
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_FMZ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMZ
FUNCTION FMLEQ_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
L1 = FMCOMP(MA%MFM,'EQ',MTFM)
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_FMC = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMC
FUNCTION FMLEQ_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLEQ_FMFM = FMCOMP(MA%MFM,'EQ',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMFM
FUNCTION FMLEQ_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT(MA%MFM,MTFM)
IF (FMCOMP(MA%MFM,'EQ',MTFM)) THEN
CALL IMI2FM(MB%MIM,MTFM)
FMLEQ_FMIM = FMCOMP(MA%MFM,'EQ',MTFM)
ELSE
FMLEQ_FMIM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMIM
FUNCTION FMLEQ_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_FMZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MTFM)
L1 = FMCOMP(MA%MFM,'EQ',MTFM)
L2 = .TRUE.
IF (MWK(START(MB%MZM(2))+3) /= 0) L2 = .FALSE.
FMLEQ_FMZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_FMZM
FUNCTION FMLEQ_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLEQ_IMI = IMCOMP(MA%MIM,'EQ',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMI
FUNCTION FMLEQ_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_IMR = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMR
FUNCTION FMLEQ_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_IMD = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMD
FUNCTION FMLEQ_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX :: Z
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,Z
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 FMSP2M(REAL(Z),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(Z) /= 0.0) L2 = .FALSE.
FMLEQ_IMZ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMZ
FUNCTION FMLEQ_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: 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 FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'EQ',MTFM)
NDIG = NDSAVE
L2 = .TRUE.
IF (AIMAG(C) /= 0.0) L2 = .FALSE.
FMLEQ_IMC = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMC
FUNCTION FMLEQ_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT(MB%MFM,MTFM)
IF (FMCOMP(MB%MFM,'EQ',MTFM)) THEN
CALL IMI2FM(MA%MIM,MTFM)
FMLEQ_IMFM = FMCOMP(MB%MFM,'EQ',MTFM)
ELSE
FMLEQ_IMFM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMFM
FUNCTION FMLEQ_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLEQ_IMIM = IMCOMP(MA%MIM,'EQ',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMIM
FUNCTION FMLEQ_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_IMZM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MB%MZM(2))+3) == 0) THEN
CALL IMI2FM(MA%MIM,MUFM)
FMLEQ_IMZM = FMCOMP(MUFM,'EQ',MTFM)
ELSE
FMLEQ_IMZM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_IMZM
FUNCTION FMLEQ_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MA%MZM(2))+3) == 0) THEN
CALL FMI2M(IVAL,MUFM)
FMLEQ_ZMI = FMCOMP(MTFM,'EQ',MUFM)
ELSE
FMLEQ_ZMI = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMI
FUNCTION FMLEQ_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMR,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZMR = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMR
FUNCTION FMLEQ_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMD,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZMD = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMD
FUNCTION FMLEQ_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMREAL(MTZM,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL ZMIMAG(MTZM,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZMZ = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMZ
FUNCTION FMLEQ_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL FMDP2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZMC = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMC
FUNCTION FMLEQ_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
L1 = FMCOMP(MB%MFM,'EQ',MTFM)
L2 = .TRUE.
IF (MWK(START(MA%MZM(2))+3) /= 0) L2 = .FALSE.
FMLEQ_ZMFM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMFM
FUNCTION FMLEQ_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MA%MZM(2))+3) == 0) THEN
CALL IMI2FM(MB%MIM,MUFM)
FMLEQ_ZMIM = FMCOMP(MUFM,'EQ',MTFM)
ELSE
FMLEQ_ZMIM = .FALSE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMIM
FUNCTION FMLEQ_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLEQ_ZMZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
CALL ZMREAL(MB%MZM,MUFM)
L1 = FMCOMP(MTFM,'EQ',MUFM)
CALL ZMIMAG(MA%MZM,MTFM)
CALL ZMIMAG(MB%MZM,MUFM)
L2 = FMCOMP(MTFM,'EQ',MUFM)
FMLEQ_ZMZM = L1.AND.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLEQ_ZMZM
END MODULE FMZM_2
MODULE FMZM_3
USE FMZM_1
INTERFACE OPERATOR (/=)
MODULE PROCEDURE FMLNE_IFM
MODULE PROCEDURE FMLNE_IIM
MODULE PROCEDURE FMLNE_IZM
MODULE PROCEDURE FMLNE_RFM
MODULE PROCEDURE FMLNE_RIM
MODULE PROCEDURE FMLNE_RZM
MODULE PROCEDURE FMLNE_DFM
MODULE PROCEDURE FMLNE_DIM
MODULE PROCEDURE FMLNE_DZM
MODULE PROCEDURE FMLNE_ZFM
MODULE PROCEDURE FMLNE_ZIM
MODULE PROCEDURE FMLNE_ZZM
MODULE PROCEDURE FMLNE_CFM
MODULE PROCEDURE FMLNE_CIM
MODULE PROCEDURE FMLNE_CZM
MODULE PROCEDURE FMLNE_FMI
MODULE PROCEDURE FMLNE_FMR
MODULE PROCEDURE FMLNE_FMD
MODULE PROCEDURE FMLNE_FMZ
MODULE PROCEDURE FMLNE_FMC
MODULE PROCEDURE FMLNE_FMFM
MODULE PROCEDURE FMLNE_FMIM
MODULE PROCEDURE FMLNE_FMZM
MODULE PROCEDURE FMLNE_IMI
MODULE PROCEDURE FMLNE_IMR
MODULE PROCEDURE FMLNE_IMD
MODULE PROCEDURE FMLNE_IMZ
MODULE PROCEDURE FMLNE_IMC
MODULE PROCEDURE FMLNE_IMFM
MODULE PROCEDURE FMLNE_IMIM
MODULE PROCEDURE FMLNE_IMZM
MODULE PROCEDURE FMLNE_ZMI
MODULE PROCEDURE FMLNE_ZMR
MODULE PROCEDURE FMLNE_ZMD
MODULE PROCEDURE FMLNE_ZMZ
MODULE PROCEDURE FMLNE_ZMC
MODULE PROCEDURE FMLNE_ZMFM
MODULE PROCEDURE FMLNE_ZMIM
MODULE PROCEDURE FMLNE_ZMZM
END INTERFACE
INTERFACE OPERATOR (>)
MODULE PROCEDURE FMLGT_IFM
MODULE PROCEDURE FMLGT_IIM
MODULE PROCEDURE FMLGT_RFM
MODULE PROCEDURE FMLGT_RIM
MODULE PROCEDURE FMLGT_DFM
MODULE PROCEDURE FMLGT_DIM
MODULE PROCEDURE FMLGT_FMI
MODULE PROCEDURE FMLGT_FMR
MODULE PROCEDURE FMLGT_FMD
MODULE PROCEDURE FMLGT_FMFM
MODULE PROCEDURE FMLGT_FMIM
MODULE PROCEDURE FMLGT_IMI
MODULE PROCEDURE FMLGT_IMR
MODULE PROCEDURE FMLGT_IMD
MODULE PROCEDURE FMLGT_IMFM
MODULE PROCEDURE FMLGT_IMIM
END INTERFACE
INTERFACE OPERATOR (>=)
MODULE PROCEDURE FMLGE_IFM
MODULE PROCEDURE FMLGE_IIM
MODULE PROCEDURE FMLGE_RFM
MODULE PROCEDURE FMLGE_RIM
MODULE PROCEDURE FMLGE_DFM
MODULE PROCEDURE FMLGE_DIM
MODULE PROCEDURE FMLGE_FMI
MODULE PROCEDURE FMLGE_FMR
MODULE PROCEDURE FMLGE_FMD
MODULE PROCEDURE FMLGE_FMFM
MODULE PROCEDURE FMLGE_FMIM
MODULE PROCEDURE FMLGE_IMI
MODULE PROCEDURE FMLGE_IMR
MODULE PROCEDURE FMLGE_IMD
MODULE PROCEDURE FMLGE_IMFM
MODULE PROCEDURE FMLGE_IMIM
END INTERFACE
INTERFACE OPERATOR (<)
MODULE PROCEDURE FMLLT_IFM
MODULE PROCEDURE FMLLT_IIM
MODULE PROCEDURE FMLLT_RFM
MODULE PROCEDURE FMLLT_RIM
MODULE PROCEDURE FMLLT_DFM
MODULE PROCEDURE FMLLT_DIM
MODULE PROCEDURE FMLLT_FMI
MODULE PROCEDURE FMLLT_FMR
MODULE PROCEDURE FMLLT_FMD
MODULE PROCEDURE FMLLT_FMFM
MODULE PROCEDURE FMLLT_FMIM
MODULE PROCEDURE FMLLT_IMI
MODULE PROCEDURE FMLLT_IMR
MODULE PROCEDURE FMLLT_IMD
MODULE PROCEDURE FMLLT_IMFM
MODULE PROCEDURE FMLLT_IMIM
END INTERFACE
INTERFACE OPERATOR (<=)
MODULE PROCEDURE FMLLE_IFM
MODULE PROCEDURE FMLLE_IIM
MODULE PROCEDURE FMLLE_RFM
MODULE PROCEDURE FMLLE_RIM
MODULE PROCEDURE FMLLE_DFM
MODULE PROCEDURE FMLLE_DIM
MODULE PROCEDURE FMLLE_FMI
MODULE PROCEDURE FMLLE_FMR
MODULE PROCEDURE FMLLE_FMD
MODULE PROCEDURE FMLLE_FMFM
MODULE PROCEDURE FMLLE_FMIM
MODULE PROCEDURE FMLLE_IMI
MODULE PROCEDURE FMLLE_IMR
MODULE PROCEDURE FMLLE_IMD
MODULE PROCEDURE FMLLE_IMFM
MODULE PROCEDURE FMLLE_IMIM
END INTERFACE
CONTAINS
! /=
FUNCTION FMLNE_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLNE_IFM = FMCOMP(MTFM,'NE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IFM
FUNCTION FMLNE_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLNE_IIM = IMCOMP(MTIM,'NE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IIM
FUNCTION FMLNE_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_IZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IZM
FUNCTION FMLNE_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLNE_RFM = FMCOMP(MTFM,'NE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_RFM
FUNCTION FMLNE_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
REAL :: R
INTEGER :: KA,NDSAVE
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_RIM = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_RIM
FUNCTION FMLNE_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_RZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_RZM
FUNCTION FMLNE_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLNE_DFM = FMCOMP(MTFM,'NE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DFM
FUNCTION FMLNE_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_DIM = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DIM
FUNCTION FMLNE_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_DZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_DZM
FUNCTION FMLNE_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(REAL(Z),MTFM)
L1 = FMCOMP(MTFM,'NE',MA%MFM)
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_ZFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZFM
FUNCTION FMLNE_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
COMPLEX :: Z
INTENT (IN) :: Z,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 FMSP2M(REAL(Z),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_ZIM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZIM
FUNCTION FMLNE_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMREAL(MTZM,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL ZMIMAG(MTZM,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZZM
FUNCTION FMLNE_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_CFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
L1 = FMCOMP(MTFM,'NE',MA%MFM)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_CFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_CFM
FUNCTION FMLNE_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_CIM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: 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 FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_CIM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_CIM
FUNCTION FMLNE_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_CZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMDP2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_CZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_CZM
FUNCTION FMLNE_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLNE_FMI = FMCOMP(MA%MFM,'NE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMI
FUNCTION FMLNE_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLNE_FMR = FMCOMP(MA%MFM,'NE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMR
FUNCTION FMLNE_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLNE_FMD = FMCOMP(MA%MFM,'NE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMD
FUNCTION FMLNE_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(REAL(Z),MTFM)
L1 = FMCOMP(MA%MFM,'NE',MTFM)
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_FMZ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMZ
FUNCTION FMLNE_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
L1 = FMCOMP(MA%MFM,'NE',MTFM)
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_FMC = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMC
FUNCTION FMLNE_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLNE_FMFM = FMCOMP(MA%MFM,'NE',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMFM
FUNCTION FMLNE_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT(MA%MFM,MTFM)
IF (FMCOMP(MA%MFM,'EQ',MTFM)) THEN
CALL IMI2FM(MB%MIM,MTFM)
FMLNE_FMIM = FMCOMP(MA%MFM,'NE',MTFM)
ELSE
FMLNE_FMIM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMIM
FUNCTION FMLNE_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_FMZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MTFM)
L1 = FMCOMP(MA%MFM,'NE',MTFM)
L2 = .FALSE.
IF (MWK(START(MB%MZM(2))+3) /= 0) L2 = .TRUE.
FMLNE_FMZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_FMZM
FUNCTION FMLNE_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLNE_IMI = IMCOMP(MA%MIM,'NE',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMI
FUNCTION FMLNE_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_IMR = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMR
FUNCTION FMLNE_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_IMD = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMD
FUNCTION FMLNE_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
COMPLEX :: Z
INTENT (IN) :: MA,Z
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 FMSP2M(REAL(Z),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(Z) /= 0.0) L2 = .TRUE.
FMLNE_IMZ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMZ
FUNCTION FMLNE_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: 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 FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL IMI2FM(MA%MIM,MUFM)
L1 = FMCOMP(MUFM,'NE',MTFM)
NDIG = NDSAVE
L2 = .FALSE.
IF (AIMAG(C) /= 0.0) L2 = .TRUE.
FMLNE_IMC = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMC
FUNCTION FMLNE_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMINT(MB%MFM,MTFM)
IF (FMCOMP(MB%MFM,'EQ',MTFM)) THEN
CALL IMI2FM(MA%MIM,MTFM)
FMLNE_IMFM = FMCOMP(MB%MFM,'NE',MTFM)
ELSE
FMLNE_IMFM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMFM
FUNCTION FMLNE_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLNE_IMIM = IMCOMP(MA%MIM,'NE',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMIM
FUNCTION FMLNE_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_IMZM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (ZM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MB%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MB%MZM(2))+3) == 0) THEN
CALL IMI2FM(MA%MIM,MUFM)
FMLNE_IMZM = FMCOMP(MUFM,'NE',MTFM)
ELSE
FMLNE_IMZM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_IMZM
FUNCTION FMLNE_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MA%MZM(2))+3) == 0) THEN
CALL FMI2M(IVAL,MUFM)
FMLNE_ZMI = FMCOMP(MTFM,'NE',MUFM)
ELSE
FMLNE_ZMI = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMI
FUNCTION FMLNE_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMR,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZMR = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMR
FUNCTION FMLNE_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMD,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZMD = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMD
FUNCTION FMLNE_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMZ,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMREAL(MTZM,MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL ZMIMAG(MTZM,MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZMZ = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMZ
FUNCTION FMLNE_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMC,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL ZMREAL(MA%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL FMDP2M(AIMAG(C),MTFM)
CALL ZMIMAG(MA%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZMC = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMC
FUNCTION FMLNE_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMFM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
L1 = FMCOMP(MB%MFM,'NE',MTFM)
L2 = .FALSE.
IF (MWK(START(MA%MZM(2))+3) /= 0) L2 = .TRUE.
FMLNE_ZMFM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMFM
FUNCTION FMLNE_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MB
TYPE (ZM) :: MA
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
IF (FMCOMP(MUFM,'EQ',MTFM).AND.MWK(START(MA%MZM(2))+3) == 0) THEN
CALL IMI2FM(MB%MIM,MUFM)
FMLNE_ZMIM = FMCOMP(MUFM,'NE',MTFM)
ELSE
FMLNE_ZMIM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMIM
FUNCTION FMLNE_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLNE_ZMZM,L1,L2
LOGICAL, EXTERNAL :: FMCOMP
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMREAL(MA%MZM,MTFM)
CALL ZMREAL(MB%MZM,MUFM)
L1 = FMCOMP(MTFM,'NE',MUFM)
CALL ZMIMAG(MA%MZM,MTFM)
CALL ZMIMAG(MB%MZM,MUFM)
L2 = FMCOMP(MTFM,'NE',MUFM)
FMLNE_ZMZM = L1.OR.L2
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLNE_ZMZM
! >
FUNCTION FMLGT_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLGT_IFM = FMCOMP(MTFM,'GT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IFM
FUNCTION FMLGT_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLGT_IIM = IMCOMP(MTIM,'GT',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IIM
FUNCTION FMLGT_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLGT_RFM = FMCOMP(MTFM,'GT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_RFM
FUNCTION FMLGT_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_RIM = FMCOMP(MTFM,'GT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_RIM
FUNCTION FMLGT_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLGT_DFM = FMCOMP(MTFM,'GT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_DFM
FUNCTION FMLGT_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_DIM = FMCOMP(MTFM,'GT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_DIM
FUNCTION FMLGT_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLGT_FMI = FMCOMP(MA%MFM,'GT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMI
FUNCTION FMLGT_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLGT_FMR = FMCOMP(MA%MFM,'GT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMR
FUNCTION FMLGT_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLGT_FMD = FMCOMP(MA%MFM,'GT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMD
FUNCTION FMLGT_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGT_FMFM = FMCOMP(MA%MFM,'GT',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMFM
FUNCTION FMLGT_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MB%MIM,MTFM)
FMLGT_FMIM = FMCOMP(MA%MFM,'GT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_FMIM
FUNCTION FMLGT_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLGT_IMI = IMCOMP(MA%MIM,'GT',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMI
FUNCTION FMLGT_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_IMR = FMCOMP(MUFM,'GT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMR
FUNCTION FMLGT_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGT_IMD = FMCOMP(MUFM,'GT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMD
FUNCTION FMLGT_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MA%MIM,MTFM)
FMLGT_IMFM = FMCOMP(MTFM,'GT',MB%MFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMFM
FUNCTION FMLGT_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGT_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGT_IMIM = IMCOMP(MA%MIM,'GT',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGT_IMIM
! >=
FUNCTION FMLGE_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLGE_IFM = FMCOMP(MTFM,'GE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IFM
FUNCTION FMLGE_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLGE_IIM = IMCOMP(MTIM,'GE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IIM
FUNCTION FMLGE_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLGE_RFM = FMCOMP(MTFM,'GE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_RFM
FUNCTION FMLGE_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_RIM = FMCOMP(MTFM,'GE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_RIM
FUNCTION FMLGE_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLGE_DFM = FMCOMP(MTFM,'GE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_DFM
FUNCTION FMLGE_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_DIM = FMCOMP(MTFM,'GE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_DIM
FUNCTION FMLGE_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLGE_FMI = FMCOMP(MA%MFM,'GE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMI
FUNCTION FMLGE_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLGE_FMR = FMCOMP(MA%MFM,'GE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMR
FUNCTION FMLGE_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLGE_FMD = FMCOMP(MA%MFM,'GE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMD
FUNCTION FMLGE_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGE_FMFM = FMCOMP(MA%MFM,'GE',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMFM
FUNCTION FMLGE_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MB%MIM,MTFM)
FMLGE_FMIM = FMCOMP(MA%MFM,'GE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_FMIM
FUNCTION FMLGE_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLGE_IMI = IMCOMP(MA%MIM,'GE',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMI
FUNCTION FMLGE_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_IMR = FMCOMP(MUFM,'GE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMR
FUNCTION FMLGE_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLGE_IMD = FMCOMP(MUFM,'GE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMD
FUNCTION FMLGE_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MA%MIM,MTFM)
FMLGE_IMFM = FMCOMP(MTFM,'GE',MB%MFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMFM
FUNCTION FMLGE_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLGE_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLGE_IMIM = IMCOMP(MA%MIM,'GE',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLGE_IMIM
! <
FUNCTION FMLLT_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLLT_IFM = FMCOMP(MTFM,'LT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IFM
FUNCTION FMLLT_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLLT_IIM = IMCOMP(MTIM,'LT',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IIM
FUNCTION FMLLT_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLLT_RFM = FMCOMP(MTFM,'LT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_RFM
FUNCTION FMLLT_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_RIM = FMCOMP(MTFM,'LT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_RIM
FUNCTION FMLLT_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLLT_DFM = FMCOMP(MTFM,'LT',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_DFM
FUNCTION FMLLT_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_DIM = FMCOMP(MTFM,'LT',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_DIM
FUNCTION FMLLT_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLLT_FMI = FMCOMP(MA%MFM,'LT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMI
FUNCTION FMLLT_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLLT_FMR = FMCOMP(MA%MFM,'LT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMR
FUNCTION FMLLT_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLLT_FMD = FMCOMP(MA%MFM,'LT',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMD
FUNCTION FMLLT_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLT_FMFM = FMCOMP(MA%MFM,'LT',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMFM
FUNCTION FMLLT_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MB%MIM,MTFM)
FMLLT_FMIM = FMCOMP(MA%MFM,'LT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_FMIM
FUNCTION FMLLT_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLLT_IMI = IMCOMP(MA%MIM,'LT',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMI
FUNCTION FMLLT_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_IMR = FMCOMP(MUFM,'LT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMR
FUNCTION FMLLT_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLT_IMD = FMCOMP(MUFM,'LT',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMD
FUNCTION FMLLT_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MA%MIM,MTFM)
FMLLT_IMFM = FMCOMP(MTFM,'LT',MB%MFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMFM
FUNCTION FMLLT_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLT_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLT_IMIM = IMCOMP(MA%MIM,'LT',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLT_IMIM
! <=
FUNCTION FMLLE_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLLE_IFM = FMCOMP(MTFM,'LE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IFM
FUNCTION FMLLE_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLLE_IIM = IMCOMP(MTIM,'LE',MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IIM
FUNCTION FMLLE_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_RFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLLE_RFM = FMCOMP(MTFM,'LE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_RFM
FUNCTION FMLLE_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_RIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: R,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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_RIM = FMCOMP(MTFM,'LE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_RIM
FUNCTION FMLLE_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_DFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLLE_DFM = FMCOMP(MTFM,'LE',MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_DFM
FUNCTION FMLLE_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_DIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_DIM = FMCOMP(MTFM,'LE',MUFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_DIM
FUNCTION FMLLE_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMI
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
FMLLE_FMI = FMCOMP(MA%MFM,'LE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMI
FUNCTION FMLLE_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
FMLLE_FMR = FMCOMP(MA%MFM,'LE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMR
FUNCTION FMLLE_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
FMLLE_FMD = FMCOMP(MA%MFM,'LE',MTFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMD
FUNCTION FMLLE_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLE_FMFM = FMCOMP(MA%MFM,'LE',MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMFM
FUNCTION FMLLE_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_FMIM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA
TYPE (IM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MB%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MB%MIM,MTFM)
FMLLE_FMIM = FMCOMP(MA%MFM,'LE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_FMIM
FUNCTION FMLLE_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMI
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
FMLLE_IMI = IMCOMP(MA%MIM,'LE',MTIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMI
FUNCTION FMLLE_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMR
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
INTEGER :: KA,NDSAVE
REAL :: R
INTENT (IN) :: MA,R
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 FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_IMR = FMCOMP(MUFM,'LE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMR
FUNCTION FMLLE_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMD
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
DOUBLE PRECISION :: 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 FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
FMLLE_IMD = FMCOMP(MUFM,'LE',MTFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMD
FUNCTION FMLLE_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMFM
LOGICAL, EXTERNAL :: FMCOMP
TYPE (IM) :: MA
TYPE (FM) :: MB
INTEGER :: KA,NDSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
NDSAVE = NDIG
KA = MWK(START(MA%MIM)+2)
NDIG = MAX(KA+NGRD52,NDIG)
CALL IMI2FM(MA%MIM,MTFM)
FMLLE_IMFM = FMCOMP(MTFM,'LE',MB%MFM)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMFM
FUNCTION FMLLE_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FMLLE_IMIM
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FMLLE_IMIM = IMCOMP(MA%MIM,'LE',MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLLE_IMIM
END MODULE FMZM_3
MODULE FMZM_4
USE FMZM_1
INTERFACE OPERATOR (+)
MODULE PROCEDURE FMADD_IFM
MODULE PROCEDURE FMADD_IIM
MODULE PROCEDURE FMADD_IZM
MODULE PROCEDURE FMADD_RFM
MODULE PROCEDURE FMADD_RIM
MODULE PROCEDURE FMADD_RZM
MODULE PROCEDURE FMADD_DFM
MODULE PROCEDURE FMADD_DIM
MODULE PROCEDURE FMADD_DZM
MODULE PROCEDURE FMADD_ZFM
MODULE PROCEDURE FMADD_ZIM
MODULE PROCEDURE FMADD_ZZM
MODULE PROCEDURE FMADD_CFM
MODULE PROCEDURE FMADD_CIM
MODULE PROCEDURE FMADD_CZM
MODULE PROCEDURE FMADD_FMI
MODULE PROCEDURE FMADD_FMR
MODULE PROCEDURE FMADD_FMD
MODULE PROCEDURE FMADD_FMZ
MODULE PROCEDURE FMADD_FMC
MODULE PROCEDURE FMADD_FMFM
MODULE PROCEDURE FMADD_FMIM
MODULE PROCEDURE FMADD_FMZM
MODULE PROCEDURE FMADD_IMI
MODULE PROCEDURE FMADD_IMR
MODULE PROCEDURE FMADD_IMD
MODULE PROCEDURE FMADD_IMZ
MODULE PROCEDURE FMADD_IMC
MODULE PROCEDURE FMADD_IMFM
MODULE PROCEDURE FMADD_IMIM
MODULE PROCEDURE FMADD_IMZM
MODULE PROCEDURE FMADD_ZMI
MODULE PROCEDURE FMADD_ZMR
MODULE PROCEDURE FMADD_ZMD
MODULE PROCEDURE FMADD_ZMZ
MODULE PROCEDURE FMADD_ZMC
MODULE PROCEDURE FMADD_ZMFM
MODULE PROCEDURE FMADD_ZMIM
MODULE PROCEDURE FMADD_ZMZM
MODULE PROCEDURE FMADD_FM
MODULE PROCEDURE FMADD_IM
MODULE PROCEDURE FMADD_ZM
MODULE PROCEDURE FMADD_IFM1
MODULE PROCEDURE FMADD_RFM1
MODULE PROCEDURE FMADD_DFM1
MODULE PROCEDURE FMADD_ZFM1
MODULE PROCEDURE FMADD_CFM1
MODULE PROCEDURE FMADD_FMI1
MODULE PROCEDURE FMADD_FMR1
MODULE PROCEDURE FMADD_FMD1
MODULE PROCEDURE FMADD_FMZ1
MODULE PROCEDURE FMADD_FMC1
MODULE PROCEDURE FMADD_FMFM1
MODULE PROCEDURE FMADD_IMFM1
MODULE PROCEDURE FMADD_ZMFM1
MODULE PROCEDURE FMADD_FMIM1
MODULE PROCEDURE FMADD_FMZM1
MODULE PROCEDURE FMADD_FM1I
MODULE PROCEDURE FMADD_FM1R
MODULE PROCEDURE FMADD_FM1D
MODULE PROCEDURE FMADD_FM1Z
MODULE PROCEDURE FMADD_FM1C
MODULE PROCEDURE FMADD_I1FM
MODULE PROCEDURE FMADD_R1FM
MODULE PROCEDURE FMADD_D1FM
MODULE PROCEDURE FMADD_Z1FM
MODULE PROCEDURE FMADD_C1FM
MODULE PROCEDURE FMADD_FM1FM
MODULE PROCEDURE FMADD_FM1IM
MODULE PROCEDURE FMADD_FM1ZM
MODULE PROCEDURE FMADD_IM1FM
MODULE PROCEDURE FMADD_ZM1FM
MODULE PROCEDURE FMADD_I1FM1
MODULE PROCEDURE FMADD_R1FM1
MODULE PROCEDURE FMADD_D1FM1
MODULE PROCEDURE FMADD_Z1FM1
MODULE PROCEDURE FMADD_C1FM1
MODULE PROCEDURE FMADD_FM1I1
MODULE PROCEDURE FMADD_FM1R1
MODULE PROCEDURE FMADD_FM1D1
MODULE PROCEDURE FMADD_FM1Z1
MODULE PROCEDURE FMADD_FM1C1
MODULE PROCEDURE FMADD_FM1FM1
MODULE PROCEDURE FMADD_IM1FM1
MODULE PROCEDURE FMADD_ZM1FM1
MODULE PROCEDURE FMADD_FM1IM1
MODULE PROCEDURE FMADD_FM1ZM1
MODULE PROCEDURE FMADD_IIM1
MODULE PROCEDURE FMADD_RIM1
MODULE PROCEDURE FMADD_DIM1
MODULE PROCEDURE FMADD_ZIM1
MODULE PROCEDURE FMADD_CIM1
MODULE PROCEDURE FMADD_IMI1
MODULE PROCEDURE FMADD_IMR1
MODULE PROCEDURE FMADD_IMD1
MODULE PROCEDURE FMADD_IMZ1
MODULE PROCEDURE FMADD_IMC1
MODULE PROCEDURE FMADD_IMIM1
MODULE PROCEDURE FMADD_ZMIM1
MODULE PROCEDURE FMADD_IMZM1
MODULE PROCEDURE FMADD_IM1I
MODULE PROCEDURE FMADD_IM1R
MODULE PROCEDURE FMADD_IM1D
MODULE PROCEDURE FMADD_IM1Z
MODULE PROCEDURE FMADD_IM1C
MODULE PROCEDURE FMADD_I1IM
MODULE PROCEDURE FMADD_R1IM
MODULE PROCEDURE FMADD_D1IM
MODULE PROCEDURE FMADD_Z1IM
MODULE PROCEDURE FMADD_C1IM
MODULE PROCEDURE FMADD_IM1IM
MODULE PROCEDURE FMADD_IM1ZM
MODULE PROCEDURE FMADD_ZM1IM
MODULE PROCEDURE FMADD_I1IM1
MODULE PROCEDURE FMADD_R1IM1
MODULE PROCEDURE FMADD_D1IM1
MODULE PROCEDURE FMADD_Z1IM1
MODULE PROCEDURE FMADD_C1IM1
MODULE PROCEDURE FMADD_IM1I1
MODULE PROCEDURE FMADD_IM1R1
MODULE PROCEDURE FMADD_IM1D1
MODULE PROCEDURE FMADD_IM1Z1
MODULE PROCEDURE FMADD_IM1C1
MODULE PROCEDURE FMADD_IM1IM1
MODULE PROCEDURE FMADD_ZM1IM1
MODULE PROCEDURE FMADD_IM1ZM1
MODULE PROCEDURE FMADD_IZM1
MODULE PROCEDURE FMADD_RZM1
MODULE PROCEDURE FMADD_DZM1
MODULE PROCEDURE FMADD_ZZM1
MODULE PROCEDURE FMADD_CZM1
MODULE PROCEDURE FMADD_ZMI1
MODULE PROCEDURE FMADD_ZMR1
MODULE PROCEDURE FMADD_ZMD1
MODULE PROCEDURE FMADD_ZMZ1
MODULE PROCEDURE FMADD_ZMC1
MODULE PROCEDURE FMADD_ZMZM1
MODULE PROCEDURE FMADD_ZM1I
MODULE PROCEDURE FMADD_ZM1R
MODULE PROCEDURE FMADD_ZM1D
MODULE PROCEDURE FMADD_ZM1Z
MODULE PROCEDURE FMADD_ZM1C
MODULE PROCEDURE FMADD_I1ZM
MODULE PROCEDURE FMADD_R1ZM
MODULE PROCEDURE FMADD_D1ZM
MODULE PROCEDURE FMADD_Z1ZM
MODULE PROCEDURE FMADD_C1ZM
MODULE PROCEDURE FMADD_ZM1ZM
MODULE PROCEDURE FMADD_I1ZM1
MODULE PROCEDURE FMADD_R1ZM1
MODULE PROCEDURE FMADD_D1ZM1
MODULE PROCEDURE FMADD_Z1ZM1
MODULE PROCEDURE FMADD_C1ZM1
MODULE PROCEDURE FMADD_ZM1I1
MODULE PROCEDURE FMADD_ZM1R1
MODULE PROCEDURE FMADD_ZM1D1
MODULE PROCEDURE FMADD_ZM1Z1
MODULE PROCEDURE FMADD_ZM1C1
MODULE PROCEDURE FMADD_ZM1ZM1
MODULE PROCEDURE FMADD_IFM2
MODULE PROCEDURE FMADD_RFM2
MODULE PROCEDURE FMADD_DFM2
MODULE PROCEDURE FMADD_ZFM2
MODULE PROCEDURE FMADD_CFM2
MODULE PROCEDURE FMADD_FMI2
MODULE PROCEDURE FMADD_FMR2
MODULE PROCEDURE FMADD_FMD2
MODULE PROCEDURE FMADD_FMZ2
MODULE PROCEDURE FMADD_FMC2
MODULE PROCEDURE FMADD_FMFM2
MODULE PROCEDURE FMADD_IMFM2
MODULE PROCEDURE FMADD_ZMFM2
MODULE PROCEDURE FMADD_FMIM2
MODULE PROCEDURE FMADD_FMZM2
MODULE PROCEDURE FMADD_FM2I
MODULE PROCEDURE FMADD_FM2R
MODULE PROCEDURE FMADD_FM2D
MODULE PROCEDURE FMADD_FM2Z
MODULE PROCEDURE FMADD_FM2C
MODULE PROCEDURE FMADD_I2FM
MODULE PROCEDURE FMADD_R2FM
MODULE PROCEDURE FMADD_D2FM
MODULE PROCEDURE FMADD_Z2FM
MODULE PROCEDURE FMADD_C2FM
MODULE PROCEDURE FMADD_FM2FM
MODULE PROCEDURE FMADD_FM2IM
MODULE PROCEDURE FMADD_FM2ZM
MODULE PROCEDURE FMADD_IM2FM
MODULE PROCEDURE FMADD_ZM2FM
MODULE PROCEDURE FMADD_I2FM2
MODULE PROCEDURE FMADD_R2FM2
MODULE PROCEDURE FMADD_D2FM2
MODULE PROCEDURE FMADD_Z2FM2
MODULE PROCEDURE FMADD_C2FM2
MODULE PROCEDURE FMADD_FM2I2
MODULE PROCEDURE FMADD_FM2R2
MODULE PROCEDURE FMADD_FM2D2
MODULE PROCEDURE FMADD_FM2Z2
MODULE PROCEDURE FMADD_FM2C2
MODULE PROCEDURE FMADD_FM2FM2
MODULE PROCEDURE FMADD_IM2FM2
MODULE PROCEDURE FMADD_ZM2FM2
MODULE PROCEDURE FMADD_FM2IM2
MODULE PROCEDURE FMADD_FM2ZM2
MODULE PROCEDURE FMADD_IIM2
MODULE PROCEDURE FMADD_RIM2
MODULE PROCEDURE FMADD_DIM2
MODULE PROCEDURE FMADD_ZIM2
MODULE PROCEDURE FMADD_CIM2
MODULE PROCEDURE FMADD_IMI2
MODULE PROCEDURE FMADD_IMR2
MODULE PROCEDURE FMADD_IMD2
MODULE PROCEDURE FMADD_IMZ2
MODULE PROCEDURE FMADD_IMC2
MODULE PROCEDURE FMADD_IMIM2
MODULE PROCEDURE FMADD_ZMIM2
MODULE PROCEDURE FMADD_IMZM2
MODULE PROCEDURE FMADD_IM2I
MODULE PROCEDURE FMADD_IM2R
MODULE PROCEDURE FMADD_IM2D
MODULE PROCEDURE FMADD_IM2Z
MODULE PROCEDURE FMADD_IM2C
MODULE PROCEDURE FMADD_I2IM
MODULE PROCEDURE FMADD_R2IM
MODULE PROCEDURE FMADD_D2IM
MODULE PROCEDURE FMADD_Z2IM
MODULE PROCEDURE FMADD_C2IM
MODULE PROCEDURE FMADD_IM2IM
MODULE PROCEDURE FMADD_IM2ZM
MODULE PROCEDURE FMADD_ZM2IM
MODULE PROCEDURE FMADD_I2IM2
MODULE PROCEDURE FMADD_R2IM2
MODULE PROCEDURE FMADD_D2IM2
MODULE PROCEDURE FMADD_Z2IM2
MODULE PROCEDURE FMADD_C2IM2
MODULE PROCEDURE FMADD_IM2I2
MODULE PROCEDURE FMADD_IM2R2
MODULE PROCEDURE FMADD_IM2D2
MODULE PROCEDURE FMADD_IM2Z2
MODULE PROCEDURE FMADD_IM2C2
MODULE PROCEDURE FMADD_IM2IM2
MODULE PROCEDURE FMADD_ZM2IM2
MODULE PROCEDURE FMADD_IM2ZM2
MODULE PROCEDURE FMADD_IZM2
MODULE PROCEDURE FMADD_RZM2
MODULE PROCEDURE FMADD_DZM2
MODULE PROCEDURE FMADD_ZZM2
MODULE PROCEDURE FMADD_CZM2
MODULE PROCEDURE FMADD_ZMI2
MODULE PROCEDURE FMADD_ZMR2
MODULE PROCEDURE FMADD_ZMD2
MODULE PROCEDURE FMADD_ZMZ2
MODULE PROCEDURE FMADD_ZMC2
MODULE PROCEDURE FMADD_ZMZM2
MODULE PROCEDURE FMADD_ZM2I
MODULE PROCEDURE FMADD_ZM2R
MODULE PROCEDURE FMADD_ZM2D
MODULE PROCEDURE FMADD_ZM2Z
MODULE PROCEDURE FMADD_ZM2C
MODULE PROCEDURE FMADD_I2ZM
MODULE PROCEDURE FMADD_R2ZM
MODULE PROCEDURE FMADD_D2ZM
MODULE PROCEDURE FMADD_Z2ZM
MODULE PROCEDURE FMADD_C2ZM
MODULE PROCEDURE FMADD_ZM2ZM
MODULE PROCEDURE FMADD_I2ZM2
MODULE PROCEDURE FMADD_R2ZM2
MODULE PROCEDURE FMADD_D2ZM2
MODULE PROCEDURE FMADD_Z2ZM2
MODULE PROCEDURE FMADD_C2ZM2
MODULE PROCEDURE FMADD_ZM2I2
MODULE PROCEDURE FMADD_ZM2R2
MODULE PROCEDURE FMADD_ZM2D2
MODULE PROCEDURE FMADD_ZM2Z2
MODULE PROCEDURE FMADD_ZM2C2
MODULE PROCEDURE FMADD_ZM2ZM2
MODULE PROCEDURE FMADD_FM1
MODULE PROCEDURE FMADD_IM1
MODULE PROCEDURE FMADD_ZM1
MODULE PROCEDURE FMADD_FM2
MODULE PROCEDURE FMADD_IM2
MODULE PROCEDURE FMADD_ZM2
END INTERFACE
CONTAINS
! +
FUNCTION FMADD_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_IFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IFM
FUNCTION FMADD_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMADD_IIM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_IIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IIM
FUNCTION FMADD_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_IZM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_IZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IZM
FUNCTION FMADD_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_RFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RFM
FUNCTION FMADD_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_RIM
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_RIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RIM
FUNCTION FMADD_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_RZM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_RZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RZM
FUNCTION FMADD_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_DFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DFM
FUNCTION FMADD_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_DIM
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_DIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIM
FUNCTION FMADD_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_DZM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_DZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DZM
FUNCTION FMADD_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_ZFM
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZFM
FUNCTION FMADD_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_ZIM
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZIM
FUNCTION FMADD_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZZM
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_ZZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZZM
FUNCTION FMADD_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_CFM
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_CFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CFM
FUNCTION FMADD_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_CIM
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CIM
FUNCTION FMADD_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_CZM
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_CZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CZM
FUNCTION FMADD_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMI
FUNCTION FMADD_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMR
FUNCTION FMADD_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMD
FUNCTION FMADD_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_FMZ
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZ
FUNCTION FMADD_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_FMC
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMC
FUNCTION FMADD_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMADD_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMADD(MA%MFM,MB%MFM,FMADD_FMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMFM
FUNCTION FMADD_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMIM
FUNCTION FMADD_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB,FMADD_FMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
CALL ZMADD(MTZM,MB%MZM,FMADD_FMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZM
FUNCTION FMADD_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMADD_IMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMI
FUNCTION FMADD_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_IMR
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MUFM,MTFM,FMADD_IMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMR
FUNCTION FMADD_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMADD_IMD
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMADD(MUFM,MTFM,FMADD_IMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMD
FUNCTION FMADD_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_IMZ
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZ
FUNCTION FMADD_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMADD_IMC
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMC
FUNCTION FMADD_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB,FMADD_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMADD(MTFM,MB%MFM,FMADD_IMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMFM
FUNCTION FMADD_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMADD_IMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMADD(MA%MIM,MB%MIM,FMADD_IMIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMIM
FUNCTION FMADD_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB,FMADD_IMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MUZM,MB%MZM,FMADD_IMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZM
FUNCTION FMADD_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMI
FUNCTION FMADD_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMR%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMR
FUNCTION FMADD_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMD%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMD
FUNCTION FMADD_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMZ
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZ
FUNCTION FMADD_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZMC
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMC
FUNCTION FMADD_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA,FMADD_ZMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMFM
FUNCTION FMADD_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA,FMADD_ZMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MA%MZM,MUZM,FMADD_ZMIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMIM
FUNCTION FMADD_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,FMADD_ZMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMADD(MA%MZM,MB%MZM,FMADD_ZMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZM
FUNCTION FMADD_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMADD_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,FMADD_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM
FUNCTION FMADD_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMADD_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,FMADD_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM
FUNCTION FMADD_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMADD_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEQ(MA%MZM,FMADD_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM
! Array addition operations for FM.
! (1) rank 0 + rank 1
FUNCTION FMADD_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_IFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MA(J)%MFM,FMADD_IFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IFM1
FUNCTION FMADD_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_RFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MA(J)%MFM,FMADD_RFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RFM1
FUNCTION FMADD_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MA(J)%MFM,FMADD_DFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DFM1
FUNCTION FMADD_ZFM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZFM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZFM1%MZM(1) = -1
FMADD_ZFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_ZFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZFM1
FUNCTION FMADD_CFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_CFM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CFM1%MZM(1) = -1
FMADD_CFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CFM1
FUNCTION FMADD_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMADD_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_FMI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMI1
FUNCTION FMADD_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_FMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMR1
FUNCTION FMADD_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_FMD1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMD1
FUNCTION FMADD_FMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_FMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_FMZ1%MZM(1) = -1
FMADD_FMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZ1
FUNCTION FMADD_FMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_FMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_FMC1%MZM(1) = -1
FMADD_FMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMC1
FUNCTION FMADD_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMADD_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMADD(MA%MFM,MB(J)%MFM,FMADD_FMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMFM1
FUNCTION FMADD_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMADD_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, N
CALL FMADD(MTFM,MB(J)%MFM,FMADD_IMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMFM1
FUNCTION FMADD_ZMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMADD_ZMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZMFM1%MZM(1) = -1
FMADD_ZMFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMFM1
FUNCTION FMADD_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMADD_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FMIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMIM1
FUNCTION FMADD_FMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMADD_FMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FMZM1%MZM(1) = -1
FMADD_FMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MB(J)%MZM,FMADD_FMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZM1
! (2) rank 1 + rank 0
FUNCTION FMADD_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_FM1I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1I(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1I
FUNCTION FMADD_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_FM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1R
FUNCTION FMADD_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_FM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1D
FUNCTION FMADD_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_FM1Z%MZM(1) = -1
FMADD_FM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1Z
FUNCTION FMADD_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_FM1C%MZM(1) = -1
FMADD_FM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1C
FUNCTION FMADD_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMADD_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_I1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1FM
FUNCTION FMADD_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_R1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1FM
FUNCTION FMADD_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_D1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1FM
FUNCTION FMADD_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1FM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1FM%MZM(1) = -1
FMADD_Z1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1FM
FUNCTION FMADD_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1FM%MZM(1) = -1
FMADD_C1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_C1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1FM
FUNCTION FMADD_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MB%MFM,FMADD_FM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1FM
FUNCTION FMADD_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1IM
FUNCTION FMADD_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1ZM%MZM(1) = -1
FMADD_FM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMADD(MTZM,MB%MZM,FMADD_FM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1ZM
FUNCTION FMADD_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMADD(MTFM,MB%MFM,FMADD_IM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1FM
FUNCTION FMADD_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1FM%MZM(1) = -1
FMADD_ZM1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1FM
! (3) rank 1 + rank 1
FUNCTION FMADD_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_FM1I1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1I1
FUNCTION FMADD_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMADD_FM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1R1
FUNCTION FMADD_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_FM1D1%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_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1D1
FUNCTION FMADD_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMADD_FM1Z1%MZM(1) = -1
FMADD_FM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1Z1
FUNCTION FMADD_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_FM1C1%MZM(1) = -1
FMADD_FM1C1%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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1C1
FUNCTION FMADD_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMADD_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMADD(MTFM,MA(J)%MFM,FMADD_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1FM1
FUNCTION FMADD_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MTFM,MA(J)%MFM,FMADD_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1FM1
FUNCTION FMADD_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1FM1%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_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMADD(MTFM,MA(J)%MFM,FMADD_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1FM1
FUNCTION FMADD_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1FM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1FM1%MZM(1) = -1
FMADD_Z1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1FM1
FUNCTION FMADD_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1FM1%MZM(1) = -1
FMADD_C1FM1%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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1FM1
FUNCTION FMADD_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMADD(MA(J)%MFM,MB(J)%MFM,FMADD_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1FM1
FUNCTION FMADD_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMADD(MA(J)%MFM,MTFM,FMADD_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1IM1
FUNCTION FMADD_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_FM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_FM1ZM1%MZM(1) = -1
FMADD_FM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMADD(MTZM,MB(J)%MZM,FMADD_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1ZM1
FUNCTION FMADD_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMADD(MTFM,MB(J)%MFM,FMADD_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1FM1
FUNCTION FMADD_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1FM1%MZM(1) = -1
FMADD_ZM1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1FM1
! (4) rank 0 + rank 2
FUNCTION FMADD_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_IFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_IFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IFM2
FUNCTION FMADD_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_RFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_RFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RFM2
FUNCTION FMADD_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_DFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DFM2
FUNCTION FMADD_ZFM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZFM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZFM2%MZM(1) = -1
FMADD_ZFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZFM2
FUNCTION FMADD_CFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_CFM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CFM2%MZM(1) = -1
FMADD_CFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CFM2
FUNCTION FMADD_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_FMI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMI2
FUNCTION FMADD_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_FMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMR2
FUNCTION FMADD_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_FMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMD2
FUNCTION FMADD_FMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_FMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_FMZ2%MZM(1) = -1
FMADD_FMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZ2
FUNCTION FMADD_FMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_FMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_FMC2%MZM(1) = -1
FMADD_FMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMC2
FUNCTION FMADD_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD(MA%MFM,MB(J,K)%MFM,FMADD_FMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMFM2
FUNCTION FMADD_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMADD(MTFM,MB(J,K)%MFM,FMADD_IMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMFM2
FUNCTION FMADD_ZMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_ZMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZMFM2%MZM(1) = -1
FMADD_ZMFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMFM2
FUNCTION FMADD_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FMIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MTFM)
CALL FMADD(MA%MFM,MTFM,FMADD_FMIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMIM2
FUNCTION FMADD_FMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_FMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FMZM2%MZM(1) = -1
FMADD_FMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMADD(MTZM,MB(J,K)%MZM,FMADD_FMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FMZM2
! (5) rank 2 + rank 0
FUNCTION FMADD_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_FM2I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2I(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2I
FUNCTION FMADD_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_FM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2R
FUNCTION FMADD_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_FM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2D
FUNCTION FMADD_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_FM2Z%MZM(1) = -1
FMADD_FM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_FM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2Z
FUNCTION FMADD_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_FM2C%MZM(1) = -1
FMADD_FM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2C
FUNCTION FMADD_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_I2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2FM
FUNCTION FMADD_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_R2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2FM
FUNCTION FMADD_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2FM%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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA%MFM,FMADD_D2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2FM
FUNCTION FMADD_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2FM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2FM%MZM(1) = -1
FMADD_Z2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2FM
FUNCTION FMADD_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2FM%MZM(1) = -1
FMADD_C2FM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2FM
FUNCTION FMADD_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MB%MFM,FMADD_FM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2FM
FUNCTION FMADD_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2IM
FUNCTION FMADD_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2ZM%MZM(1) = -1
FMADD_FM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMADD(MTZM,MB%MZM,FMADD_FM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2ZM
FUNCTION FMADD_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMADD(MTFM,MB%MFM,FMADD_IM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2FM
FUNCTION FMADD_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2FM%MZM(1) = -1
FMADD_ZM2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2FM
! (6) rank 2 + rank 2
FUNCTION FMADD_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_FM2I2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_FM2I2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2I2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2I2
FUNCTION FMADD_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMADD_FM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_FM2R2(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 FMSP2M(R(J,K),MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2R2
FUNCTION FMADD_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_FM2D2%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_FM2D2(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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2D2
FUNCTION FMADD_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMADD_FM2Z2%MZM(1) = -1
FMADD_FM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_FM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2Z2
FUNCTION FMADD_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_FM2C2%MZM(1) = -1
FMADD_FM2C2%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_FM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2C2
FUNCTION FMADD_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_I2FM2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_I2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2FM2
FUNCTION FMADD_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_R2FM2(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 FMSP2M(R(J,K),MTFM)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_R2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2FM2
FUNCTION FMADD_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2FM2%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_D2FM2(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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MTFM,MA(J,K)%MFM,FMADD_D2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2FM2
FUNCTION FMADD_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2FM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2FM2%MZM(1) = -1
FMADD_Z2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z2FM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2FM2
FUNCTION FMADD_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2FM2%MZM(1) = -1
FMADD_C2FM2%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_C2FM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2FM2
FUNCTION FMADD_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_FM2FM2(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 FMADD(MA(J,K)%MFM,MB(J,K)%MFM,FMADD_FM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2FM2
FUNCTION FMADD_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_FM2IM2(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(MB(J,K)%MIM,MTFM)
CALL FMADD(MA(J,K)%MFM,MTFM,FMADD_FM2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2IM2
FUNCTION FMADD_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_FM2ZM2%MZM(1) = -1
FMADD_FM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMADD(MTZM,MB(J,K)%MZM,FMADD_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2ZM2
FUNCTION FMADD_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_IM2FM2(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,MTFM)
CALL FMADD(MTFM,MB(J,K)%MFM,FMADD_IM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2FM2
FUNCTION FMADD_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2FM2%MZM(1) = -1
FMADD_ZM2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2FM2
! Array addition operations for IM.
! (1) rank 0 + rank 1
FUNCTION FMADD_IIM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IIM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_IIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMADD(MTIM,MA(J)%MIM,FMADD_IIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IIM1
FUNCTION FMADD_RIM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_RIM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_RIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_RIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RIM1
FUNCTION FMADD_DIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_DIM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMADD(MTFM,MUFM,FMADD_DIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIM1
FUNCTION FMADD_ZIM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZIM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZIM1%MZM(1) = -1
FMADD_ZIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_ZIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZIM1
FUNCTION FMADD_CIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_CIM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CIM1%MZM(1) = -1
FMADD_CIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CIM1
FUNCTION FMADD_IMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMADD_IMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_IMI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMI1
FUNCTION FMADD_IMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_IMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_IMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMR1
FUNCTION FMADD_IMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_IMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_IMD1%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 FMDP2M(D(J),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMD1
FUNCTION FMADD_IMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_IMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_IMZ1%MZM(1) = -1
FMADD_IMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZ1
FUNCTION FMADD_IMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_IMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_IMC1%MZM(1) = -1
FMADD_IMC1%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMC1
FUNCTION FMADD_IMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MB)) :: FMADD_IMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IMIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMADD(MA%MIM,MB(J)%MIM,FMADD_IMIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMIM1
FUNCTION FMADD_ZMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMADD_ZMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZMIM1%MZM(1) = -1
FMADD_ZMIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMIM1
FUNCTION FMADD_IMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMADD_IMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IMZM1%MZM(1) = -1
FMADD_IMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MB(J)%MZM,FMADD_IMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZM1
! (2) rank 1 + rank 0
FUNCTION FMADD_IM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_IM1I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMADD(MA(J)%MIM,MTIM,FMADD_IM1I(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1I
FUNCTION FMADD_IM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_IM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMADD(MVFM,MTFM,FMADD_IM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1R
FUNCTION FMADD_IM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_IM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMADD(MVFM,MTFM,FMADD_IM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1D
FUNCTION FMADD_IM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_IM1Z%MZM(1) = -1
FMADD_IM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_IM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1Z
FUNCTION FMADD_IM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_IM1C%MZM(1) = -1
FMADD_IM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1C
FUNCTION FMADD_I1IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMADD_I1IM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_I1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1IM
FUNCTION FMADD_R1IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_R1IM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_R1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1IM
FUNCTION FMADD_D1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_D1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1IM%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 FMDP2M(D(J),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_D1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1IM
FUNCTION FMADD_Z1IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1IM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1IM%MZM(1) = -1
FMADD_Z1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1IM
FUNCTION FMADD_C1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1IM%MZM(1) = -1
FMADD_C1IM%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_C1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1IM
FUNCTION FMADD_IM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMADD(MA(J)%MIM,MB%MIM,FMADD_IM1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1IM
FUNCTION FMADD_IM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1ZM%MZM(1) = -1
FMADD_IM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(M1ZM,MB%MZM,FMADD_IM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1ZM
FUNCTION FMADD_ZM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1IM%MZM(1) = -1
FMADD_ZM1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,M1ZM,FMADD_ZM1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1IM
! (3) rank 1 + rank 1
FUNCTION FMADD_IM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_IM1I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMADD_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMADD(MA(J)%MIM,MTIM,FMADD_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1I1
FUNCTION FMADD_IM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMADD_IM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1R1
FUNCTION FMADD_IM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_IM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_IM1D1%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_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1D1
FUNCTION FMADD_IM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMADD_IM1Z1%MZM(1) = -1
FMADD_IM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1Z1
FUNCTION FMADD_IM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_IM1C1%MZM(1) = -1
FMADD_IM1C1%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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1C1
FUNCTION FMADD_I1IM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMADD_I1IM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMADD_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMADD(MTIM,MA(J)%MIM,FMADD_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1IM1
FUNCTION FMADD_R1IM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMADD_R1IM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMADD_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSP2M(R(J),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1IM1
FUNCTION FMADD_D1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMADD_D1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1IM1%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_D1IM1(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 FMDP2M(D(J),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_D1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1IM1
FUNCTION FMADD_Z1IM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1IM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1IM1%MZM(1) = -1
FMADD_Z1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1IM1
FUNCTION FMADD_C1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1IM1%MZM(1) = -1
FMADD_C1IM1%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_C1IM1(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_C1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1IM1
FUNCTION FMADD_IM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMADD_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMADD(MA(J)%MIM,MB(J)%MIM,FMADD_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1IM1
FUNCTION FMADD_IM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_IM1ZM1%MZM(1) = -1
FMADD_IM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(M1ZM,MB(J)%MZM,FMADD_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1ZM1
FUNCTION FMADD_ZM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1IM1%MZM(1) = -1
FMADD_ZM1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(MA(J)%MZM,M1ZM,FMADD_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1IM1
! (4) rank 0 + rank 2
FUNCTION FMADD_IIM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IIM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_IIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MTIM,MA(J,K)%MIM,FMADD_IIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IIM2
FUNCTION FMADD_RIM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_RIM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_RIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RIM2
FUNCTION FMADD_DIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DIM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DIM2
FUNCTION FMADD_ZIM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZIM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZIM2%MZM(1) = -1
FMADD_ZIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZIM2
FUNCTION FMADD_CIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_CIM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CIM2%MZM(1) = -1
FMADD_CIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CIM2
FUNCTION FMADD_IMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_IMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_IMI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMADD(MA%MIM,MTIM,FMADD_IMI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMI2
FUNCTION FMADD_IMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_IMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_IMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMR2
FUNCTION FMADD_IMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_IMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_IMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MUFM,MTFM,FMADD_IMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMD2
FUNCTION FMADD_IMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_IMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_IMZ2%MZM(1) = -1
FMADD_IMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZ2
FUNCTION FMADD_IMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_IMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_IMC2%MZM(1) = -1
FMADD_IMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMC2
FUNCTION FMADD_IMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_IMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IMIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMADD(MA%MIM,MB(J,K)%MIM,FMADD_IMIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMIM2
FUNCTION FMADD_ZMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_ZMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZMIM2%MZM(1) = -1
FMADD_ZMIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMIM2
FUNCTION FMADD_IMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_IMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IMZM2%MZM(1) = -1
FMADD_IMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMADD(MTZM,MB(J,K)%MZM,FMADD_IMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IMZM2
! (5) rank 2 + rank 0
FUNCTION FMADD_IM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_IM2I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MA(J,K)%MIM,MTIM,FMADD_IM2I(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2I
FUNCTION FMADD_IM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_IM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_IM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2R
FUNCTION FMADD_IM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_IM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_IM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2D
FUNCTION FMADD_IM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_IM2Z%MZM(1) = -1
FMADD_IM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_IM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2Z
FUNCTION FMADD_IM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_IM2C%MZM(1) = -1
FMADD_IM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2C
FUNCTION FMADD_I2IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2IM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMADD(MTIM,MA%MIM,FMADD_I2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2IM
FUNCTION FMADD_R2IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2IM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_R2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2IM
FUNCTION FMADD_D2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2IM%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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MTFM,MVFM,FMADD_D2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2IM
FUNCTION FMADD_Z2IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2IM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2IM%MZM(1) = -1
FMADD_Z2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2IM
FUNCTION FMADD_C2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2IM%MZM(1) = -1
FMADD_C2IM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_C2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2IM
FUNCTION FMADD_IM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MA(J,K)%MIM,MB%MIM,FMADD_IM2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2IM
FUNCTION FMADD_IM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2ZM%MZM(1) = -1
FMADD_IM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(M1ZM,MB%MZM,FMADD_IM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2ZM
FUNCTION FMADD_ZM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2IM%MZM(1) = -1
FMADD_ZM2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MA(J,K)%MZM,M1ZM,FMADD_ZM2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2IM
! (6) rank 2 + rank 2
FUNCTION FMADD_IM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_IM2I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMADD_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMADD(MA(J,K)%MIM,MTIM,FMADD_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2I2
FUNCTION FMADD_IM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMADD_IM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_IM2R2(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 FMSP2M(R(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2R2
FUNCTION FMADD_IM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_IM2D2%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_IM2D2(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 FMDP2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMADD(M1FM,MTFM,FMADD_IM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2D2
FUNCTION FMADD_IM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMADD_IM2Z2%MZM(1) = -1
FMADD_IM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MUZM,MTZM,FMADD_IM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2Z2
FUNCTION FMADD_IM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_IM2C2%MZM(1) = -1
FMADD_IM2C2%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_IM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2C2
FUNCTION FMADD_I2IM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2IM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMADD_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMADD(MTIM,MA(J,K)%MIM,FMADD_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2IM2
FUNCTION FMADD_R2IM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2IM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMADD_R2IM2(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 FMSP2M(R(J,K),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_R2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2IM2
FUNCTION FMADD_D2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2IM2%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_D2IM2(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 FMDP2M(D(J,K),MTFM)
CALL FMADD(MTFM,M1FM,FMADD_D2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2IM2
FUNCTION FMADD_Z2IM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2IM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2IM2%MZM(1) = -1
FMADD_Z2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z2IM2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_Z2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2IM2
FUNCTION FMADD_C2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2IM2%MZM(1) = -1
FMADD_C2IM2%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_C2IM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMADD(MTZM,MUZM,FMADD_C2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2IM2
FUNCTION FMADD_IM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMADD_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMADD(MA(J,K)%MIM,MB(J,K)%MIM,FMADD_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2IM2
FUNCTION FMADD_IM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_IM2ZM2%MZM(1) = -1
FMADD_IM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(M1ZM,MB(J,K)%MZM,FMADD_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2ZM2
FUNCTION FMADD_ZM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2IM2%MZM(1) = -1
FMADD_ZM2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMADD(MA(J,K)%MZM,M1ZM,FMADD_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2IM2
! Array addition operations for ZM.
! (1) rank 0 + rank 1
FUNCTION FMADD_IZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_IZM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_IZM1%MZM(1) = -1
FMADD_IZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_IZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IZM1
FUNCTION FMADD_RZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_RZM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_RZM1%MZM(1) = -1
FMADD_RZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_RZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RZM1
FUNCTION FMADD_DZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_DZM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DZM1%MZM(1) = -1
FMADD_DZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_DZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DZM1
FUNCTION FMADD_ZZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZZM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZZM1%MZM(1) = -1
FMADD_ZZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_ZZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZZM1
FUNCTION FMADD_CZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_CZM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CZM1%MZM(1) = -1
FMADD_CZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_CZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CZM1
FUNCTION FMADD_ZMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMADD_ZMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_ZMI1%MZM(1) = -1
FMADD_ZMI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMI1
FUNCTION FMADD_ZMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMADD_ZMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_ZMR1%MZM(1) = -1
FMADD_ZMR1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMR1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMR1
FUNCTION FMADD_ZMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_ZMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_ZMD1%MZM(1) = -1
FMADD_ZMD1%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMD1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMD1
FUNCTION FMADD_ZMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_ZMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_ZMZ1%MZM(1) = -1
FMADD_ZMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZ1
FUNCTION FMADD_ZMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_ZMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_ZMC1%MZM(1) = -1
FMADD_ZMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMC1
FUNCTION FMADD_ZMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMADD_ZMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZMZM1%MZM(1) = -1
FMADD_ZMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL ZMADD(MA%MZM,MB(J)%MZM,FMADD_ZMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZM1
! (2) rank 1 + rank 0
FUNCTION FMADD_ZM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMADD_ZM1I%MZM(1) = -1
FMADD_ZM1I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1I(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1I
FUNCTION FMADD_ZM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMADD_ZM1R%MZM(1) = -1
FMADD_ZM1R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1R(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1R
FUNCTION FMADD_ZM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_ZM1D%MZM(1) = -1
FMADD_ZM1D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1D(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1D
FUNCTION FMADD_ZM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZM1Z%MZM(1) = -1
FMADD_ZM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1Z
FUNCTION FMADD_ZM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_ZM1C%MZM(1) = -1
FMADD_ZM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1C
FUNCTION FMADD_I1ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMADD_I1ZM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1ZM%MZM(1) = -1
FMADD_I1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_I1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1ZM
FUNCTION FMADD_R1ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMADD_R1ZM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1ZM%MZM(1) = -1
FMADD_R1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_R1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1ZM
FUNCTION FMADD_D1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_D1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1ZM%MZM(1) = -1
FMADD_D1ZM%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_D1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1ZM
FUNCTION FMADD_Z1ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1ZM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1ZM%MZM(1) = -1
FMADD_Z1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_Z1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1ZM
FUNCTION FMADD_C1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1ZM%MZM(1) = -1
FMADD_C1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_C1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1ZM
FUNCTION FMADD_ZM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1ZM%MZM(1) = -1
FMADD_ZM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MB%MZM,FMADD_ZM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1ZM
! (3) rank 1 + rank 1
FUNCTION FMADD_ZM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_ZM1I1%MZM(1) = -1
FMADD_ZM1I1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1I1
FUNCTION FMADD_ZM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMADD_ZM1R1%MZM(1) = -1
FMADD_ZM1R1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1R1
FUNCTION FMADD_ZM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMADD_ZM1D1%MZM(1) = -1
FMADD_ZM1D1%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_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1D1
FUNCTION FMADD_ZM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMADD_ZM1Z1%MZM(1) = -1
FMADD_ZM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1Z1
FUNCTION FMADD_ZM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMADD_ZM1C1%MZM(1) = -1
FMADD_ZM1C1%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_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J)%MZM,MTZM,FMADD_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1C1
FUNCTION FMADD_I1ZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMADD_I1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMADD_I1ZM1%MZM(1) = -1
FMADD_I1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I1ZM1
FUNCTION FMADD_R1ZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMADD_R1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMADD_R1ZM1%MZM(1) = -1
FMADD_R1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R1ZM1
FUNCTION FMADD_D1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMADD_D1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMADD_D1ZM1%MZM(1) = -1
FMADD_D1ZM1%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_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D1ZM1
FUNCTION FMADD_Z1ZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMADD_Z1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMADD_Z1ZM1%MZM(1) = -1
FMADD_Z1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z1ZM1
FUNCTION FMADD_C1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMADD_C1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMADD_C1ZM1%MZM(1) = -1
FMADD_C1ZM1%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_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J)%MZM,FMADD_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C1ZM1
FUNCTION FMADD_ZM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMADD_ZM1ZM1%MZM(1) = -1
FMADD_ZM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMADD(MA(J)%MZM,MB(J)%MZM,FMADD_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1ZM1
! (4) rank 0 + rank 2
FUNCTION FMADD_IZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IZM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_IZM2%MZM(1) = -1
FMADD_IZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_IZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IZM2
FUNCTION FMADD_RZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_RZM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_RZM2%MZM(1) = -1
FMADD_RZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_RZM2
FUNCTION FMADD_DZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_DZM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_DZM2%MZM(1) = -1
FMADD_DZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_DZM2
FUNCTION FMADD_ZZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZZM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZZM2%MZM(1) = -1
FMADD_ZZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_ZZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZZM2
FUNCTION FMADD_CZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_CZM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_CZM2%MZM(1) = -1
FMADD_CZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_CZM2
FUNCTION FMADD_ZMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_ZMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_ZMI2%MZM(1) = -1
FMADD_ZMI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMI2
FUNCTION FMADD_ZMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_ZMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_ZMR2%MZM(1) = -1
FMADD_ZMR2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMR2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMR2
FUNCTION FMADD_ZMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_ZMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_ZMD2%MZM(1) = -1
FMADD_ZMD2%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMD2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMD2
FUNCTION FMADD_ZMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_ZMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_ZMZ2%MZM(1) = -1
FMADD_ZMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZ2
FUNCTION FMADD_ZMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_ZMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_ZMC2%MZM(1) = -1
FMADD_ZMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA%MZM,MTZM,FMADD_ZMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMC2
FUNCTION FMADD_ZMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMADD_ZMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZMZM2%MZM(1) = -1
FMADD_ZMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMADD(MA%MZM,MB(J,K)%MZM,FMADD_ZMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZMZM2
! (5) rank 2 + rank 0
FUNCTION FMADD_ZM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMADD_ZM2I%MZM(1) = -1
FMADD_ZM2I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_ZM2I(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2I
FUNCTION FMADD_ZM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMADD_ZM2R%MZM(1) = -1
FMADD_ZM2R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZM2R(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2R
FUNCTION FMADD_ZM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMADD_ZM2D%MZM(1) = -1
FMADD_ZM2D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZM2D(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2D
FUNCTION FMADD_ZM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMADD_ZM2Z%MZM(1) = -1
FMADD_ZM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2Z
FUNCTION FMADD_ZM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMADD_ZM2C%MZM(1) = -1
FMADD_ZM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_ZM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2C
FUNCTION FMADD_I2ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2ZM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2ZM%MZM(1) = -1
FMADD_I2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_I2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2ZM
FUNCTION FMADD_R2ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2ZM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2ZM%MZM(1) = -1
FMADD_R2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_R2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2ZM
FUNCTION FMADD_D2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2ZM%MZM(1) = -1
FMADD_D2ZM%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_D2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2ZM
FUNCTION FMADD_Z2ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2ZM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2ZM%MZM(1) = -1
FMADD_Z2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_Z2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2ZM
FUNCTION FMADD_C2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2ZM%MZM(1) = -1
FMADD_C2ZM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA%MZM,FMADD_C2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2ZM
FUNCTION FMADD_ZM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2ZM%MZM(1) = -1
FMADD_ZM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMADD(MA(J,K)%MZM,MB%MZM,FMADD_ZM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2ZM
! (6) rank 2 + rank 2
FUNCTION FMADD_ZM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_ZM2I2%MZM(1) = -1
FMADD_ZM2I2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2I2(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 ZMI2M(IVAL(J,K),MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2I2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2I2
FUNCTION FMADD_ZM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMADD_ZM2R2%MZM(1) = -1
FMADD_ZM2R2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2R2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2R2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2R2
FUNCTION FMADD_ZM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMADD_ZM2D2%MZM(1) = -1
FMADD_ZM2D2%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_ZM2D2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2D2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2D2
FUNCTION FMADD_ZM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMADD_ZM2Z2%MZM(1) = -1
FMADD_ZM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2Z2
FUNCTION FMADD_ZM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMADD_ZM2C2%MZM(1) = -1
FMADD_ZM2C2%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_ZM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MA(J,K)%MZM,MTZM,FMADD_ZM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2C2
FUNCTION FMADD_I2ZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMADD_I2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMADD_I2ZM2%MZM(1) = -1
FMADD_I2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_I2ZM2(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 FMI2M(IVAL(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_I2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_I2ZM2
FUNCTION FMADD_R2ZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMADD_R2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMADD_R2ZM2%MZM(1) = -1
FMADD_R2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_R2ZM2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_R2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_R2ZM2
FUNCTION FMADD_D2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMADD_D2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMADD_D2ZM2%MZM(1) = -1
FMADD_D2ZM2%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_D2ZM2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_D2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_D2ZM2
FUNCTION FMADD_Z2ZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMADD_Z2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMADD_Z2ZM2%MZM(1) = -1
FMADD_Z2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_Z2ZM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_Z2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_Z2ZM2
FUNCTION FMADD_C2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMADD_C2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMADD_C2ZM2%MZM(1) = -1
FMADD_C2ZM2%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_C2ZM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMADD(MTZM,MA(J,K)%MZM,FMADD_C2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_C2ZM2
FUNCTION FMADD_ZM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMADD_ZM2ZM2%MZM(1) = -1
FMADD_ZM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMADD_ZM2ZM2(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 ZMADD(MA(J,K)%MZM,MB(J,K)%MZM,FMADD_ZM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2ZM2
FUNCTION FMADD_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMADD_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMADD_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEQ(MA(J)%MFM,FMADD_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM1
FUNCTION FMADD_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMADD_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMADD_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMEQ(MA(J)%MIM,FMADD_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM1
FUNCTION FMADD_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMADD_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMADD_ZM1%MZM(1) = -1
FMADD_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMEQ(MA(J)%MZM,FMADD_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM1
FUNCTION FMADD_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMADD_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQ(MA(J,K)%MFM,FMADD_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_FM2
FUNCTION FMADD_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMADD_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMEQ(MA(J,K)%MIM,FMADD_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_IM2
FUNCTION FMADD_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMADD_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMADD_ZM2%MZM(1) = -1
FMADD_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MA(J,K)%MZM,FMADD_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMADD_ZM2
END MODULE FMZM_4
MODULE FMZM_5
USE FMZM_1
INTERFACE OPERATOR (-)
MODULE PROCEDURE FMSUB_IFM
MODULE PROCEDURE FMSUB_IIM
MODULE PROCEDURE FMSUB_IZM
MODULE PROCEDURE FMSUB_RFM
MODULE PROCEDURE FMSUB_RIM
MODULE PROCEDURE FMSUB_RZM
MODULE PROCEDURE FMSUB_DFM
MODULE PROCEDURE FMSUB_DIM
MODULE PROCEDURE FMSUB_DZM
MODULE PROCEDURE FMSUB_ZFM
MODULE PROCEDURE FMSUB_ZIM
MODULE PROCEDURE FMSUB_ZZM
MODULE PROCEDURE FMSUB_CFM
MODULE PROCEDURE FMSUB_CIM
MODULE PROCEDURE FMSUB_CZM
MODULE PROCEDURE FMSUB_FMI
MODULE PROCEDURE FMSUB_FMR
MODULE PROCEDURE FMSUB_FMD
MODULE PROCEDURE FMSUB_FMZ
MODULE PROCEDURE FMSUB_FMC
MODULE PROCEDURE FMSUB_FMFM
MODULE PROCEDURE FMSUB_FMIM
MODULE PROCEDURE FMSUB_FMZM
MODULE PROCEDURE FMSUB_IMI
MODULE PROCEDURE FMSUB_IMR
MODULE PROCEDURE FMSUB_IMD
MODULE PROCEDURE FMSUB_IMZ
MODULE PROCEDURE FMSUB_IMC
MODULE PROCEDURE FMSUB_IMFM
MODULE PROCEDURE FMSUB_IMIM
MODULE PROCEDURE FMSUB_IMZM
MODULE PROCEDURE FMSUB_ZMI
MODULE PROCEDURE FMSUB_ZMR
MODULE PROCEDURE FMSUB_ZMD
MODULE PROCEDURE FMSUB_ZMZ
MODULE PROCEDURE FMSUB_ZMC
MODULE PROCEDURE FMSUB_ZMFM
MODULE PROCEDURE FMSUB_ZMIM
MODULE PROCEDURE FMSUB_ZMZM
MODULE PROCEDURE FMSUB_FM
MODULE PROCEDURE FMSUB_IM
MODULE PROCEDURE FMSUB_ZM
MODULE PROCEDURE FMSUB_IFM1
MODULE PROCEDURE FMSUB_RFM1
MODULE PROCEDURE FMSUB_DFM1
MODULE PROCEDURE FMSUB_ZFM1
MODULE PROCEDURE FMSUB_CFM1
MODULE PROCEDURE FMSUB_FMI1
MODULE PROCEDURE FMSUB_FMR1
MODULE PROCEDURE FMSUB_FMD1
MODULE PROCEDURE FMSUB_FMZ1
MODULE PROCEDURE FMSUB_FMC1
MODULE PROCEDURE FMSUB_FMFM1
MODULE PROCEDURE FMSUB_IMFM1
MODULE PROCEDURE FMSUB_ZMFM1
MODULE PROCEDURE FMSUB_FMIM1
MODULE PROCEDURE FMSUB_FMZM1
MODULE PROCEDURE FMSUB_FM1I
MODULE PROCEDURE FMSUB_FM1R
MODULE PROCEDURE FMSUB_FM1D
MODULE PROCEDURE FMSUB_FM1Z
MODULE PROCEDURE FMSUB_FM1C
MODULE PROCEDURE FMSUB_I1FM
MODULE PROCEDURE FMSUB_R1FM
MODULE PROCEDURE FMSUB_D1FM
MODULE PROCEDURE FMSUB_Z1FM
MODULE PROCEDURE FMSUB_C1FM
MODULE PROCEDURE FMSUB_FM1FM
MODULE PROCEDURE FMSUB_FM1IM
MODULE PROCEDURE FMSUB_FM1ZM
MODULE PROCEDURE FMSUB_IM1FM
MODULE PROCEDURE FMSUB_ZM1FM
MODULE PROCEDURE FMSUB_I1FM1
MODULE PROCEDURE FMSUB_R1FM1
MODULE PROCEDURE FMSUB_D1FM1
MODULE PROCEDURE FMSUB_Z1FM1
MODULE PROCEDURE FMSUB_C1FM1
MODULE PROCEDURE FMSUB_FM1I1
MODULE PROCEDURE FMSUB_FM1R1
MODULE PROCEDURE FMSUB_FM1D1
MODULE PROCEDURE FMSUB_FM1Z1
MODULE PROCEDURE FMSUB_FM1C1
MODULE PROCEDURE FMSUB_FM1FM1
MODULE PROCEDURE FMSUB_IM1FM1
MODULE PROCEDURE FMSUB_ZM1FM1
MODULE PROCEDURE FMSUB_FM1IM1
MODULE PROCEDURE FMSUB_FM1ZM1
MODULE PROCEDURE FMSUB_IIM1
MODULE PROCEDURE FMSUB_RIM1
MODULE PROCEDURE FMSUB_DIM1
MODULE PROCEDURE FMSUB_ZIM1
MODULE PROCEDURE FMSUB_CIM1
MODULE PROCEDURE FMSUB_IMI1
MODULE PROCEDURE FMSUB_IMR1
MODULE PROCEDURE FMSUB_IMD1
MODULE PROCEDURE FMSUB_IMZ1
MODULE PROCEDURE FMSUB_IMC1
MODULE PROCEDURE FMSUB_IMIM1
MODULE PROCEDURE FMSUB_ZMIM1
MODULE PROCEDURE FMSUB_IMZM1
MODULE PROCEDURE FMSUB_IM1I
MODULE PROCEDURE FMSUB_IM1R
MODULE PROCEDURE FMSUB_IM1D
MODULE PROCEDURE FMSUB_IM1Z
MODULE PROCEDURE FMSUB_IM1C
MODULE PROCEDURE FMSUB_I1IM
MODULE PROCEDURE FMSUB_R1IM
MODULE PROCEDURE FMSUB_D1IM
MODULE PROCEDURE FMSUB_Z1IM
MODULE PROCEDURE FMSUB_C1IM
MODULE PROCEDURE FMSUB_IM1IM
MODULE PROCEDURE FMSUB_IM1ZM
MODULE PROCEDURE FMSUB_ZM1IM
MODULE PROCEDURE FMSUB_I1IM1
MODULE PROCEDURE FMSUB_R1IM1
MODULE PROCEDURE FMSUB_D1IM1
MODULE PROCEDURE FMSUB_Z1IM1
MODULE PROCEDURE FMSUB_C1IM1
MODULE PROCEDURE FMSUB_IM1I1
MODULE PROCEDURE FMSUB_IM1R1
MODULE PROCEDURE FMSUB_IM1D1
MODULE PROCEDURE FMSUB_IM1Z1
MODULE PROCEDURE FMSUB_IM1C1
MODULE PROCEDURE FMSUB_IM1IM1
MODULE PROCEDURE FMSUB_ZM1IM1
MODULE PROCEDURE FMSUB_IM1ZM1
MODULE PROCEDURE FMSUB_IZM1
MODULE PROCEDURE FMSUB_RZM1
MODULE PROCEDURE FMSUB_DZM1
MODULE PROCEDURE FMSUB_ZZM1
MODULE PROCEDURE FMSUB_CZM1
MODULE PROCEDURE FMSUB_ZMI1
MODULE PROCEDURE FMSUB_ZMR1
MODULE PROCEDURE FMSUB_ZMD1
MODULE PROCEDURE FMSUB_ZMZ1
MODULE PROCEDURE FMSUB_ZMC1
MODULE PROCEDURE FMSUB_ZMZM1
MODULE PROCEDURE FMSUB_ZM1I
MODULE PROCEDURE FMSUB_ZM1R
MODULE PROCEDURE FMSUB_ZM1D
MODULE PROCEDURE FMSUB_ZM1Z
MODULE PROCEDURE FMSUB_ZM1C
MODULE PROCEDURE FMSUB_I1ZM
MODULE PROCEDURE FMSUB_R1ZM
MODULE PROCEDURE FMSUB_D1ZM
MODULE PROCEDURE FMSUB_Z1ZM
MODULE PROCEDURE FMSUB_C1ZM
MODULE PROCEDURE FMSUB_ZM1ZM
MODULE PROCEDURE FMSUB_I1ZM1
MODULE PROCEDURE FMSUB_R1ZM1
MODULE PROCEDURE FMSUB_D1ZM1
MODULE PROCEDURE FMSUB_Z1ZM1
MODULE PROCEDURE FMSUB_C1ZM1
MODULE PROCEDURE FMSUB_ZM1I1
MODULE PROCEDURE FMSUB_ZM1R1
MODULE PROCEDURE FMSUB_ZM1D1
MODULE PROCEDURE FMSUB_ZM1Z1
MODULE PROCEDURE FMSUB_ZM1C1
MODULE PROCEDURE FMSUB_ZM1ZM1
MODULE PROCEDURE FMSUB_IFM2
MODULE PROCEDURE FMSUB_RFM2
MODULE PROCEDURE FMSUB_DFM2
MODULE PROCEDURE FMSUB_ZFM2
MODULE PROCEDURE FMSUB_CFM2
MODULE PROCEDURE FMSUB_FMI2
MODULE PROCEDURE FMSUB_FMR2
MODULE PROCEDURE FMSUB_FMD2
MODULE PROCEDURE FMSUB_FMZ2
MODULE PROCEDURE FMSUB_FMC2
MODULE PROCEDURE FMSUB_FMFM2
MODULE PROCEDURE FMSUB_IMFM2
MODULE PROCEDURE FMSUB_ZMFM2
MODULE PROCEDURE FMSUB_FMIM2
MODULE PROCEDURE FMSUB_FMZM2
MODULE PROCEDURE FMSUB_FM2I
MODULE PROCEDURE FMSUB_FM2R
MODULE PROCEDURE FMSUB_FM2D
MODULE PROCEDURE FMSUB_FM2Z
MODULE PROCEDURE FMSUB_FM2C
MODULE PROCEDURE FMSUB_I2FM
MODULE PROCEDURE FMSUB_R2FM
MODULE PROCEDURE FMSUB_D2FM
MODULE PROCEDURE FMSUB_Z2FM
MODULE PROCEDURE FMSUB_C2FM
MODULE PROCEDURE FMSUB_FM2FM
MODULE PROCEDURE FMSUB_FM2IM
MODULE PROCEDURE FMSUB_FM2ZM
MODULE PROCEDURE FMSUB_IM2FM
MODULE PROCEDURE FMSUB_ZM2FM
MODULE PROCEDURE FMSUB_I2FM2
MODULE PROCEDURE FMSUB_R2FM2
MODULE PROCEDURE FMSUB_D2FM2
MODULE PROCEDURE FMSUB_Z2FM2
MODULE PROCEDURE FMSUB_C2FM2
MODULE PROCEDURE FMSUB_FM2I2
MODULE PROCEDURE FMSUB_FM2R2
MODULE PROCEDURE FMSUB_FM2D2
MODULE PROCEDURE FMSUB_FM2Z2
MODULE PROCEDURE FMSUB_FM2C2
MODULE PROCEDURE FMSUB_FM2FM2
MODULE PROCEDURE FMSUB_IM2FM2
MODULE PROCEDURE FMSUB_ZM2FM2
MODULE PROCEDURE FMSUB_FM2IM2
MODULE PROCEDURE FMSUB_FM2ZM2
MODULE PROCEDURE FMSUB_IIM2
MODULE PROCEDURE FMSUB_RIM2
MODULE PROCEDURE FMSUB_DIM2
MODULE PROCEDURE FMSUB_ZIM2
MODULE PROCEDURE FMSUB_CIM2
MODULE PROCEDURE FMSUB_IMI2
MODULE PROCEDURE FMSUB_IMR2
MODULE PROCEDURE FMSUB_IMD2
MODULE PROCEDURE FMSUB_IMZ2
MODULE PROCEDURE FMSUB_IMC2
MODULE PROCEDURE FMSUB_IMIM2
MODULE PROCEDURE FMSUB_ZMIM2
MODULE PROCEDURE FMSUB_IMZM2
MODULE PROCEDURE FMSUB_IM2I
MODULE PROCEDURE FMSUB_IM2R
MODULE PROCEDURE FMSUB_IM2D
MODULE PROCEDURE FMSUB_IM2Z
MODULE PROCEDURE FMSUB_IM2C
MODULE PROCEDURE FMSUB_I2IM
MODULE PROCEDURE FMSUB_R2IM
MODULE PROCEDURE FMSUB_D2IM
MODULE PROCEDURE FMSUB_Z2IM
MODULE PROCEDURE FMSUB_C2IM
MODULE PROCEDURE FMSUB_IM2IM
MODULE PROCEDURE FMSUB_IM2ZM
MODULE PROCEDURE FMSUB_ZM2IM
MODULE PROCEDURE FMSUB_I2IM2
MODULE PROCEDURE FMSUB_R2IM2
MODULE PROCEDURE FMSUB_D2IM2
MODULE PROCEDURE FMSUB_Z2IM2
MODULE PROCEDURE FMSUB_C2IM2
MODULE PROCEDURE FMSUB_IM2I2
MODULE PROCEDURE FMSUB_IM2R2
MODULE PROCEDURE FMSUB_IM2D2
MODULE PROCEDURE FMSUB_IM2Z2
MODULE PROCEDURE FMSUB_IM2C2
MODULE PROCEDURE FMSUB_IM2IM2
MODULE PROCEDURE FMSUB_ZM2IM2
MODULE PROCEDURE FMSUB_IM2ZM2
MODULE PROCEDURE FMSUB_IZM2
MODULE PROCEDURE FMSUB_RZM2
MODULE PROCEDURE FMSUB_DZM2
MODULE PROCEDURE FMSUB_ZZM2
MODULE PROCEDURE FMSUB_CZM2
MODULE PROCEDURE FMSUB_ZMI2
MODULE PROCEDURE FMSUB_ZMR2
MODULE PROCEDURE FMSUB_ZMD2
MODULE PROCEDURE FMSUB_ZMZ2
MODULE PROCEDURE FMSUB_ZMC2
MODULE PROCEDURE FMSUB_ZMZM2
MODULE PROCEDURE FMSUB_ZM2I
MODULE PROCEDURE FMSUB_ZM2R
MODULE PROCEDURE FMSUB_ZM2D
MODULE PROCEDURE FMSUB_ZM2Z
MODULE PROCEDURE FMSUB_ZM2C
MODULE PROCEDURE FMSUB_I2ZM
MODULE PROCEDURE FMSUB_R2ZM
MODULE PROCEDURE FMSUB_D2ZM
MODULE PROCEDURE FMSUB_Z2ZM
MODULE PROCEDURE FMSUB_C2ZM
MODULE PROCEDURE FMSUB_ZM2ZM
MODULE PROCEDURE FMSUB_I2ZM2
MODULE PROCEDURE FMSUB_R2ZM2
MODULE PROCEDURE FMSUB_D2ZM2
MODULE PROCEDURE FMSUB_Z2ZM2
MODULE PROCEDURE FMSUB_C2ZM2
MODULE PROCEDURE FMSUB_ZM2I2
MODULE PROCEDURE FMSUB_ZM2R2
MODULE PROCEDURE FMSUB_ZM2D2
MODULE PROCEDURE FMSUB_ZM2Z2
MODULE PROCEDURE FMSUB_ZM2C2
MODULE PROCEDURE FMSUB_ZM2ZM2
MODULE PROCEDURE FMSUB_FM1
MODULE PROCEDURE FMSUB_IM1
MODULE PROCEDURE FMSUB_ZM1
MODULE PROCEDURE FMSUB_FM2
MODULE PROCEDURE FMSUB_IM2
MODULE PROCEDURE FMSUB_ZM2
END INTERFACE
CONTAINS
! -
FUNCTION FMSUB_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_IFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IFM
FUNCTION FMSUB_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMSUB_IIM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMSUB(MTIM,MA%MIM,FMSUB_IIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IIM
FUNCTION FMSUB_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_IZM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_IZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IZM
FUNCTION FMSUB_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_RFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RFM
FUNCTION FMSUB_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_RIM
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_RIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RIM
FUNCTION FMSUB_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_RZM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_RZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RZM
FUNCTION FMSUB_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_DFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DFM
FUNCTION FMSUB_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_DIM
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_DIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIM
FUNCTION FMSUB_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_DZM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_DZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DZM
FUNCTION FMSUB_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_ZFM
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZFM
FUNCTION FMSUB_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_ZIM
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZIM
FUNCTION FMSUB_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZZM
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_ZZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZZM
FUNCTION FMSUB_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_CFM
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_CFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CFM
FUNCTION FMSUB_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_CIM
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CIM
FUNCTION FMSUB_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_CZM
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_CZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CZM
FUNCTION FMSUB_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMI
FUNCTION FMSUB_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMR
FUNCTION FMSUB_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMD
FUNCTION FMSUB_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_FMZ
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZ
FUNCTION FMSUB_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_FMC
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMC
FUNCTION FMSUB_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMSUB_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMSUB(MA%MFM,MB%MFM,FMSUB_FMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMFM
FUNCTION FMSUB_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMIM
FUNCTION FMSUB_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB,FMSUB_FMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
CALL ZMSUB(MTZM,MB%MZM,FMSUB_FMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZM
FUNCTION FMSUB_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMSUB_IMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMI
FUNCTION FMSUB_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_IMR
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMR
FUNCTION FMSUB_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMSUB_IMD
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMD
FUNCTION FMSUB_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_IMZ
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZ
FUNCTION FMSUB_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMSUB_IMC
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMC
FUNCTION FMSUB_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB,FMSUB_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMSUB(MTFM,MB%MFM,FMSUB_IMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMFM
FUNCTION FMSUB_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMSUB_IMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMSUB(MA%MIM,MB%MIM,FMSUB_IMIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMIM
FUNCTION FMSUB_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB,FMSUB_IMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MB%MZM,FMSUB_IMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZM
FUNCTION FMSUB_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMI
FUNCTION FMSUB_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMR%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMR
FUNCTION FMSUB_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMD%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMD
FUNCTION FMSUB_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMZ
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZ
FUNCTION FMSUB_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZMC
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMC
FUNCTION FMSUB_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA,FMSUB_ZMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMFM
FUNCTION FMSUB_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA,FMSUB_ZMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MA%MZM,MUZM,FMSUB_ZMIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMIM
FUNCTION FMSUB_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,FMSUB_ZMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMSUB(MA%MZM,MB%MZM,FMSUB_ZMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZM
FUNCTION FMSUB_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSUB_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,MTFM)
IF (MWK(START(MTFM)+2) /= MUNKNO .AND. MWK(START(MTFM)+3) /= 0) &
MWK(START(MTFM)) = -MWK(START(MTFM))
CALL FMEQ(MTFM,FMSUB_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM
FUNCTION FMSUB_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMSUB_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,MTIM)
IF (MWK(START(MTIM)+2) /= MUNKNO .AND. MWK(START(MTIM)+3) /= 0) &
MWK(START(MTIM)) = -MWK(START(MTIM))
CALL IMEQ(MTIM,FMSUB_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM
FUNCTION FMSUB_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSUB_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEQ(MA%MZM,MTZM)
IF (MWK(START(MTZM(1))+2) /= MUNKNO .AND. MWK(START(MTZM(1))+3) /= 0) &
MWK(START(MTZM(1))) = -MWK(START(MTZM(1)))
IF (MWK(START(MTZM(2))+2) /= MUNKNO .AND. MWK(START(MTZM(2))+3) /= 0) THEN
MWK(START(MTZM(2))) = -MWK(START(MTZM(2)))
ENDIF
CALL ZMEQ(MTZM,FMSUB_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM
! Array subtraction operations for FM.
! (1) rank 0 - rank 1
FUNCTION FMSUB_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_IFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_IFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IFM1
FUNCTION FMSUB_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_RFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RFM1
FUNCTION FMSUB_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_DFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DFM1
FUNCTION FMSUB_ZFM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZFM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZFM1%MZM(1) = -1
FMSUB_ZFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_ZFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZFM1
FUNCTION FMSUB_CFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_CFM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CFM1%MZM(1) = -1
FMSUB_CFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CFM1
FUNCTION FMSUB_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMSUB_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_FMI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMI1
FUNCTION FMSUB_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_FMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMR1
FUNCTION FMSUB_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_FMD1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMD1
FUNCTION FMSUB_FMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_FMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_FMZ1%MZM(1) = -1
FMSUB_FMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZ1
FUNCTION FMSUB_FMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_FMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_FMC1%MZM(1) = -1
FMSUB_FMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMC1
FUNCTION FMSUB_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMSUB_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMSUB(MA%MFM,MB(J)%MFM,FMSUB_FMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMFM1
FUNCTION FMSUB_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMSUB_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MB(J)%MFM,FMSUB_IMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMFM1
FUNCTION FMSUB_ZMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMSUB_ZMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZMFM1%MZM(1) = -1
FMSUB_ZMFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMFM1
FUNCTION FMSUB_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMSUB_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FMIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMIM1
FUNCTION FMSUB_FMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMSUB_FMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FMZM1%MZM(1) = -1
FMSUB_FMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MB(J)%MZM,FMSUB_FMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZM1
! (2) rank 1 - rank 0
FUNCTION FMSUB_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_FM1I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1I(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1I
FUNCTION FMSUB_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_FM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1R
FUNCTION FMSUB_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_FM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1D
FUNCTION FMSUB_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_FM1Z%MZM(1) = -1
FMSUB_FM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1Z
FUNCTION FMSUB_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_FM1C%MZM(1) = -1
FMSUB_FM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1C
FUNCTION FMSUB_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_I1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1FM
FUNCTION FMSUB_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_R1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1FM
FUNCTION FMSUB_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_D1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1FM
FUNCTION FMSUB_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1FM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1FM%MZM(1) = -1
FMSUB_Z1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1FM
FUNCTION FMSUB_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1FM%MZM(1) = -1
FMSUB_C1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_C1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1FM
FUNCTION FMSUB_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MB%MFM,FMSUB_FM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1FM
FUNCTION FMSUB_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1IM
FUNCTION FMSUB_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1ZM%MZM(1) = -1
FMSUB_FM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMSUB(MTZM,MB%MZM,FMSUB_FM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1ZM
FUNCTION FMSUB_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMSUB(MTFM,MB%MFM,FMSUB_IM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1FM
FUNCTION FMSUB_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1FM%MZM(1) = -1
FMSUB_ZM1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1FM
! (3) rank 1 - rank 1
FUNCTION FMSUB_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_FM1I1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1I1
FUNCTION FMSUB_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMSUB_FM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1R1
FUNCTION FMSUB_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_FM1D1%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_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1D1
FUNCTION FMSUB_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMSUB_FM1Z1%MZM(1) = -1
FMSUB_FM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1Z1
FUNCTION FMSUB_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_FM1C1%MZM(1) = -1
FMSUB_FM1C1%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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1C1
FUNCTION FMSUB_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1FM1
FUNCTION FMSUB_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1FM1
FUNCTION FMSUB_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1FM1%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_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1FM1
FUNCTION FMSUB_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1FM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1FM1%MZM(1) = -1
FMSUB_Z1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1FM1
FUNCTION FMSUB_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1FM1%MZM(1) = -1
FMSUB_C1FM1%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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1FM1
FUNCTION FMSUB_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSUB(MA(J)%MFM,MB(J)%MFM,FMSUB_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1FM1
FUNCTION FMSUB_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMSUB(MA(J)%MFM,MTFM,FMSUB_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1IM1
FUNCTION FMSUB_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_FM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_FM1ZM1%MZM(1) = -1
FMSUB_FM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMSUB(MTZM,MB(J)%MZM,FMSUB_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1ZM1
FUNCTION FMSUB_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMSUB(MTFM,MB(J)%MFM,FMSUB_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1FM1
FUNCTION FMSUB_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1FM1%MZM(1) = -1
FMSUB_ZM1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1FM1
! (4) rank 0 - rank 2
FUNCTION FMSUB_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_IFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_IFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IFM2
FUNCTION FMSUB_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_RFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RFM2
FUNCTION FMSUB_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_DFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DFM2
FUNCTION FMSUB_ZFM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZFM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZFM2%MZM(1) = -1
FMSUB_ZFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZFM2
FUNCTION FMSUB_CFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_CFM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CFM2%MZM(1) = -1
FMSUB_CFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CFM2
FUNCTION FMSUB_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_FMI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMI2
FUNCTION FMSUB_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_FMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMR2
FUNCTION FMSUB_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_FMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMD2
FUNCTION FMSUB_FMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_FMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_FMZ2%MZM(1) = -1
FMSUB_FMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZ2
FUNCTION FMSUB_FMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_FMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_FMC2%MZM(1) = -1
FMSUB_FMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMC2
FUNCTION FMSUB_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB(MA%MFM,MB(J,K)%MFM,FMSUB_FMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMFM2
FUNCTION FMSUB_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMSUB(MTFM,MB(J,K)%MFM,FMSUB_IMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMFM2
FUNCTION FMSUB_ZMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_ZMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZMFM2%MZM(1) = -1
FMSUB_ZMFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMFM2
FUNCTION FMSUB_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FMIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MTFM)
CALL FMSUB(MA%MFM,MTFM,FMSUB_FMIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMIM2
FUNCTION FMSUB_FMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_FMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FMZM2%MZM(1) = -1
FMSUB_FMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMSUB(MTZM,MB(J,K)%MZM,FMSUB_FMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FMZM2
! (5) rank 2 - rank 0
FUNCTION FMSUB_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_FM2I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2I(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2I
FUNCTION FMSUB_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_FM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2R
FUNCTION FMSUB_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_FM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2D
FUNCTION FMSUB_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_FM2Z%MZM(1) = -1
FMSUB_FM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_FM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2Z
FUNCTION FMSUB_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_FM2C%MZM(1) = -1
FMSUB_FM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2C
FUNCTION FMSUB_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_I2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2FM
FUNCTION FMSUB_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_R2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2FM
FUNCTION FMSUB_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2FM%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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA%MFM,FMSUB_D2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2FM
FUNCTION FMSUB_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2FM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2FM%MZM(1) = -1
FMSUB_Z2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2FM
FUNCTION FMSUB_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2FM%MZM(1) = -1
FMSUB_C2FM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2FM
FUNCTION FMSUB_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MB%MFM,FMSUB_FM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2FM
FUNCTION FMSUB_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2IM
FUNCTION FMSUB_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2ZM%MZM(1) = -1
FMSUB_FM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMSUB(MTZM,MB%MZM,FMSUB_FM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2ZM
FUNCTION FMSUB_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMSUB(MTFM,MB%MFM,FMSUB_IM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2FM
FUNCTION FMSUB_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2FM%MZM(1) = -1
FMSUB_ZM2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2FM
! (6) rank 2 - rank 2
FUNCTION FMSUB_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_FM2I2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_FM2I2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2I2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2I2
FUNCTION FMSUB_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMSUB_FM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_FM2R2(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 FMSP2M(R(J,K),MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2R2
FUNCTION FMSUB_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_FM2D2%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_FM2D2(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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2D2
FUNCTION FMSUB_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMSUB_FM2Z2%MZM(1) = -1
FMSUB_FM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_FM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2Z2
FUNCTION FMSUB_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_FM2C2%MZM(1) = -1
FMSUB_FM2C2%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_FM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2C2
FUNCTION FMSUB_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_I2FM2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_I2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2FM2
FUNCTION FMSUB_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_R2FM2(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 FMSP2M(R(J,K),MTFM)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_R2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2FM2
FUNCTION FMSUB_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2FM2%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_D2FM2(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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_D2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2FM2
FUNCTION FMSUB_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2FM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2FM2%MZM(1) = -1
FMSUB_Z2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z2FM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2FM2
FUNCTION FMSUB_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2FM2%MZM(1) = -1
FMSUB_C2FM2%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_C2FM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2FM2
FUNCTION FMSUB_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_FM2FM2(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 FMSUB(MA(J,K)%MFM,MB(J,K)%MFM,FMSUB_FM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2FM2
FUNCTION FMSUB_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_FM2IM2(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(MB(J,K)%MIM,MTFM)
CALL FMSUB(MA(J,K)%MFM,MTFM,FMSUB_FM2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2IM2
FUNCTION FMSUB_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_FM2ZM2%MZM(1) = -1
FMSUB_FM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMSUB(MTZM,MB(J,K)%MZM,FMSUB_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2ZM2
FUNCTION FMSUB_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_IM2FM2(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,MTFM)
CALL FMSUB(MTFM,MB(J,K)%MFM,FMSUB_IM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2FM2
FUNCTION FMSUB_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2FM2%MZM(1) = -1
FMSUB_ZM2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2FM2
! Array subtraction operations for IM.
! (1) rank 0 - rank 1
FUNCTION FMSUB_IIM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IIM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_IIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMSUB(MTIM,MA(J)%MIM,FMSUB_IIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IIM1
FUNCTION FMSUB_RIM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_RIM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_RIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RIM1
FUNCTION FMSUB_DIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_DIM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMSUB(MTFM,MUFM,FMSUB_DIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIM1
FUNCTION FMSUB_ZIM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZIM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZIM1%MZM(1) = -1
FMSUB_ZIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_ZIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZIM1
FUNCTION FMSUB_CIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_CIM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CIM1%MZM(1) = -1
FMSUB_CIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CIM1
FUNCTION FMSUB_IMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMSUB_IMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_IMI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMI1
FUNCTION FMSUB_IMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_IMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_IMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMR1
FUNCTION FMSUB_IMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_IMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_IMD1%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 FMDP2M(D(J),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMD1
FUNCTION FMSUB_IMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_IMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_IMZ1%MZM(1) = -1
FMSUB_IMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZ1
FUNCTION FMSUB_IMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_IMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_IMC1%MZM(1) = -1
FMSUB_IMC1%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMC1
FUNCTION FMSUB_IMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MB)) :: FMSUB_IMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IMIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMSUB(MA%MIM,MB(J)%MIM,FMSUB_IMIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMIM1
FUNCTION FMSUB_ZMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMSUB_ZMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZMIM1%MZM(1) = -1
FMSUB_ZMIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMIM1
FUNCTION FMSUB_IMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMSUB_IMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IMZM1%MZM(1) = -1
FMSUB_IMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MB(J)%MZM,FMSUB_IMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZM1
! (2) rank 1 - rank 0
FUNCTION FMSUB_IM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_IM1I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMSUB(MA(J)%MIM,MTIM,FMSUB_IM1I(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1I
FUNCTION FMSUB_IM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_IM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMSUB(MVFM,MTFM,FMSUB_IM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1R
FUNCTION FMSUB_IM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_IM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMSUB(MVFM,MTFM,FMSUB_IM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1D
FUNCTION FMSUB_IM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_IM1Z%MZM(1) = -1
FMSUB_IM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_IM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1Z
FUNCTION FMSUB_IM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_IM1C%MZM(1) = -1
FMSUB_IM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1C
FUNCTION FMSUB_I1IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1IM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMSUB(MTIM,MA%MIM,FMSUB_I1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1IM
FUNCTION FMSUB_R1IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_R1IM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_R1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1IM
FUNCTION FMSUB_D1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_D1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1IM%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 FMDP2M(D(J),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_D1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1IM
FUNCTION FMSUB_Z1IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1IM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1IM%MZM(1) = -1
FMSUB_Z1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1IM
FUNCTION FMSUB_C1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1IM%MZM(1) = -1
FMSUB_C1IM%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_C1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1IM
FUNCTION FMSUB_IM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMSUB(MA(J)%MIM,MB%MIM,FMSUB_IM1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1IM
FUNCTION FMSUB_IM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1ZM%MZM(1) = -1
FMSUB_IM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(M1ZM,MB%MZM,FMSUB_IM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1ZM
FUNCTION FMSUB_ZM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1IM%MZM(1) = -1
FMSUB_ZM1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,M1ZM,FMSUB_ZM1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1IM
! (3) rank 1 - rank 1
FUNCTION FMSUB_IM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_IM1I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMSUB_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMSUB(MA(J)%MIM,MTIM,FMSUB_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1I1
FUNCTION FMSUB_IM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMSUB_IM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1R1
FUNCTION FMSUB_IM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_IM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_IM1D1%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_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1D1
FUNCTION FMSUB_IM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMSUB_IM1Z1%MZM(1) = -1
FMSUB_IM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1Z1
FUNCTION FMSUB_IM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_IM1C1%MZM(1) = -1
FMSUB_IM1C1%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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1C1
FUNCTION FMSUB_I1IM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1IM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMSUB_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMSUB(MTIM,MA(J)%MIM,FMSUB_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1IM1
FUNCTION FMSUB_R1IM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMSUB_R1IM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMSUB_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSP2M(R(J),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1IM1
FUNCTION FMSUB_D1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMSUB_D1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1IM1%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_D1IM1(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 FMDP2M(D(J),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_D1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1IM1
FUNCTION FMSUB_Z1IM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1IM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1IM1%MZM(1) = -1
FMSUB_Z1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1IM1
FUNCTION FMSUB_C1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1IM1%MZM(1) = -1
FMSUB_C1IM1%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_C1IM1(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_C1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1IM1
FUNCTION FMSUB_IM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMSUB_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMSUB(MA(J)%MIM,MB(J)%MIM,FMSUB_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1IM1
FUNCTION FMSUB_IM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_IM1ZM1%MZM(1) = -1
FMSUB_IM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(M1ZM,MB(J)%MZM,FMSUB_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1ZM1
FUNCTION FMSUB_ZM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1IM1%MZM(1) = -1
FMSUB_ZM1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(MA(J)%MZM,M1ZM,FMSUB_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1IM1
! (4) rank 0 - rank 2
FUNCTION FMSUB_IIM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IIM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_IIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MTIM,MA(J,K)%MIM,FMSUB_IIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IIM2
FUNCTION FMSUB_RIM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_RIM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RIM2
FUNCTION FMSUB_DIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DIM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DIM2
FUNCTION FMSUB_ZIM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZIM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZIM2%MZM(1) = -1
FMSUB_ZIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZIM2
FUNCTION FMSUB_CIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_CIM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CIM2%MZM(1) = -1
FMSUB_CIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CIM2
FUNCTION FMSUB_IMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_IMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_IMI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMSUB(MA%MIM,MTIM,FMSUB_IMI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMI2
FUNCTION FMSUB_IMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_IMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_IMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMR2
FUNCTION FMSUB_IMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_IMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_IMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MUFM,MTFM,FMSUB_IMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMD2
FUNCTION FMSUB_IMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_IMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_IMZ2%MZM(1) = -1
FMSUB_IMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZ2
FUNCTION FMSUB_IMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_IMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_IMC2%MZM(1) = -1
FMSUB_IMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMC2
FUNCTION FMSUB_IMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_IMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IMIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMSUB(MA%MIM,MB(J,K)%MIM,FMSUB_IMIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMIM2
FUNCTION FMSUB_ZMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_ZMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZMIM2%MZM(1) = -1
FMSUB_ZMIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMIM2
FUNCTION FMSUB_IMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_IMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IMZM2%MZM(1) = -1
FMSUB_IMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMSUB(MTZM,MB(J,K)%MZM,FMSUB_IMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IMZM2
! (5) rank 2 - rank 0
FUNCTION FMSUB_IM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_IM2I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MA(J,K)%MIM,MTIM,FMSUB_IM2I(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2I
FUNCTION FMSUB_IM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_IM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_IM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2R
FUNCTION FMSUB_IM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_IM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_IM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2D
FUNCTION FMSUB_IM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_IM2Z%MZM(1) = -1
FMSUB_IM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_IM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2Z
FUNCTION FMSUB_IM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_IM2C%MZM(1) = -1
FMSUB_IM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2C
FUNCTION FMSUB_I2IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2IM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMSUB(MTIM,MA%MIM,FMSUB_I2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2IM
FUNCTION FMSUB_R2IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2IM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_R2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2IM
FUNCTION FMSUB_D2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2IM%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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MTFM,MVFM,FMSUB_D2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2IM
FUNCTION FMSUB_Z2IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2IM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2IM%MZM(1) = -1
FMSUB_Z2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2IM
FUNCTION FMSUB_C2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2IM%MZM(1) = -1
FMSUB_C2IM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_C2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2IM
FUNCTION FMSUB_IM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MA(J,K)%MIM,MB%MIM,FMSUB_IM2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2IM
FUNCTION FMSUB_IM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2ZM%MZM(1) = -1
FMSUB_IM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(M1ZM,MB%MZM,FMSUB_IM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2ZM
FUNCTION FMSUB_ZM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2IM%MZM(1) = -1
FMSUB_ZM2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MA(J,K)%MZM,M1ZM,FMSUB_ZM2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2IM
! (6) rank 2 - rank 2
FUNCTION FMSUB_IM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_IM2I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMSUB_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMSUB(MA(J,K)%MIM,MTIM,FMSUB_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2I2
FUNCTION FMSUB_IM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMSUB_IM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_IM2R2(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 FMSP2M(R(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2R2
FUNCTION FMSUB_IM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_IM2D2%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_IM2D2(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 FMDP2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMSUB(M1FM,MTFM,FMSUB_IM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2D2
FUNCTION FMSUB_IM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMSUB_IM2Z2%MZM(1) = -1
FMSUB_IM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MUZM,MTZM,FMSUB_IM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2Z2
FUNCTION FMSUB_IM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_IM2C2%MZM(1) = -1
FMSUB_IM2C2%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_IM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2C2
FUNCTION FMSUB_I2IM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2IM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMSUB_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMSUB(MTIM,MA(J,K)%MIM,FMSUB_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2IM2
FUNCTION FMSUB_R2IM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2IM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMSUB_R2IM2(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 FMSP2M(R(J,K),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_R2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2IM2
FUNCTION FMSUB_D2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2IM2%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_D2IM2(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 FMDP2M(D(J,K),MTFM)
CALL FMSUB(MTFM,M1FM,FMSUB_D2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2IM2
FUNCTION FMSUB_Z2IM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2IM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2IM2%MZM(1) = -1
FMSUB_Z2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z2IM2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_Z2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2IM2
FUNCTION FMSUB_C2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2IM2%MZM(1) = -1
FMSUB_C2IM2%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_C2IM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMSUB(MTZM,MUZM,FMSUB_C2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2IM2
FUNCTION FMSUB_IM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMSUB_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MA(J,K)%MIM,MB(J,K)%MIM,FMSUB_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2IM2
FUNCTION FMSUB_IM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_IM2ZM2%MZM(1) = -1
FMSUB_IM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(M1ZM,MB(J,K)%MZM,FMSUB_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2ZM2
FUNCTION FMSUB_ZM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2IM2%MZM(1) = -1
FMSUB_ZM2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMSUB(MA(J,K)%MZM,M1ZM,FMSUB_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2IM2
! Array subtraction operations for ZM.
! (1) rank 0 - rank 1
FUNCTION FMSUB_IZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_IZM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_IZM1%MZM(1) = -1
FMSUB_IZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_IZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IZM1
FUNCTION FMSUB_RZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_RZM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RZM1%MZM(1) = -1
FMSUB_RZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_RZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RZM1
FUNCTION FMSUB_DZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_DZM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DZM1%MZM(1) = -1
FMSUB_DZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_DZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DZM1
FUNCTION FMSUB_ZZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZZM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZZM1%MZM(1) = -1
FMSUB_ZZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_ZZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZZM1
FUNCTION FMSUB_CZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_CZM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CZM1%MZM(1) = -1
FMSUB_CZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_CZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CZM1
FUNCTION FMSUB_ZMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMSUB_ZMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_ZMI1%MZM(1) = -1
FMSUB_ZMI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMI1
FUNCTION FMSUB_ZMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMSUB_ZMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_ZMR1%MZM(1) = -1
FMSUB_ZMR1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMR1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMR1
FUNCTION FMSUB_ZMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_ZMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_ZMD1%MZM(1) = -1
FMSUB_ZMD1%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMD1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMD1
FUNCTION FMSUB_ZMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_ZMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_ZMZ1%MZM(1) = -1
FMSUB_ZMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZ1
FUNCTION FMSUB_ZMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_ZMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_ZMC1%MZM(1) = -1
FMSUB_ZMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMC1
FUNCTION FMSUB_ZMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMSUB_ZMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZMZM1%MZM(1) = -1
FMSUB_ZMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL ZMSUB(MA%MZM,MB(J)%MZM,FMSUB_ZMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZM1
! (2) rank 1 - rank 0
FUNCTION FMSUB_ZM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMSUB_ZM1I%MZM(1) = -1
FMSUB_ZM1I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1I(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1I
FUNCTION FMSUB_ZM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMSUB_ZM1R%MZM(1) = -1
FMSUB_ZM1R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1R(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1R
FUNCTION FMSUB_ZM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_ZM1D%MZM(1) = -1
FMSUB_ZM1D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1D(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1D
FUNCTION FMSUB_ZM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZM1Z%MZM(1) = -1
FMSUB_ZM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1Z
FUNCTION FMSUB_ZM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_ZM1C%MZM(1) = -1
FMSUB_ZM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1C
FUNCTION FMSUB_I1ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1ZM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1ZM%MZM(1) = -1
FMSUB_I1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_I1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1ZM
FUNCTION FMSUB_R1ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMSUB_R1ZM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1ZM%MZM(1) = -1
FMSUB_R1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_R1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1ZM
FUNCTION FMSUB_D1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_D1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1ZM%MZM(1) = -1
FMSUB_D1ZM%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_D1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1ZM
FUNCTION FMSUB_Z1ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1ZM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1ZM%MZM(1) = -1
FMSUB_Z1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_Z1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1ZM
FUNCTION FMSUB_C1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1ZM%MZM(1) = -1
FMSUB_C1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_C1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1ZM
FUNCTION FMSUB_ZM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1ZM%MZM(1) = -1
FMSUB_ZM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MB%MZM,FMSUB_ZM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1ZM
! (3) rank 1 - rank 1
FUNCTION FMSUB_ZM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_ZM1I1%MZM(1) = -1
FMSUB_ZM1I1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1I1
FUNCTION FMSUB_ZM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMSUB_ZM1R1%MZM(1) = -1
FMSUB_ZM1R1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1R1
FUNCTION FMSUB_ZM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM1D1%MZM(1) = -1
FMSUB_ZM1D1%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_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1D1
FUNCTION FMSUB_ZM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMSUB_ZM1Z1%MZM(1) = -1
FMSUB_ZM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1Z1
FUNCTION FMSUB_ZM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMSUB_ZM1C1%MZM(1) = -1
FMSUB_ZM1C1%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_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J)%MZM,MTZM,FMSUB_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1C1
FUNCTION FMSUB_I1ZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMSUB_I1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMSUB_I1ZM1%MZM(1) = -1
FMSUB_I1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I1ZM1
FUNCTION FMSUB_R1ZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMSUB_R1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMSUB_R1ZM1%MZM(1) = -1
FMSUB_R1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R1ZM1
FUNCTION FMSUB_D1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMSUB_D1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMSUB_D1ZM1%MZM(1) = -1
FMSUB_D1ZM1%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_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D1ZM1
FUNCTION FMSUB_Z1ZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMSUB_Z1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMSUB_Z1ZM1%MZM(1) = -1
FMSUB_Z1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z1ZM1
FUNCTION FMSUB_C1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMSUB_C1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMSUB_C1ZM1%MZM(1) = -1
FMSUB_C1ZM1%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_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C1ZM1
FUNCTION FMSUB_ZM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMSUB_ZM1ZM1%MZM(1) = -1
FMSUB_ZM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMSUB(MA(J)%MZM,MB(J)%MZM,FMSUB_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1ZM1
! (4) rank 0 - rank 2
FUNCTION FMSUB_IZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IZM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_IZM2%MZM(1) = -1
FMSUB_IZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_IZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IZM2
FUNCTION FMSUB_RZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_RZM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_RZM2%MZM(1) = -1
FMSUB_RZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_RZM2
FUNCTION FMSUB_DZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_DZM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_DZM2%MZM(1) = -1
FMSUB_DZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_DZM2
FUNCTION FMSUB_ZZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZZM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZZM2%MZM(1) = -1
FMSUB_ZZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_ZZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZZM2
FUNCTION FMSUB_CZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_CZM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_CZM2%MZM(1) = -1
FMSUB_CZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_CZM2
FUNCTION FMSUB_ZMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_ZMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_ZMI2%MZM(1) = -1
FMSUB_ZMI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMI2
FUNCTION FMSUB_ZMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_ZMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_ZMR2%MZM(1) = -1
FMSUB_ZMR2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMR2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMR2
FUNCTION FMSUB_ZMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_ZMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_ZMD2%MZM(1) = -1
FMSUB_ZMD2%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMD2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMD2
FUNCTION FMSUB_ZMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_ZMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_ZMZ2%MZM(1) = -1
FMSUB_ZMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZ2
FUNCTION FMSUB_ZMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_ZMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_ZMC2%MZM(1) = -1
FMSUB_ZMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA%MZM,MTZM,FMSUB_ZMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMC2
FUNCTION FMSUB_ZMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMSUB_ZMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZMZM2%MZM(1) = -1
FMSUB_ZMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMSUB(MA%MZM,MB(J,K)%MZM,FMSUB_ZMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZMZM2
! (5) rank 2 - rank 0
FUNCTION FMSUB_ZM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMSUB_ZM2I%MZM(1) = -1
FMSUB_ZM2I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_ZM2I(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2I
FUNCTION FMSUB_ZM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMSUB_ZM2R%MZM(1) = -1
FMSUB_ZM2R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZM2R(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2R
FUNCTION FMSUB_ZM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMSUB_ZM2D%MZM(1) = -1
FMSUB_ZM2D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZM2D(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2D
FUNCTION FMSUB_ZM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMSUB_ZM2Z%MZM(1) = -1
FMSUB_ZM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2Z
FUNCTION FMSUB_ZM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMSUB_ZM2C%MZM(1) = -1
FMSUB_ZM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_ZM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2C
FUNCTION FMSUB_I2ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2ZM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2ZM%MZM(1) = -1
FMSUB_I2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_I2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2ZM
FUNCTION FMSUB_R2ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2ZM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2ZM%MZM(1) = -1
FMSUB_R2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_R2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2ZM
FUNCTION FMSUB_D2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2ZM%MZM(1) = -1
FMSUB_D2ZM%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_D2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2ZM
FUNCTION FMSUB_Z2ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2ZM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2ZM%MZM(1) = -1
FMSUB_Z2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_Z2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2ZM
FUNCTION FMSUB_C2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2ZM%MZM(1) = -1
FMSUB_C2ZM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA%MZM,FMSUB_C2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2ZM
FUNCTION FMSUB_ZM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2ZM%MZM(1) = -1
FMSUB_ZM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MA(J,K)%MZM,MB%MZM,FMSUB_ZM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2ZM
! (6) rank 2 - rank 2
FUNCTION FMSUB_ZM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_ZM2I2%MZM(1) = -1
FMSUB_ZM2I2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2I2(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 ZMI2M(IVAL(J,K),MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2I2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2I2
FUNCTION FMSUB_ZM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMSUB_ZM2R2%MZM(1) = -1
FMSUB_ZM2R2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2R2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2R2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2R2
FUNCTION FMSUB_ZM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMSUB_ZM2D2%MZM(1) = -1
FMSUB_ZM2D2%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_ZM2D2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2D2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2D2
FUNCTION FMSUB_ZM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMSUB_ZM2Z2%MZM(1) = -1
FMSUB_ZM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2Z2
FUNCTION FMSUB_ZM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMSUB_ZM2C2%MZM(1) = -1
FMSUB_ZM2C2%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_ZM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MA(J,K)%MZM,MTZM,FMSUB_ZM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2C2
FUNCTION FMSUB_I2ZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMSUB_I2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMSUB_I2ZM2%MZM(1) = -1
FMSUB_I2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_I2ZM2(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 FMI2M(IVAL(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_I2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_I2ZM2
FUNCTION FMSUB_R2ZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMSUB_R2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMSUB_R2ZM2%MZM(1) = -1
FMSUB_R2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_R2ZM2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_R2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_R2ZM2
FUNCTION FMSUB_D2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMSUB_D2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMSUB_D2ZM2%MZM(1) = -1
FMSUB_D2ZM2%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_D2ZM2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_D2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_D2ZM2
FUNCTION FMSUB_Z2ZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMSUB_Z2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMSUB_Z2ZM2%MZM(1) = -1
FMSUB_Z2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_Z2ZM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_Z2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_Z2ZM2
FUNCTION FMSUB_C2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMSUB_C2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMSUB_C2ZM2%MZM(1) = -1
FMSUB_C2ZM2%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_C2ZM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_C2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_C2ZM2
FUNCTION FMSUB_ZM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMSUB_ZM2ZM2%MZM(1) = -1
FMSUB_ZM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMSUB_ZM2ZM2(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 ZMSUB(MA(J,K)%MZM,MB(J,K)%MZM,FMSUB_ZM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2ZM2
FUNCTION FMSUB_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSUB_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSUB_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL FMSUB(MTFM,MA(J)%MFM,FMSUB_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM1
FUNCTION FMSUB_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMSUB_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSUB_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(0,MTIM)
DO J = 1, N
CALL IMSUB(MTIM,MA(J)%MIM,FMSUB_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM1
FUNCTION FMSUB_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSUB_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSUB_ZM1%MZM(1) = -1
FMSUB_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMI2M(0,MTZM)
DO J = 1, N
CALL ZMSUB(MTZM,MA(J)%MZM,FMSUB_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM1
FUNCTION FMSUB_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSUB_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSUB(MTFM,MA(J,K)%MFM,FMSUB_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_FM2
FUNCTION FMSUB_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSUB_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(0,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMSUB(MTIM,MA(J,K)%MIM,FMSUB_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_IM2
FUNCTION FMSUB_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSUB_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSUB_ZM2%MZM(1) = -1
FMSUB_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMI2M(0,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSUB(MTZM,MA(J,K)%MZM,FMSUB_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUB_ZM2
END MODULE FMZM_5
MODULE FMZM_6
USE FMZM_1
INTERFACE OPERATOR (*)
MODULE PROCEDURE FMMPY_IFM
MODULE PROCEDURE FMMPY_IIM
MODULE PROCEDURE FMMPY_IZM
MODULE PROCEDURE FMMPY_RFM
MODULE PROCEDURE FMMPY_RIM
MODULE PROCEDURE FMMPY_RZM
MODULE PROCEDURE FMMPY_DFM
MODULE PROCEDURE FMMPY_DIM
MODULE PROCEDURE FMMPY_DZM
MODULE PROCEDURE FMMPY_ZFM
MODULE PROCEDURE FMMPY_ZIM
MODULE PROCEDURE FMMPY_ZZM
MODULE PROCEDURE FMMPY_CFM
MODULE PROCEDURE FMMPY_CIM
MODULE PROCEDURE FMMPY_CZM
MODULE PROCEDURE FMMPY_FMI
MODULE PROCEDURE FMMPY_FMR
MODULE PROCEDURE FMMPY_FMD
MODULE PROCEDURE FMMPY_FMZ
MODULE PROCEDURE FMMPY_FMC
MODULE PROCEDURE FMMPY_FMFM
MODULE PROCEDURE FMMPY_FMIM
MODULE PROCEDURE FMMPY_FMZM
MODULE PROCEDURE FMMPY_IMI
MODULE PROCEDURE FMMPY_IMR
MODULE PROCEDURE FMMPY_IMD
MODULE PROCEDURE FMMPY_IMZ
MODULE PROCEDURE FMMPY_IMC
MODULE PROCEDURE FMMPY_IMFM
MODULE PROCEDURE FMMPY_IMIM
MODULE PROCEDURE FMMPY_IMZM
MODULE PROCEDURE FMMPY_ZMI
MODULE PROCEDURE FMMPY_ZMR
MODULE PROCEDURE FMMPY_ZMD
MODULE PROCEDURE FMMPY_ZMZ
MODULE PROCEDURE FMMPY_ZMC
MODULE PROCEDURE FMMPY_ZMFM
MODULE PROCEDURE FMMPY_ZMIM
MODULE PROCEDURE FMMPY_ZMZM
MODULE PROCEDURE FMMPY_IFM1
MODULE PROCEDURE FMMPY_RFM1
MODULE PROCEDURE FMMPY_DFM1
MODULE PROCEDURE FMMPY_ZFM1
MODULE PROCEDURE FMMPY_CFM1
MODULE PROCEDURE FMMPY_FMI1
MODULE PROCEDURE FMMPY_FMR1
MODULE PROCEDURE FMMPY_FMD1
MODULE PROCEDURE FMMPY_FMZ1
MODULE PROCEDURE FMMPY_FMC1
MODULE PROCEDURE FMMPY_FMFM1
MODULE PROCEDURE FMMPY_IMFM1
MODULE PROCEDURE FMMPY_ZMFM1
MODULE PROCEDURE FMMPY_FMIM1
MODULE PROCEDURE FMMPY_FMZM1
MODULE PROCEDURE FMMPY_FM1I
MODULE PROCEDURE FMMPY_FM1R
MODULE PROCEDURE FMMPY_FM1D
MODULE PROCEDURE FMMPY_FM1Z
MODULE PROCEDURE FMMPY_FM1C
MODULE PROCEDURE FMMPY_I1FM
MODULE PROCEDURE FMMPY_R1FM
MODULE PROCEDURE FMMPY_D1FM
MODULE PROCEDURE FMMPY_Z1FM
MODULE PROCEDURE FMMPY_C1FM
MODULE PROCEDURE FMMPY_FM1FM
MODULE PROCEDURE FMMPY_FM1IM
MODULE PROCEDURE FMMPY_FM1ZM
MODULE PROCEDURE FMMPY_IM1FM
MODULE PROCEDURE FMMPY_ZM1FM
MODULE PROCEDURE FMMPY_I1FM1
MODULE PROCEDURE FMMPY_R1FM1
MODULE PROCEDURE FMMPY_D1FM1
MODULE PROCEDURE FMMPY_Z1FM1
MODULE PROCEDURE FMMPY_C1FM1
MODULE PROCEDURE FMMPY_FM1I1
MODULE PROCEDURE FMMPY_FM1R1
MODULE PROCEDURE FMMPY_FM1D1
MODULE PROCEDURE FMMPY_FM1Z1
MODULE PROCEDURE FMMPY_FM1C1
MODULE PROCEDURE FMMPY_FM1FM1
MODULE PROCEDURE FMMPY_IM1FM1
MODULE PROCEDURE FMMPY_ZM1FM1
MODULE PROCEDURE FMMPY_FM1IM1
MODULE PROCEDURE FMMPY_FM1ZM1
MODULE PROCEDURE FMMPY_IIM1
MODULE PROCEDURE FMMPY_RIM1
MODULE PROCEDURE FMMPY_DIM1
MODULE PROCEDURE FMMPY_ZIM1
MODULE PROCEDURE FMMPY_CIM1
MODULE PROCEDURE FMMPY_IMI1
MODULE PROCEDURE FMMPY_IMR1
MODULE PROCEDURE FMMPY_IMD1
MODULE PROCEDURE FMMPY_IMZ1
MODULE PROCEDURE FMMPY_IMC1
MODULE PROCEDURE FMMPY_IMIM1
MODULE PROCEDURE FMMPY_ZMIM1
MODULE PROCEDURE FMMPY_IMZM1
MODULE PROCEDURE FMMPY_IM1I
MODULE PROCEDURE FMMPY_IM1R
MODULE PROCEDURE FMMPY_IM1D
MODULE PROCEDURE FMMPY_IM1Z
MODULE PROCEDURE FMMPY_IM1C
MODULE PROCEDURE FMMPY_I1IM
MODULE PROCEDURE FMMPY_R1IM
MODULE PROCEDURE FMMPY_D1IM
MODULE PROCEDURE FMMPY_Z1IM
MODULE PROCEDURE FMMPY_C1IM
MODULE PROCEDURE FMMPY_IM1IM
MODULE PROCEDURE FMMPY_IM1ZM
MODULE PROCEDURE FMMPY_ZM1IM
MODULE PROCEDURE FMMPY_I1IM1
MODULE PROCEDURE FMMPY_R1IM1
MODULE PROCEDURE FMMPY_D1IM1
MODULE PROCEDURE FMMPY_Z1IM1
MODULE PROCEDURE FMMPY_C1IM1
MODULE PROCEDURE FMMPY_IM1I1
MODULE PROCEDURE FMMPY_IM1R1
MODULE PROCEDURE FMMPY_IM1D1
MODULE PROCEDURE FMMPY_IM1Z1
MODULE PROCEDURE FMMPY_IM1C1
MODULE PROCEDURE FMMPY_IM1IM1
MODULE PROCEDURE FMMPY_ZM1IM1
MODULE PROCEDURE FMMPY_IM1ZM1
MODULE PROCEDURE FMMPY_IZM1
MODULE PROCEDURE FMMPY_RZM1
MODULE PROCEDURE FMMPY_DZM1
MODULE PROCEDURE FMMPY_ZZM1
MODULE PROCEDURE FMMPY_CZM1
MODULE PROCEDURE FMMPY_ZMI1
MODULE PROCEDURE FMMPY_ZMR1
MODULE PROCEDURE FMMPY_ZMD1
MODULE PROCEDURE FMMPY_ZMZ1
MODULE PROCEDURE FMMPY_ZMC1
MODULE PROCEDURE FMMPY_ZMZM1
MODULE PROCEDURE FMMPY_ZM1I
MODULE PROCEDURE FMMPY_ZM1R
MODULE PROCEDURE FMMPY_ZM1D
MODULE PROCEDURE FMMPY_ZM1Z
MODULE PROCEDURE FMMPY_ZM1C
MODULE PROCEDURE FMMPY_I1ZM
MODULE PROCEDURE FMMPY_R1ZM
MODULE PROCEDURE FMMPY_D1ZM
MODULE PROCEDURE FMMPY_Z1ZM
MODULE PROCEDURE FMMPY_C1ZM
MODULE PROCEDURE FMMPY_ZM1ZM
MODULE PROCEDURE FMMPY_I1ZM1
MODULE PROCEDURE FMMPY_R1ZM1
MODULE PROCEDURE FMMPY_D1ZM1
MODULE PROCEDURE FMMPY_Z1ZM1
MODULE PROCEDURE FMMPY_C1ZM1
MODULE PROCEDURE FMMPY_ZM1I1
MODULE PROCEDURE FMMPY_ZM1R1
MODULE PROCEDURE FMMPY_ZM1D1
MODULE PROCEDURE FMMPY_ZM1Z1
MODULE PROCEDURE FMMPY_ZM1C1
MODULE PROCEDURE FMMPY_ZM1ZM1
MODULE PROCEDURE FMMPY_IFM2
MODULE PROCEDURE FMMPY_RFM2
MODULE PROCEDURE FMMPY_DFM2
MODULE PROCEDURE FMMPY_ZFM2
MODULE PROCEDURE FMMPY_CFM2
MODULE PROCEDURE FMMPY_FMI2
MODULE PROCEDURE FMMPY_FMR2
MODULE PROCEDURE FMMPY_FMD2
MODULE PROCEDURE FMMPY_FMZ2
MODULE PROCEDURE FMMPY_FMC2
MODULE PROCEDURE FMMPY_FMFM2
MODULE PROCEDURE FMMPY_IMFM2
MODULE PROCEDURE FMMPY_ZMFM2
MODULE PROCEDURE FMMPY_FMIM2
MODULE PROCEDURE FMMPY_FMZM2
MODULE PROCEDURE FMMPY_FM2I
MODULE PROCEDURE FMMPY_FM2R
MODULE PROCEDURE FMMPY_FM2D
MODULE PROCEDURE FMMPY_FM2Z
MODULE PROCEDURE FMMPY_FM2C
MODULE PROCEDURE FMMPY_I2FM
MODULE PROCEDURE FMMPY_R2FM
MODULE PROCEDURE FMMPY_D2FM
MODULE PROCEDURE FMMPY_Z2FM
MODULE PROCEDURE FMMPY_C2FM
MODULE PROCEDURE FMMPY_FM2FM
MODULE PROCEDURE FMMPY_FM2IM
MODULE PROCEDURE FMMPY_FM2ZM
MODULE PROCEDURE FMMPY_IM2FM
MODULE PROCEDURE FMMPY_ZM2FM
MODULE PROCEDURE FMMPY_I2FM2
MODULE PROCEDURE FMMPY_R2FM2
MODULE PROCEDURE FMMPY_D2FM2
MODULE PROCEDURE FMMPY_Z2FM2
MODULE PROCEDURE FMMPY_C2FM2
MODULE PROCEDURE FMMPY_FM2I2
MODULE PROCEDURE FMMPY_FM2R2
MODULE PROCEDURE FMMPY_FM2D2
MODULE PROCEDURE FMMPY_FM2Z2
MODULE PROCEDURE FMMPY_FM2C2
MODULE PROCEDURE FMMPY_FM2FM2
MODULE PROCEDURE FMMPY_IM2FM2
MODULE PROCEDURE FMMPY_ZM2FM2
MODULE PROCEDURE FMMPY_FM2IM2
MODULE PROCEDURE FMMPY_FM2ZM2
MODULE PROCEDURE FMMPY_IIM2
MODULE PROCEDURE FMMPY_RIM2
MODULE PROCEDURE FMMPY_DIM2
MODULE PROCEDURE FMMPY_ZIM2
MODULE PROCEDURE FMMPY_CIM2
MODULE PROCEDURE FMMPY_IMI2
MODULE PROCEDURE FMMPY_IMR2
MODULE PROCEDURE FMMPY_IMD2
MODULE PROCEDURE FMMPY_IMZ2
MODULE PROCEDURE FMMPY_IMC2
MODULE PROCEDURE FMMPY_IMIM2
MODULE PROCEDURE FMMPY_ZMIM2
MODULE PROCEDURE FMMPY_IMZM2
MODULE PROCEDURE FMMPY_IM2I
MODULE PROCEDURE FMMPY_IM2R
MODULE PROCEDURE FMMPY_IM2D
MODULE PROCEDURE FMMPY_IM2Z
MODULE PROCEDURE FMMPY_IM2C
MODULE PROCEDURE FMMPY_I2IM
MODULE PROCEDURE FMMPY_R2IM
MODULE PROCEDURE FMMPY_D2IM
MODULE PROCEDURE FMMPY_Z2IM
MODULE PROCEDURE FMMPY_C2IM
MODULE PROCEDURE FMMPY_IM2IM
MODULE PROCEDURE FMMPY_IM2ZM
MODULE PROCEDURE FMMPY_ZM2IM
MODULE PROCEDURE FMMPY_I2IM2
MODULE PROCEDURE FMMPY_R2IM2
MODULE PROCEDURE FMMPY_D2IM2
MODULE PROCEDURE FMMPY_Z2IM2
MODULE PROCEDURE FMMPY_C2IM2
MODULE PROCEDURE FMMPY_IM2I2
MODULE PROCEDURE FMMPY_IM2R2
MODULE PROCEDURE FMMPY_IM2D2
MODULE PROCEDURE FMMPY_IM2Z2
MODULE PROCEDURE FMMPY_IM2C2
MODULE PROCEDURE FMMPY_IM2IM2
MODULE PROCEDURE FMMPY_ZM2IM2
MODULE PROCEDURE FMMPY_IM2ZM2
MODULE PROCEDURE FMMPY_IZM2
MODULE PROCEDURE FMMPY_RZM2
MODULE PROCEDURE FMMPY_DZM2
MODULE PROCEDURE FMMPY_ZZM2
MODULE PROCEDURE FMMPY_CZM2
MODULE PROCEDURE FMMPY_ZMI2
MODULE PROCEDURE FMMPY_ZMR2
MODULE PROCEDURE FMMPY_ZMD2
MODULE PROCEDURE FMMPY_ZMZ2
MODULE PROCEDURE FMMPY_ZMC2
MODULE PROCEDURE FMMPY_ZMZM2
MODULE PROCEDURE FMMPY_ZM2I
MODULE PROCEDURE FMMPY_ZM2R
MODULE PROCEDURE FMMPY_ZM2D
MODULE PROCEDURE FMMPY_ZM2Z
MODULE PROCEDURE FMMPY_ZM2C
MODULE PROCEDURE FMMPY_I2ZM
MODULE PROCEDURE FMMPY_R2ZM
MODULE PROCEDURE FMMPY_D2ZM
MODULE PROCEDURE FMMPY_Z2ZM
MODULE PROCEDURE FMMPY_C2ZM
MODULE PROCEDURE FMMPY_ZM2ZM
MODULE PROCEDURE FMMPY_I2ZM2
MODULE PROCEDURE FMMPY_R2ZM2
MODULE PROCEDURE FMMPY_D2ZM2
MODULE PROCEDURE FMMPY_Z2ZM2
MODULE PROCEDURE FMMPY_C2ZM2
MODULE PROCEDURE FMMPY_ZM2I2
MODULE PROCEDURE FMMPY_ZM2R2
MODULE PROCEDURE FMMPY_ZM2D2
MODULE PROCEDURE FMMPY_ZM2Z2
MODULE PROCEDURE FMMPY_ZM2C2
MODULE PROCEDURE FMMPY_ZM2ZM2
END INTERFACE
CONTAINS
! *
FUNCTION FMMPY_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMMPYI(MA%MFM,IVAL,FMMPY_IFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IFM
FUNCTION FMMPY_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMMPY_IIM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMMPYI(MA%MIM,IVAL,FMMPY_IIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IIM
FUNCTION FMMPY_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_IZM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMMPYI(MA%MZM,IVAL,FMMPY_IZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IZM
FUNCTION FMMPY_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_RFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RFM
FUNCTION FMMPY_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_RIM
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_RIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RIM
FUNCTION FMMPY_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_RZM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_RZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RZM
FUNCTION FMMPY_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_DFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DFM
FUNCTION FMMPY_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_DIM
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_DIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIM
FUNCTION FMMPY_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_DZM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_DZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DZM
FUNCTION FMMPY_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_ZFM
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZFM
FUNCTION FMMPY_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_ZIM
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZIM
FUNCTION FMMPY_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZZM
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_ZZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZZM
FUNCTION FMMPY_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_CFM
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_CFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CFM
FUNCTION FMMPY_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_CIM
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CIM
FUNCTION FMMPY_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_CZM
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_CZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CZM
FUNCTION FMMPY_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMMPYI(MA%MFM,IVAL,FMMPY_FMI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMI
FUNCTION FMMPY_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMR
FUNCTION FMMPY_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMD
FUNCTION FMMPY_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_FMZ
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZ
FUNCTION FMMPY_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_FMC
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMC
FUNCTION FMMPY_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMMPY_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMPY(MA%MFM,MB%MFM,FMMPY_FMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMFM
FUNCTION FMMPY_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMMPY_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMIM
FUNCTION FMMPY_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB,FMMPY_FMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
CALL ZMMPY(MTZM,MB%MZM,FMMPY_FMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZM
FUNCTION FMMPY_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMMPY_IMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMMPYI(MA%MIM,IVAL,FMMPY_IMI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMI
FUNCTION FMMPY_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_IMR
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMR
FUNCTION FMMPY_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMMPY_IMD
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMD
FUNCTION FMMPY_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_IMZ
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZ
FUNCTION FMMPY_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMMPY_IMC
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMC
FUNCTION FMMPY_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB,FMMPY_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMMPY(MTFM,MB%MFM,FMMPY_IMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMFM
FUNCTION FMMPY_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMMPY_IMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMMPY(MA%MIM,MB%MIM,FMMPY_IMIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMIM
FUNCTION FMMPY_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB,FMMPY_IMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MB%MZM,FMMPY_IMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZM
FUNCTION FMMPY_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMMPYI(MA%MZM,IVAL,FMMPY_ZMI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMI
FUNCTION FMMPY_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMR%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMR
FUNCTION FMMPY_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMD%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMD
FUNCTION FMMPY_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMZ
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZ
FUNCTION FMMPY_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMMPY_ZMC
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMC
FUNCTION FMMPY_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA,FMMPY_ZMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMFM
FUNCTION FMMPY_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA,FMMPY_ZMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MA%MZM,MUZM,FMMPY_ZMIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMIM
FUNCTION FMMPY_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,FMMPY_ZMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMMPY(MA%MZM,MB%MZM,FMMPY_ZMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZM
! Array multiplication operations for FM.
! (1) rank 0 * rank 1
FUNCTION FMMPY_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_IFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_IFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IFM1
FUNCTION FMMPY_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_RFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RFM1
FUNCTION FMMPY_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_DFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DFM1
FUNCTION FMMPY_ZFM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZFM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZFM1%MZM(1) = -1
FMMPY_ZFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_ZFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZFM1
FUNCTION FMMPY_CFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_CFM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CFM1%MZM(1) = -1
FMMPY_CFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CFM1
FUNCTION FMMPY_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMMPY_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_FMI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMI1
FUNCTION FMMPY_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_FMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMR1
FUNCTION FMMPY_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_FMD1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMD1
FUNCTION FMMPY_FMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_FMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_FMZ1%MZM(1) = -1
FMMPY_FMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZ1
FUNCTION FMMPY_FMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_FMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_FMC1%MZM(1) = -1
FMMPY_FMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMC1
FUNCTION FMMPY_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMMPY_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMMPY(MA%MFM,MB(J)%MFM,FMMPY_FMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMFM1
FUNCTION FMMPY_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMMPY_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, N
CALL FMMPY(MTFM,MB(J)%MFM,FMMPY_IMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMFM1
FUNCTION FMMPY_ZMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMMPY_ZMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZMFM1%MZM(1) = -1
FMMPY_ZMFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMFM1
FUNCTION FMMPY_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMMPY_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FMIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMIM1
FUNCTION FMMPY_FMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMMPY_FMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FMZM1%MZM(1) = -1
FMMPY_FMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MB(J)%MZM,FMMPY_FMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZM1
! (2) rank 1 * rank 0
FUNCTION FMMPY_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_FM1I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1I(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1I
FUNCTION FMMPY_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_FM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1R
FUNCTION FMMPY_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_FM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1D
FUNCTION FMMPY_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_FM1Z%MZM(1) = -1
FMMPY_FM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1Z
FUNCTION FMMPY_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_FM1C%MZM(1) = -1
FMMPY_FM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1C
FUNCTION FMMPY_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_I1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1FM
FUNCTION FMMPY_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_R1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1FM
FUNCTION FMMPY_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_D1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1FM
FUNCTION FMMPY_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1FM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1FM%MZM(1) = -1
FMMPY_Z1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1FM
FUNCTION FMMPY_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1FM%MZM(1) = -1
FMMPY_C1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_C1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1FM
FUNCTION FMMPY_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MB%MFM,FMMPY_FM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1FM
FUNCTION FMMPY_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1IM
FUNCTION FMMPY_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1ZM%MZM(1) = -1
FMMPY_FM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMMPY(MTZM,MB%MZM,FMMPY_FM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1ZM
FUNCTION FMMPY_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMMPY(MTFM,MB%MFM,FMMPY_IM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1FM
FUNCTION FMMPY_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1FM%MZM(1) = -1
FMMPY_ZM1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1FM
! (3) rank 1 * rank 1
FUNCTION FMMPY_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_FM1I1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1I1
FUNCTION FMMPY_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMMPY_FM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1R1
FUNCTION FMMPY_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_FM1D1%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_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1D1
FUNCTION FMMPY_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMMPY_FM1Z1%MZM(1) = -1
FMMPY_FM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1Z1
FUNCTION FMMPY_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_FM1C1%MZM(1) = -1
FMMPY_FM1C1%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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1C1
FUNCTION FMMPY_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1FM1
FUNCTION FMMPY_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1FM1
FUNCTION FMMPY_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1FM1%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_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMMPY(MTFM,MA(J)%MFM,FMMPY_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1FM1
FUNCTION FMMPY_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1FM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1FM1%MZM(1) = -1
FMMPY_Z1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1FM1
FUNCTION FMMPY_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1FM1%MZM(1) = -1
FMMPY_C1FM1%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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1FM1
FUNCTION FMMPY_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMMPY(MA(J)%MFM,MB(J)%MFM,FMMPY_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1FM1
FUNCTION FMMPY_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMMPY(MA(J)%MFM,MTFM,FMMPY_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1IM1
FUNCTION FMMPY_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_FM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_FM1ZM1%MZM(1) = -1
FMMPY_FM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMMPY(MTZM,MB(J)%MZM,FMMPY_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM1ZM1
FUNCTION FMMPY_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMMPY(MTFM,MB(J)%MFM,FMMPY_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1FM1
FUNCTION FMMPY_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1FM1%MZM(1) = -1
FMMPY_ZM1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1FM1
! (4) rank 0 * rank 2
FUNCTION FMMPY_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_IFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_IFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IFM2
FUNCTION FMMPY_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_RFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RFM2
FUNCTION FMMPY_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_DFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DFM2
FUNCTION FMMPY_ZFM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZFM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZFM2%MZM(1) = -1
FMMPY_ZFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZFM2
FUNCTION FMMPY_CFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_CFM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CFM2%MZM(1) = -1
FMMPY_CFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CFM2
FUNCTION FMMPY_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_FMI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMI2
FUNCTION FMMPY_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_FMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMR2
FUNCTION FMMPY_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_FMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMD2
FUNCTION FMMPY_FMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_FMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_FMZ2%MZM(1) = -1
FMMPY_FMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZ2
FUNCTION FMMPY_FMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_FMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_FMC2%MZM(1) = -1
FMMPY_FMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMC2
FUNCTION FMMPY_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY(MA%MFM,MB(J,K)%MFM,FMMPY_FMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMFM2
FUNCTION FMMPY_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMMPY(MTFM,MB(J,K)%MFM,FMMPY_IMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMFM2
FUNCTION FMMPY_ZMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_ZMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZMFM2%MZM(1) = -1
FMMPY_ZMFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMFM2
FUNCTION FMMPY_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FMIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MTFM)
CALL FMMPY(MA%MFM,MTFM,FMMPY_FMIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMIM2
FUNCTION FMMPY_FMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_FMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FMZM2%MZM(1) = -1
FMMPY_FMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMMPY(MTZM,MB(J,K)%MZM,FMMPY_FMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FMZM2
! (5) rank 2 * rank 0
FUNCTION FMMPY_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_FM2I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2I(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2I
FUNCTION FMMPY_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_FM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2R
FUNCTION FMMPY_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_FM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2D
FUNCTION FMMPY_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_FM2Z%MZM(1) = -1
FMMPY_FM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_FM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2Z
FUNCTION FMMPY_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_FM2C%MZM(1) = -1
FMMPY_FM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2C
FUNCTION FMMPY_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_I2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2FM
FUNCTION FMMPY_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_R2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2FM
FUNCTION FMMPY_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2FM%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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA%MFM,FMMPY_D2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2FM
FUNCTION FMMPY_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2FM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2FM%MZM(1) = -1
FMMPY_Z2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2FM
FUNCTION FMMPY_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2FM%MZM(1) = -1
FMMPY_C2FM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2FM
FUNCTION FMMPY_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MB%MFM,FMMPY_FM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2FM
FUNCTION FMMPY_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2IM
FUNCTION FMMPY_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2ZM%MZM(1) = -1
FMMPY_FM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMMPY(MTZM,MB%MZM,FMMPY_FM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2ZM
FUNCTION FMMPY_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMMPY(MTFM,MB%MFM,FMMPY_IM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2FM
FUNCTION FMMPY_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2FM%MZM(1) = -1
FMMPY_ZM2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2FM
! (6) rank 2 * rank 2
FUNCTION FMMPY_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_FM2I2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_FM2I2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2I2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2I2
FUNCTION FMMPY_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMMPY_FM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_FM2R2(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 FMSP2M(R(J,K),MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2R2
FUNCTION FMMPY_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_FM2D2%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_FM2D2(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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2D2
FUNCTION FMMPY_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMMPY_FM2Z2%MZM(1) = -1
FMMPY_FM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_FM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2Z2
FUNCTION FMMPY_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_FM2C2%MZM(1) = -1
FMMPY_FM2C2%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_FM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2C2
FUNCTION FMMPY_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_I2FM2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_I2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2FM2
FUNCTION FMMPY_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_R2FM2(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 FMSP2M(R(J,K),MTFM)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_R2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2FM2
FUNCTION FMMPY_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2FM2%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_D2FM2(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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MA(J,K)%MFM,FMMPY_D2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2FM2
FUNCTION FMMPY_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2FM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2FM2%MZM(1) = -1
FMMPY_Z2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z2FM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2FM2
FUNCTION FMMPY_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2FM2%MZM(1) = -1
FMMPY_C2FM2%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_C2FM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2FM2
FUNCTION FMMPY_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_FM2FM2(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 FMMPY(MA(J,K)%MFM,MB(J,K)%MFM,FMMPY_FM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2FM2
FUNCTION FMMPY_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_FM2IM2(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(MB(J,K)%MIM,MTFM)
CALL FMMPY(MA(J,K)%MFM,MTFM,FMMPY_FM2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2IM2
FUNCTION FMMPY_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_FM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_FM2ZM2%MZM(1) = -1
FMMPY_FM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMMPY(MTZM,MB(J,K)%MZM,FMMPY_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_FM2ZM2
FUNCTION FMMPY_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_IM2FM2(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,MTFM)
CALL FMMPY(MTFM,MB(J,K)%MFM,FMMPY_IM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2FM2
FUNCTION FMMPY_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2FM2%MZM(1) = -1
FMMPY_ZM2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2FM2
! Array multiplication operations for IM.
! (1) rank 0 * rank 1
FUNCTION FMMPY_IIM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IIM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_IIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMMPY(MTIM,MA(J)%MIM,FMMPY_IIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IIM1
FUNCTION FMMPY_RIM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_RIM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_RIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RIM1
FUNCTION FMMPY_DIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_DIM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMMPY(MTFM,MUFM,FMMPY_DIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIM1
FUNCTION FMMPY_ZIM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZIM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZIM1%MZM(1) = -1
FMMPY_ZIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_ZIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZIM1
FUNCTION FMMPY_CIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_CIM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CIM1%MZM(1) = -1
FMMPY_CIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CIM1
FUNCTION FMMPY_IMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMMPY_IMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_IMI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMMPY(MA%MIM,MTIM,FMMPY_IMI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMI1
FUNCTION FMMPY_IMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_IMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_IMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMR1
FUNCTION FMMPY_IMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_IMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_IMD1%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 FMDP2M(D(J),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMD1
FUNCTION FMMPY_IMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_IMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_IMZ1%MZM(1) = -1
FMMPY_IMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZ1
FUNCTION FMMPY_IMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_IMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_IMC1%MZM(1) = -1
FMMPY_IMC1%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMC1
FUNCTION FMMPY_IMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MB)) :: FMMPY_IMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IMIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMMPY(MA%MIM,MB(J)%MIM,FMMPY_IMIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMIM1
FUNCTION FMMPY_ZMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMMPY_ZMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZMIM1%MZM(1) = -1
FMMPY_ZMIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMIM1
FUNCTION FMMPY_IMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMMPY_IMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IMZM1%MZM(1) = -1
FMMPY_IMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MB(J)%MZM,FMMPY_IMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZM1
! (2) rank 1 * rank 0
FUNCTION FMMPY_IM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_IM1I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMMPY(MA(J)%MIM,MTIM,FMMPY_IM1I(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1I
FUNCTION FMMPY_IM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_IM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMMPY(MVFM,MTFM,FMMPY_IM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1R
FUNCTION FMMPY_IM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_IM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMMPY(MVFM,MTFM,FMMPY_IM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1D
FUNCTION FMMPY_IM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_IM1Z%MZM(1) = -1
FMMPY_IM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_IM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1Z
FUNCTION FMMPY_IM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_IM1C%MZM(1) = -1
FMMPY_IM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1C
FUNCTION FMMPY_I1IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1IM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMMPY(MTIM,MA%MIM,FMMPY_I1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1IM
FUNCTION FMMPY_R1IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_R1IM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_R1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1IM
FUNCTION FMMPY_D1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_D1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1IM%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 FMDP2M(D(J),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_D1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1IM
FUNCTION FMMPY_Z1IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1IM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1IM%MZM(1) = -1
FMMPY_Z1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1IM
FUNCTION FMMPY_C1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1IM%MZM(1) = -1
FMMPY_C1IM%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_C1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1IM
FUNCTION FMMPY_IM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMMPY(MA(J)%MIM,MB%MIM,FMMPY_IM1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1IM
FUNCTION FMMPY_IM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1ZM%MZM(1) = -1
FMMPY_IM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(M1ZM,MB%MZM,FMMPY_IM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1ZM
FUNCTION FMMPY_ZM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1IM%MZM(1) = -1
FMMPY_ZM1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,M1ZM,FMMPY_ZM1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1IM
! (3) rank 1 * rank 1
FUNCTION FMMPY_IM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_IM1I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMMPY_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMMPY(MA(J)%MIM,MTIM,FMMPY_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1I1
FUNCTION FMMPY_IM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMMPY_IM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1R1
FUNCTION FMMPY_IM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMMPY_IM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_IM1D1%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_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1D1
FUNCTION FMMPY_IM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMMPY_IM1Z1%MZM(1) = -1
FMMPY_IM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1Z1
FUNCTION FMMPY_IM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_IM1C1%MZM(1) = -1
FMMPY_IM1C1%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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1C1
FUNCTION FMMPY_I1IM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1IM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMMPY_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMMPY(MTIM,MA(J)%MIM,FMMPY_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1IM1
FUNCTION FMMPY_R1IM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMMPY_R1IM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMMPY_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSP2M(R(J),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1IM1
FUNCTION FMMPY_D1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMMPY_D1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1IM1%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_D1IM1(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 FMDP2M(D(J),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_D1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1IM1
FUNCTION FMMPY_Z1IM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1IM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1IM1%MZM(1) = -1
FMMPY_Z1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1IM1
FUNCTION FMMPY_C1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1IM1%MZM(1) = -1
FMMPY_C1IM1%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_C1IM1(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_C1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1IM1
FUNCTION FMMPY_IM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMMPY_IM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMMPY_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMMPY(MA(J)%MIM,MB(J)%MIM,FMMPY_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1IM1
FUNCTION FMMPY_IM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_IM1ZM1%MZM(1) = -1
FMMPY_IM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(M1ZM,MB(J)%MZM,FMMPY_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM1ZM1
FUNCTION FMMPY_ZM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1IM1%MZM(1) = -1
FMMPY_ZM1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(MA(J)%MZM,M1ZM,FMMPY_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1IM1
! (4) rank 0 * rank 2
FUNCTION FMMPY_IIM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IIM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_IIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MTIM,MA(J,K)%MIM,FMMPY_IIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IIM2
FUNCTION FMMPY_RIM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_RIM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RIM2
FUNCTION FMMPY_DIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DIM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DIM2
FUNCTION FMMPY_ZIM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZIM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZIM2%MZM(1) = -1
FMMPY_ZIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZIM2
FUNCTION FMMPY_CIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_CIM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CIM2%MZM(1) = -1
FMMPY_CIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CIM2
FUNCTION FMMPY_IMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_IMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_IMI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMMPY(MA%MIM,MTIM,FMMPY_IMI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMI2
FUNCTION FMMPY_IMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_IMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_IMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMR2
FUNCTION FMMPY_IMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_IMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_IMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MUFM,MTFM,FMMPY_IMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMD2
FUNCTION FMMPY_IMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_IMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_IMZ2%MZM(1) = -1
FMMPY_IMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZ2
FUNCTION FMMPY_IMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_IMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_IMC2%MZM(1) = -1
FMMPY_IMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMC2
FUNCTION FMMPY_IMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_IMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IMIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMMPY(MA%MIM,MB(J,K)%MIM,FMMPY_IMIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMIM2
FUNCTION FMMPY_ZMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_ZMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZMIM2%MZM(1) = -1
FMMPY_ZMIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMIM2
FUNCTION FMMPY_IMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_IMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IMZM2%MZM(1) = -1
FMMPY_IMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMMPY(MTZM,MB(J,K)%MZM,FMMPY_IMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IMZM2
! (5) rank 2 * rank 0
FUNCTION FMMPY_IM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_IM2I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MA(J,K)%MIM,MTIM,FMMPY_IM2I(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2I
FUNCTION FMMPY_IM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_IM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_IM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2R
FUNCTION FMMPY_IM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_IM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_IM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2D
FUNCTION FMMPY_IM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_IM2Z%MZM(1) = -1
FMMPY_IM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_IM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2Z
FUNCTION FMMPY_IM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_IM2C%MZM(1) = -1
FMMPY_IM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2C
FUNCTION FMMPY_I2IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2IM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMMPY(MTIM,MA%MIM,FMMPY_I2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2IM
FUNCTION FMMPY_R2IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2IM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_R2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2IM
FUNCTION FMMPY_D2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2IM%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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MTFM,MVFM,FMMPY_D2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2IM
FUNCTION FMMPY_Z2IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2IM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2IM%MZM(1) = -1
FMMPY_Z2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2IM
FUNCTION FMMPY_C2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2IM%MZM(1) = -1
FMMPY_C2IM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_C2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2IM
FUNCTION FMMPY_IM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MA(J,K)%MIM,MB%MIM,FMMPY_IM2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2IM
FUNCTION FMMPY_IM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2ZM%MZM(1) = -1
FMMPY_IM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(M1ZM,MB%MZM,FMMPY_IM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2ZM
FUNCTION FMMPY_ZM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2IM%MZM(1) = -1
FMMPY_ZM2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MA(J,K)%MZM,M1ZM,FMMPY_ZM2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2IM
! (6) rank 2 * rank 2
FUNCTION FMMPY_IM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_IM2I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMMPY_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMMPY(MA(J,K)%MIM,MTIM,FMMPY_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2I2
FUNCTION FMMPY_IM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMMPY_IM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_IM2R2(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 FMSP2M(R(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2R2
FUNCTION FMMPY_IM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_IM2D2%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_IM2D2(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 FMDP2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMMPY(M1FM,MTFM,FMMPY_IM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2D2
FUNCTION FMMPY_IM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMMPY_IM2Z2%MZM(1) = -1
FMMPY_IM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MUZM,MTZM,FMMPY_IM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2Z2
FUNCTION FMMPY_IM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_IM2C2%MZM(1) = -1
FMMPY_IM2C2%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_IM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2C2
FUNCTION FMMPY_I2IM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2IM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMMPY_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMMPY(MTIM,MA(J,K)%MIM,FMMPY_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2IM2
FUNCTION FMMPY_R2IM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2IM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMMPY_R2IM2(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 FMSP2M(R(J,K),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_R2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2IM2
FUNCTION FMMPY_D2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2IM2%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_D2IM2(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 FMDP2M(D(J,K),MTFM)
CALL FMMPY(MTFM,M1FM,FMMPY_D2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2IM2
FUNCTION FMMPY_Z2IM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2IM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2IM2%MZM(1) = -1
FMMPY_Z2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z2IM2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_Z2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2IM2
FUNCTION FMMPY_C2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2IM2%MZM(1) = -1
FMMPY_C2IM2%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_C2IM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMMPY(MTZM,MUZM,FMMPY_C2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2IM2
FUNCTION FMMPY_IM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMMPY_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MA(J,K)%MIM,MB(J,K)%MIM,FMMPY_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2IM2
FUNCTION FMMPY_IM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_IM2ZM2%MZM(1) = -1
FMMPY_IM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(M1ZM,MB(J,K)%MZM,FMMPY_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IM2ZM2
FUNCTION FMMPY_ZM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2IM2%MZM(1) = -1
FMMPY_ZM2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMMPY(MA(J,K)%MZM,M1ZM,FMMPY_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2IM2
! Array multiplication operations for ZM.
! (1) rank 0 * rank 1
FUNCTION FMMPY_IZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_IZM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_IZM1%MZM(1) = -1
FMMPY_IZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_IZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IZM1
FUNCTION FMMPY_RZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_RZM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RZM1%MZM(1) = -1
FMMPY_RZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_RZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RZM1
FUNCTION FMMPY_DZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_DZM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DZM1%MZM(1) = -1
FMMPY_DZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_DZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DZM1
FUNCTION FMMPY_ZZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZZM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZZM1%MZM(1) = -1
FMMPY_ZZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_ZZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZZM1
FUNCTION FMMPY_CZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_CZM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CZM1%MZM(1) = -1
FMMPY_CZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_CZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CZM1
FUNCTION FMMPY_ZMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMMPY_ZMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_ZMI1%MZM(1) = -1
FMMPY_ZMI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMI1
FUNCTION FMMPY_ZMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMMPY_ZMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_ZMR1%MZM(1) = -1
FMMPY_ZMR1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMR1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMR1
FUNCTION FMMPY_ZMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_ZMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_ZMD1%MZM(1) = -1
FMMPY_ZMD1%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMD1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMD1
FUNCTION FMMPY_ZMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_ZMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_ZMZ1%MZM(1) = -1
FMMPY_ZMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZ1
FUNCTION FMMPY_ZMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_ZMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_ZMC1%MZM(1) = -1
FMMPY_ZMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMC1
FUNCTION FMMPY_ZMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMMPY_ZMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZMZM1%MZM(1) = -1
FMMPY_ZMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL ZMMPY(MA%MZM,MB(J)%MZM,FMMPY_ZMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZM1
! (2) rank 1 * rank 0
FUNCTION FMMPY_ZM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMMPY_ZM1I%MZM(1) = -1
FMMPY_ZM1I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1I(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1I
FUNCTION FMMPY_ZM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMMPY_ZM1R%MZM(1) = -1
FMMPY_ZM1R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1R(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1R
FUNCTION FMMPY_ZM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_ZM1D%MZM(1) = -1
FMMPY_ZM1D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1D(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1D
FUNCTION FMMPY_ZM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZM1Z%MZM(1) = -1
FMMPY_ZM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1Z
FUNCTION FMMPY_ZM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_ZM1C%MZM(1) = -1
FMMPY_ZM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1C
FUNCTION FMMPY_I1ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1ZM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1ZM%MZM(1) = -1
FMMPY_I1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_I1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1ZM
FUNCTION FMMPY_R1ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMMPY_R1ZM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1ZM%MZM(1) = -1
FMMPY_R1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_R1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1ZM
FUNCTION FMMPY_D1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_D1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1ZM%MZM(1) = -1
FMMPY_D1ZM%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_D1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1ZM
FUNCTION FMMPY_Z1ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1ZM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1ZM%MZM(1) = -1
FMMPY_Z1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_Z1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1ZM
FUNCTION FMMPY_C1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1ZM%MZM(1) = -1
FMMPY_C1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_C1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1ZM
FUNCTION FMMPY_ZM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1ZM%MZM(1) = -1
FMMPY_ZM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MB%MZM,FMMPY_ZM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1ZM
! (3) rank 1 * rank 1
FUNCTION FMMPY_ZM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_ZM1I1%MZM(1) = -1
FMMPY_ZM1I1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1I1
FUNCTION FMMPY_ZM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMMPY_ZM1R1%MZM(1) = -1
FMMPY_ZM1R1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1R1
FUNCTION FMMPY_ZM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM1D1%MZM(1) = -1
FMMPY_ZM1D1%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_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1D1
FUNCTION FMMPY_ZM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMMPY_ZM1Z1%MZM(1) = -1
FMMPY_ZM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1Z1
FUNCTION FMMPY_ZM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMMPY_ZM1C1%MZM(1) = -1
FMMPY_ZM1C1%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_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J)%MZM,MTZM,FMMPY_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1C1
FUNCTION FMMPY_I1ZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMMPY_I1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMMPY_I1ZM1%MZM(1) = -1
FMMPY_I1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I1ZM1
FUNCTION FMMPY_R1ZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMMPY_R1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMMPY_R1ZM1%MZM(1) = -1
FMMPY_R1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R1ZM1
FUNCTION FMMPY_D1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMMPY_D1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMMPY_D1ZM1%MZM(1) = -1
FMMPY_D1ZM1%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_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D1ZM1
FUNCTION FMMPY_Z1ZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMMPY_Z1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMMPY_Z1ZM1%MZM(1) = -1
FMMPY_Z1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z1ZM1
FUNCTION FMMPY_C1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMMPY_C1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMMPY_C1ZM1%MZM(1) = -1
FMMPY_C1ZM1%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_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J)%MZM,FMMPY_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C1ZM1
FUNCTION FMMPY_ZM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMMPY_ZM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMMPY_ZM1ZM1%MZM(1) = -1
FMMPY_ZM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMMPY(MA(J)%MZM,MB(J)%MZM,FMMPY_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM1ZM1
! (4) rank 0 * rank 2
FUNCTION FMMPY_IZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_IZM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_IZM2%MZM(1) = -1
FMMPY_IZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_IZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_IZM2
FUNCTION FMMPY_RZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_RZM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_RZM2%MZM(1) = -1
FMMPY_RZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_RZM2
FUNCTION FMMPY_DZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_DZM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_DZM2%MZM(1) = -1
FMMPY_DZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_DZM2
FUNCTION FMMPY_ZZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZZM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZZM2%MZM(1) = -1
FMMPY_ZZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_ZZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZZM2
FUNCTION FMMPY_CZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_CZM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_CZM2%MZM(1) = -1
FMMPY_CZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_CZM2
FUNCTION FMMPY_ZMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_ZMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_ZMI2%MZM(1) = -1
FMMPY_ZMI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMI2
FUNCTION FMMPY_ZMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_ZMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_ZMR2%MZM(1) = -1
FMMPY_ZMR2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMR2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMR2
FUNCTION FMMPY_ZMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_ZMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_ZMD2%MZM(1) = -1
FMMPY_ZMD2%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMD2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMD2
FUNCTION FMMPY_ZMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_ZMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_ZMZ2%MZM(1) = -1
FMMPY_ZMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZ2
FUNCTION FMMPY_ZMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_ZMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_ZMC2%MZM(1) = -1
FMMPY_ZMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA%MZM,MTZM,FMMPY_ZMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMC2
FUNCTION FMMPY_ZMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMMPY_ZMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZMZM2%MZM(1) = -1
FMMPY_ZMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMMPY(MA%MZM,MB(J,K)%MZM,FMMPY_ZMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZMZM2
! (5) rank 2 * rank 0
FUNCTION FMMPY_ZM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMMPY_ZM2I%MZM(1) = -1
FMMPY_ZM2I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_ZM2I(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2I
FUNCTION FMMPY_ZM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMMPY_ZM2R%MZM(1) = -1
FMMPY_ZM2R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZM2R(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2R
FUNCTION FMMPY_ZM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMMPY_ZM2D%MZM(1) = -1
FMMPY_ZM2D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZM2D(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2D
FUNCTION FMMPY_ZM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMMPY_ZM2Z%MZM(1) = -1
FMMPY_ZM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2Z
FUNCTION FMMPY_ZM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMMPY_ZM2C%MZM(1) = -1
FMMPY_ZM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_ZM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2C
FUNCTION FMMPY_I2ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2ZM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2ZM%MZM(1) = -1
FMMPY_I2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_I2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2ZM
FUNCTION FMMPY_R2ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2ZM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2ZM%MZM(1) = -1
FMMPY_R2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_R2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2ZM
FUNCTION FMMPY_D2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2ZM%MZM(1) = -1
FMMPY_D2ZM%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_D2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2ZM
FUNCTION FMMPY_Z2ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2ZM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2ZM%MZM(1) = -1
FMMPY_Z2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_Z2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2ZM
FUNCTION FMMPY_C2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2ZM%MZM(1) = -1
FMMPY_C2ZM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA%MZM,FMMPY_C2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2ZM
FUNCTION FMMPY_ZM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2ZM%MZM(1) = -1
FMMPY_ZM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMMPY(MA(J,K)%MZM,MB%MZM,FMMPY_ZM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2ZM
! (6) rank 2 * rank 2
FUNCTION FMMPY_ZM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_ZM2I2%MZM(1) = -1
FMMPY_ZM2I2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2I2(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 ZMI2M(IVAL(J,K),MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2I2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2I2
FUNCTION FMMPY_ZM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMMPY_ZM2R2%MZM(1) = -1
FMMPY_ZM2R2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2R2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2R2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2R2
FUNCTION FMMPY_ZM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMMPY_ZM2D2%MZM(1) = -1
FMMPY_ZM2D2%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_ZM2D2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2D2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2D2
FUNCTION FMMPY_ZM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMMPY_ZM2Z2%MZM(1) = -1
FMMPY_ZM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2Z2
FUNCTION FMMPY_ZM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMMPY_ZM2C2%MZM(1) = -1
FMMPY_ZM2C2%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_ZM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MA(J,K)%MZM,MTZM,FMMPY_ZM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2C2
FUNCTION FMMPY_I2ZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMMPY_I2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMMPY_I2ZM2%MZM(1) = -1
FMMPY_I2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_I2ZM2(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 FMI2M(IVAL(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_I2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_I2ZM2
FUNCTION FMMPY_R2ZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMMPY_R2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMMPY_R2ZM2%MZM(1) = -1
FMMPY_R2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_R2ZM2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_R2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_R2ZM2
FUNCTION FMMPY_D2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMMPY_D2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMMPY_D2ZM2%MZM(1) = -1
FMMPY_D2ZM2%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_D2ZM2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_D2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_D2ZM2
FUNCTION FMMPY_Z2ZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMMPY_Z2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMMPY_Z2ZM2%MZM(1) = -1
FMMPY_Z2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_Z2ZM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_Z2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_Z2ZM2
FUNCTION FMMPY_C2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMMPY_C2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMMPY_C2ZM2%MZM(1) = -1
FMMPY_C2ZM2%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_C2ZM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMMPY(MTZM,MA(J,K)%MZM,FMMPY_C2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_C2ZM2
FUNCTION FMMPY_ZM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMMPY_ZM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMPY_ZM2ZM2%MZM(1) = -1
FMMPY_ZM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMMPY_ZM2ZM2(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 ZMMPY(MA(J,K)%MZM,MB(J,K)%MZM,FMMPY_ZM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMPY_ZM2ZM2
END MODULE FMZM_6
MODULE FMZM_7
USE FMZM_1
INTERFACE OPERATOR (/)
MODULE PROCEDURE FMDIV_IFM
MODULE PROCEDURE FMDIV_IIM
MODULE PROCEDURE FMDIV_IZM
MODULE PROCEDURE FMDIV_RFM
MODULE PROCEDURE FMDIV_RIM
MODULE PROCEDURE FMDIV_RZM
MODULE PROCEDURE FMDIV_DFM
MODULE PROCEDURE FMDIV_DIM
MODULE PROCEDURE FMDIV_DZM
MODULE PROCEDURE FMDIV_ZFM
MODULE PROCEDURE FMDIV_ZIM
MODULE PROCEDURE FMDIV_ZZM
MODULE PROCEDURE FMDIV_CFM
MODULE PROCEDURE FMDIV_CIM
MODULE PROCEDURE FMDIV_CZM
MODULE PROCEDURE FMDIV_FMI
MODULE PROCEDURE FMDIV_FMR
MODULE PROCEDURE FMDIV_FMD
MODULE PROCEDURE FMDIV_FMZ
MODULE PROCEDURE FMDIV_FMC
MODULE PROCEDURE FMDIV_FMFM
MODULE PROCEDURE FMDIV_FMIM
MODULE PROCEDURE FMDIV_FMZM
MODULE PROCEDURE FMDIV_IMI
MODULE PROCEDURE FMDIV_IMR
MODULE PROCEDURE FMDIV_IMD
MODULE PROCEDURE FMDIV_IMZ
MODULE PROCEDURE FMDIV_IMC
MODULE PROCEDURE FMDIV_IMFM
MODULE PROCEDURE FMDIV_IMIM
MODULE PROCEDURE FMDIV_IMZM
MODULE PROCEDURE FMDIV_ZMI
MODULE PROCEDURE FMDIV_ZMR
MODULE PROCEDURE FMDIV_ZMD
MODULE PROCEDURE FMDIV_ZMZ
MODULE PROCEDURE FMDIV_ZMC
MODULE PROCEDURE FMDIV_ZMFM
MODULE PROCEDURE FMDIV_ZMIM
MODULE PROCEDURE FMDIV_ZMZM
MODULE PROCEDURE FMDIV_IFM1
MODULE PROCEDURE FMDIV_RFM1
MODULE PROCEDURE FMDIV_DFM1
MODULE PROCEDURE FMDIV_ZFM1
MODULE PROCEDURE FMDIV_CFM1
MODULE PROCEDURE FMDIV_FMI1
MODULE PROCEDURE FMDIV_FMR1
MODULE PROCEDURE FMDIV_FMD1
MODULE PROCEDURE FMDIV_FMZ1
MODULE PROCEDURE FMDIV_FMC1
MODULE PROCEDURE FMDIV_FMFM1
MODULE PROCEDURE FMDIV_IMFM1
MODULE PROCEDURE FMDIV_ZMFM1
MODULE PROCEDURE FMDIV_FMIM1
MODULE PROCEDURE FMDIV_FMZM1
MODULE PROCEDURE FMDIV_FM1I
MODULE PROCEDURE FMDIV_FM1R
MODULE PROCEDURE FMDIV_FM1D
MODULE PROCEDURE FMDIV_FM1Z
MODULE PROCEDURE FMDIV_FM1C
MODULE PROCEDURE FMDIV_I1FM
MODULE PROCEDURE FMDIV_R1FM
MODULE PROCEDURE FMDIV_D1FM
MODULE PROCEDURE FMDIV_Z1FM
MODULE PROCEDURE FMDIV_C1FM
MODULE PROCEDURE FMDIV_FM1FM
MODULE PROCEDURE FMDIV_FM1IM
MODULE PROCEDURE FMDIV_FM1ZM
MODULE PROCEDURE FMDIV_IM1FM
MODULE PROCEDURE FMDIV_ZM1FM
MODULE PROCEDURE FMDIV_I1FM1
MODULE PROCEDURE FMDIV_R1FM1
MODULE PROCEDURE FMDIV_D1FM1
MODULE PROCEDURE FMDIV_Z1FM1
MODULE PROCEDURE FMDIV_C1FM1
MODULE PROCEDURE FMDIV_FM1I1
MODULE PROCEDURE FMDIV_FM1R1
MODULE PROCEDURE FMDIV_FM1D1
MODULE PROCEDURE FMDIV_FM1Z1
MODULE PROCEDURE FMDIV_FM1C1
MODULE PROCEDURE FMDIV_FM1FM1
MODULE PROCEDURE FMDIV_IM1FM1
MODULE PROCEDURE FMDIV_ZM1FM1
MODULE PROCEDURE FMDIV_FM1IM1
MODULE PROCEDURE FMDIV_FM1ZM1
MODULE PROCEDURE FMDIV_IIM1
MODULE PROCEDURE FMDIV_RIM1
MODULE PROCEDURE FMDIV_DIM1
MODULE PROCEDURE FMDIV_ZIM1
MODULE PROCEDURE FMDIV_CIM1
MODULE PROCEDURE FMDIV_IMI1
MODULE PROCEDURE FMDIV_IMR1
MODULE PROCEDURE FMDIV_IMD1
MODULE PROCEDURE FMDIV_IMZ1
MODULE PROCEDURE FMDIV_IMC1
MODULE PROCEDURE FMDIV_IMIM1
MODULE PROCEDURE FMDIV_ZMIM1
MODULE PROCEDURE FMDIV_IMZM1
MODULE PROCEDURE FMDIV_IM1I
MODULE PROCEDURE FMDIV_IM1R
MODULE PROCEDURE FMDIV_IM1D
MODULE PROCEDURE FMDIV_IM1Z
MODULE PROCEDURE FMDIV_IM1C
MODULE PROCEDURE FMDIV_I1IM
MODULE PROCEDURE FMDIV_R1IM
MODULE PROCEDURE FMDIV_D1IM
MODULE PROCEDURE FMDIV_Z1IM
MODULE PROCEDURE FMDIV_C1IM
MODULE PROCEDURE FMDIV_IM1IM
MODULE PROCEDURE FMDIV_IM1ZM
MODULE PROCEDURE FMDIV_ZM1IM
MODULE PROCEDURE FMDIV_I1IM1
MODULE PROCEDURE FMDIV_R1IM1
MODULE PROCEDURE FMDIV_D1IM1
MODULE PROCEDURE FMDIV_Z1IM1
MODULE PROCEDURE FMDIV_C1IM1
MODULE PROCEDURE FMDIV_IM1I1
MODULE PROCEDURE FMDIV_IM1R1
MODULE PROCEDURE FMDIV_IM1D1
MODULE PROCEDURE FMDIV_IM1Z1
MODULE PROCEDURE FMDIV_IM1C1
MODULE PROCEDURE FMDIV_IM1IM1
MODULE PROCEDURE FMDIV_ZM1IM1
MODULE PROCEDURE FMDIV_IM1ZM1
MODULE PROCEDURE FMDIV_IZM1
MODULE PROCEDURE FMDIV_RZM1
MODULE PROCEDURE FMDIV_DZM1
MODULE PROCEDURE FMDIV_ZZM1
MODULE PROCEDURE FMDIV_CZM1
MODULE PROCEDURE FMDIV_ZMI1
MODULE PROCEDURE FMDIV_ZMR1
MODULE PROCEDURE FMDIV_ZMD1
MODULE PROCEDURE FMDIV_ZMZ1
MODULE PROCEDURE FMDIV_ZMC1
MODULE PROCEDURE FMDIV_ZMZM1
MODULE PROCEDURE FMDIV_ZM1I
MODULE PROCEDURE FMDIV_ZM1R
MODULE PROCEDURE FMDIV_ZM1D
MODULE PROCEDURE FMDIV_ZM1Z
MODULE PROCEDURE FMDIV_ZM1C
MODULE PROCEDURE FMDIV_I1ZM
MODULE PROCEDURE FMDIV_R1ZM
MODULE PROCEDURE FMDIV_D1ZM
MODULE PROCEDURE FMDIV_Z1ZM
MODULE PROCEDURE FMDIV_C1ZM
MODULE PROCEDURE FMDIV_ZM1ZM
MODULE PROCEDURE FMDIV_I1ZM1
MODULE PROCEDURE FMDIV_R1ZM1
MODULE PROCEDURE FMDIV_D1ZM1
MODULE PROCEDURE FMDIV_Z1ZM1
MODULE PROCEDURE FMDIV_C1ZM1
MODULE PROCEDURE FMDIV_ZM1I1
MODULE PROCEDURE FMDIV_ZM1R1
MODULE PROCEDURE FMDIV_ZM1D1
MODULE PROCEDURE FMDIV_ZM1Z1
MODULE PROCEDURE FMDIV_ZM1C1
MODULE PROCEDURE FMDIV_ZM1ZM1
MODULE PROCEDURE FMDIV_IFM2
MODULE PROCEDURE FMDIV_RFM2
MODULE PROCEDURE FMDIV_DFM2
MODULE PROCEDURE FMDIV_ZFM2
MODULE PROCEDURE FMDIV_CFM2
MODULE PROCEDURE FMDIV_FMI2
MODULE PROCEDURE FMDIV_FMR2
MODULE PROCEDURE FMDIV_FMD2
MODULE PROCEDURE FMDIV_FMZ2
MODULE PROCEDURE FMDIV_FMC2
MODULE PROCEDURE FMDIV_FMFM2
MODULE PROCEDURE FMDIV_IMFM2
MODULE PROCEDURE FMDIV_ZMFM2
MODULE PROCEDURE FMDIV_FMIM2
MODULE PROCEDURE FMDIV_FMZM2
MODULE PROCEDURE FMDIV_FM2I
MODULE PROCEDURE FMDIV_FM2R
MODULE PROCEDURE FMDIV_FM2D
MODULE PROCEDURE FMDIV_FM2Z
MODULE PROCEDURE FMDIV_FM2C
MODULE PROCEDURE FMDIV_I2FM
MODULE PROCEDURE FMDIV_R2FM
MODULE PROCEDURE FMDIV_D2FM
MODULE PROCEDURE FMDIV_Z2FM
MODULE PROCEDURE FMDIV_C2FM
MODULE PROCEDURE FMDIV_FM2FM
MODULE PROCEDURE FMDIV_FM2IM
MODULE PROCEDURE FMDIV_FM2ZM
MODULE PROCEDURE FMDIV_IM2FM
MODULE PROCEDURE FMDIV_ZM2FM
MODULE PROCEDURE FMDIV_I2FM2
MODULE PROCEDURE FMDIV_R2FM2
MODULE PROCEDURE FMDIV_D2FM2
MODULE PROCEDURE FMDIV_Z2FM2
MODULE PROCEDURE FMDIV_C2FM2
MODULE PROCEDURE FMDIV_FM2I2
MODULE PROCEDURE FMDIV_FM2R2
MODULE PROCEDURE FMDIV_FM2D2
MODULE PROCEDURE FMDIV_FM2Z2
MODULE PROCEDURE FMDIV_FM2C2
MODULE PROCEDURE FMDIV_FM2FM2
MODULE PROCEDURE FMDIV_IM2FM2
MODULE PROCEDURE FMDIV_ZM2FM2
MODULE PROCEDURE FMDIV_FM2IM2
MODULE PROCEDURE FMDIV_FM2ZM2
MODULE PROCEDURE FMDIV_IIM2
MODULE PROCEDURE FMDIV_RIM2
MODULE PROCEDURE FMDIV_DIM2
MODULE PROCEDURE FMDIV_ZIM2
MODULE PROCEDURE FMDIV_CIM2
MODULE PROCEDURE FMDIV_IMI2
MODULE PROCEDURE FMDIV_IMR2
MODULE PROCEDURE FMDIV_IMD2
MODULE PROCEDURE FMDIV_IMZ2
MODULE PROCEDURE FMDIV_IMC2
MODULE PROCEDURE FMDIV_IMIM2
MODULE PROCEDURE FMDIV_ZMIM2
MODULE PROCEDURE FMDIV_IMZM2
MODULE PROCEDURE FMDIV_IM2I
MODULE PROCEDURE FMDIV_IM2R
MODULE PROCEDURE FMDIV_IM2D
MODULE PROCEDURE FMDIV_IM2Z
MODULE PROCEDURE FMDIV_IM2C
MODULE PROCEDURE FMDIV_I2IM
MODULE PROCEDURE FMDIV_R2IM
MODULE PROCEDURE FMDIV_D2IM
MODULE PROCEDURE FMDIV_Z2IM
MODULE PROCEDURE FMDIV_C2IM
MODULE PROCEDURE FMDIV_IM2IM
MODULE PROCEDURE FMDIV_IM2ZM
MODULE PROCEDURE FMDIV_ZM2IM
MODULE PROCEDURE FMDIV_I2IM2
MODULE PROCEDURE FMDIV_R2IM2
MODULE PROCEDURE FMDIV_D2IM2
MODULE PROCEDURE FMDIV_Z2IM2
MODULE PROCEDURE FMDIV_C2IM2
MODULE PROCEDURE FMDIV_IM2I2
MODULE PROCEDURE FMDIV_IM2R2
MODULE PROCEDURE FMDIV_IM2D2
MODULE PROCEDURE FMDIV_IM2Z2
MODULE PROCEDURE FMDIV_IM2C2
MODULE PROCEDURE FMDIV_IM2IM2
MODULE PROCEDURE FMDIV_ZM2IM2
MODULE PROCEDURE FMDIV_IM2ZM2
MODULE PROCEDURE FMDIV_IZM2
MODULE PROCEDURE FMDIV_RZM2
MODULE PROCEDURE FMDIV_DZM2
MODULE PROCEDURE FMDIV_ZZM2
MODULE PROCEDURE FMDIV_CZM2
MODULE PROCEDURE FMDIV_ZMI2
MODULE PROCEDURE FMDIV_ZMR2
MODULE PROCEDURE FMDIV_ZMD2
MODULE PROCEDURE FMDIV_ZMZ2
MODULE PROCEDURE FMDIV_ZMC2
MODULE PROCEDURE FMDIV_ZMZM2
MODULE PROCEDURE FMDIV_ZM2I
MODULE PROCEDURE FMDIV_ZM2R
MODULE PROCEDURE FMDIV_ZM2D
MODULE PROCEDURE FMDIV_ZM2Z
MODULE PROCEDURE FMDIV_ZM2C
MODULE PROCEDURE FMDIV_I2ZM
MODULE PROCEDURE FMDIV_R2ZM
MODULE PROCEDURE FMDIV_D2ZM
MODULE PROCEDURE FMDIV_Z2ZM
MODULE PROCEDURE FMDIV_C2ZM
MODULE PROCEDURE FMDIV_ZM2ZM
MODULE PROCEDURE FMDIV_I2ZM2
MODULE PROCEDURE FMDIV_R2ZM2
MODULE PROCEDURE FMDIV_D2ZM2
MODULE PROCEDURE FMDIV_Z2ZM2
MODULE PROCEDURE FMDIV_C2ZM2
MODULE PROCEDURE FMDIV_ZM2I2
MODULE PROCEDURE FMDIV_ZM2R2
MODULE PROCEDURE FMDIV_ZM2D2
MODULE PROCEDURE FMDIV_ZM2Z2
MODULE PROCEDURE FMDIV_ZM2C2
MODULE PROCEDURE FMDIV_ZM2ZM2
END INTERFACE
CONTAINS
! /
FUNCTION FMDIV_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_IFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IFM
FUNCTION FMDIV_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMDIV_IIM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMDIV(MTIM,MA%MIM,FMDIV_IIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IIM
FUNCTION FMDIV_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_IZM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_IZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IZM
FUNCTION FMDIV_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_RFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RFM
FUNCTION FMDIV_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_RIM
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_RIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RIM
FUNCTION FMDIV_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_RZM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_RZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RZM
FUNCTION FMDIV_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_DFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DFM
FUNCTION FMDIV_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_DIM
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_DIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIM
FUNCTION FMDIV_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_DZM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_DZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DZM
FUNCTION FMDIV_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_ZFM
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZFM
FUNCTION FMDIV_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_ZIM
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZIM
FUNCTION FMDIV_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZZM
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_ZZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZZM
FUNCTION FMDIV_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_CFM
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_CFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CFM
FUNCTION FMDIV_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_CIM
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CIM
FUNCTION FMDIV_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_CZM
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_CZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CZM
FUNCTION FMDIV_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDIVI(MA%MFM,IVAL,FMDIV_FMI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMI
FUNCTION FMDIV_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMR
FUNCTION FMDIV_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMD
FUNCTION FMDIV_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_FMZ
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZ
FUNCTION FMDIV_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_FMC
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMC
FUNCTION FMDIV_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMDIV_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMDIV(MA%MFM,MB%MFM,FMDIV_FMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMFM
FUNCTION FMDIV_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDIV_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMIM
FUNCTION FMDIV_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB,FMDIV_FMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
CALL ZMDIV(MTZM,MB%MZM,FMDIV_FMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZM
FUNCTION FMDIV_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMDIV_IMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMDIVI(MA%MIM,IVAL,FMDIV_IMI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMI
FUNCTION FMDIV_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_IMR
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMR
FUNCTION FMDIV_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDIV_IMD
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMD
FUNCTION FMDIV_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_IMZ
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZ
FUNCTION FMDIV_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMDIV_IMC
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMC
FUNCTION FMDIV_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB,FMDIV_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMDIV(MTFM,MB%MFM,FMDIV_IMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMFM
FUNCTION FMDIV_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMDIV_IMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMDIV(MA%MIM,MB%MIM,FMDIV_IMIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMIM
FUNCTION FMDIV_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB,FMDIV_IMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MB%MZM,FMDIV_IMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZM
FUNCTION FMDIV_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMDIVI(MA%MZM,IVAL,FMDIV_ZMI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMI
FUNCTION FMDIV_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMR%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMR
FUNCTION FMDIV_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMD%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMD
FUNCTION FMDIV_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMZ
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZ
FUNCTION FMDIV_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDIV_ZMC
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMC
FUNCTION FMDIV_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA,FMDIV_ZMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMFM
FUNCTION FMDIV_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA,FMDIV_ZMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MA%MZM,MUZM,FMDIV_ZMIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMIM
FUNCTION FMDIV_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,FMDIV_ZMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMDIV(MA%MZM,MB%MZM,FMDIV_ZMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZM
! Array division operations for FM.
! (1) rank 0 / rank 1
FUNCTION FMDIV_IFM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IFM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_IFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_IFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IFM1
FUNCTION FMDIV_RFM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_RFM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_RFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RFM1
FUNCTION FMDIV_DFM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_DFM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_DFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DFM1
FUNCTION FMDIV_ZFM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZFM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZFM1%MZM(1) = -1
FMDIV_ZFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_ZFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZFM1
FUNCTION FMDIV_CFM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_CFM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CFM1%MZM(1) = -1
FMDIV_CFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CFM1
FUNCTION FMDIV_FMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMDIV_FMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_FMI1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMI1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMI1
FUNCTION FMDIV_FMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_FMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_FMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMR1
FUNCTION FMDIV_FMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_FMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_FMD1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMD1
FUNCTION FMDIV_FMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_FMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_FMZ1%MZM(1) = -1
FMDIV_FMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZ1
FUNCTION FMDIV_FMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_FMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_FMC1%MZM(1) = -1
FMDIV_FMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMC1
FUNCTION FMDIV_FMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMDIV_FMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL FMDIV(MA%MFM,MB(J)%MFM,FMDIV_FMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMFM1
FUNCTION FMDIV_IMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMDIV_IMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IMFM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, N
CALL FMDIV(MTFM,MB(J)%MFM,FMDIV_IMFM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMFM1
FUNCTION FMDIV_ZMFM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMDIV_ZMFM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZMFM1%MZM(1) = -1
FMDIV_ZMFM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMFM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMFM1
FUNCTION FMDIV_FMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MB)) :: FMDIV_FMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FMIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMIM1
FUNCTION FMDIV_FMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMDIV_FMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FMZM1%MZM(1) = -1
FMDIV_FMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MB(J)%MZM,FMDIV_FMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZM1
! (2) rank 1 / rank 0
FUNCTION FMDIV_FM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_FM1I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1I(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1I
FUNCTION FMDIV_FM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_FM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1R
FUNCTION FMDIV_FM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_FM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1D
FUNCTION FMDIV_FM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_FM1Z%MZM(1) = -1
FMDIV_FM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1Z
FUNCTION FMDIV_FM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_FM1C%MZM(1) = -1
FMDIV_FM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1C
FUNCTION FMDIV_I1FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1FM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_I1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1FM
FUNCTION FMDIV_R1FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_R1FM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_R1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1FM
FUNCTION FMDIV_D1FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_D1FM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_D1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1FM
FUNCTION FMDIV_Z1FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1FM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1FM%MZM(1) = -1
FMDIV_Z1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1FM
FUNCTION FMDIV_C1FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1FM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1FM%MZM(1) = -1
FMDIV_C1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_C1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1FM
FUNCTION FMDIV_FM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MB%MFM,FMDIV_FM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1FM
FUNCTION FMDIV_FM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1IM
FUNCTION FMDIV_FM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1ZM%MZM(1) = -1
FMDIV_FM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMDIV(MTZM,MB%MZM,FMDIV_FM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1ZM
FUNCTION FMDIV_IM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMDIV(MTFM,MB%MFM,FMDIV_IM1FM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1FM
FUNCTION FMDIV_ZM1FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1FM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1FM%MZM(1) = -1
FMDIV_ZM1FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1FM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1FM
! (3) rank 1 / rank 1
FUNCTION FMDIV_FM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_FM1I1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1I1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1I1
FUNCTION FMDIV_FM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMDIV_FM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1R1
FUNCTION FMDIV_FM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_FM1D1%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_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1D1
FUNCTION FMDIV_FM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMDIV_FM1Z1%MZM(1) = -1
FMDIV_FM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1Z1
FUNCTION FMDIV_FM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_FM1C1%MZM(1) = -1
FMDIV_FM1C1%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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1C1
FUNCTION FMDIV_I1FM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1FM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_I1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1FM1
FUNCTION FMDIV_R1FM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_R1FM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_R1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1FM1
FUNCTION FMDIV_D1FM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_D1FM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1FM1%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_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL FMDIV(MTFM,MA(J)%MFM,FMDIV_D1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1FM1
FUNCTION FMDIV_Z1FM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1FM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1FM1%MZM(1) = -1
FMDIV_Z1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MA(J)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1FM1
FUNCTION FMDIV_C1FM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1FM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1FM1%MZM(1) = -1
FMDIV_C1FM1%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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1FM1
FUNCTION FMDIV_FM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDIV(MA(J)%MFM,MB(J)%MFM,FMDIV_FM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1FM1
FUNCTION FMDIV_FM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_FM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MTFM)
CALL FMDIV(MA(J)%MFM,MTFM,FMDIV_FM1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1IM1
FUNCTION FMDIV_FM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_FM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_FM1ZM1%MZM(1) = -1
FMDIV_FM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MA(J)%MFM,MTFM,MTZM)
CALL ZMDIV(MTZM,MB(J)%MZM,FMDIV_FM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM1ZM1
FUNCTION FMDIV_IM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MTFM)
CALL FMDIV(MTFM,MB(J)%MFM,FMDIV_IM1FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1FM1
FUNCTION FMDIV_ZM1FM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1FM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1FM1%MZM(1) = -1
FMDIV_ZM1FM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL ZMCMPX(MB(J)%MFM,MTFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1FM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1FM1
! (4) rank 0 / rank 2
FUNCTION FMDIV_IFM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IFM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_IFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_IFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IFM2
FUNCTION FMDIV_RFM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_RFM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_RFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RFM2
FUNCTION FMDIV_DFM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DFM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_DFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DFM2
FUNCTION FMDIV_ZFM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZFM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZFM2%MZM(1) = -1
FMDIV_ZFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZFM2
FUNCTION FMDIV_CFM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_CFM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CFM2%MZM(1) = -1
FMDIV_CFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CFM2
FUNCTION FMDIV_FMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_FMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_FMI2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMI2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMI2
FUNCTION FMDIV_FMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_FMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_FMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMR2
FUNCTION FMDIV_FMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_FMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_FMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMD2
FUNCTION FMDIV_FMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_FMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_FMZ2%MZM(1) = -1
FMDIV_FMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZ2
FUNCTION FMDIV_FMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_FMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_FMC2%MZM(1) = -1
FMDIV_FMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMC2
FUNCTION FMDIV_FMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_FMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV(MA%MFM,MB(J,K)%MFM,FMDIV_FMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMFM2
FUNCTION FMDIV_IMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_IMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IMFM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL FMDIV(MTFM,MB(J,K)%MFM,FMDIV_IMFM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMFM2
FUNCTION FMDIV_ZMFM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_ZMFM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZMFM2%MZM(1) = -1
FMDIV_ZMFM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMFM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMFM2
FUNCTION FMDIV_FMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_FMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FMIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MTFM)
CALL FMDIV(MA%MFM,MTFM,FMDIV_FMIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMIM2
FUNCTION FMDIV_FMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_FMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FMZM2%MZM(1) = -1
FMDIV_FMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMDIV(MTZM,MB(J,K)%MZM,FMDIV_FMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FMZM2
! (5) rank 2 / rank 0
FUNCTION FMDIV_FM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_FM2I%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2I(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2I
FUNCTION FMDIV_FM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_FM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2R
FUNCTION FMDIV_FM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_FM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2D
FUNCTION FMDIV_FM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_FM2Z%MZM(1) = -1
FMDIV_FM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_FM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2Z
FUNCTION FMDIV_FM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_FM2C%MZM(1) = -1
FMDIV_FM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2C
FUNCTION FMDIV_I2FM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2FM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL FMI2M(IVAL(J,K),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_I2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2FM
FUNCTION FMDIV_R2FM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2FM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_R2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2FM
FUNCTION FMDIV_D2FM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2FM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2FM%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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA%MFM,FMDIV_D2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2FM
FUNCTION FMDIV_Z2FM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2FM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2FM%MZM(1) = -1
FMDIV_Z2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2FM
FUNCTION FMDIV_C2FM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2FM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2FM%MZM(1) = -1
FMDIV_C2FM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2FM
FUNCTION FMDIV_FM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MB%MFM,FMDIV_FM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2FM
FUNCTION FMDIV_FM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2IM
FUNCTION FMDIV_FM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2ZM%MZM(1) = -1
FMDIV_FM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMDIV(MTZM,MB%MZM,FMDIV_FM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2ZM
FUNCTION FMDIV_IM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,MTFM)
CALL FMDIV(MTFM,MB%MFM,FMDIV_IM2FM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2FM
FUNCTION FMDIV_ZM2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2FM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2FM%MZM(1) = -1
FMDIV_ZM2FM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2FM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2FM
! (6) rank 2 / rank 2
FUNCTION FMDIV_FM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_FM2I2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_FM2I2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2I2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2I2
FUNCTION FMDIV_FM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMDIV_FM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_FM2R2(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 FMSP2M(R(J,K),MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2R2
FUNCTION FMDIV_FM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_FM2D2%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_FM2D2(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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2D2
FUNCTION FMDIV_FM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMDIV_FM2Z2%MZM(1) = -1
FMDIV_FM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_FM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2Z2
FUNCTION FMDIV_FM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_FM2C2%MZM(1) = -1
FMDIV_FM2C2%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_FM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_FM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2C2
FUNCTION FMDIV_I2FM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (FM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2FM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_I2FM2(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 FMI2M(IVAL(J,K),MTFM)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_I2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2FM2
FUNCTION FMDIV_R2FM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2FM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_R2FM2(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 FMSP2M(R(J,K),MTFM)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_R2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2FM2
FUNCTION FMDIV_D2FM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2FM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2FM2%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_D2FM2(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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MA(J,K)%MFM,FMDIV_D2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2FM2
FUNCTION FMDIV_Z2FM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2FM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2FM2%MZM(1) = -1
FMDIV_Z2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z2FM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MA(J,K)%MFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2FM2
FUNCTION FMDIV_C2FM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2FM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2FM2%MZM(1) = -1
FMDIV_C2FM2%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_C2FM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_C2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2FM2
FUNCTION FMDIV_FM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_FM2FM2(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 FMDIV(MA(J,K)%MFM,MB(J,K)%MFM,FMDIV_FM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2FM2
FUNCTION FMDIV_FM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_FM2IM2(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(MB(J,K)%MIM,MTFM)
CALL FMDIV(MA(J,K)%MFM,MTFM,FMDIV_FM2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2IM2
FUNCTION FMDIV_FM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_FM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_FM2ZM2%MZM(1) = -1
FMDIV_FM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MA(J,K)%MFM,MTFM,MTZM)
CALL ZMDIV(MTZM,MB(J,K)%MZM,FMDIV_FM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_FM2ZM2
FUNCTION FMDIV_IM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_IM2FM2(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,MTFM)
CALL FMDIV(MTFM,MB(J,K)%MFM,FMDIV_IM2FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2FM2
FUNCTION FMDIV_ZM2FM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2FM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2FM2%MZM(1) = -1
FMDIV_ZM2FM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCMPX(MB(J,K)%MFM,MTFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2FM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2FM2
! Array division operations for IM.
! (1) rank 0 / rank 1
FUNCTION FMDIV_IIM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IIM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_IIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMDIV(MTIM,MA(J)%MIM,FMDIV_IIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IIM1
FUNCTION FMDIV_RIM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_RIM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_RIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RIM1
FUNCTION FMDIV_DIM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_DIM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DIM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MUFM)
CALL FMDIV(MTFM,MUFM,FMDIV_DIM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIM1
FUNCTION FMDIV_ZIM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZIM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZIM1%MZM(1) = -1
FMDIV_ZIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_ZIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZIM1
FUNCTION FMDIV_CIM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_CIM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CIM1%MZM(1) = -1
FMDIV_CIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CIM1
FUNCTION FMDIV_IMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMDIV_IMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_IMI1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMDIV(MA%MIM,MTIM,FMDIV_IMI1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMI1
FUNCTION FMDIV_IMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_IMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_IMR1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMR1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMR1
FUNCTION FMDIV_IMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_IMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_IMD1%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 FMDP2M(D(J),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMD1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMD1
FUNCTION FMDIV_IMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_IMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_IMZ1%MZM(1) = -1
FMDIV_IMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZ1
FUNCTION FMDIV_IMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_IMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_IMC1%MZM(1) = -1
FMDIV_IMC1%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMC1
FUNCTION FMDIV_IMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MB)) :: FMDIV_IMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IMIM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL IMDIV(MA%MIM,MB(J)%MIM,FMDIV_IMIM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMIM1
FUNCTION FMDIV_ZMIM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMDIV_ZMIM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZMIM1%MZM(1) = -1
FMDIV_ZMIM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMIM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMIM1
FUNCTION FMDIV_IMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMDIV_IMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IMZM1%MZM(1) = -1
FMDIV_IMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MB(J)%MZM,FMDIV_IMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZM1
! (2) rank 1 / rank 0
FUNCTION FMDIV_IM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_IM1I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, N
CALL IMDIV(MA(J)%MIM,MTIM,FMDIV_IM1I(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1I
FUNCTION FMDIV_IM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_IM1R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMDIV(MVFM,MTFM,FMDIV_IM1R(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1R
FUNCTION FMDIV_IM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_IM1D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,MVFM)
CALL FMDIV(MVFM,MTFM,FMDIV_IM1D(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1D
FUNCTION FMDIV_IM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_IM1Z%MZM(1) = -1
FMDIV_IM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,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_IM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1Z
FUNCTION FMDIV_IM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_IM1C%MZM(1) = -1
FMDIV_IM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1C
FUNCTION FMDIV_I1IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1IM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMDIV(MTIM,MA%MIM,FMDIV_I1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1IM
FUNCTION FMDIV_R1IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_R1IM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_R1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1IM
FUNCTION FMDIV_D1IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_D1IM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1IM%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 FMDP2M(D(J),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_D1IM(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1IM
FUNCTION FMDIV_Z1IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1IM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1IM%MZM(1) = -1
FMDIV_Z1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1IM
FUNCTION FMDIV_C1IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1IM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1IM%MZM(1) = -1
FMDIV_C1IM%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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_C1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1IM
FUNCTION FMDIV_IM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL IMDIV(MA(J)%MIM,MB%MIM,FMDIV_IM1IM(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1IM
FUNCTION FMDIV_IM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1ZM%MZM(1) = -1
FMDIV_IM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(M1ZM,MB%MZM,FMDIV_IM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1ZM
FUNCTION FMDIV_ZM1IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1IM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1IM%MZM(1) = -1
FMDIV_ZM1IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,M1ZM,FMDIV_ZM1IM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1IM
! (3) rank 1 / rank 1
FUNCTION FMDIV_IM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_IM1I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMDIV_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMDIV(MA(J)%MIM,MTIM,FMDIV_IM1I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1I1
FUNCTION FMDIV_IM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMDIV_IM1R1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM1R1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1R1
FUNCTION FMDIV_IM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMDIV_IM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_IM1D1%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_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM1D1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1D1
FUNCTION FMDIV_IM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMDIV_IM1Z1%MZM(1) = -1
FMDIV_IM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1Z1
FUNCTION FMDIV_IM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_IM1C1%MZM(1) = -1
FMDIV_IM1C1%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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1C1
FUNCTION FMDIV_I1IM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1IM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMDIV_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
DO J = 1, N
CALL IMI2M(IVAL(J),MTIM)
CALL IMDIV(MTIM,MA(J)%MIM,FMDIV_I1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1IM1
FUNCTION FMDIV_R1IM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (FM), DIMENSION(SIZE(R)) :: FMDIV_R1IM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1IM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL FMST2M(' UNKNOWN ',FMDIV_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL FMSP2M(R(J),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_R1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1IM1
FUNCTION FMDIV_D1IM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (FM), DIMENSION(SIZE(D)) :: FMDIV_D1IM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1IM1%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_D1IM1(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 FMDP2M(D(J),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_D1IM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1IM1
FUNCTION FMDIV_Z1IM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1IM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1IM1%MZM(1) = -1
FMDIV_Z1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1IM1
FUNCTION FMDIV_C1IM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1IM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1IM1%MZM(1) = -1
FMDIV_C1IM1%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_C1IM1(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 FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_C1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1IM1
FUNCTION FMDIV_IM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (IM), DIMENSION(SIZE(MA)) :: FMDIV_IM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL IMST2M(' UNKNOWN ',FMDIV_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL IMDIV(MA(J)%MIM,MB(J)%MIM,FMDIV_IM1IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1IM1
FUNCTION FMDIV_IM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_IM1ZM1%MZM(1) = -1
FMDIV_IM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MA(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(M1ZM,MB(J)%MZM,FMDIV_IM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM1ZM1
FUNCTION FMDIV_ZM1IM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1IM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1IM1%MZM(1) = -1
FMDIV_ZM1IM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MTFM)
DO J = 1, N
CALL IMI2FM(MB(J)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(MA(J)%MZM,M1ZM,FMDIV_ZM1IM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1IM1
! (4) rank 0 / rank 2
FUNCTION FMDIV_IIM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IIM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_IIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MTIM,MA(J,K)%MIM,FMDIV_IIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IIM2
FUNCTION FMDIV_RIM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_RIM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RIM2
FUNCTION FMDIV_DIM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DIM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DIM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DIM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DIM2
FUNCTION FMDIV_ZIM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZIM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZIM2%MZM(1) = -1
FMDIV_ZIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_ZIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZIM2
FUNCTION FMDIV_CIM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_CIM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CIM2%MZM(1) = -1
FMDIV_CIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CIM2
FUNCTION FMDIV_IMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_IMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_IMI2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMDIV(MA%MIM,MTIM,FMDIV_IMI2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMI2
FUNCTION FMDIV_IMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_IMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_IMR2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMR2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMR2
FUNCTION FMDIV_IMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_IMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_IMD2%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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MUFM,MTFM,FMDIV_IMD2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMD2
FUNCTION FMDIV_IMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_IMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_IMZ2%MZM(1) = -1
FMDIV_IMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZ2
FUNCTION FMDIV_IMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_IMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_IMC2%MZM(1) = -1
FMDIV_IMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMC2
FUNCTION FMDIV_IMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_IMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IMIM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMDIV(MA%MIM,MB(J,K)%MIM,FMDIV_IMIM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMIM2
FUNCTION FMDIV_ZMIM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_ZMIM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZMIM2%MZM(1) = -1
FMDIV_ZMIM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,MVFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMIM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMIM2
FUNCTION FMDIV_IMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_IMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IMZM2%MZM(1) = -1
FMDIV_IMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MVFM,MTFM,MTZM)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMDIV(MTZM,MB(J,K)%MZM,FMDIV_IMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IMZM2
! (5) rank 2 / rank 0
FUNCTION FMDIV_IM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_IM2I%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MA(J,K)%MIM,MTIM,FMDIV_IM2I(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2I
FUNCTION FMDIV_IM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_IM2R%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_IM2R(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2R
FUNCTION FMDIV_IM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_IM2D%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_IM2D(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2D
FUNCTION FMDIV_IM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_IM2Z%MZM(1) = -1
FMDIV_IM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,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_IM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2Z
FUNCTION FMDIV_IM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_IM2C%MZM(1) = -1
FMDIV_IM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2C
FUNCTION FMDIV_I2IM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2IM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMDIV(MTIM,MA%MIM,FMDIV_I2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2IM
FUNCTION FMDIV_R2IM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2IM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2IM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_R2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2IM
FUNCTION FMDIV_D2IM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2IM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2IM%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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MTFM,MVFM,FMDIV_D2IM(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2IM
FUNCTION FMDIV_Z2IM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2IM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2IM%MZM(1) = -1
FMDIV_Z2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,MVFM)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMCMPX(MVFM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2IM
FUNCTION FMDIV_C2IM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2IM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2IM%MZM(1) = -1
FMDIV_C2IM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_C2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2IM
FUNCTION FMDIV_IM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MA(J,K)%MIM,MB%MIM,FMDIV_IM2IM(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2IM
FUNCTION FMDIV_IM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2ZM%MZM(1) = -1
FMDIV_IM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(M1ZM,MB%MZM,FMDIV_IM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2ZM
FUNCTION FMDIV_ZM2IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2IM%MZM(1) = -1
FMDIV_ZM2IM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,M1FM)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MA(J,K)%MZM,M1ZM,FMDIV_ZM2IM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2IM
! (6) rank 2 / rank 2
FUNCTION FMDIV_IM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_IM2I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMDIV_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMDIV(MA(J,K)%MIM,MTIM,FMDIV_IM2I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2I2
FUNCTION FMDIV_IM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMDIV_IM2R2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_IM2R2(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 FMSP2M(R(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM2R2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2R2
FUNCTION FMDIV_IM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_IM2D2%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_IM2D2(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 FMDP2M(D(J,K),MTFM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL FMDIV(M1FM,MTFM,FMDIV_IM2D2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2D2
FUNCTION FMDIV_IM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMDIV_IM2Z2%MZM(1) = -1
FMDIV_IM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MUZM,MTZM,FMDIV_IM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2Z2
FUNCTION FMDIV_IM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_IM2C2%MZM(1) = -1
FMDIV_IM2C2%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_IM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2C2
FUNCTION FMDIV_I2IM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2IM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMDIV_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2M(IVAL(J,K),MTIM)
CALL IMDIV(MTIM,MA(J,K)%MIM,FMDIV_I2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2IM2
FUNCTION FMDIV_R2IM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (FM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2IM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2IM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMST2M(' UNKNOWN ',FMDIV_R2IM2(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 FMSP2M(R(J,K),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_R2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2IM2
FUNCTION FMDIV_D2IM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (FM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2IM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2IM2%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_D2IM2(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 FMDP2M(D(J,K),MTFM)
CALL FMDIV(MTFM,M1FM,FMDIV_D2IM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2IM2
FUNCTION FMDIV_Z2IM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2IM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2IM2%MZM(1) = -1
FMDIV_Z2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z2IM2(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 ZMZ2M(Z(J,K),MTZM)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_Z2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2IM2
FUNCTION FMDIV_C2IM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2IM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2IM2%MZM(1) = -1
FMDIV_C2IM2%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_C2IM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(M1FM,MUFM,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDIV_C2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2IM2
FUNCTION FMDIV_IM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMST2M(' UNKNOWN ',FMDIV_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMDIV(MA(J,K)%MIM,MB(J,K)%MIM,FMDIV_IM2IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2IM2
FUNCTION FMDIV_IM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_IM2ZM2%MZM(1) = -1
FMDIV_IM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MA(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(M1ZM,MB(J,K)%MZM,FMDIV_IM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IM2ZM2
FUNCTION FMDIV_ZM2IM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2IM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2IM2%MZM(1) = -1
FMDIV_ZM2IM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
CALL FMI2M(0,MTFM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMI2FM(MB(J,K)%MIM,M1FM)
CALL ZMCMPX(M1FM,MTFM,M1ZM)
CALL ZMDIV(MA(J,K)%MZM,M1ZM,FMDIV_ZM2IM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2IM2
! Array division operations for ZM.
! (1) rank 0 / rank 1
FUNCTION FMDIV_IZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_IZM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_IZM1%MZM(1) = -1
FMDIV_IZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_IZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IZM1
FUNCTION FMDIV_RZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_RZM1
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RZM1%MZM(1) = -1
FMDIV_RZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_RZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RZM1
FUNCTION FMDIV_DZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_DZM1
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DZM1%MZM(1) = -1
FMDIV_DZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_DZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DZM1
FUNCTION FMDIV_ZZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZZM1
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZZM1%MZM(1) = -1
FMDIV_ZZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_ZZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZZM1
FUNCTION FMDIV_CZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_CZM1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CZM1%MZM(1) = -1
FMDIV_CZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_CZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CZM1
FUNCTION FMDIV_ZMI1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMDIV_ZMI1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_ZMI1%MZM(1) = -1
FMDIV_ZMI1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMI1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMI1
FUNCTION FMDIV_ZMR1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMDIV_ZMR1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_ZMR1%MZM(1) = -1
FMDIV_ZMR1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMR1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMR1
FUNCTION FMDIV_ZMD1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_ZMD1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_ZMD1%MZM(1) = -1
FMDIV_ZMD1%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMD1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMD1
FUNCTION FMDIV_ZMZ1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_ZMZ1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_ZMZ1%MZM(1) = -1
FMDIV_ZMZ1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZ1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZ1
FUNCTION FMDIV_ZMC1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_ZMC1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_ZMC1%MZM(1) = -1
FMDIV_ZMC1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMC1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMC1
FUNCTION FMDIV_ZMZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB)) :: FMDIV_ZMZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZMZM1%MZM(1) = -1
FMDIV_ZMZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MB)
DO J = 1, N
CALL ZMDIV(MA%MZM,MB(J)%MZM,FMDIV_ZMZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZM1
! (2) rank 1 / rank 0
FUNCTION FMDIV_ZM1I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1I
INTEGER :: IVAL,J,N
INTENT (IN) :: MA,IVAL
FMDIV_ZM1I%MZM(1) = -1
FMDIV_ZM1I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1I(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1I
FUNCTION FMDIV_ZM1R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1R
INTEGER :: J,N
REAL :: R
INTENT (IN) :: MA,R
FMDIV_ZM1R%MZM(1) = -1
FMDIV_ZM1R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1R(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1R
FUNCTION FMDIV_ZM1D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1D
INTEGER :: J,N
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_ZM1D%MZM(1) = -1
FMDIV_ZM1D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1D(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1D
FUNCTION FMDIV_ZM1Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1Z
INTEGER :: J,N
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZM1Z%MZM(1) = -1
FMDIV_ZM1Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1Z(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1Z
FUNCTION FMDIV_ZM1C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1C
INTEGER :: J,N
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_ZM1C%MZM(1) = -1
FMDIV_ZM1C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1C(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1C
FUNCTION FMDIV_I1ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1ZM
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1ZM%MZM(1) = -1
FMDIV_I1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(IVAL)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_I1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1ZM
FUNCTION FMDIV_R1ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMDIV_R1ZM
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1ZM%MZM(1) = -1
FMDIV_R1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_R1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1ZM
FUNCTION FMDIV_D1ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_D1ZM
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1ZM%MZM(1) = -1
FMDIV_D1ZM%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 FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_D1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1ZM
FUNCTION FMDIV_Z1ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1ZM
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1ZM%MZM(1) = -1
FMDIV_Z1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_Z1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1ZM
FUNCTION FMDIV_C1ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1ZM
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1ZM%MZM(1) = -1
FMDIV_C1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_C1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1ZM
FUNCTION FMDIV_ZM1ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1ZM
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1ZM%MZM(1) = -1
FMDIV_ZM1ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
N = SIZE(MA)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MB%MZM,FMDIV_ZM1ZM(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1ZM
! (3) rank 1 / rank 1
FUNCTION FMDIV_ZM1I1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1I1
INTEGER, DIMENSION(:) :: IVAL
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_ZM1I1%MZM(1) = -1
FMDIV_ZM1I1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMI2M(IVAL(J),MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1I1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1I1
FUNCTION FMDIV_ZM1R1(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1R1
INTEGER :: J,N
REAL, DIMENSION(:) :: R
INTENT (IN) :: MA,R
FMDIV_ZM1R1%MZM(1) = -1
FMDIV_ZM1R1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1R1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1R1
FUNCTION FMDIV_ZM1D1(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1D1
INTEGER :: J,N
DOUBLE PRECISION, DIMENSION(:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM1D1%MZM(1) = -1
FMDIV_ZM1D1%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_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1D1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1D1
FUNCTION FMDIV_ZM1Z1(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1Z1
INTEGER :: J,N
COMPLEX, DIMENSION(:) :: Z
INTENT (IN) :: MA,Z
FMDIV_ZM1Z1%MZM(1) = -1
FMDIV_ZM1Z1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1Z1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1Z1
FUNCTION FMDIV_ZM1C1(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1C1
INTEGER :: J,N
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
INTENT (IN) :: MA,C
FMDIV_ZM1C1%MZM(1) = -1
FMDIV_ZM1C1%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_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J)%MZM,MTZM,FMDIV_ZM1C1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1C1
FUNCTION FMDIV_I1ZM1(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
INTEGER, DIMENSION(:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL)) :: FMDIV_I1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,IVAL
FMDIV_I1ZM1%MZM(1) = -1
FMDIV_I1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(IVAL)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(IVAL)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMI2M(IVAL(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_I1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I1ZM1
FUNCTION FMDIV_R1ZM1(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
REAL, DIMENSION(:) :: R
TYPE (ZM), DIMENSION(SIZE(R)) :: FMDIV_R1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,R
FMDIV_R1ZM1%MZM(1) = -1
FMDIV_R1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(R)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(R)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMSP2M(R(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_R1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R1ZM1
FUNCTION FMDIV_D1ZM1(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
DOUBLE PRECISION, DIMENSION(:) :: D
TYPE (ZM), DIMENSION(SIZE(D)) :: FMDIV_D1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,D
FMDIV_D1ZM1%MZM(1) = -1
FMDIV_D1ZM1%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_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(D)
CALL FMI2M(0,MUFM)
DO J = 1, N
CALL FMDP2M(D(J),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_D1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D1ZM1
FUNCTION FMDIV_Z1ZM1(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX, DIMENSION(:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z)) :: FMDIV_Z1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,Z
FMDIV_Z1ZM1%MZM(1) = -1
FMDIV_Z1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA) /= SIZE(Z)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(Z)
DO J = 1, N
CALL ZMZ2M(Z(J),MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_Z1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z1ZM1
FUNCTION FMDIV_C1ZM1(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:) :: C
TYPE (ZM), DIMENSION(SIZE(C)) :: FMDIV_C1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,C
FMDIV_C1ZM1%MZM(1) = -1
FMDIV_C1ZM1%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_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(C)
DO J = 1, N
CALL FMDP2M(REAL(C(J),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J)%MZM,FMDIV_C1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C1ZM1
FUNCTION FMDIV_ZM1ZM1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMDIV_ZM1ZM1
INTEGER :: J,N
INTENT (IN) :: MA,MB
FMDIV_ZM1ZM1%MZM(1) = -1
FMDIV_ZM1ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) /= SIZE(MB)) THEN
DO J = 1, SIZE(MA)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
RETURN
ENDIF
N = SIZE(MA)
DO J = 1, N
CALL ZMDIV(MA(J)%MZM,MB(J)%MZM,FMDIV_ZM1ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM1ZM1
! (4) rank 0 / rank 2
FUNCTION FMDIV_IZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_IZM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_IZM2%MZM(1) = -1
FMDIV_IZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMI2M(IVAL,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_IZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_IZM2
FUNCTION FMDIV_RZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_RZM2
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_RZM2%MZM(1) = -1
FMDIV_RZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_RZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_RZM2
FUNCTION FMDIV_DZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_DZM2
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_DZM2%MZM(1) = -1
FMDIV_DZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_DZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_DZM2
FUNCTION FMDIV_ZZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZZM2
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZZM2%MZM(1) = -1
FMDIV_ZZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_ZZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZZM2
FUNCTION FMDIV_CZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_CZM2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_CZM2%MZM(1) = -1
FMDIV_CZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_CZM2
FUNCTION FMDIV_ZMI2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_ZMI2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_ZMI2%MZM(1) = -1
FMDIV_ZMI2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMI2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMI2
FUNCTION FMDIV_ZMR2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_ZMR2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_ZMR2%MZM(1) = -1
FMDIV_ZMR2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMR2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMR2
FUNCTION FMDIV_ZMD2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_ZMD2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_ZMD2%MZM(1) = -1
FMDIV_ZMD2%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMD2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMD2
FUNCTION FMDIV_ZMZ2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_ZMZ2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_ZMZ2%MZM(1) = -1
FMDIV_ZMZ2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMZ2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZ2
FUNCTION FMDIV_ZMC2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_ZMC2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_ZMC2%MZM(1) = -1
FMDIV_ZMC2%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA%MZM,MTZM,FMDIV_ZMC2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMC2
FUNCTION FMDIV_ZMZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MB,DIM=1),SIZE(MB,DIM=2)) :: FMDIV_ZMZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZMZM2%MZM(1) = -1
FMDIV_ZMZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MB,DIM=1)
DO K = 1, SIZE(MB,DIM=2)
CALL ZMDIV(MA%MZM,MB(J,K)%MZM,FMDIV_ZMZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZMZM2
! (5) rank 2 / rank 0
FUNCTION FMDIV_ZM2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2I
INTEGER :: IVAL,J,K
INTENT (IN) :: MA,IVAL
FMDIV_ZM2I%MZM(1) = -1
FMDIV_ZM2I%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,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_ZM2I(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2I
FUNCTION FMDIV_ZM2R(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2R
INTEGER :: J,K
REAL :: R
INTENT (IN) :: MA,R
FMDIV_ZM2R%MZM(1) = -1
FMDIV_ZM2R%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,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_ZM2R(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2R
FUNCTION FMDIV_ZM2D(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2D
INTEGER :: J,K
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
FMDIV_ZM2D%MZM(1) = -1
FMDIV_ZM2D%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(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_ZM2D(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2D
FUNCTION FMDIV_ZM2Z(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2Z
INTEGER :: J,K
COMPLEX :: Z
INTENT (IN) :: MA,Z
FMDIV_ZM2Z%MZM(1) = -1
FMDIV_ZM2Z%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2Z(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2Z
FUNCTION FMDIV_ZM2C(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2C
INTEGER :: J,K
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
FMDIV_ZM2C%MZM(1) = -1
FMDIV_ZM2C%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_ZM2C(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2C
FUNCTION FMDIV_I2ZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2ZM
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2ZM%MZM(1) = -1
FMDIV_I2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL ZMI2M(IVAL(J,K),MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_I2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2ZM
FUNCTION FMDIV_R2ZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2ZM
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2ZM%MZM(1) = -1
FMDIV_R2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,MUFM)
DO J = 1, SIZE(R,DIM=1)
DO K = 1, SIZE(R,DIM=2)
CALL FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_R2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2ZM
FUNCTION FMDIV_D2ZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2ZM
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2ZM%MZM(1) = -1
FMDIV_D2ZM%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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_D2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2ZM
FUNCTION FMDIV_Z2ZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2ZM
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2ZM%MZM(1) = -1
FMDIV_Z2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(Z,DIM=1)
DO K = 1, SIZE(Z,DIM=2)
CALL ZMZ2M(Z(J,K),MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_Z2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2ZM
FUNCTION FMDIV_C2ZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2ZM
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2ZM%MZM(1) = -1
FMDIV_C2ZM%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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA%MZM,FMDIV_C2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2ZM
FUNCTION FMDIV_ZM2ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2ZM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2ZM%MZM(1) = -1
FMDIV_ZM2ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMDIV(MA(J,K)%MZM,MB%MZM,FMDIV_ZM2ZM(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2ZM
! (6) rank 2 / rank 2
FUNCTION FMDIV_ZM2I2(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2I2
INTEGER, DIMENSION(:,:) :: IVAL
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_ZM2I2%MZM(1) = -1
FMDIV_ZM2I2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2I2(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 ZMI2M(IVAL(J,K),MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2I2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2I2
FUNCTION FMDIV_ZM2R2(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2R2
INTEGER :: J,K
REAL, DIMENSION(:,:) :: R
INTENT (IN) :: MA,R
FMDIV_ZM2R2%MZM(1) = -1
FMDIV_ZM2R2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2R2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2R2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2R2
FUNCTION FMDIV_ZM2D2(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2D2
INTEGER :: J,K
DOUBLE PRECISION, DIMENSION(:,:) :: D
INTENT (IN) :: MA,D
FMDIV_ZM2D2%MZM(1) = -1
FMDIV_ZM2D2%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_ZM2D2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2D2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2D2
FUNCTION FMDIV_ZM2Z2(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2Z2
INTEGER :: J,K
COMPLEX, DIMENSION(:,:) :: Z
INTENT (IN) :: MA,Z
FMDIV_ZM2Z2%MZM(1) = -1
FMDIV_ZM2Z2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2Z2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2Z2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2Z2
FUNCTION FMDIV_ZM2C2(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2C2
INTEGER :: J,K
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
INTENT (IN) :: MA,C
FMDIV_ZM2C2%MZM(1) = -1
FMDIV_ZM2C2%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_ZM2C2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MA(J,K)%MZM,MTZM,FMDIV_ZM2C2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2C2
FUNCTION FMDIV_I2ZM2(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (ZM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMDIV_I2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,IVAL
FMDIV_I2ZM2%MZM(1) = -1
FMDIV_I2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(IVAL,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(IVAL,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_I2ZM2(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 FMI2M(IVAL(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_I2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_I2ZM2
FUNCTION FMDIV_R2ZM2(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
REAL, DIMENSION(:,:) :: R
TYPE (ZM), DIMENSION(SIZE(R,DIM=1),SIZE(R,DIM=2)) :: FMDIV_R2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,R
FMDIV_R2ZM2%MZM(1) = -1
FMDIV_R2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(R,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(R,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_R2ZM2(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 FMSP2M(R(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_R2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_R2ZM2
FUNCTION FMDIV_D2ZM2(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
DOUBLE PRECISION, DIMENSION(:,:) :: D
TYPE (ZM), DIMENSION(SIZE(D,DIM=1),SIZE(D,DIM=2)) :: FMDIV_D2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,D
FMDIV_D2ZM2%MZM(1) = -1
FMDIV_D2ZM2%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_D2ZM2(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 FMDP2M(D(J,K),MTFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_D2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_D2ZM2
FUNCTION FMDIV_Z2ZM2(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX, DIMENSION(:,:) :: Z
TYPE (ZM), DIMENSION(SIZE(Z,DIM=1),SIZE(Z,DIM=2)) :: FMDIV_Z2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,Z
FMDIV_Z2ZM2%MZM(1) = -1
FMDIV_Z2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (SIZE(MA,DIM=1) /= SIZE(Z,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(Z,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_Z2ZM2(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 ZMZ2M(Z(J,K),MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_Z2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_Z2ZM2
FUNCTION FMDIV_C2ZM2(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
COMPLEX (KIND(0.0D0)), DIMENSION(:,:) :: C
TYPE (ZM), DIMENSION(SIZE(C,DIM=1),SIZE(C,DIM=2)) :: FMDIV_C2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,C
FMDIV_C2ZM2%MZM(1) = -1
FMDIV_C2ZM2%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_C2ZM2(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 FMDP2M(REAL(C(J,K),KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C(J,K)),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMDIV(MTZM,MA(J,K)%MZM,FMDIV_C2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_C2ZM2
FUNCTION FMDIV_ZM2ZM2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(:,:) :: MB
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMDIV_ZM2ZM2
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMDIV_ZM2ZM2%MZM(1) = -1
FMDIV_ZM2ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=1) /= SIZE(MB,DIM=1) .OR. SIZE(MA,DIM=2) /= SIZE(MB,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMST2M(' UNKNOWN + UNKNOWN i ',FMDIV_ZM2ZM2(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 ZMDIV(MA(J,K)%MZM,MB(J,K)%MZM,FMDIV_ZM2ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIV_ZM2ZM2
END MODULE FMZM_7
MODULE FMZM_8
USE FMZM_1
INTERFACE OPERATOR (**)
MODULE PROCEDURE FMPWR_IFM
MODULE PROCEDURE FMPWR_IIM
MODULE PROCEDURE FMPWR_IZM
MODULE PROCEDURE FMPWR_RFM
MODULE PROCEDURE FMPWR_RIM
MODULE PROCEDURE FMPWR_RZM
MODULE PROCEDURE FMPWR_DFM
MODULE PROCEDURE FMPWR_DIM
MODULE PROCEDURE FMPWR_DZM
MODULE PROCEDURE FMPWR_ZFM
MODULE PROCEDURE FMPWR_ZIM
MODULE PROCEDURE FMPWR_ZZM
MODULE PROCEDURE FMPWR_CFM
MODULE PROCEDURE FMPWR_CIM
MODULE PROCEDURE FMPWR_CZM
MODULE PROCEDURE FMPWR_FMI
MODULE PROCEDURE FMPWR_FMR
MODULE PROCEDURE FMPWR_FMD
MODULE PROCEDURE FMPWR_FMZ
MODULE PROCEDURE FMPWR_FMC
MODULE PROCEDURE FMPWR_FMFM
MODULE PROCEDURE FMPWR_FMIM
MODULE PROCEDURE FMPWR_FMZM
MODULE PROCEDURE FMPWR_IMI
MODULE PROCEDURE FMPWR_IMR
MODULE PROCEDURE FMPWR_IMD
MODULE PROCEDURE FMPWR_IMZ
MODULE PROCEDURE FMPWR_IMC
MODULE PROCEDURE FMPWR_IMFM
MODULE PROCEDURE FMPWR_IMIM
MODULE PROCEDURE FMPWR_IMZM
MODULE PROCEDURE FMPWR_ZMI
MODULE PROCEDURE FMPWR_ZMR
MODULE PROCEDURE FMPWR_ZMD
MODULE PROCEDURE FMPWR_ZMZ
MODULE PROCEDURE FMPWR_ZMC
MODULE PROCEDURE FMPWR_ZMFM
MODULE PROCEDURE FMPWR_ZMIM
MODULE PROCEDURE FMPWR_ZMZM
END INTERFACE
INTERFACE ABS
MODULE PROCEDURE FMABS_FM
MODULE PROCEDURE FMABS_IM
MODULE PROCEDURE FMABS_ZM
MODULE PROCEDURE FMABS_FM1
MODULE PROCEDURE FMABS_IM1
MODULE PROCEDURE FMABS_ZM1
MODULE PROCEDURE FMABS_FM2
MODULE PROCEDURE FMABS_IM2
MODULE PROCEDURE FMABS_ZM2
END INTERFACE
INTERFACE ACOS
MODULE PROCEDURE FMACOS_FM
MODULE PROCEDURE FMACOS_ZM
MODULE PROCEDURE FMACOS_FM1
MODULE PROCEDURE FMACOS_ZM1
MODULE PROCEDURE FMACOS_FM2
MODULE PROCEDURE FMACOS_ZM2
END INTERFACE
INTERFACE ACOSH
MODULE PROCEDURE FMACOSH_FM
MODULE PROCEDURE FMACOSH_ZM
MODULE PROCEDURE FMACOSH_FM1
MODULE PROCEDURE FMACOSH_ZM1
MODULE PROCEDURE FMACOSH_FM2
MODULE PROCEDURE FMACOSH_ZM2
END INTERFACE
INTERFACE AIMAG
MODULE PROCEDURE FMAIMAG_ZM
MODULE PROCEDURE FMAIMAG_ZM1
MODULE PROCEDURE FMAIMAG_ZM2
END INTERFACE
INTERFACE AINT
MODULE PROCEDURE FMAINT_FM
MODULE PROCEDURE FMAINT_ZM
MODULE PROCEDURE FMAINT_FM1
MODULE PROCEDURE FMAINT_ZM1
MODULE PROCEDURE FMAINT_FM2
MODULE PROCEDURE FMAINT_ZM2
END INTERFACE
INTERFACE ANINT
MODULE PROCEDURE FMANINT_FM
MODULE PROCEDURE FMANINT_ZM
MODULE PROCEDURE FMANINT_FM1
MODULE PROCEDURE FMANINT_ZM1
MODULE PROCEDURE FMANINT_FM2
MODULE PROCEDURE FMANINT_ZM2
END INTERFACE
INTERFACE ASIN
MODULE PROCEDURE FMASIN_FM
MODULE PROCEDURE FMASIN_ZM
MODULE PROCEDURE FMASIN_FM1
MODULE PROCEDURE FMASIN_ZM1
MODULE PROCEDURE FMASIN_FM2
MODULE PROCEDURE FMASIN_ZM2
END INTERFACE
INTERFACE ASINH
MODULE PROCEDURE FMASINH_FM
MODULE PROCEDURE FMASINH_ZM
MODULE PROCEDURE FMASINH_FM1
MODULE PROCEDURE FMASINH_ZM1
MODULE PROCEDURE FMASINH_FM2
MODULE PROCEDURE FMASINH_ZM2
END INTERFACE
INTERFACE ATAN
MODULE PROCEDURE FMATAN_FM
MODULE PROCEDURE FMATAN2_FM
MODULE PROCEDURE FMATAN_ZM
MODULE PROCEDURE FMATAN_FM1
MODULE PROCEDURE FMATAN_ZM1
MODULE PROCEDURE FMATAN_FM2
MODULE PROCEDURE FMATAN_ZM2
END INTERFACE
INTERFACE ATANH
MODULE PROCEDURE FMATANH_FM
MODULE PROCEDURE FMATANH_ZM
MODULE PROCEDURE FMATANH_FM1
MODULE PROCEDURE FMATANH_ZM1
MODULE PROCEDURE FMATANH_FM2
MODULE PROCEDURE FMATANH_ZM2
END INTERFACE
INTERFACE ATAN2
MODULE PROCEDURE FMATAN2_FM
END INTERFACE
INTERFACE BTEST
MODULE PROCEDURE FMBTEST_IM
END INTERFACE
INTERFACE CEILING
MODULE PROCEDURE FMCEILING_FM
MODULE PROCEDURE FMCEILING_IM
MODULE PROCEDURE FMCEILING_ZM
MODULE PROCEDURE FMCEILING_FM1
MODULE PROCEDURE FMCEILING_IM1
MODULE PROCEDURE FMCEILING_ZM1
MODULE PROCEDURE FMCEILING_FM2
MODULE PROCEDURE FMCEILING_IM2
MODULE PROCEDURE FMCEILING_ZM2
END INTERFACE
INTERFACE CMPLX
MODULE PROCEDURE FMCMPLX_FM
MODULE PROCEDURE FMCMPLX_IM
END INTERFACE
INTERFACE CONJG
MODULE PROCEDURE FMCONJG_ZM
MODULE PROCEDURE FMCONJG_ZM1
MODULE PROCEDURE FMCONJG_ZM2
END INTERFACE
INTERFACE COS
MODULE PROCEDURE FMCOS_FM
MODULE PROCEDURE FMCOS_ZM
MODULE PROCEDURE FMCOS_FM1
MODULE PROCEDURE FMCOS_ZM1
MODULE PROCEDURE FMCOS_FM2
MODULE PROCEDURE FMCOS_ZM2
END INTERFACE
INTERFACE COSH
MODULE PROCEDURE FMCOSH_FM
MODULE PROCEDURE FMCOSH_ZM
MODULE PROCEDURE FMCOSH_FM1
MODULE PROCEDURE FMCOSH_ZM1
MODULE PROCEDURE FMCOSH_FM2
MODULE PROCEDURE FMCOSH_ZM2
END INTERFACE
INTERFACE DBLE
MODULE PROCEDURE FMDBLE_FM
MODULE PROCEDURE FMDBLE_IM
MODULE PROCEDURE FMDBLE_ZM
END INTERFACE
INTERFACE DIGITS
MODULE PROCEDURE FMDIGITS_FM
MODULE PROCEDURE FMDIGITS_IM
MODULE PROCEDURE FMDIGITS_ZM
END INTERFACE
INTERFACE DIM
MODULE PROCEDURE FMDIM_FM
MODULE PROCEDURE FMDIM_IM
END INTERFACE
INTERFACE DINT
MODULE PROCEDURE FMDINT_FM
MODULE PROCEDURE FMDINT_ZM
END INTERFACE
INTERFACE DOT_PRODUCT
MODULE PROCEDURE FMDOTPRODUCT_FM
MODULE PROCEDURE FMDOTPRODUCT_IM
MODULE PROCEDURE FMDOTPRODUCT_ZM
END INTERFACE
INTERFACE EPSILON
MODULE PROCEDURE FMEPSILON_FM
END INTERFACE
INTERFACE EXP
MODULE PROCEDURE FMEXP_FM
MODULE PROCEDURE FMEXP_ZM
MODULE PROCEDURE FMEXP_FM1
MODULE PROCEDURE FMEXP_ZM1
MODULE PROCEDURE FMEXP_FM2
MODULE PROCEDURE FMEXP_ZM2
END INTERFACE
INTERFACE EXPONENT
MODULE PROCEDURE FMEXPONENT_FM
END INTERFACE
INTERFACE FLOOR
MODULE PROCEDURE FMFLOOR_FM
MODULE PROCEDURE FMFLOOR_IM
MODULE PROCEDURE FMFLOOR_ZM
MODULE PROCEDURE FMFLOOR_FM1
MODULE PROCEDURE FMFLOOR_IM1
MODULE PROCEDURE FMFLOOR_ZM1
MODULE PROCEDURE FMFLOOR_FM2
MODULE PROCEDURE FMFLOOR_IM2
MODULE PROCEDURE FMFLOOR_ZM2
END INTERFACE
INTERFACE FRACTION
MODULE PROCEDURE FMFRACTION_FM
MODULE PROCEDURE FMFRACTION_ZM
MODULE PROCEDURE FMFRACTION_FM1
MODULE PROCEDURE FMFRACTION_ZM1
MODULE PROCEDURE FMFRACTION_FM2
MODULE PROCEDURE FMFRACTION_ZM2
END INTERFACE
INTERFACE HUGE
MODULE PROCEDURE FMHUGE_FM
MODULE PROCEDURE FMHUGE_IM
MODULE PROCEDURE FMHUGE_ZM
END INTERFACE
INTERFACE HYPOT
MODULE PROCEDURE FMHYPOT_FM
END INTERFACE
INTERFACE INT
MODULE PROCEDURE FMINT_FM
MODULE PROCEDURE FMINT_IM
MODULE PROCEDURE FMINT_ZM
MODULE PROCEDURE FMINT_FM1
MODULE PROCEDURE FMINT_IM1
MODULE PROCEDURE FMINT_ZM1
MODULE PROCEDURE FMINT_FM2
MODULE PROCEDURE FMINT_IM2
MODULE PROCEDURE FMINT_ZM2
END INTERFACE
INTERFACE LOG
MODULE PROCEDURE FMLOG_FM
MODULE PROCEDURE FMLOG_ZM
MODULE PROCEDURE FMLOG_FM1
MODULE PROCEDURE FMLOG_ZM1
MODULE PROCEDURE FMLOG_FM2
MODULE PROCEDURE FMLOG_ZM2
END INTERFACE
INTERFACE LOG10
MODULE PROCEDURE FMLOG10_FM
MODULE PROCEDURE FMLOG10_ZM
MODULE PROCEDURE FMLOG10_FM1
MODULE PROCEDURE FMLOG10_ZM1
MODULE PROCEDURE FMLOG10_FM2
MODULE PROCEDURE FMLOG10_ZM2
END INTERFACE
INTERFACE MATMUL
MODULE PROCEDURE FMMATMUL22_FM
MODULE PROCEDURE FMMATMUL12_FM
MODULE PROCEDURE FMMATMUL21_FM
MODULE PROCEDURE FMMATMUL22_IM
MODULE PROCEDURE FMMATMUL12_IM
MODULE PROCEDURE FMMATMUL21_IM
MODULE PROCEDURE FMMATMUL22_ZM
MODULE PROCEDURE FMMATMUL12_ZM
MODULE PROCEDURE FMMATMUL21_ZM
END INTERFACE
INTERFACE MAX
MODULE PROCEDURE FMMAX_FM
MODULE PROCEDURE FMMAX_IM
END INTERFACE
INTERFACE MAXEXPONENT
MODULE PROCEDURE FMMAXEXPONENT_FM
END INTERFACE
INTERFACE MAXLOC
MODULE PROCEDURE FMMAXLOC1_FM
MODULE PROCEDURE FMMAXLOC2_FM
MODULE PROCEDURE FMMAXLOC1_IM
MODULE PROCEDURE FMMAXLOC2_IM
END INTERFACE
INTERFACE MAXVAL
MODULE PROCEDURE FMMAXVAL1_FM
MODULE PROCEDURE FMMAXVAL2_FM
MODULE PROCEDURE FMMAXVAL1_IM
MODULE PROCEDURE FMMAXVAL2_IM
END INTERFACE
INTERFACE MIN
MODULE PROCEDURE FMMIN_FM
MODULE PROCEDURE FMMIN_IM
END INTERFACE
INTERFACE MINEXPONENT
MODULE PROCEDURE FMMINEXPONENT_FM
END INTERFACE
INTERFACE MINLOC
MODULE PROCEDURE FMMINLOC1_FM
MODULE PROCEDURE FMMINLOC2_FM
MODULE PROCEDURE FMMINLOC1_IM
MODULE PROCEDURE FMMINLOC2_IM
END INTERFACE
INTERFACE MINVAL
MODULE PROCEDURE FMMINVAL1_FM
MODULE PROCEDURE FMMINVAL2_FM
MODULE PROCEDURE FMMINVAL1_IM
MODULE PROCEDURE FMMINVAL2_IM
END INTERFACE
INTERFACE MOD
MODULE PROCEDURE FMMOD_FM
MODULE PROCEDURE FMMOD_IM
END INTERFACE
INTERFACE MODULO
MODULE PROCEDURE FMMODULO_FM
MODULE PROCEDURE FMMODULO_IM
END INTERFACE
INTERFACE NEAREST
MODULE PROCEDURE FMNEAREST_FM
END INTERFACE
INTERFACE NINT
MODULE PROCEDURE FMNINT_FM
MODULE PROCEDURE FMNINT_IM
MODULE PROCEDURE FMNINT_ZM
MODULE PROCEDURE FMNINT_FM1
MODULE PROCEDURE FMNINT_IM1
MODULE PROCEDURE FMNINT_ZM1
MODULE PROCEDURE FMNINT_FM2
MODULE PROCEDURE FMNINT_IM2
MODULE PROCEDURE FMNINT_ZM2
END INTERFACE
INTERFACE NORM2
MODULE PROCEDURE FMNORM21_FM
END INTERFACE
INTERFACE PRECISION
MODULE PROCEDURE FMPRECISION_FM
MODULE PROCEDURE FMPRECISION_ZM
END INTERFACE
INTERFACE PRODUCT
MODULE PROCEDURE FMPRODUCT1_FM
MODULE PROCEDURE FMPRODUCT2_FM
MODULE PROCEDURE FMPRODUCT1_IM
MODULE PROCEDURE FMPRODUCT2_IM
MODULE PROCEDURE FMPRODUCT1_ZM
MODULE PROCEDURE FMPRODUCT2_ZM
END INTERFACE
INTERFACE RADIX
MODULE PROCEDURE FMRADIX_FM
MODULE PROCEDURE FMRADIX_IM
MODULE PROCEDURE FMRADIX_ZM
END INTERFACE
INTERFACE RANGE
MODULE PROCEDURE FMRANGE_FM
MODULE PROCEDURE FMRANGE_IM
MODULE PROCEDURE FMRANGE_ZM
END INTERFACE
INTERFACE REAL
MODULE PROCEDURE FMREAL_FM
MODULE PROCEDURE FMREAL_IM
MODULE PROCEDURE FMREAL_ZM
END INTERFACE
INTERFACE RRSPACING
MODULE PROCEDURE FMRRSPACING_FM
END INTERFACE
INTERFACE SCALE
MODULE PROCEDURE FMSCALE_FM
MODULE PROCEDURE FMSCALE_ZM
END INTERFACE
INTERFACE SETEXPONENT
MODULE PROCEDURE FMSETEXPONENT_FM
END INTERFACE
INTERFACE SIGN
MODULE PROCEDURE FMSIGN_FM
MODULE PROCEDURE FMSIGN_IM
END INTERFACE
CONTAINS
! **
FUNCTION FMPWR_IFM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_IFM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMPWR(MTFM,MA%MFM,FMPWR_IFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IFM
FUNCTION FMPWR_IIM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMPWR_IIM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMPWR(MTIM,MA%MIM,FMPWR_IIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IIM
FUNCTION FMPWR_IZM(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_IZM
INTEGER :: IVAL
INTENT (IN) :: IVAL,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(IVAL,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_IZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IZM
FUNCTION FMPWR_RFM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_RFM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMPWR(MTFM,MA%MFM,FMPWR_RFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_RFM
FUNCTION FMPWR_RIM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_RIM
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MTFM,MUFM,FMPWR_RIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_RIM
FUNCTION FMPWR_RZM(R,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_RZM
REAL :: R
INTENT (IN) :: R,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_RZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_RZM
FUNCTION FMPWR_DFM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_DFM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMPWR(MTFM,MA%MFM,FMPWR_DFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DFM
FUNCTION FMPWR_DIM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_DIM
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MTFM,MUFM,FMPWR_DIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DIM
FUNCTION FMPWR_DZM(D,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_DZM
DOUBLE PRECISION :: D
INTENT (IN) :: D,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_DZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_DZM
FUNCTION FMPWR_ZFM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_ZFM
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MTZM,MUZM,FMPWR_ZFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZFM
FUNCTION FMPWR_ZIM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_ZIM
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MTZM,MUZM,FMPWR_ZIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZIM
FUNCTION FMPWR_ZZM(Z,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZZM
COMPLEX :: Z
INTENT (IN) :: Z,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_ZZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZZM
FUNCTION FMPWR_CFM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_CFM
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MTZM,MUZM,FMPWR_CFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_CFM
FUNCTION FMPWR_CIM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_CIM
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_CIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_CIM
FUNCTION FMPWR_CZM(C,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_CZM
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: C,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MTZM,MA%MZM,FMPWR_CZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_CZM
FUNCTION FMPWR_FMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMIPWR(MA%MFM,IVAL,FMPWR_FMI%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMI
FUNCTION FMPWR_FMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMPWR(MA%MFM,MTFM,FMPWR_FMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMR
FUNCTION FMPWR_FMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMPWR(MA%MFM,MTFM,FMPWR_FMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMD
FUNCTION FMPWR_FMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_FMZ
TYPE (FM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MTZM,FMPWR_FMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMZ
FUNCTION FMPWR_FMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_FMC
TYPE (FM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MA%MFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MTZM,FMPWR_FMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMC
FUNCTION FMPWR_FMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMPWR_FMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMPWR(MA%MFM,MB%MFM,FMPWR_FMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMFM
FUNCTION FMPWR_FMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPWR_FMIM
TYPE (IM) :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMPWR(MA%MFM,MTFM,FMPWR_FMIM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMIM
FUNCTION FMPWR_FMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (ZM) :: MB,FMPWR_FMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,MTZM)
CALL ZMPWR(MTZM,MB%MZM,FMPWR_FMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_FMZM
FUNCTION FMPWR_IMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMPWR_IMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(IVAL,MTIM)
CALL IMPWR(MA%MIM,MTIM,FMPWR_IMI%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMI
FUNCTION FMPWR_IMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_IMR
TYPE (IM) :: MA
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MUFM,MTFM,FMPWR_IMR%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMR
FUNCTION FMPWR_IMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMPWR_IMD
TYPE (IM) :: MA
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL IMI2FM(MA%MIM,MUFM)
CALL FMPWR(MUFM,MTFM,FMPWR_IMD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMD
FUNCTION FMPWR_IMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_IMZ
TYPE (IM) :: MA
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MTZM,FMPWR_IMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMZ
FUNCTION FMPWR_IMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMPWR_IMC
TYPE (IM) :: MA
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(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_IMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMC
FUNCTION FMPWR_IMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (FM) :: MB,FMPWR_IMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMPWR(MTFM,MB%MFM,FMPWR_IMFM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMFM
FUNCTION FMPWR_IMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMPWR_IMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMPWR(MA%MIM,MB%MIM,FMPWR_IMIM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMIM
FUNCTION FMPWR_IMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
TYPE (ZM) :: MB,FMPWR_IMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MUZM,MB%MZM,FMPWR_IMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_IMZM
FUNCTION FMPWR_ZMI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMI
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMIPWR(MA%MZM,IVAL,FMPWR_ZMI%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMI
FUNCTION FMPWR_ZMR(MA,R)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMR
REAL :: R
INTENT (IN) :: MA,R
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSP2M(R,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMR%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMR
FUNCTION FMPWR_ZMD(MA,D)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMD
DOUBLE PRECISION :: D
INTENT (IN) :: MA,D
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(D,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMD%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMD
FUNCTION FMPWR_ZMZ(MA,Z)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMZ
COMPLEX :: Z
INTENT (IN) :: MA,Z
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMZ2M(Z,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMZ%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMZ
FUNCTION FMPWR_ZMC(MA,C)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMPWR_ZMC
COMPLEX (KIND(0.0D0)) :: C
INTENT (IN) :: MA,C
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM)
CALL FMDP2M(AIMAG(C),MUFM)
CALL ZMCMPX(MTFM,MUFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMC
FUNCTION FMPWR_ZMFM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MB
TYPE (ZM) :: MA,FMPWR_ZMFM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MB%MFM,MTFM,MTZM)
CALL ZMPWR(MA%MZM,MTZM,FMPWR_ZMFM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMFM
FUNCTION FMPWR_ZMIM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MB
TYPE (ZM) :: MA,FMPWR_ZMIM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MB%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,MUZM)
CALL ZMPWR(MA%MZM,MUZM,FMPWR_ZMIM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMIM
FUNCTION FMPWR_ZMZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,FMPWR_ZMZM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL ZMPWR(MA%MZM,MB%MZM,FMPWR_ZMZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPWR_ZMZM
! ABS
FUNCTION FMABS_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMABS_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMABS(MA%MFM,FMABS_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_FM
FUNCTION FMABS_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMABS_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMABS(MA%MIM,FMABS_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_IM
FUNCTION FMABS_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMABS_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMABS(MA%MZM,FMABS_ZM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_ZM
FUNCTION FMABS_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMABS_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMABS_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMABS(MA(J)%MFM,FMABS_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_FM1
FUNCTION FMABS_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMABS_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMABS_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMABS(MA(J)%MIM,FMABS_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_IM1
FUNCTION FMABS_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMABS_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMABS_ZM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMABS(MA(J)%MZM,FMABS_ZM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_ZM1
FUNCTION FMABS_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMABS_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMABS_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMABS(MA(J,K)%MFM,FMABS_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_FM2
FUNCTION FMABS_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMABS_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMABS_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMABS(MA(J,K)%MIM,FMABS_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_IM2
FUNCTION FMABS_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMABS_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMABS_ZM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMABS(MA(J,K)%MZM,FMABS_ZM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMABS_ZM2
! ACOS
FUNCTION FMACOS_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMACOS_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMACOS(MA%MFM,FMACOS_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_FM
FUNCTION FMACOS_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMACOS_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMACOS(MA%MZM,FMACOS_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_ZM
FUNCTION FMACOS_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMACOS_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMACOS_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMACOS(MA(J)%MFM,FMACOS_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_FM1
FUNCTION FMACOS_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMACOS_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMACOS_ZM1%MZM(1) = -1
FMACOS_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMACOS(MA(J)%MZM,FMACOS_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_ZM1
FUNCTION FMACOS_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMACOS_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMACOS_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMACOS(MA(J,K)%MFM,FMACOS_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_FM2
FUNCTION FMACOS_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMACOS_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMACOS_ZM2%MZM(1) = -1
FMACOS_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMACOS(MA(J,K)%MZM,FMACOS_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOS_ZM2
! ACOSH
FUNCTION FMACOSH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMACOSH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMACOSH(MA%MFM,FMACOSH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_FM
FUNCTION FMACOSH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMACOSH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMACOSH(MA%MZM,FMACOSH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_ZM
FUNCTION FMACOSH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMACOSH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMACOSH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMACOSH(MA(J)%MFM,FMACOSH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_FM1
FUNCTION FMACOSH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMACOSH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMACOSH_ZM1%MZM(1) = -1
FMACOSH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMACOSH(MA(J)%MZM,FMACOSH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_ZM1
FUNCTION FMACOSH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMACOSH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMACOSH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMACOSH(MA(J,K)%MFM,FMACOSH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_FM2
FUNCTION FMACOSH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMACOSH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMACOSH_ZM2%MZM(1) = -1
FMACOSH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMACOSH(MA(J,K)%MZM,FMACOSH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMACOSH_ZM2
! AIMAG
FUNCTION FMAIMAG_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMAIMAG_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMIMAG(MA%MZM,FMAIMAG_ZM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAIMAG_ZM
FUNCTION FMAIMAG_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMAIMAG_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMAIMAG_ZM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMIMAG(MA(J)%MZM,FMAIMAG_ZM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAIMAG_ZM1
FUNCTION FMAIMAG_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMAIMAG_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMAIMAG_ZM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMIMAG(MA(J,K)%MZM,FMAIMAG_ZM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAIMAG_ZM2
! AINT
FUNCTION FMAINT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMAINT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,FMAINT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_FM
FUNCTION FMAINT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMAINT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMINT(MA%MZM,FMAINT_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_ZM
FUNCTION FMAINT_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMAINT_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMAINT_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMINT(MA(J)%MFM,FMAINT_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_FM1
FUNCTION FMAINT_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMAINT_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMAINT_ZM1%MZM(1) = -1
FMAINT_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMINT(MA(J)%MZM,FMAINT_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_ZM1
FUNCTION FMAINT_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMAINT_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMAINT_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMINT(MA(J,K)%MFM,FMAINT_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_FM2
FUNCTION FMAINT_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMAINT_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMAINT_ZM2%MZM(1) = -1
FMAINT_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMINT(MA(J,K)%MZM,FMAINT_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMAINT_ZM2
! ANINT
FUNCTION FMANINT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMANINT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMNINT(MA%MFM,FMANINT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_FM
FUNCTION FMANINT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMANINT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMNINT(MA%MZM,FMANINT_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_ZM
FUNCTION FMANINT_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMANINT_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMANINT_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMNINT(MA(J)%MFM,FMANINT_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_FM1
FUNCTION FMANINT_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMANINT_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMANINT_ZM1%MZM(1) = -1
FMANINT_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMNINT(MA(J)%MZM,FMANINT_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_ZM1
FUNCTION FMANINT_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMANINT_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMANINT_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMNINT(MA(J,K)%MFM,FMANINT_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_FM2
FUNCTION FMANINT_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMANINT_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMANINT_ZM2%MZM(1) = -1
FMANINT_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMNINT(MA(J,K)%MZM,FMANINT_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMANINT_ZM2
! ASIN
FUNCTION FMASIN_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMASIN_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMASIN(MA%MFM,FMASIN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_FM
FUNCTION FMASIN_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMASIN_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMASIN(MA%MZM,FMASIN_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_ZM
FUNCTION FMASIN_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMASIN_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMASIN_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMASIN(MA(J)%MFM,FMASIN_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_FM1
FUNCTION FMASIN_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMASIN_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMASIN_ZM1%MZM(1) = -1
FMASIN_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMASIN(MA(J)%MZM,FMASIN_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_ZM1
FUNCTION FMASIN_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMASIN_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMASIN_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMASIN(MA(J,K)%MFM,FMASIN_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_FM2
FUNCTION FMASIN_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMASIN_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMASIN_ZM2%MZM(1) = -1
FMASIN_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMASIN(MA(J,K)%MZM,FMASIN_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASIN_ZM2
! ASINH
FUNCTION FMASINH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMASINH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMASINH(MA%MFM,FMASINH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_FM
FUNCTION FMASINH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMASINH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMASINH(MA%MZM,FMASINH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_ZM
FUNCTION FMASINH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMASINH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMASINH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMASINH(MA(J)%MFM,FMASINH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_FM1
FUNCTION FMASINH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMASINH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMASINH_ZM1%MZM(1) = -1
FMASINH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMASINH(MA(J)%MZM,FMASINH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_ZM1
FUNCTION FMASINH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMASINH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMASINH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMASINH(MA(J,K)%MFM,FMASINH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_FM2
FUNCTION FMASINH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMASINH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMASINH_ZM2%MZM(1) = -1
FMASINH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMASINH(MA(J,K)%MZM,FMASINH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMASINH_ZM2
! ATAN
FUNCTION FMATAN_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMATAN_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMATAN(MA%MFM,FMATAN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_FM
FUNCTION FMATAN_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMATAN_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMATAN(MA%MZM,FMATAN_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_ZM
FUNCTION FMATAN_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMATAN_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMATAN_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMATAN(MA(J)%MFM,FMATAN_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_FM1
FUNCTION FMATAN_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMATAN_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMATAN_ZM1%MZM(1) = -1
FMATAN_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMATAN(MA(J)%MZM,FMATAN_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_ZM1
FUNCTION FMATAN_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMATAN_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMATAN_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMATAN(MA(J,K)%MFM,FMATAN_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_FM2
FUNCTION FMATAN_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMATAN_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMATAN_ZM2%MZM(1) = -1
FMATAN_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMATAN(MA(J,K)%MZM,FMATAN_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN_ZM2
! ATANH
FUNCTION FMATANH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMATANH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMATANH(MA%MFM,FMATANH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_FM
FUNCTION FMATANH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMATANH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMATANH(MA%MZM,FMATANH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_ZM
FUNCTION FMATANH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMATANH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMATANH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMATANH(MA(J)%MFM,FMATANH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_FM1
FUNCTION FMATANH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMATANH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMATANH_ZM1%MZM(1) = -1
FMATANH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMATANH(MA(J)%MZM,FMATANH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_ZM1
FUNCTION FMATANH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMATANH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMATANH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMATANH(MA(J,K)%MFM,FMATANH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_FM2
FUNCTION FMATANH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMATANH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMATANH_ZM2%MZM(1) = -1
FMATANH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMATANH(MA(J,K)%MZM,FMATANH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATANH_ZM2
! ATAN2
FUNCTION FMATAN2_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMATAN2_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMATN2(MA%MFM,MB%MFM,FMATAN2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMATAN2_FM
! BTEST
FUNCTION FMBTEST_IM(MA,POS)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: POS
LOGICAL :: FMBTEST_IM
INTENT (IN) :: MA,POS
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(2,MTIM)
CALL IMI2M(POS,MUIM)
CALL IMPWR(MTIM,MUIM,MVIM)
CALL IMDIV(MA%MIM,MVIM,MUIM)
MWK(START(MUIM)) = 1
CALL IMMOD(MUIM,MTIM,MVIM)
IF (MWK(START(MVIM)+3) == 0) THEN
FMBTEST_IM = .FALSE.
ELSE
FMBTEST_IM = .TRUE.
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBTEST_IM
! CEILING
FUNCTION FMCEILING_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMCEILING_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,MTFM)
CALL FMSUB(MA%MFM,MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MFM,FMCEILING_FM%MFM)
ELSE IF (MWK(START(MA%MFM)) > 0) THEN
CALL FMADDI(MTFM,1)
CALL FMEQ(MTFM,FMCEILING_FM%MFM)
ELSE
CALL FMEQ(MTFM,FMCEILING_FM%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_FM
FUNCTION FMCEILING_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMCEILING_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,FMCEILING_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_IM
FUNCTION FMCEILING_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMCEILING_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MZM(1),MTFM)
CALL FMSUB(MA%MZM(1),MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MZM(1),MVFM)
ELSE IF (MWK(START(MA%MZM(1))) > 0) THEN
CALL FMADDI(MTFM,1)
CALL FMEQ(MTFM,MVFM)
ELSE
CALL FMEQ(MTFM,MVFM)
ENDIF
CALL FMINT(MA%MZM(2),MTFM)
CALL FMSUB(MA%MZM(2),MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MZM(2),MUFM)
ELSE IF (MWK(START(MA%MZM(2))) > 0) THEN
CALL FMADDI(MTFM,1)
CALL FMEQ(MTFM,MUFM)
ELSE
CALL FMEQ(MTFM,MUFM)
ENDIF
CALL ZMCMPX(MVFM,MUFM,FMCEILING_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_ZM
FUNCTION FMCEILING_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMCEILING_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCEILING_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FM_EQ(FMCEILING_FM(MA(J)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMCEILING_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_FM1
FUNCTION FMCEILING_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMCEILING_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCEILING_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMCEILING_IM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMCEILING_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_IM1
FUNCTION FMCEILING_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMCEILING_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCEILING_ZM1%MZM(1) = -1
FMCEILING_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZM_EQ(FMCEILING_ZM(MA(J)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMCEILING_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_ZM1
FUNCTION FMCEILING_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCEILING_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCEILING_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FM_EQ(FMCEILING_FM(MA(J,K)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMCEILING_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_FM2
FUNCTION FMCEILING_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCEILING_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCEILING_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMCEILING_IM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMCEILING_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_IM2
FUNCTION FMCEILING_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCEILING_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCEILING_ZM2%MZM(1) = -1
FMCEILING_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZM_EQ(FMCEILING_ZM(MA(J,K)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMCEILING_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCEILING_ZM2
! CMPLX
FUNCTION FMCMPLX_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMCMPLX_FM
TYPE (FM) :: MA
TYPE (FM), OPTIONAL :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (PRESENT(MB)) THEN
CALL FM_UNDEF_INP(MB)
CALL ZMCMPX(MA%MFM,MB%MFM,FMCMPLX_FM%MZM)
ELSE
CALL FMI2M(0,MTFM)
CALL ZMCMPX(MA%MFM,MTFM,FMCMPLX_FM%MZM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCMPLX_FM
FUNCTION FMCMPLX_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMCMPLX_IM
TYPE (IM) :: MA
TYPE (IM), OPTIONAL :: MB
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
IF (PRESENT(MB)) THEN
CALL FM_UNDEF_INP(MB)
CALL IMI2FM(MA%MIM,MTFM)
CALL IMI2FM(MB%MIM,MUFM)
CALL ZMCMPX(MTFM,MUFM,FMCMPLX_IM%MZM)
ELSE
CALL IMI2FM(MA%MIM,MTFM)
CALL FMI2M(0,MUFM)
CALL ZMCMPX(MTFM,MUFM,FMCMPLX_IM%MZM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCMPLX_IM
! CONJG
FUNCTION FMCONJG_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: FMCONJG_ZM,MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMCONJ(MA%MZM,FMCONJG_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCONJG_ZM
FUNCTION FMCONJG_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMCONJG_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCONJG_ZM1%MZM(1) = -1
FMCONJG_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMCONJ(MA(J)%MZM,FMCONJG_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCONJG_ZM1
FUNCTION FMCONJG_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCONJG_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCONJG_ZM2%MZM(1) = -1
FMCONJG_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCONJ(MA(J,K)%MZM,FMCONJG_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCONJG_ZM2
! COS
FUNCTION FMCOS_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMCOS_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMCOS(MA%MFM,FMCOS_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_FM
FUNCTION FMCOS_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMCOS_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMCOS(MA%MZM,FMCOS_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_ZM
FUNCTION FMCOS_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMCOS_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOS_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMCOS(MA(J)%MFM,FMCOS_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_FM1
FUNCTION FMCOS_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMCOS_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOS_ZM1%MZM(1) = -1
FMCOS_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMCOS(MA(J)%MZM,FMCOS_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_ZM1
FUNCTION FMCOS_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOS_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOS_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMCOS(MA(J,K)%MFM,FMCOS_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_FM2
FUNCTION FMCOS_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOS_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOS_ZM2%MZM(1) = -1
FMCOS_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCOS(MA(J,K)%MZM,FMCOS_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_ZM2
! COSH
FUNCTION FMCOSH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMCOSH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMCOSH(MA%MFM,FMCOSH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_FM
FUNCTION FMCOSH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMCOSH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOSH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMCOSH(MA(J)%MFM,FMCOSH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_FM1
FUNCTION FMCOSH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMCOSH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOSH_ZM1%MZM(1) = -1
FMCOSH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMCOSH(MA(J)%MZM,FMCOSH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_ZM1
FUNCTION FMCOSH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOSH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOSH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMCOSH(MA(J,K)%MFM,FMCOSH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_FM2
FUNCTION FMCOSH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOSH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOSH_ZM2%MZM(1) = -1
FMCOSH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMCOSH(MA(J,K)%MZM,FMCOSH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_ZM2
FUNCTION FMCOSH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMCOSH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMCOSH(MA%MZM,FMCOSH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_ZM
! DBLE
FUNCTION FMDBLE_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDBLE_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,FMDBLE_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDBLE_FM
FUNCTION FMDBLE_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDBLE_IM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,FMDBLE_IM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDBLE_IM
FUNCTION FMDBLE_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMDBLE_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,FMDBLE_ZM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDBLE_ZM
! DIGITS
FUNCTION FMDIGITS_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMDIGITS_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
! The next IF is always true, since some compilers complained that
! this function and several others did not use the input argument.
! MA is used only by the interface to determine its type, so the
! correct routine can be called. FMDIGITS_FM returns the number of
! FM digits in base MBASE currently being used, so that does not
! depend on the value of MA. The IF logic below tries to fool the
! compiler into believing that MA is being used, so it will not
! issue gratuitous warning messages.
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMDIGITS_FM = NDIG
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIGITS_FM
FUNCTION FMDIGITS_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: FMDIGITS_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MIM > -31 .OR. LJSUMS > -31) FMDIGITS_IM = SIZE_OF_MWK/10
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIGITS_IM
FUNCTION FMDIGITS_ZM(MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: FMDIGITS_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) FMDIGITS_ZM = NDIG
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIGITS_ZM
! DIM
FUNCTION FMDIM_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMDIM_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMDIM(MA%MFM,MB%MFM,FMDIM_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIM_FM
FUNCTION FMDIM_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMDIM_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMDIM(MA%MIM,MB%MIM,FMDIM_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDIM_IM
! DINT
FUNCTION FMDINT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMDINT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,FMDINT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDINT_FM
FUNCTION FMDINT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMDINT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMINT(MA%MZM,FMDINT_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDINT_ZM
! DOT_PRODUCT
FUNCTION FMDOTPRODUCT_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),MB(:),FMDOTPRODUCT_FM
INTEGER :: J,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMDOTPRODUCT_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL FMI2M(0,M3FM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU(MA(JA)%MFM,MUFM,NDSAVE,NDIG)
JB = LBOUND(MB,DIM=1) + J - 1
CALL FMEQU(MB(JB)%MFM,MVFM,NDSAVE,NDIG)
CALL FMMPY(MUFM,MVFM,MTFM)
CALL FMADD_R1(M3FM,MTFM)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(M3FM,FMDOTPRODUCT_FM%MFM,NDIG,NDSAVE)
NDIG = NDSAVE
ELSE
CALL FMI2M(1,MTFM)
CALL FMI2M(0,MUFM)
CALL FMDIV(MTFM,MUFM,FMDOTPRODUCT_FM%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDOTPRODUCT_FM
FUNCTION FMDOTPRODUCT_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),MB(:),FMDOTPRODUCT_IM
INTEGER :: J,JA,JB
INTENT (IN) :: MA,MB
FMDOTPRODUCT_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB)) THEN
CALL IMI2M(0,M3IM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MB,DIM=1) + J - 1
CALL IMMPY(MA(JA)%MIM,MB(JB)%MIM,MTIM)
CALL IMADD(M3IM,MTIM,MUIM)
CALL IMEQ(MUIM,M3IM)
ENDDO
CALL IMEQ(M3IM,FMDOTPRODUCT_IM%MIM)
ELSE
CALL IMI2M(1,MTIM)
CALL IMI2M(0,MUIM)
CALL IMDIV(MTIM,MUIM,FMDOTPRODUCT_IM%MIM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDOTPRODUCT_IM
FUNCTION FMDOTPRODUCT_ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:),MB(:),FMDOTPRODUCT_ZM
INTEGER :: J,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMDOTPRODUCT_ZM%MZM(1) = -1
FMDOTPRODUCT_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL ZMI2M(0,M3ZM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL ZMEQU(MA(JA)%MZM,MUZM,NDSAVE,NDIG)
MWK(START(MUZM(2))) = -MWK(START(MUZM(2)))
JB = LBOUND(MB,DIM=1) + J - 1
CALL ZMEQU(MB(JB)%MZM,MVZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,MVZM,MTZM)
CALL ZMADD(M3ZM,MTZM,MUZM)
CALL ZMEQ(MUZM,M3ZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(M3ZM,FMDOTPRODUCT_ZM%MZM,NDIG,NDSAVE)
NDIG = NDSAVE
ELSE
CALL ZMI2M(1,MTZM)
CALL ZMI2M(0,MUZM)
CALL ZMDIV(MTZM,MUZM,FMDOTPRODUCT_ZM%MZM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMDOTPRODUCT_ZM
! EPSILON
FUNCTION FMEPSILON_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMEPSILON_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) CALL FMI2M(1,MTFM)
CALL FMULP(MTFM,FMEPSILON_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEPSILON_FM
! EXP
FUNCTION FMEXP_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMEXP_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEXP(MA%MFM,FMEXP_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_FM
FUNCTION FMEXP_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMEXP_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEXP(MA%MZM,FMEXP_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_ZM
FUNCTION FMEXP_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMEXP_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMEXP_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEXP(MA(J)%MFM,FMEXP_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_FM1
FUNCTION FMEXP_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMEXP_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMEXP_ZM1%MZM(1) = -1
FMEXP_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMEXP(MA(J)%MZM,FMEXP_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_ZM1
FUNCTION FMEXP_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMEXP_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMEXP_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEXP(MA(J,K)%MFM,FMEXP_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_FM2
FUNCTION FMEXP_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMEXP_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMEXP_ZM2%MZM(1) = -1
FMEXP_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEXP(MA(J,K)%MZM,FMEXP_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_ZM2
! EXPONENT
FUNCTION FMEXPONENT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMEXPONENT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
FMEXPONENT_FM = INT(MWK(START(MA%MFM)+2))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXPONENT_FM
! FLOOR
FUNCTION FMFLOOR_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMFLOOR_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,MTFM)
CALL FMSUB(MA%MFM,MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MFM,FMFLOOR_FM%MFM)
ELSE IF (MWK(START(MA%MFM)) < 0) THEN
CALL FMADDI(MTFM,-1)
CALL FMEQ(MTFM,FMFLOOR_FM%MFM)
ELSE
CALL FMEQ(MTFM,FMFLOOR_FM%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_FM
FUNCTION FMFLOOR_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMFLOOR_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,FMFLOOR_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_IM
FUNCTION FMFLOOR_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMFLOOR_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MZM(1),MTFM)
CALL FMSUB(MA%MZM(1),MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MZM(1),MVFM)
ELSE IF (MWK(START(MA%MZM(1))) < 0) THEN
CALL FMADDI(MTFM,-1)
CALL FMEQ(MTFM,MVFM)
ELSE
CALL FMEQ(MTFM,MVFM)
ENDIF
CALL FMINT(MA%MZM(2),MTFM)
CALL FMSUB(MA%MZM(2),MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MZM(2),MUFM)
ELSE IF (MWK(START(MA%MZM(2))) < 0) THEN
CALL FMADDI(MTFM,-1)
CALL FMEQ(MTFM,MUFM)
ELSE
CALL FMEQ(MTFM,MUFM)
ENDIF
CALL ZMCMPX(MVFM,MUFM,FMFLOOR_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_ZM
FUNCTION FMFLOOR_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMFLOOR_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFLOOR_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FM_EQ(FMFLOOR_FM(MA(J)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMFLOOR_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_FM1
FUNCTION FMFLOOR_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMFLOOR_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFLOOR_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMFLOOR_IM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMFLOOR_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_IM1
FUNCTION FMFLOOR_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMFLOOR_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFLOOR_ZM1%MZM(1) = -1
FMFLOOR_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZM_EQ(FMFLOOR_ZM(MA(J)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMFLOOR_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_ZM1
FUNCTION FMFLOOR_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFLOOR_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFLOOR_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FM_EQ(FMFLOOR_FM(MA(J,K)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMFLOOR_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_FM2
FUNCTION FMFLOOR_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFLOOR_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFLOOR_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMFLOOR_IM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMFLOOR_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_IM2
FUNCTION FMFLOOR_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFLOOR_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFLOOR_ZM2%MZM(1) = -1
FMFLOOR_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZM_EQ(FMFLOOR_ZM(MA(J,K)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMFLOOR_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFLOOR_ZM2
! FRACTION
FUNCTION FMFRACTION_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMFRACTION_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,MTFM)
MWK(START(MTFM)+2) = 0
CALL FMEQ(MTFM,FMFRACTION_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_FM
FUNCTION FMFRACTION_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMFRACTION_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEQ(MA%MZM,MTZM)
MWK(START(MTZM(1))+2) = 0
MWK(START(MTZM(2))+2) = 0
CALL ZMEQ(MTZM,FMFRACTION_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_ZM
FUNCTION FMFRACTION_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMFRACTION_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFRACTION_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FM_EQ(FMFRACTION_FM(MA(J)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMFRACTION_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_FM1
FUNCTION FMFRACTION_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMFRACTION_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFRACTION_ZM1%MZM(1) = -1
FMFRACTION_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZM_EQ(FMFRACTION_ZM(MA(J)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMFRACTION_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_ZM1
FUNCTION FMFRACTION_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFRACTION_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFRACTION_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FM_EQ(FMFRACTION_FM(MA(J,K)),MT_FM)
CALL FMEQ(MT_FM%MFM,FMFRACTION_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_FM2
FUNCTION FMFRACTION_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFRACTION_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFRACTION_ZM2%MZM(1) = -1
FMFRACTION_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZM_EQ(FMFRACTION_ZM(MA(J,K)),MT_ZM)
CALL ZMEQ(MT_ZM%MZM,FMFRACTION_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRACTION_ZM2
! HUGE
FUNCTION FMHUGE_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMHUGE_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) CALL FMBIG(FMHUGE_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMHUGE_FM
FUNCTION FMHUGE_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMHUGE_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MIM > -31 .OR. LJSUMS > -31) CALL IMBIG(FMHUGE_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMHUGE_IM
FUNCTION FMHUGE_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMHUGE_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) CALL FMBIG(MTFM)
CALL ZMCMPX(MTFM,MTFM,FMHUGE_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMHUGE_ZM
! HYPOT
FUNCTION FMHYPOT_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMHYPOT_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMHYPOT(MA%MFM,MB%MFM,FMHYPOT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMHYPOT_FM
! INT
FUNCTION FMINT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM) :: FMINT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,MTFM)
CALL IMFM2I(MTFM,FMINT_FM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_FM
FUNCTION FMINT_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMINT_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,FMINT_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_IM
FUNCTION FMINT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM) :: FMINT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMINT(MTFM,MUFM)
CALL IMFM2I(MUFM,FMINT_ZM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_ZM
FUNCTION FMINT_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMINT_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMINT_FM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMINT_FM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_FM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_FM1
FUNCTION FMINT_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMINT_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMINT_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMINT_IM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_IM1
FUNCTION FMINT_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMINT_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMINT_ZM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMINT_ZM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_ZM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_ZM1
FUNCTION FMINT_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMINT_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMINT_FM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMINT_FM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_FM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_FM2
FUNCTION FMINT_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMINT_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMINT_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMINT_IM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_IM2
FUNCTION FMINT_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMINT_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMINT_ZM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMINT_ZM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMINT_ZM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINT_ZM2
! LOG
FUNCTION FMLOG_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMLOG_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMLN(MA%MFM,FMLOG_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_FM
FUNCTION FMLOG_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMLOG_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMLN(MA(J)%MFM,FMLOG_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_FM1
FUNCTION FMLOG_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMLOG_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG_ZM1%MZM(1) = -1
FMLOG_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMLN(MA(J)%MZM,FMLOG_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ZM1
FUNCTION FMLOG_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMLN(MA(J,K)%MFM,FMLOG_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_FM2
FUNCTION FMLOG_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG_ZM2%MZM(1) = -1
FMLOG_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMLN(MA(J,K)%MZM,FMLOG_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ZM2
FUNCTION FMLOG_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMLOG_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMLN(MA%MZM,FMLOG_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ZM
! LOG10
FUNCTION FMLOG10_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMLOG10_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMLG10(MA%MFM,FMLOG10_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_FM
FUNCTION FMLOG10_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMLOG10_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMLG10(MA%MZM,FMLOG10_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_ZM
FUNCTION FMLOG10_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMLOG10_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG10_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMLG10(MA(J)%MFM,FMLOG10_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_FM1
FUNCTION FMLOG10_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMLOG10_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG10_ZM1%MZM(1) = -1
FMLOG10_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMLG10(MA(J)%MZM,FMLOG10_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_ZM1
FUNCTION FMLOG10_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG10_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG10_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMLG10(MA(J,K)%MFM,FMLOG10_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_FM2
FUNCTION FMLOG10_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG10_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG10_ZM2%MZM(1) = -1
FMLOG10_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMLG10(MA(J,K)%MZM,FMLOG10_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG10_ZM2
! MATMUL
FUNCTION FMMATMUL22_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),MB(:,:)
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MB,DIM=2)) :: FMMATMUL22_FM
INTEGER :: I,J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL22_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=2) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
MXEXP = MXEXP2
CALL FMI2M(0,MTFM)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEQU(MA(I,K)%MFM,MUFM,NDSAVE,NDIG)
CALL FMEQU(MB(K,J)%MFM,MVFM,NDSAVE,NDIG)
CALL FMMPY(MUFM,MVFM,M01)
CALL FMADD_R1(MTFM,M01)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(MTFM,FMMATMUL22_FM(I,J)%MFM,NDIG,NDSAVE)
ENDDO
ENDDO
NDIG = NDSAVE
ELSE
CALL FMI2M(1,MTFM)
CALL FMI2M(0,MUFM)
CALL FMDIV(MTFM,MUFM,MVFM)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL FMEQ(MVFM,FMMATMUL22_FM(I,J)%MFM)
ENDDO
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL22_FM
FUNCTION FMMATMUL12_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),MB(:,:)
TYPE (FM), DIMENSION(SIZE(MB,DIM=2)) :: FMMATMUL12_FM
INTEGER :: J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL12_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO J = 1, SIZE(MB,DIM=2)
MXEXP = MXEXP2
CALL FMI2M(0,MTFM)
DO K = 1, SIZE(MA,DIM=1)
CALL FMEQU(MA(K)%MFM,MUFM,NDSAVE,NDIG)
CALL FMEQU(MB(K,J)%MFM,MVFM,NDSAVE,NDIG)
CALL FMMPY(MUFM,MVFM,M01)
CALL FMADD_R1(MTFM,M01)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(MTFM,FMMATMUL12_FM(J)%MFM,NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL FMST2M(' UNKNOWN ',MVFM)
DO J = 1, SIZE(MB,DIM=2)
CALL FMEQ(MVFM,FMMATMUL12_FM(J)%MFM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL12_FM
FUNCTION FMMATMUL21_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),MB(:)
TYPE (FM), DIMENSION(SIZE(MA,DIM=1)) :: FMMATMUL21_FM
INTEGER :: J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL21_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MB) == SIZE(MA,DIM=2)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO J = 1, SIZE(MA,DIM=1)
MXEXP = MXEXP2
CALL FMI2M(0,MTFM)
DO K = 1, SIZE(MB,DIM=1)
CALL FMEQU(MA(J,K)%MFM,MUFM,NDSAVE,NDIG)
CALL FMEQU(MB(K)%MFM,MVFM,NDSAVE,NDIG)
CALL FMMPY(MUFM,MVFM,M01)
CALL FMADD_R1(MTFM,M01)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(MTFM,FMMATMUL21_FM(J)%MFM,NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL FMST2M(' UNKNOWN ',MVFM)
DO J = 1, SIZE(MA,DIM=1)
CALL FMEQ(MVFM,FMMATMUL21_FM(J)%MFM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL21_FM
FUNCTION FMMATMUL22_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),MB(:,:)
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MB,DIM=2)) :: FMMATMUL22_IM
INTEGER :: I,J,K
INTENT (IN) :: MA,MB
FMMATMUL22_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=2) == SIZE(MB,DIM=1)) THEN
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL IMI2M(0,MTIM)
DO K = 1, SIZE(MA,DIM=2)
CALL IMMPY(MA(I,K)%MIM,MB(K,J)%MIM,M01)
CALL IMADD(MTIM,M01,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDDO
CALL IMEQ(MTIM,FMMATMUL22_IM(I,J)%MIM)
ENDDO
ENDDO
ELSE
CALL IMI2M(1,MTIM)
CALL IMI2M(0,MUIM)
CALL IMDIV(MTIM,MUIM,M3IM)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL IMEQ(M3IM,FMMATMUL22_IM(I,J)%MIM)
ENDDO
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL22_IM
FUNCTION FMMATMUL12_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),MB(:,:)
TYPE (IM), DIMENSION(SIZE(MB,DIM=2)) :: FMMATMUL12_IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMATMUL12_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB,DIM=1)) THEN
DO J = 1, SIZE(MB,DIM=2)
CALL IMI2M(0,MTIM)
DO K = 1, SIZE(MA,DIM=1)
CALL IMMPY(MA(K)%MIM,MB(K,J)%MIM,M01)
CALL IMADD(MTIM,M01,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDDO
CALL IMEQ(MTIM,FMMATMUL12_IM(J)%MIM)
ENDDO
ELSE
CALL IMST2M(' UNKNOWN ',MUIM)
DO J = 1, SIZE(MB,DIM=2)
CALL IMEQ(MUIM,FMMATMUL12_IM(J)%MIM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL12_IM
FUNCTION FMMATMUL21_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),MB(:)
TYPE (IM), DIMENSION(SIZE(MA,DIM=1)) :: FMMATMUL21_IM
INTEGER :: J,K
INTENT (IN) :: MA,MB
FMMATMUL21_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MB) == SIZE(MA,DIM=2)) THEN
DO J = 1, SIZE(MA,DIM=1)
CALL IMI2M(0,MTIM)
DO K = 1, SIZE(MB,DIM=1)
CALL IMMPY(MA(J,K)%MIM,MB(K)%MIM,M01)
CALL IMADD(MTIM,M01,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDDO
CALL IMEQ(MTIM,FMMATMUL21_IM(J)%MIM)
ENDDO
ELSE
CALL IMST2M(' UNKNOWN ',MUIM)
DO J = 1, SIZE(MA,DIM=1)
CALL IMEQ(MUIM,FMMATMUL21_IM(J)%MIM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL21_IM
FUNCTION FMMATMUL22_ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:,:),MB(:,:)
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MB,DIM=2)) :: FMMATMUL22_ZM
INTEGER :: I,J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL22_ZM%MZM(1) = -1
FMMATMUL22_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA,DIM=2) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
MXEXP = MXEXP2
CALL ZMI2M(0,MTZM)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMEQU(MA(I,K)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMEQU(MB(K,J)%MZM,MVZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,MVZM,MZ02)
CALL ZMADD(MTZM,MZ02,MUZM)
CALL ZMEQ(MUZM,MTZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(MTZM,FMMATMUL22_ZM(I,J)%MZM,NDIG,NDSAVE)
ENDDO
ENDDO
NDIG = NDSAVE
ELSE
CALL ZMI2M(1,MTZM)
CALL ZMI2M(0,MUZM)
CALL ZMDIV(MTZM,MUZM,MVZM)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MB,DIM=2)
CALL ZMEQ(MVZM,FMMATMUL22_ZM(I,J)%MZM)
ENDDO
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL22_ZM
FUNCTION FMMATMUL12_ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:),MB(:,:)
TYPE (ZM), DIMENSION(SIZE(MB,DIM=2)) :: FMMATMUL12_ZM
INTEGER :: J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL12_ZM%MZM(1) = -1
FMMATMUL12_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MA) == SIZE(MB,DIM=1)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO J = 1, SIZE(MB,DIM=2)
MXEXP = MXEXP2
CALL ZMI2M(0,MTZM)
DO K = 1, SIZE(MA,DIM=1)
CALL ZMEQU(MA(K)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMEQU(MB(K,J)%MZM,MVZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,MVZM,MZ01)
CALL ZMADD(MTZM,MZ01,MUZM)
CALL ZMEQ(MUZM,MTZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(MTZM,FMMATMUL12_ZM(J)%MZM,NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL ZMST2M(' UNKNOWN ',MVZM)
DO J = 1, SIZE(MB,DIM=2)
CALL ZMEQ(MVZM,FMMATMUL12_ZM(J)%MZM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL12_ZM
FUNCTION FMMATMUL21_ZM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:,:),MB(:)
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1)) :: FMMATMUL21_ZM
INTEGER :: J,K,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA,MB
FMMATMUL21_ZM%MZM(1) = -1
FMMATMUL21_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IF (SIZE(MB) == SIZE(MA,DIM=2)) THEN
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
DO J = 1, SIZE(MA,DIM=1)
MXEXP = MXEXP2
CALL ZMI2M(0,MTZM)
DO K = 1, SIZE(MB,DIM=1)
CALL ZMEQU(MA(J,K)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMEQU(MB(K)%MZM,MVZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,MVZM,MZ01)
CALL ZMADD(MTZM,MZ01,MUZM)
CALL ZMEQ(MUZM,MTZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(MTZM,FMMATMUL21_ZM(J)%MZM,NDIG,NDSAVE)
ENDDO
NDIG = NDSAVE
ELSE
CALL ZMST2M(' UNKNOWN ',MVZM)
DO J = 1, SIZE(MA,DIM=1)
CALL ZMEQ(MVZM,FMMATMUL21_ZM(J)%MZM)
ENDDO
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMATMUL21_ZM
! MAX
FUNCTION FMMAX_FM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMMAX_FM
TYPE (FM), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMAX(MA%MFM,MB%MFM,MTFM)
IF (PRESENT(MC)) THEN
CALL FM_UNDEF_INP(MC)
CALL FMMAX(MTFM,MC%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_UNDEF_INP(MD)
CALL FMMAX(MTFM,MD%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_UNDEF_INP(ME)
CALL FMMAX(MTFM,ME%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_UNDEF_INP(MF)
CALL FMMAX(MTFM,MF%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_UNDEF_INP(MG)
CALL FMMAX(MTFM,MG%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_UNDEF_INP(MH)
CALL FMMAX(MTFM,MH%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_UNDEF_INP(MI)
CALL FMMAX(MTFM,MI%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_UNDEF_INP(MJ)
CALL FMMAX(MTFM,MJ%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
CALL FMEQ(MTFM,FMMAX_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAX_FM
FUNCTION FMMAX_IM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMMAX_IM
TYPE (IM), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMMAX(MA%MIM,MB%MIM,MTIM)
IF (PRESENT(MC)) THEN
CALL FM_UNDEF_INP(MC)
CALL IMMAX(MTIM,MC%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_UNDEF_INP(MD)
CALL IMMAX(MTIM,MD%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_UNDEF_INP(ME)
CALL IMMAX(MTIM,ME%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_UNDEF_INP(MF)
CALL IMMAX(MTIM,MF%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_UNDEF_INP(MG)
CALL IMMAX(MTIM,MG%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_UNDEF_INP(MH)
CALL IMMAX(MTIM,MH%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_UNDEF_INP(MI)
CALL IMMAX(MTIM,MI%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_UNDEF_INP(MJ)
CALL IMMAX(MTIM,MJ%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
CALL IMEQ(MTIM,FMMAX_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAX_IM
! MAXEXPONENT
FUNCTION FMMAXEXPONENT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMMAXEXPONENT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMMAXEXPONENT_FM = INT(MXEXP) + 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXEXPONENT_FM
! MAXLOC
FUNCTION FMMAXLOC1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:)
INTEGER :: FMMAXLOC1_FM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' -OVERFLOW ',M3FM)
FMMAXLOC1_FM = LBOUND(MA,DIM=1)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (FMCOMP(MA(JA)%MFM,'>',M3FM)) THEN
CALL FMEQ(MA(JA)%MFM,M3FM)
FMMAXLOC1_FM = JA
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXLOC1_FM
FUNCTION FMMAXLOC2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:)
INTEGER :: FMMAXLOC2_FM(2)
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' -OVERFLOW ',M3FM)
FMMAXLOC2_FM = (/ LBOUND(MA,DIM=1), LBOUND(MA,DIM=2) /)
DO K = 1, SIZE(MA,DIM=2)
DO J = 1, SIZE(MA,DIM=1)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (FMCOMP(MA(JA,JB)%MFM,'>',M3FM)) THEN
CALL FMEQ(MA(JA,JB)%MFM,M3FM)
FMMAXLOC2_FM = (/ JA, JB /)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXLOC2_FM
FUNCTION FMMAXLOC1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:)
INTEGER :: FMMAXLOC1_IM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' -OVERFLOW ',M3IM)
FMMAXLOC1_IM = LBOUND(MA,DIM=1)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (IMCOMP(MA(JA)%MIM,'>',M3IM)) THEN
CALL IMEQ(MA(JA)%MIM,M3IM)
FMMAXLOC1_IM = JA
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXLOC1_IM
FUNCTION FMMAXLOC2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:)
INTEGER :: FMMAXLOC2_IM(2)
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' -OVERFLOW ',M3IM)
FMMAXLOC2_IM = (/ LBOUND(MA,DIM=1), LBOUND(MA,DIM=2) /)
DO K = 1, SIZE(MA,DIM=2)
DO J = 1, SIZE(MA,DIM=1)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (IMCOMP(MA(JA,JB)%MIM,'>',M3IM)) THEN
CALL IMEQ(MA(JA,JB)%MIM,M3IM)
FMMAXLOC2_IM = (/ JA, JB /)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXLOC2_IM
! MAXVAL
FUNCTION FMMAXVAL1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),FMMAXVAL1_FM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
FMMAXVAL1_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' -OVERFLOW ',M3FM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (FMCOMP(MA(JA)%MFM,'>',M3FM)) CALL FMEQ(MA(JA)%MFM,M3FM)
ENDDO
CALL FMEQ(M3FM,FMMAXVAL1_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL1_FM
FUNCTION FMMAXVAL2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),FMMAXVAL2_FM
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
FMMAXVAL2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' -OVERFLOW ',M3FM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (FMCOMP(MA(JA,JB)%MFM,'>',M3FM)) CALL FMEQ(MA(JA,JB)%MFM,M3FM)
ENDDO
ENDDO
CALL FMEQ(M3FM,FMMAXVAL2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL2_FM
FUNCTION FMMAXVAL1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),FMMAXVAL1_IM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
FMMAXVAL1_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' -OVERFLOW ',M3IM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (IMCOMP(MA(JA)%MIM,'>',M3IM)) CALL IMEQ(MA(JA)%MIM,M3IM)
ENDDO
CALL IMEQ(M3IM,FMMAXVAL1_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL1_IM
FUNCTION FMMAXVAL2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),FMMAXVAL2_IM
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
FMMAXVAL2_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' -OVERFLOW ',M3IM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (IMCOMP(MA(JA,JB)%MIM,'>',M3IM)) CALL IMEQ(MA(JA,JB)%MIM,M3IM)
ENDDO
ENDDO
CALL IMEQ(M3IM,FMMAXVAL2_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMAXVAL2_IM
! MIN
FUNCTION FMMIN_FM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMMIN_FM
TYPE (FM), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMIN(MA%MFM,MB%MFM,MTFM)
IF (PRESENT(MC)) THEN
CALL FM_UNDEF_INP(MC)
CALL FMMIN(MTFM,MC%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_UNDEF_INP(MD)
CALL FMMIN(MTFM,MD%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_UNDEF_INP(ME)
CALL FMMIN(MTFM,ME%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_UNDEF_INP(MF)
CALL FMMIN(MTFM,MF%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_UNDEF_INP(MG)
CALL FMMIN(MTFM,MG%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_UNDEF_INP(MH)
CALL FMMIN(MTFM,MH%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_UNDEF_INP(MI)
CALL FMMIN(MTFM,MI%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_UNDEF_INP(MJ)
CALL FMMIN(MTFM,MJ%MFM,MUFM)
CALL FMEQ(MUFM,MTFM)
ENDIF
CALL FMEQ(MTFM,FMMIN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMIN_FM
FUNCTION FMMIN_IM(MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMMIN_IM
TYPE (IM), OPTIONAL :: MC,MD,ME,MF,MG,MH,MI,MJ
INTENT (IN) :: MA,MB,MC,MD,ME,MF,MG,MH,MI,MJ
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMMIN(MA%MIM,MB%MIM,MTIM)
IF (PRESENT(MC)) THEN
CALL FM_UNDEF_INP(MC)
CALL IMMIN(MTIM,MC%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MD)) THEN
CALL FM_UNDEF_INP(MD)
CALL IMMIN(MTIM,MD%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(ME)) THEN
CALL FM_UNDEF_INP(ME)
CALL IMMIN(MTIM,ME%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MF)) THEN
CALL FM_UNDEF_INP(MF)
CALL IMMIN(MTIM,MF%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MG)) THEN
CALL FM_UNDEF_INP(MG)
CALL IMMIN(MTIM,MG%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MH)) THEN
CALL FM_UNDEF_INP(MH)
CALL IMMIN(MTIM,MH%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MI)) THEN
CALL FM_UNDEF_INP(MI)
CALL IMMIN(MTIM,MI%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
IF (PRESENT(MJ)) THEN
CALL FM_UNDEF_INP(MJ)
CALL IMMIN(MTIM,MJ%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
CALL IMEQ(MTIM,FMMIN_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMIN_IM
! MINEXPONENT
FUNCTION FMMINEXPONENT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMMINEXPONENT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMMINEXPONENT_FM = -INT(MXEXP)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINEXPONENT_FM
! MINVAL
FUNCTION FMMINVAL1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),FMMINVAL1_FM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
FMMINVAL1_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' OVERFLOW ',M3FM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (FMCOMP(MA(JA)%MFM,'<',M3FM)) CALL FMEQ(MA(JA)%MFM,M3FM)
ENDDO
CALL FMEQ(M3FM,FMMINVAL1_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL1_FM
FUNCTION FMMINVAL2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),FMMINVAL2_FM
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
FMMINVAL2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' OVERFLOW ',M3FM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (FMCOMP(MA(JA,JB)%MFM,'<',M3FM)) CALL FMEQ(MA(JA,JB)%MFM,M3FM)
ENDDO
ENDDO
CALL FMEQ(M3FM,FMMINVAL2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL2_FM
FUNCTION FMMINVAL1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),FMMINVAL1_IM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
FMMINVAL1_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' OVERFLOW ',M3IM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (IMCOMP(MA(JA)%MIM,'<',M3IM)) CALL IMEQ(MA(JA)%MIM,M3IM)
ENDDO
CALL IMEQ(M3IM,FMMINVAL1_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL1_IM
FUNCTION FMMINVAL2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),FMMINVAL2_IM
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
FMMINVAL2_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' OVERFLOW ',M3IM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (IMCOMP(MA(JA,JB)%MIM,'<',M3IM)) CALL IMEQ(MA(JA,JB)%MIM,M3IM)
ENDDO
ENDDO
CALL IMEQ(M3IM,FMMINVAL2_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINVAL2_IM
! MINLOC
FUNCTION FMMINLOC1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:)
INTEGER :: FMMINLOC1_FM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' OVERFLOW ',M3FM)
FMMINLOC1_FM = LBOUND(MA,DIM=1)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (FMCOMP(MA(JA)%MFM,'<',M3FM)) THEN
CALL FMEQ(MA(JA)%MFM,M3FM)
FMMINLOC1_FM = JA
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINLOC1_FM
FUNCTION FMMINLOC2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:)
INTEGER :: FMMINLOC2_FM(2)
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: FMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMST2M(' OVERFLOW ',M3FM)
FMMINLOC2_FM = (/ LBOUND(MA,DIM=1), LBOUND(MA,DIM=2) /)
DO K = 1, SIZE(MA,DIM=2)
DO J = 1, SIZE(MA,DIM=1)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (FMCOMP(MA(JA,JB)%MFM,'<',M3FM)) THEN
CALL FMEQ(MA(JA,JB)%MFM,M3FM)
FMMINLOC2_FM = (/ JA, JB /)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINLOC2_FM
FUNCTION FMMINLOC1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:)
INTEGER :: FMMINLOC1_IM
INTEGER :: J,JA
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' OVERFLOW ',M3IM)
FMMINLOC1_IM = LBOUND(MA,DIM=1)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
IF (IMCOMP(MA(JA)%MIM,'<',M3IM)) THEN
CALL IMEQ(MA(JA)%MIM,M3IM)
FMMINLOC1_IM = JA
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINLOC1_IM
FUNCTION FMMINLOC2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:)
INTEGER :: FMMINLOC2_IM(2)
INTEGER :: J,K,JA,JB
LOGICAL, EXTERNAL :: IMCOMP
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMST2M(' OVERFLOW ',M3IM)
FMMINLOC2_IM = (/ LBOUND(MA,DIM=1), LBOUND(MA,DIM=2) /)
DO K = 1, SIZE(MA,DIM=2)
DO J = 1, SIZE(MA,DIM=1)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
IF (IMCOMP(MA(JA,JB)%MIM,'<',M3IM)) THEN
CALL IMEQ(MA(JA,JB)%MIM,M3IM)
FMMINLOC2_IM = (/ JA, JB /)
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMINLOC2_IM
! MOD
FUNCTION FMMOD_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMMOD_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMOD(MA%MFM,MB%MFM,FMMOD_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMOD_FM
FUNCTION FMMOD_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMMOD_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMMOD(MA%MIM,MB%MIM,FMMOD_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMOD_IM
! MODULO
FUNCTION FMMODULO_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMMODULO_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMOD(MA%MFM,MB%MFM,MTFM)
IF (MWK(START(MTFM)+3) /= 0) THEN
IF ((MWK(START(MA%MFM)+3) > 0 .AND. MWK(START(MA%MFM)) > 0 .AND. &
MWK(START(MB%MFM)+3) > 0 .AND. MWK(START(MB%MFM)) < 0) .OR. &
(MWK(START(MA%MFM)+3) > 0 .AND. MWK(START(MA%MFM)) < 0 .AND. &
MWK(START(MB%MFM)+3) > 0 .AND. MWK(START(MB%MFM)) > 0)) THEN
CALL FMADD_R1(MTFM,MB%MFM)
ENDIF
ENDIF
CALL FMEQ(MTFM,FMMODULO_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMODULO_FM
FUNCTION FMMODULO_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMMODULO_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMMOD(MA%MIM,MB%MIM,MTIM)
IF (MWK(START(MTIM)+3) /= 0) THEN
IF ((MWK(START(MA%MIM)+3) > 0 .AND. MWK(START(MA%MIM)) > 0 .AND. &
MWK(START(MB%MIM)+3) > 0 .AND. MWK(START(MB%MIM)) < 0) .OR. &
(MWK(START(MA%MIM)+3) > 0 .AND. MWK(START(MA%MIM)) < 0 .AND. &
MWK(START(MB%MIM)+3) > 0 .AND. MWK(START(MB%MIM)) > 0)) THEN
CALL IMADD(MTIM,MB%MIM,MUIM)
CALL IMEQ(MUIM,MTIM)
ENDIF
ENDIF
CALL IMEQ(MTIM,FMMODULO_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMMODULO_IM
! NEAREST
FUNCTION FMNEAREST_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMNEAREST_FM
INTEGER :: KRSAVE
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
KRSAVE = KROUND
CALL FMTINY(M3FM)
IF (MWK(START(MA%MFM)+2) /= MEXPUN) THEN
IF (MWK(START(MB%MFM)) > 0) THEN
KROUND = 2
CALL FMADD(MA%MFM,M3FM,FMNEAREST_FM%MFM)
ELSE
KROUND = -1
CALL FMSUB(MA%MFM,M3FM,FMNEAREST_FM%MFM)
ENDIF
ELSE
IF (MWK(START(MA%MFM)) > 0 .AND. MWK(START(MB%MFM)) > 0) THEN
CALL FMEQ(M3FM,FMNEAREST_FM%MFM)
ELSE IF (MWK(START(MA%MFM)) > 0 .AND. MWK(START(MB%MFM)) < 0) THEN
CALL FMI2M(0,FMNEAREST_FM%MFM)
ELSE IF (MWK(START(MA%MFM)) < 0 .AND. MWK(START(MB%MFM)) > 0) THEN
CALL FMI2M(0,FMNEAREST_FM%MFM)
ELSE
CALL FMMPYI_R1(M3FM,-1)
CALL FMEQ(M3FM,FMNEAREST_FM%MFM)
ENDIF
ENDIF
KROUND = KRSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNEAREST_FM
! NINT
FUNCTION FMNINT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
TYPE (IM) :: FMNINT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMNINT(MA%MFM,MTFM)
CALL IMFM2I(MTFM,FMNINT_FM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_FM
FUNCTION FMNINT_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMNINT_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMEQ(MA%MIM,FMNINT_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_IM
FUNCTION FMNINT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
TYPE (IM) :: FMNINT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,MTFM)
CALL FMNINT(MTFM,MUFM)
CALL IMFM2I(MUFM,FMNINT_ZM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_ZM
FUNCTION FMNINT_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMNINT_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMNINT_FM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMNINT_FM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_FM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_FM1
FUNCTION FMNINT_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMNINT_IM1
INTEGER :: J,N
INTENT (IN) :: MA
FMNINT_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMNINT_IM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_IM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_IM1
FUNCTION FMNINT_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMNINT_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMNINT_ZM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IM_EQ(FMNINT_ZM(MA(J)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_ZM1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_ZM1
FUNCTION FMNINT_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMNINT_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMNINT_FM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMNINT_FM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_FM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_FM2
FUNCTION FMNINT_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMNINT_IM2
INTEGER :: J,K
INTENT (IN) :: MA
FMNINT_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMNINT_IM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_IM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_IM2
FUNCTION FMNINT_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMNINT_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMNINT_ZM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IM_EQ(FMNINT_ZM(MA(J,K)),MT_IM)
CALL IMEQ(MT_IM%MIM,FMNINT_ZM2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNINT_ZM2
! NORM2
FUNCTION FMNORM21_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),FMNORM21_FM
INTEGER, ALLOCATABLE :: A(:)
INTEGER :: J,JA,N,NUMBER_USED_SAVE
INTENT (IN) :: MA
FMNORM21_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMI2M(0,FMNORM21_FM%MFM)
NUMBER_USED_SAVE = NUMBER_USED
N = SIZE(MA)
ALLOCATE(A(N))
A = -2
DO J = 1, N
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQ(MA(JA)%MFM,A(J))
ENDDO
CALL FMNORM2(A,N,FMNORM21_FM%MFM)
NUMBER_USED = NUMBER_USED_SAVE
DEALLOCATE(A)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMNORM21_FM
! PRECISION
FUNCTION FMPRECISION_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMPRECISION_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMPRECISION_FM = INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRECISION_FM
FUNCTION FMPRECISION_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: FMPRECISION_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) FMPRECISION_ZM = INT(LOG10(REAL(MBASE))*(NDIG-1) + 1)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRECISION_ZM
! PRODUCT
FUNCTION FMPRODUCT1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),FMPRODUCT1_FM
INTEGER :: J,JA,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT1_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL FMI2M(1,M3FM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU(MA(JA)%MFM,MUFM,NDSAVE,NDIG)
CALL FMMPY_R1(M3FM,MUFM)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(M3FM,FMPRODUCT1_FM%MFM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT1_FM
FUNCTION FMPRODUCT2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),FMPRODUCT2_FM
INTEGER :: J,K,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL FMI2M(1,M3FM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMEQU(MA(JA,JB)%MFM,MUFM,NDSAVE,NDIG)
CALL FMMPY_R1(M3FM,MUFM)
ENDDO
ENDDO
MXEXP = MXSAVE
CALL FMEQU(M3FM,FMPRODUCT2_FM%MFM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT2_FM
FUNCTION FMPRODUCT1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),FMPRODUCT1_IM
INTEGER :: J,JA
INTENT (IN) :: MA
FMPRODUCT1_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(1,M3IM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL IMMPY(MA(JA)%MIM,M3IM,MTIM)
CALL IMEQ(MTIM,M3IM)
ENDDO
CALL IMEQ(M3IM,FMPRODUCT1_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT1_IM
FUNCTION FMPRODUCT2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),FMPRODUCT2_IM
INTEGER :: J,K,JA,JB
INTENT (IN) :: MA
FMPRODUCT2_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(1,M3IM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL IMMPY(MA(JA,JB)%MIM,M3IM,MTIM)
CALL IMEQ(MTIM,M3IM)
ENDDO
ENDDO
CALL IMEQ(M3IM,FMPRODUCT2_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT2_IM
FUNCTION FMPRODUCT1_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:),FMPRODUCT1_ZM
INTEGER :: J,JA,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT1_ZM%MZM(1) = -1
FMPRODUCT1_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL ZMI2M(1,M3ZM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL ZMEQU(MA(JA)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,M3ZM,MTZM)
CALL ZMEQ(MTZM,M3ZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(M3ZM,FMPRODUCT1_ZM%MZM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT1_ZM
FUNCTION FMPRODUCT2_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:,:),FMPRODUCT2_ZM
INTEGER :: J,K,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMPRODUCT2_ZM%MZM(1) = -1
FMPRODUCT2_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL ZMI2M(1,M3ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL ZMEQU(MA(JA,JB)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMMPY(MUZM,M3ZM,MTZM)
CALL ZMEQ(MTZM,M3ZM)
ENDDO
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(M3ZM,FMPRODUCT2_ZM%MZM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPRODUCT2_ZM
! RADIX
FUNCTION FMRADIX_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMRADIX_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMRADIX_FM = INT(MBASE)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRADIX_FM
FUNCTION FMRADIX_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: FMRADIX_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MIM > -31 .OR. LJSUMS > -31) FMRADIX_IM = INT(MBASE)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRADIX_IM
FUNCTION FMRADIX_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: FMRADIX_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) FMRADIX_ZM = INT(MBASE)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRADIX_ZM
! RANGE
FUNCTION FMRANGE_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTEGER :: FMRANGE_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) FMRANGE_FM = NINT((MXEXP+1)*LOG10(DBLE(MBASE))) - 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRANGE_FM
FUNCTION FMRANGE_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: FMRANGE_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MIM > -31 .OR. LJSUMS > -31) FMRANGE_IM = INT(SIZE_OF_MWK/10*LOG10(DBLE(MBASE)))
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRANGE_IM
FUNCTION FMRANGE_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTEGER :: FMRANGE_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) FMRANGE_ZM = NINT((MXEXP+1)*LOG10(DBLE(MBASE))) - 1
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRANGE_ZM
! REAL
FUNCTION FMREAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMREAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,FMREAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMREAL_FM
FUNCTION FMREAL_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMREAL_IM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2FM(MA%MIM,FMREAL_IM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMREAL_IM
FUNCTION FMREAL_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMREAL_ZM
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMREAL(MA%MZM,FMREAL_ZM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMREAL_ZM
! RRSPACING
FUNCTION FMRRSPACING_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMRRSPACING_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMABS(MA%MFM,MTFM)
MWK(START(MTFM)+2) = NDIG
CALL FMEQ(MTFM,FMRRSPACING_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMRRSPACING_FM
! SCALE
FUNCTION FMSCALE_FM(MA,L)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSCALE_FM
INTEGER :: L
INTENT (IN) :: MA,L
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,MTFM)
IF (ABS(MWK(START(MTFM)+2)+L) < MXEXP) THEN
MWK(START(MTFM)+2) = MWK(START(MTFM)+2) + L
CALL FMEQ(MTFM,FMSCALE_FM%MFM)
ELSE
CALL FMI2M(INT(MBASE),MUFM)
CALL FMIPWR(MUFM,L,MVFM)
CALL FMMPY(MA%MFM,MVFM,M3FM)
CALL FMEQ(M3FM,FMSCALE_FM%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSCALE_FM
FUNCTION FMSCALE_ZM(MA,L)
USE FMVALS
IMPLICIT NONE
INTEGER :: L
TYPE (ZM) :: MA,FMSCALE_ZM
INTENT (IN) :: MA,L
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMEQ(MA%MZM,MTZM)
IF (ABS(MWK(START(MTZM(1))+2)+L) < MXEXP .AND. &
ABS(MWK(START(MTZM(2))+2)+L) < MXEXP) THEN
MWK(START(MTZM(1))+2) = MWK(START(MTZM(1))+2) + L
MWK(START(MTZM(2))+2) = MWK(START(MTZM(2))+2) + L
CALL ZMEQ(MTZM,FMSCALE_ZM%MZM)
ELSE
CALL ZMI2M(INT(MBASE),MUZM)
CALL ZMIPWR(MUZM,L,MVZM)
CALL ZMMPY(MA%MZM,MVZM,M3ZM)
CALL ZMEQ(M3ZM,FMSCALE_ZM%MZM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSCALE_ZM
! SETEXPONENT
FUNCTION FMSETEXPONENT_FM(MA,L)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSETEXPONENT_FM
INTEGER :: L
INTENT (IN) :: MA,L
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,MTFM)
MWK(START(MTFM)+2) = L
CALL FMEQ(MTFM,FMSETEXPONENT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSETEXPONENT_FM
! SIGN
FUNCTION FMSIGN_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMSIGN_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMSIGN(MA%MFM,MB%MFM,FMSIGN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIGN_FM
FUNCTION FMSIGN_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMSIGN_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMSIGN(MA%MIM,MB%MIM,FMSIGN_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIGN_IM
END MODULE FMZM_8
MODULE FMZM_9
USE FMZM_1
INTERFACE SIN
MODULE PROCEDURE FMSIN_FM
MODULE PROCEDURE FMSIN_ZM
MODULE PROCEDURE FMSIN_FM1
MODULE PROCEDURE FMSIN_ZM1
MODULE PROCEDURE FMSIN_FM2
MODULE PROCEDURE FMSIN_ZM2
END INTERFACE
INTERFACE SINH
MODULE PROCEDURE FMSINH_FM
MODULE PROCEDURE FMSINH_ZM
MODULE PROCEDURE FMSINH_FM1
MODULE PROCEDURE FMSINH_ZM1
MODULE PROCEDURE FMSINH_FM2
MODULE PROCEDURE FMSINH_ZM2
END INTERFACE
INTERFACE SPACING
MODULE PROCEDURE FMSPACING_FM
END INTERFACE
INTERFACE SQRT
MODULE PROCEDURE FMSQRT_FM
MODULE PROCEDURE FMSQRT_ZM
MODULE PROCEDURE FMSQRT_FM1
MODULE PROCEDURE FMSQRT_ZM1
MODULE PROCEDURE FMSQRT_FM2
MODULE PROCEDURE FMSQRT_ZM2
END INTERFACE
INTERFACE SUM
MODULE PROCEDURE FMSUM1_FM
MODULE PROCEDURE FMSUM2_FM
MODULE PROCEDURE FMSUM1_IM
MODULE PROCEDURE FMSUM2_IM
MODULE PROCEDURE FMSUM1_ZM
MODULE PROCEDURE FMSUM2_ZM
END INTERFACE
INTERFACE TAN
MODULE PROCEDURE FMTAN_FM
MODULE PROCEDURE FMTAN_ZM
MODULE PROCEDURE FMTAN_FM1
MODULE PROCEDURE FMTAN_ZM1
MODULE PROCEDURE FMTAN_FM2
MODULE PROCEDURE FMTAN_ZM2
END INTERFACE
INTERFACE TANH
MODULE PROCEDURE FMTANH_FM
MODULE PROCEDURE FMTANH_ZM
MODULE PROCEDURE FMTANH_FM1
MODULE PROCEDURE FMTANH_ZM1
MODULE PROCEDURE FMTANH_FM2
MODULE PROCEDURE FMTANH_ZM2
END INTERFACE
INTERFACE TINY
MODULE PROCEDURE FMTINY_FM
MODULE PROCEDURE FMTINY_IM
MODULE PROCEDURE FMTINY_ZM
END INTERFACE
INTERFACE TRANSPOSE
MODULE PROCEDURE FMTRANSPOSE_FM
MODULE PROCEDURE FMTRANSPOSE_IM
MODULE PROCEDURE FMTRANSPOSE_ZM
END INTERFACE
INTERFACE FM_FORMAT
MODULE PROCEDURE FMFORMAT_FM
END INTERFACE
INTERFACE IM_FORMAT
MODULE PROCEDURE IMFORMAT_IM
END INTERFACE
INTERFACE ZM_FORMAT
MODULE PROCEDURE ZMFORMAT_ZM
END INTERFACE
INTERFACE GCD
MODULE PROCEDURE GCD_IM
END INTERFACE
INTERFACE MULTIPLY_MOD
MODULE PROCEDURE MULTIPLYMOD_IM
END INTERFACE
INTERFACE POWER_MOD
MODULE PROCEDURE POWERMOD_IM
END INTERFACE
INTERFACE BERNOULLI
MODULE PROCEDURE FMBERNOULLI_FM
END INTERFACE
INTERFACE BETA
MODULE PROCEDURE FMBETA_FM
END INTERFACE
INTERFACE BINOMIAL
MODULE PROCEDURE FMBINOMIAL_FM
MODULE PROCEDURE FMBINOMIAL_IM
MODULE PROCEDURE FMBINOMIAL_I
END INTERFACE
INTERFACE FACTORIAL
MODULE PROCEDURE FMFACTORIAL_FM
MODULE PROCEDURE FMFACTORIAL_FM1
MODULE PROCEDURE FMFACTORIAL_FM2
MODULE PROCEDURE FMFACTORIAL_IM
MODULE PROCEDURE FMFACTORIAL_IM1
MODULE PROCEDURE FMFACTORIAL_IM2
MODULE PROCEDURE FMFACTORIAL_I
MODULE PROCEDURE FMFACTORIAL_I1
MODULE PROCEDURE FMFACTORIAL_I2
END INTERFACE
INTERFACE GAMMA
MODULE PROCEDURE FMGAMMA_FM
MODULE PROCEDURE FMGAMMA_FM1
MODULE PROCEDURE FMGAMMA_FM2
END INTERFACE
INTERFACE INCOMPLETE_BETA
MODULE PROCEDURE FMINCOMPLETE_BETA_FM
END INTERFACE
INTERFACE INCOMPLETE_GAMMA1
MODULE PROCEDURE FMINCOMPLETE_GAMMA1_FM
END INTERFACE
INTERFACE INCOMPLETE_GAMMA2
MODULE PROCEDURE FMINCOMPLETE_GAMMA2_FM
END INTERFACE
INTERFACE LOG_GAMMA
MODULE PROCEDURE FMLOG_GAMMA_FM
MODULE PROCEDURE FMLOG_GAMMA_FM1
MODULE PROCEDURE FMLOG_GAMMA_FM2
END INTERFACE
INTERFACE POLYGAMMA
MODULE PROCEDURE FMPOLYGAMMA_FM
END INTERFACE
INTERFACE POCHHAMMER
MODULE PROCEDURE FMPOCHHAMMER_FM
END INTERFACE
INTERFACE PSI
MODULE PROCEDURE FMPSI_FM
MODULE PROCEDURE FMPSI_FM1
MODULE PROCEDURE FMPSI_FM2
END INTERFACE
INTERFACE BESSEL_J
MODULE PROCEDURE FMBESSEL_J_FM
END INTERFACE
INTERFACE BESSEL_J0
MODULE PROCEDURE FMBESSEL_J0_FM
END INTERFACE
INTERFACE BESSEL_J1
MODULE PROCEDURE FMBESSEL_J1_FM
END INTERFACE
INTERFACE BESSEL_JN
MODULE PROCEDURE FMBESSEL_JN_FM
MODULE PROCEDURE FMBESSEL_JN2_FM
END INTERFACE
INTERFACE BESSEL_Y
MODULE PROCEDURE FMBESSEL_Y_FM
END INTERFACE
INTERFACE BESSEL_Y0
MODULE PROCEDURE FMBESSEL_Y0_FM
END INTERFACE
INTERFACE BESSEL_Y1
MODULE PROCEDURE FMBESSEL_Y1_FM
END INTERFACE
INTERFACE BESSEL_YN
MODULE PROCEDURE FMBESSEL_YN_FM
MODULE PROCEDURE FMBESSEL_YN2_FM
END INTERFACE
INTERFACE COS_INTEGRAL
MODULE PROCEDURE FMCOS_INTEGRAL_FM
MODULE PROCEDURE FMCOS_INTEGRAL_FM1
MODULE PROCEDURE FMCOS_INTEGRAL_FM2
END INTERFACE
INTERFACE COSH_INTEGRAL
MODULE PROCEDURE FMCOSH_INTEGRAL_FM
MODULE PROCEDURE FMCOSH_INTEGRAL_FM1
MODULE PROCEDURE FMCOSH_INTEGRAL_FM2
END INTERFACE
INTERFACE EXP_INTEGRAL_EI
MODULE PROCEDURE FMEXP_INTEGRAL_EI_FM
MODULE PROCEDURE FMEXP_INTEGRAL_EI_FM1
MODULE PROCEDURE FMEXP_INTEGRAL_EI_FM2
END INTERFACE
INTERFACE EXP_INTEGRAL_EN
MODULE PROCEDURE FMEXP_INTEGRAL_EN_FM
END INTERFACE
INTERFACE FRESNEL_C
MODULE PROCEDURE FMFRESNEL_C_FM
MODULE PROCEDURE FMFRESNEL_C_FM1
MODULE PROCEDURE FMFRESNEL_C_FM2
END INTERFACE
INTERFACE FRESNEL_S
MODULE PROCEDURE FMFRESNEL_S_FM
MODULE PROCEDURE FMFRESNEL_S_FM1
MODULE PROCEDURE FMFRESNEL_S_FM2
END INTERFACE
INTERFACE ERF
MODULE PROCEDURE FMERF_FM
MODULE PROCEDURE FMERF_FM1
MODULE PROCEDURE FMERF_FM2
END INTERFACE
INTERFACE ERFC
MODULE PROCEDURE FMERFC_FM
MODULE PROCEDURE FMERFC_FM1
MODULE PROCEDURE FMERFC_FM2
END INTERFACE
INTERFACE ERFC_SCALED
MODULE PROCEDURE FMERFC_SCALED_FM
MODULE PROCEDURE FMERFC_SCALED_FM1
MODULE PROCEDURE FMERFC_SCALED_FM2
END INTERFACE
INTERFACE LOG_ERFC
MODULE PROCEDURE FMLOG_ERFC_FM
MODULE PROCEDURE FMLOG_ERFC_FM1
MODULE PROCEDURE FMLOG_ERFC_FM2
END INTERFACE
INTERFACE LOG_INTEGRAL
MODULE PROCEDURE FMLOG_INTEGRAL_FM
MODULE PROCEDURE FMLOG_INTEGRAL_FM1
MODULE PROCEDURE FMLOG_INTEGRAL_FM2
END INTERFACE
INTERFACE SIN_INTEGRAL
MODULE PROCEDURE FMSIN_INTEGRAL_FM
MODULE PROCEDURE FMSIN_INTEGRAL_FM1
MODULE PROCEDURE FMSIN_INTEGRAL_FM2
END INTERFACE
INTERFACE SINH_INTEGRAL
MODULE PROCEDURE FMSINH_INTEGRAL_FM
MODULE PROCEDURE FMSINH_INTEGRAL_FM1
MODULE PROCEDURE FMSINH_INTEGRAL_FM2
END INTERFACE
CONTAINS
! SIN
FUNCTION FMSIN_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSIN_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSIN(MA%MFM,FMSIN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_FM
FUNCTION FMSIN_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSIN_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMSIN(MA%MZM,FMSIN_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_ZM
FUNCTION FMSIN_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSIN_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSIN_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSIN(MA(J)%MFM,FMSIN_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_FM1
FUNCTION FMSIN_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSIN_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSIN_ZM1%MZM(1) = -1
FMSIN_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMSIN(MA(J)%MZM,FMSIN_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_ZM1
FUNCTION FMSIN_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSIN_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSIN_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSIN(MA(J,K)%MFM,FMSIN_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_FM2
FUNCTION FMSIN_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSIN_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSIN_ZM2%MZM(1) = -1
FMSIN_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSIN(MA(J,K)%MZM,FMSIN_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_ZM2
! SINH
FUNCTION FMSINH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSINH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSINH(MA%MFM,FMSINH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_FM
FUNCTION FMSINH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSINH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMSINH(MA%MZM,FMSINH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_ZM
FUNCTION FMSINH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSINH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSINH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSINH(MA(J)%MFM,FMSINH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_FM1
FUNCTION FMSINH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSINH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSINH_ZM1%MZM(1) = -1
FMSINH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMSINH(MA(J)%MZM,FMSINH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_ZM1
FUNCTION FMSINH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSINH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSINH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSINH(MA(J,K)%MFM,FMSINH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_FM2
FUNCTION FMSINH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSINH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSINH_ZM2%MZM(1) = -1
FMSINH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSINH(MA(J,K)%MZM,FMSINH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_ZM2
! SPACING
FUNCTION FMSPACING_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSPACING_FM
INTENT (IN) :: MA
INTEGER :: KWRNSV
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMABS(MA%MFM,MTFM)
IF (MWK(START(MTFM)+3) /= 0) THEN
KWRNSV = KWARN
KWARN = 0
CALL FMULP(MTFM,FMSPACING_FM%MFM)
KWARN = KWRNSV
IF (MWK(START(MTFM)+2) <= -MXEXP) THEN
CALL FMTINY(FMSPACING_FM%MFM)
ENDIF
ELSE
CALL FMTINY(FMSPACING_FM%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSPACING_FM
! SQRT
FUNCTION FMSQRT_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSQRT_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSQRT(MA%MFM,FMSQRT_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_FM
FUNCTION FMSQRT_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMSQRT_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMSQRT(MA%MZM,FMSQRT_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_ZM
FUNCTION FMSQRT_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSQRT_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSQRT_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSQRT(MA(J)%MFM,FMSQRT_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_FM1
FUNCTION FMSQRT_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMSQRT_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSQRT_ZM1%MZM(1) = -1
FMSQRT_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMSQRT(MA(J)%MZM,FMSQRT_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_ZM1
FUNCTION FMSQRT_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSQRT_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSQRT_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSQRT(MA(J,K)%MFM,FMSQRT_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_FM2
FUNCTION FMSQRT_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSQRT_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSQRT_ZM2%MZM(1) = -1
FMSQRT_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMSQRT(MA(J,K)%MZM,FMSQRT_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSQRT_ZM2
! SUM
FUNCTION FMSUM1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:),FMSUM1_FM
INTEGER :: J,JA,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM1_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL FMI2M(0,M3FM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL FMEQU(MA(JA)%MFM,MUFM,NDSAVE,NDIG)
CALL FMADD_R1(M3FM,MUFM)
ENDDO
MXEXP = MXSAVE
CALL FMEQU(M3FM,FMSUM1_FM%MFM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM1_FM
FUNCTION FMSUM2_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:),FMSUM2_FM
INTEGER :: J,K,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL FMI2M(0,M3FM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL FMEQU(MA(JA,JB)%MFM,MUFM,NDSAVE,NDIG)
CALL FMADD_R1(M3FM,MUFM)
ENDDO
ENDDO
MXEXP = MXSAVE
CALL FMEQU(M3FM,FMSUM2_FM%MFM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM2_FM
FUNCTION FMSUM1_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:),FMSUM1_IM
INTEGER :: J,JA
INTENT (IN) :: MA
FMSUM1_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(0,M3IM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL IMADD(MA(JA)%MIM,M3IM,MTIM)
CALL IMEQ(MTIM,M3IM)
ENDDO
CALL IMEQ(M3IM,FMSUM1_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM1_IM
FUNCTION FMSUM2_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:),FMSUM2_IM
INTEGER :: J,K,JA,JB
INTENT (IN) :: MA
FMSUM2_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMI2M(0,M3IM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL IMADD(MA(JA,JB)%MIM,M3IM,MTIM)
CALL IMEQ(MTIM,M3IM)
ENDDO
ENDDO
CALL IMEQ(M3IM,FMSUM2_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM2_IM
FUNCTION FMSUM1_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:),FMSUM1_ZM
INTEGER :: J,JA,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM1_ZM%MZM(1) = -1
FMSUM1_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL ZMI2M(0,M3ZM)
DO J = 1, SIZE(MA)
JA = LBOUND(MA,DIM=1) + J - 1
CALL ZMEQU(MA(JA)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMADD(MUZM,M3ZM,MTZM)
CALL ZMEQ(MTZM,M3ZM)
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(M3ZM,FMSUM1_ZM%MZM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM1_ZM
FUNCTION FMSUM2_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:,:),FMSUM2_ZM
INTEGER :: J,K,JA,JB,MXSAVE,ND2,NDSAVE
INTENT (IN) :: MA
FMSUM2_ZM%MZM(1) = -1
FMSUM2_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
NDSAVE = NDIG
J = MAX(NGRD52,2)
ND2 = MAX(2*NDIG+J,2)
NDIG = ND2
MXSAVE = MXEXP
MXEXP = MXEXP2
CALL ZMI2M(0,M3ZM)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
JA = LBOUND(MA,DIM=1) + J - 1
JB = LBOUND(MA,DIM=2) + K - 1
CALL ZMEQU(MA(JA,JB)%MZM,MUZM,NDSAVE,NDIG)
CALL ZMADD(MUZM,M3ZM,MTZM)
CALL ZMEQ(MTZM,M3ZM)
ENDDO
ENDDO
MXEXP = MXSAVE
CALL ZMEQU(M3ZM,FMSUM2_ZM%MZM,NDIG,NDSAVE)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSUM2_ZM
! TAN
FUNCTION FMTAN_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMTAN_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMTAN(MA%MFM,FMTAN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_FM
FUNCTION FMTAN_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMTAN_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMTAN(MA%MZM,FMTAN_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_ZM
FUNCTION FMTAN_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMTAN_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMTAN_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMTAN(MA(J)%MFM,FMTAN_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_FM1
FUNCTION FMTAN_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMTAN_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMTAN_ZM1%MZM(1) = -1
FMTAN_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMTAN(MA(J)%MZM,FMTAN_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_ZM1
FUNCTION FMTAN_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMTAN_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMTAN_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMTAN(MA(J,K)%MFM,FMTAN_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_FM2
FUNCTION FMTAN_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMTAN_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMTAN_ZM2%MZM(1) = -1
FMTAN_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMTAN(MA(J,K)%MZM,FMTAN_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTAN_ZM2
! TANH
FUNCTION FMTANH_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMTANH_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMTANH(MA%MFM,FMTANH_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_FM
FUNCTION FMTANH_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMTANH_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMTANH(MA%MZM,FMTANH_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_ZM
FUNCTION FMTANH_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMTANH_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMTANH_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMTANH(MA(J)%MFM,FMTANH_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_FM1
FUNCTION FMTANH_ZM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA)) :: FMTANH_ZM1
INTEGER :: J,N
INTENT (IN) :: MA
FMTANH_ZM1%MZM(1) = -1
FMTANH_ZM1%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL ZMTANH(MA(J)%MZM,FMTANH_ZM1(J)%MZM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_ZM1
FUNCTION FMTANH_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMTANH_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMTANH_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMTANH(MA(J,K)%MFM,FMTANH_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_FM2
FUNCTION FMTANH_ZM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM), DIMENSION(:,:) :: MA
TYPE (ZM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMTANH_ZM2
INTEGER :: J,K
INTENT (IN) :: MA
FMTANH_ZM2%MZM(1) = -1
FMTANH_ZM2%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL ZMTANH(MA(J,K)%MZM,FMTANH_ZM2(J,K)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTANH_ZM2
! TINY
FUNCTION FMTINY_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMTINY_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) CALL FMTINY(FMTINY_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTINY_FM
FUNCTION FMTINY_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMTINY_IM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MIM > -31 .OR. LJSUMS > -31) CALL IMI2M(1,FMTINY_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTINY_IM
FUNCTION FMTINY_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,FMTINY_ZM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MZM(1) > -31 .OR. LJSUMS > -31) CALL FMTINY(MTFM)
CALL ZMCMPX(MTFM,MTFM,FMTINY_ZM%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTINY_ZM
! TRANSPOSE
FUNCTION FMTRANSPOSE_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA(:,:)
TYPE (FM), DIMENSION(SIZE(MA,DIM=2),SIZE(MA,DIM=1)) :: FMTRANSPOSE_FM
INTEGER :: I,J
INTENT (IN) :: MA
FMTRANSPOSE_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MA,DIM=2)
CALL FMEQ(MA(I,J)%MFM,FMTRANSPOSE_FM(J,I)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTRANSPOSE_FM
FUNCTION FMTRANSPOSE_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA(:,:)
TYPE (IM), DIMENSION(SIZE(MA,DIM=2),SIZE(MA,DIM=1)) :: FMTRANSPOSE_IM
INTEGER :: I,J
INTENT (IN) :: MA
FMTRANSPOSE_IM%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MA,DIM=2)
CALL IMEQ(MA(I,J)%MIM,FMTRANSPOSE_IM(J,I)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTRANSPOSE_IM
FUNCTION FMTRANSPOSE_ZM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA(:,:)
TYPE (ZM), DIMENSION(SIZE(MA,DIM=2),SIZE(MA,DIM=1)) :: FMTRANSPOSE_ZM
INTEGER :: I,J
INTENT (IN) :: MA
FMTRANSPOSE_ZM%MZM(1) = -1
FMTRANSPOSE_ZM%MZM(2) = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO I = 1, SIZE(MA,DIM=1)
DO J = 1, SIZE(MA,DIM=2)
CALL ZMEQ(MA(I,J)%MZM,FMTRANSPOSE_ZM(J,I)%MZM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMTRANSPOSE_ZM
! FM_FORMAT
FUNCTION FMFORMAT_FM(FMT,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FMT
TYPE (FM) :: MA
CHARACTER(200) :: FMFORMAT_FM
INTENT (IN) :: FMT,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMFORM(FMT,MA%MFM,FMFORMAT_FM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFORMAT_FM
! IM_FORMAT
FUNCTION IMFORMAT_IM(FMT,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FMT
CHARACTER(200) :: IMFORMAT_IM
TYPE (IM) :: MA
INTENT (IN) :: FMT,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMFORM(FMT,MA%MIM,IMFORMAT_IM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IMFORMAT_IM
! ZM_FORMAT
FUNCTION ZMFORMAT_ZM(FMTR,FMTI,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FMTR,FMTI
CHARACTER(200) :: ZMFORMAT_ZM
TYPE (ZM) :: MA
INTENT (IN) :: FMTR,FMTI,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMFORM(FMTR,FMTI,MA%MZM,ZMFORMAT_ZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION ZMFORMAT_ZM
! GCD
FUNCTION GCD_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,GCD_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMGCD(MA%MIM,MB%MIM,GCD_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION GCD_IM
! MULTIPLY_MOD
FUNCTION MULTIPLYMOD_IM(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MULTIPLYMOD_IM
INTENT (IN) :: MA,MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL IMMPYM(MA%MIM,MB%MIM,MC%MIM,MULTIPLYMOD_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION MULTIPLYMOD_IM
! POWER_MOD
FUNCTION POWERMOD_IM(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,POWERMOD_IM
INTENT (IN) :: MA,MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL IMPMOD(MA%MIM,MB%MIM,MC%MIM,POWERMOD_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION POWERMOD_IM
! BERNOULLI
FUNCTION FMBERNOULLI_FM(N)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: FMBERNOULLI_FM
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMBERNOULLI(N,FMBERNOULLI_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBERNOULLI_FM
! BETA
FUNCTION FMBETA_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMBETA_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMBETA(MA%MFM,MB%MFM,FMBETA_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBETA_FM
! BINOMIAL
FUNCTION FMBINOMIAL_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMBINOMIAL_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMCOMB(MA%MFM,MB%MFM,FMBINOMIAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBINOMIAL_FM
FUNCTION FMBINOMIAL_IM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,FMBINOMIAL_IM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL IMCOMB(MA%MIM,MB%MIM,FMBINOMIAL_IM%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBINOMIAL_IM
FUNCTION FMBINOMIAL_I(N,K)
USE FMVALS
IMPLICIT NONE
INTEGER :: N,K
TYPE (IM) :: FMBINOMIAL_I
INTENT (IN) :: N,K
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL IMCOMBI(N,K,FMBINOMIAL_I%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBINOMIAL_I
! FACTORIAL
FUNCTION FMFACTORIAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMFACTORIAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMFACT(MA%MFM,FMFACTORIAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_FM
FUNCTION FMFACTORIAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMFACTORIAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFACTORIAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMFACT(MA(J)%MFM,FMFACTORIAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_FM1
FUNCTION FMFACTORIAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFACTORIAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFACTORIAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMFACT(MA(J,K)%MFM,FMFACTORIAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_FM2
FUNCTION FMFACTORIAL_IM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,FMFACTORIAL_IM
INTENT (IN) :: MA
INTEGER :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2I(MA%MIM,IVAL)
IF (KFLAG == 0) THEN
CALL IMFACT(IVAL,FMFACTORIAL_IM%MIM)
ELSE
CALL IMST2M(' UNKNOWN ',FMFACTORIAL_IM%MIM)
KFLAG = 0
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_IM
FUNCTION FMFACTORIAL_IM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:) :: MA
TYPE (IM), DIMENSION(SIZE(MA)) :: FMFACTORIAL_IM1
INTEGER :: IVAL,J,N
INTENT (IN) :: MA
FMFACTORIAL_IM1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL IMM2I(MA(J)%MIM,IVAL)
IF (KFLAG == 0) THEN
CALL IMFACT(IVAL,FMFACTORIAL_IM1(J)%MIM)
ELSE
CALL IMST2M(' UNKNOWN ',FMFACTORIAL_IM1(J)%MIM)
KFLAG = 0
ENDIF
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_IM1
FUNCTION FMFACTORIAL_IM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM), DIMENSION(:,:) :: MA
TYPE (IM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFACTORIAL_IM2
INTEGER :: IVAL,J,K
INTENT (IN) :: MA
FMFACTORIAL_IM2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL IMM2I(MA(J,K)%MIM,IVAL)
IF (KFLAG == 0) THEN
CALL IMFACT(IVAL,FMFACTORIAL_IM2(J,K)%MIM)
ELSE
CALL IMST2M(' UNKNOWN ',FMFACTORIAL_IM2(J,K)%MIM)
KFLAG = 0
ENDIF
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_IM2
FUNCTION FMFACTORIAL_I(IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: FMFACTORIAL_I
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL IMFACT(IVAL,FMFACTORIAL_I%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_I
FUNCTION FMFACTORIAL_I1(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL)) :: FMFACTORIAL_I1
INTEGER :: J,N
INTENT (IN) :: IVAL
FMFACTORIAL_I1%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
N = SIZE(IVAL)
DO J = 1, N
CALL IMFACT(IVAL(J),FMFACTORIAL_I1(J)%MIM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_I1
FUNCTION FMFACTORIAL_I2(IVAL)
USE FMVALS
IMPLICIT NONE
INTEGER, DIMENSION(:,:) :: IVAL
TYPE (IM), DIMENSION(SIZE(IVAL,DIM=1),SIZE(IVAL,DIM=2)) :: FMFACTORIAL_I2
INTEGER :: J,K
INTENT (IN) :: IVAL
FMFACTORIAL_I2%MIM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
DO J = 1, SIZE(IVAL,DIM=1)
DO K = 1, SIZE(IVAL,DIM=2)
CALL IMFACT(IVAL(J,K),FMFACTORIAL_I2(J,K)%MIM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFACTORIAL_I2
! GAMMA
FUNCTION FMGAMMA_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMGAMMA_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMGAM(MA%MFM,FMGAMMA_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMGAMMA_FM
FUNCTION FMGAMMA_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMGAMMA_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMGAMMA_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMGAM(MA(J)%MFM,FMGAMMA_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMGAMMA_FM1
FUNCTION FMGAMMA_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMGAMMA_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMGAMMA_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMGAM(MA(J,K)%MFM,FMGAMMA_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMGAMMA_FM2
! INCOMPLETE_BETA
FUNCTION FMINCOMPLETE_BETA_FM(MX,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MX,MA,MB,FMINCOMPLETE_BETA_FM
INTENT (IN) :: MX,MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MX)
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMIBTA(MX%MFM,MA%MFM,MB%MFM,FMINCOMPLETE_BETA_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_BETA_FM
! INCOMPLETE_GAMMA1
FUNCTION FMINCOMPLETE_GAMMA1_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMINCOMPLETE_GAMMA1_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMIGM1(MA%MFM,MB%MFM,FMINCOMPLETE_GAMMA1_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_GAMMA1_FM
! INCOMPLETE_GAMMA2
FUNCTION FMINCOMPLETE_GAMMA2_FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,FMINCOMPLETE_GAMMA2_FM
INTENT (IN) :: MA,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMIGM2(MA%MFM,MB%MFM,FMINCOMPLETE_GAMMA2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMINCOMPLETE_GAMMA2_FM
! LOG_GAMMA
FUNCTION FMLOG_GAMMA_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMLOG_GAMMA_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMLNGM(MA%MFM,FMLOG_GAMMA_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_GAMMA_FM
FUNCTION FMLOG_GAMMA_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMLOG_GAMMA_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG_GAMMA_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMLNGM(MA(J)%MFM,FMLOG_GAMMA_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_GAMMA_FM1
FUNCTION FMLOG_GAMMA_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG_GAMMA_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG_GAMMA_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMLNGM(MA(J,K)%MFM,FMLOG_GAMMA_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_GAMMA_FM2
! POLYGAMMA
FUNCTION FMPOLYGAMMA_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPOLYGAMMA_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMPGAM(N,MA%MFM,FMPOLYGAMMA_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPOLYGAMMA_FM
! POCHHAMMER
FUNCTION FMPOCHHAMMER_FM(MA,N)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPOCHHAMMER_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMPOCH(MA%MFM,N,FMPOCHHAMMER_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPOCHHAMMER_FM
! PSI
FUNCTION FMPSI_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMPSI_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMPSI(MA%MFM,FMPSI_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPSI_FM
FUNCTION FMPSI_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMPSI_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMPSI_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMPSI(MA(J)%MFM,FMPSI_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPSI_FM1
FUNCTION FMPSI_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMPSI_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMPSI_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMPSI(MA(J,K)%MFM,FMPSI_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMPSI_FM2
! BESSEL_J
FUNCTION FMBESSEL_J_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_J_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESJ(N,MA%MFM,FMBESSEL_J_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J_FM
! BESSEL_J0
FUNCTION FMBESSEL_J0_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_J0_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESJ(0,MA%MFM,FMBESSEL_J0_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J0_FM
! BESSEL_J1
FUNCTION FMBESSEL_J1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_J1_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESJ(1,MA%MFM,FMBESSEL_J1_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_J1_FM
! BESSEL_JN
FUNCTION FMBESSEL_JN_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_JN_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESJ(N,MA%MFM,FMBESSEL_JN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_JN_FM
! BESSEL_JN2
FUNCTION FMBESSEL_JN2_FM(N1,N2,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N1,N2
TYPE (FM) :: MA,FMBESSEL_JN2_FM(ABS(N2-N1)+1)
INTENT (IN) :: N1,N2,MA
FMBESSEL_JN2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESJ2(N1,N2,MA%MFM,FMBESSEL_JN2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_JN2_FM
! BESSEL_Y
FUNCTION FMBESSEL_Y_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_Y_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESY(N,MA%MFM,FMBESSEL_Y_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y_FM
! BESSEL_Y0
FUNCTION FMBESSEL_Y0_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_Y0_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESY(0,MA%MFM,FMBESSEL_Y0_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y0_FM
! BESSEL_Y1
FUNCTION FMBESSEL_Y1_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_Y1_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESY(1,MA%MFM,FMBESSEL_Y1_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_Y1_FM
! BESSEL_YN
FUNCTION FMBESSEL_YN_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMBESSEL_YN_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESY(N,MA%MFM,FMBESSEL_YN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_YN_FM
! BESSEL_YN2
FUNCTION FMBESSEL_YN2_FM(N1,N2,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: N1,N2
TYPE (FM) :: MA,FMBESSEL_YN2_FM(ABS(N2-N1)+1)
INTENT (IN) :: N1,N2,MA
FMBESSEL_YN2_FM%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMBESY2(N1,N2,MA%MFM,FMBESSEL_YN2_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMBESSEL_YN2_FM
! COS_INTEGRAL
FUNCTION FMCOS_INTEGRAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMCOS_INTEGRAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMCI(MA%MFM,FMCOS_INTEGRAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_INTEGRAL_FM
FUNCTION FMCOS_INTEGRAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMCOS_INTEGRAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOS_INTEGRAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMCI(MA(J)%MFM,FMCOS_INTEGRAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_INTEGRAL_FM1
FUNCTION FMCOS_INTEGRAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOS_INTEGRAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOS_INTEGRAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMCI(MA(J,K)%MFM,FMCOS_INTEGRAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOS_INTEGRAL_FM2
! COSH_INTEGRAL
FUNCTION FMCOSH_INTEGRAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMCOSH_INTEGRAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMCHI(MA%MFM,FMCOSH_INTEGRAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_INTEGRAL_FM
FUNCTION FMCOSH_INTEGRAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMCOSH_INTEGRAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMCOSH_INTEGRAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMCHI(MA(J)%MFM,FMCOSH_INTEGRAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_INTEGRAL_FM1
FUNCTION FMCOSH_INTEGRAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMCOSH_INTEGRAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMCOSH_INTEGRAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMCHI(MA(J,K)%MFM,FMCOSH_INTEGRAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMCOSH_INTEGRAL_FM2
! EXP_INTEGRAL_EI
FUNCTION FMEXP_INTEGRAL_EI_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMEXP_INTEGRAL_EI_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEI(MA%MFM,FMEXP_INTEGRAL_EI_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EI_FM
FUNCTION FMEXP_INTEGRAL_EI_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMEXP_INTEGRAL_EI_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMEXP_INTEGRAL_EI_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMEI(MA(J)%MFM,FMEXP_INTEGRAL_EI_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EI_FM1
FUNCTION FMEXP_INTEGRAL_EI_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMEXP_INTEGRAL_EI_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMEXP_INTEGRAL_EI_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMEI(MA(J,K)%MFM,FMEXP_INTEGRAL_EI_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EI_FM2
! EXP_INTEGRAL_EN
FUNCTION FMEXP_INTEGRAL_EN_FM(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMEXP_INTEGRAL_EN_FM
INTEGER :: N
INTENT (IN) :: N,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEN(N,MA%MFM,FMEXP_INTEGRAL_EN_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMEXP_INTEGRAL_EN_FM
! FRESNEL_C
FUNCTION FMFRESNEL_C_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMFRESNEL_C_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMC(MA%MFM,FMFRESNEL_C_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_C_FM
FUNCTION FMFRESNEL_C_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMFRESNEL_C_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFRESNEL_C_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMC(MA(J)%MFM,FMFRESNEL_C_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_C_FM1
FUNCTION FMFRESNEL_C_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFRESNEL_C_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFRESNEL_C_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMC(MA(J,K)%MFM,FMFRESNEL_C_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_C_FM2
! FRESNEL_S
FUNCTION FMFRESNEL_S_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMFRESNEL_S_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMS(MA%MFM,FMFRESNEL_S_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_S_FM
FUNCTION FMFRESNEL_S_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMFRESNEL_S_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMFRESNEL_S_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMS(MA(J)%MFM,FMFRESNEL_S_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_S_FM1
FUNCTION FMFRESNEL_S_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMFRESNEL_S_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMFRESNEL_S_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMS(MA(J,K)%MFM,FMFRESNEL_S_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMFRESNEL_S_FM2
! ERF
FUNCTION FMERF_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMERF_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMERF(MA%MFM,FMERF_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERF_FM
FUNCTION FMERF_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMERF_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMERF_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMERF(MA(J)%MFM,FMERF_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERF_FM1
FUNCTION FMERF_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMERF_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMERF_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMERF(MA(J,K)%MFM,FMERF_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERF_FM2
! ERFC
FUNCTION FMERFC_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMERFC_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMERFC(MA%MFM,FMERFC_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_FM
FUNCTION FMERFC_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMERFC_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMERFC_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMERFC(MA(J)%MFM,FMERFC_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_FM1
FUNCTION FMERFC_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMERFC_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMERFC_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMERFC(MA(J,K)%MFM,FMERFC_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_FM2
! ERFC_SCALED
FUNCTION FMERFC_SCALED_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMERFC_SCALED_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMERFCS(MA%MFM,FMERFC_SCALED_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_SCALED_FM
FUNCTION FMERFC_SCALED_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMERFC_SCALED_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMERFC_SCALED_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMERFCS(MA(J)%MFM,FMERFC_SCALED_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_SCALED_FM1
FUNCTION FMERFC_SCALED_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMERFC_SCALED_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMERFC_SCALED_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMERFCS(MA(J,K)%MFM,FMERFC_SCALED_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMERFC_SCALED_FM2
! LOG_ERFC
FUNCTION FMLOG_ERFC_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMLOG_ERFC_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMLERC(MA%MFM,FMLOG_ERFC_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ERFC_FM
FUNCTION FMLOG_ERFC_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMLOG_ERFC_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG_ERFC_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMLERC(MA(J)%MFM,FMLOG_ERFC_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ERFC_FM1
FUNCTION FMLOG_ERFC_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG_ERFC_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG_ERFC_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMLERC(MA(J,K)%MFM,FMLOG_ERFC_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_ERFC_FM2
! LOG_INTEGRAL
FUNCTION FMLOG_INTEGRAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMLOG_INTEGRAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMLI(MA%MFM,FMLOG_INTEGRAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_INTEGRAL_FM
FUNCTION FMLOG_INTEGRAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMLOG_INTEGRAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMLOG_INTEGRAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMLI(MA(J)%MFM,FMLOG_INTEGRAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_INTEGRAL_FM1
FUNCTION FMLOG_INTEGRAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMLOG_INTEGRAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMLOG_INTEGRAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMLI(MA(J,K)%MFM,FMLOG_INTEGRAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMLOG_INTEGRAL_FM2
! SIN_INTEGRAL
FUNCTION FMSIN_INTEGRAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSIN_INTEGRAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSI(MA%MFM,FMSIN_INTEGRAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_INTEGRAL_FM
FUNCTION FMSIN_INTEGRAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSIN_INTEGRAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSIN_INTEGRAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSI(MA(J)%MFM,FMSIN_INTEGRAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_INTEGRAL_FM1
FUNCTION FMSIN_INTEGRAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSIN_INTEGRAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSIN_INTEGRAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSI(MA(J,K)%MFM,FMSIN_INTEGRAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSIN_INTEGRAL_FM2
! SINH_INTEGRAL
FUNCTION FMSINH_INTEGRAL_FM(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,FMSINH_INTEGRAL_FM
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMSHI(MA%MFM,FMSINH_INTEGRAL_FM%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_INTEGRAL_FM
FUNCTION FMSINH_INTEGRAL_FM1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:) :: MA
TYPE (FM), DIMENSION(SIZE(MA)) :: FMSINH_INTEGRAL_FM1
INTEGER :: J,N
INTENT (IN) :: MA
FMSINH_INTEGRAL_FM1%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
N = SIZE(MA)
DO J = 1, N
CALL FMSHI(MA(J)%MFM,FMSINH_INTEGRAL_FM1(J)%MFM)
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_INTEGRAL_FM1
FUNCTION FMSINH_INTEGRAL_FM2(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM), DIMENSION(:,:) :: MA
TYPE (FM), DIMENSION(SIZE(MA,DIM=1),SIZE(MA,DIM=2)) :: FMSINH_INTEGRAL_FM2
INTEGER :: J,K
INTENT (IN) :: MA
FMSINH_INTEGRAL_FM2%MFM = -1
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
DO J = 1, SIZE(MA,DIM=1)
DO K = 1, SIZE(MA,DIM=2)
CALL FMSHI(MA(J,K)%MFM,FMSINH_INTEGRAL_FM2(J,K)%MFM)
ENDDO
ENDDO
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FMSINH_INTEGRAL_FM2
END MODULE FMZM_9
MODULE FMZM_10
USE FMZM_1
CONTAINS
! Interface routines for calling with the FM, IM, and ZM derived types.
SUBROUTINE FM_ABS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMABS(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ABS
SUBROUTINE FM_ACOS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMACOS(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ACOS
SUBROUTINE FM_ACOSH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMACOSH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ACOSH
SUBROUTINE FM_ADD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMADD(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ADD
SUBROUTINE FM_ADD_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MA)
CALL FMADD_R1(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ADD_R1
SUBROUTINE FM_ADD_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MB)
CALL FMADD_R2(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ADD_R2
SUBROUTINE FM_ADDI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMADDI(MA%MFM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ADDI
SUBROUTINE FM_ASIN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMASIN(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ASIN
SUBROUTINE FM_ASINH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMASINH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ASINH
SUBROUTINE FM_ATAN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMATAN(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ATAN
SUBROUTINE FM_ATANH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMATANH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ATANH
SUBROUTINE FM_ATN2(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMATN2(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ATN2
SUBROUTINE FM_BIG(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMBIG(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BIG
SUBROUTINE FM_CEILING(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,MTFM)
CALL FMSUB(MA%MFM,MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MFM,MB%MFM)
ELSE IF (MWK(START(MA%MFM)) > 0) THEN
CALL FMADDI(MTFM,1)
CALL FMEQ(MTFM,MB%MFM)
ELSE
CALL FMEQ(MTFM,MB%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CEILING
SUBROUTINE FM_CHANGEBASE(MA,MB,NEW_MBASE,NEW_NDIG)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTEGER :: NEW_MBASE,NEW_NDIG
INTENT (IN) :: MA,NEW_MBASE,NEW_NDIG
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMCHANGEBASE(MA%MFM,MB%MFM,NEW_MBASE,NEW_NDIG)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CHANGEBASE
SUBROUTINE FM_CHSH(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL FMCHSH(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CHSH
FUNCTION FM_COMP(MA,LREL,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FM_COMP
LOGICAL, EXTERNAL :: FMCOMP
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
CHARACTER(*) :: LREL
INTENT (IN) :: LREL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FM_COMP = FMCOMP(MA%MFM,LREL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_COMP
SUBROUTINE FM_COS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMCOS(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_COS
SUBROUTINE FM_COSH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMCOSH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_COSH
SUBROUTINE FM_CSSN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL FMCSSN(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CSSN
SUBROUTINE FM_DIM(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMDIM(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIM
SUBROUTINE FM_DIV(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMDIV(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIV
SUBROUTINE FM_DIV_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MA)
CALL FMDIV_R1(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIV_R1
SUBROUTINE FM_DIV_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MB)
CALL FMDIV_R2(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIV_R2
SUBROUTINE FM_DIVI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMDIVI(MA%MFM,IVAL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIVI
SUBROUTINE FM_DIVI_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MA)
CALL FMDIVI_R1(MA%MFM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DIVI_R1
SUBROUTINE FM_DP2M(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
DOUBLE PRECISION :: X
INTENT (IN) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDP2M(X,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DP2M
SUBROUTINE FM_DPM(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
DOUBLE PRECISION :: X
INTENT (IN) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMDPM(X,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_DPM
SUBROUTINE FM_EPSILON(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
IF (MA%MFM > -31 .OR. LJSUMS > -31) CALL FMI2M(1,MTFM)
CALL FMULP(MTFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EPSILON
SUBROUTINE FM_EQU(MA,MB,NA,NB)
USE FMVALS
IMPLICIT NONE
INTEGER :: KA,KB,NA,NB,NDSAVE
INTENT (IN) :: NA,NB
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
KA = NA
KB = NB
NDSAVE = NDIG
NDIG = KA
CALL FMEQU(MA%MFM,MB%MFM,KA,KB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EQU
SUBROUTINE FM_EQU_R1(MA,NA,NB)
USE FMVALS
IMPLICIT NONE
INTEGER :: KA,KB,NA,NB,NDSAVE
INTENT (IN) :: NA,NB
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
KA = NA
KB = NB
NDSAVE = NDIG
NDIG = KA
CALL FMEQU_R1(MA%MFM,KA,KB)
NDIG = NDSAVE
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EQU_R1
SUBROUTINE FM_EXP(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEXP(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EXP
SUBROUTINE FM_FLAG(K)
USE FMVALS
IMPLICIT NONE
INTEGER :: K
INTENT (INOUT) :: K
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMFLAG(K)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FLAG
SUBROUTINE FM_FORM(FORM,MA,STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM,STRING
INTENT (IN) :: FORM
INTENT (INOUT) :: STRING
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMFORM(FORM,MA%MFM,STRING)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FORM
SUBROUTINE FM_FLOOR(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMINT(MA%MFM,MTFM)
CALL FMSUB(MA%MFM,MTFM,MUFM)
IF (MWK(START(MUFM)+3) == 0) THEN
CALL FMEQ(MA%MFM,MB%MFM)
ELSE IF (MWK(START(MA%MFM)) < 0) THEN
CALL FMADDI(MTFM,-1)
CALL FMEQ(MTFM,MB%MFM)
ELSE
CALL FMEQ(MTFM,MB%MFM)
ENDIF
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FLOOR
SUBROUTINE FM_FPRT(FORM,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM
INTENT (IN) :: FORM
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMFPRT(FORM,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FPRT
SUBROUTINE FM_FRACTION(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ(MA%MFM,MTFM)
MWK(START(MTFM)+2) = 0
CALL FMEQ(MTFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FRACTION
SUBROUTINE FM_HYPOT(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMHYPOT(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_HYPOT
SUBROUTINE FM_I2M(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMI2M(IVAL,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_I2M
SUBROUTINE FM_INP(LINE,MA,LA,LB)
USE FMVALS
IMPLICIT NONE
INTEGER :: LA,LB
INTENT (IN) :: LA,LB
CHARACTER :: LINE(LB)
INTENT (IN) :: LINE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMINP(LINE,MA%MFM,LA,LB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INP
SUBROUTINE FM_INT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMINT(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_INT
SUBROUTINE FM_IPWR(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMIPWR(MA%MFM,IVAL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_IPWR
SUBROUTINE FM_LG10(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMLG10(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LG10
SUBROUTINE FM_LN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMLN(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LN
SUBROUTINE FM_LNI(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMLNI(IVAL,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LNI
SUBROUTINE FM_M2DP(MA,X)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
DOUBLE PRECISION :: X
INTENT (INOUT) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2DP(MA%MFM,X)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_M2DP
SUBROUTINE FM_M2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2I(MA%MFM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_M2I
SUBROUTINE FM_M2SP(MA,X)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
REAL :: X
INTENT (INOUT) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMM2SP(MA%MFM,X)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_M2SP
SUBROUTINE FM_MAX(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMMAX(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MAX
SUBROUTINE FM_MIN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMMIN(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MIN
SUBROUTINE FM_MOD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMMOD(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MOD
SUBROUTINE FM_MODULO(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMMOD(MA%MFM,MB%MFM,MTFM)
IF (MWK(START(MTFM)+3) /= 0) THEN
IF ((MWK(START(MA%MFM)+3) > 0 .AND. MWK(START(MA%MFM)) > 0 .AND. &
MWK(START(MB%MFM)+3) > 0 .AND. MWK(START(MB%MFM)) < 0) .OR. &
(MWK(START(MA%MFM)+3) > 0 .AND. MWK(START(MA%MFM)) < 0 .AND. &
MWK(START(MB%MFM)+3) > 0 .AND. MWK(START(MB%MFM)) > 0)) THEN
CALL FMADD_R1(MTFM,MB%MFM)
ENDIF
ENDIF
CALL FMEQ(MTFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MODULO
SUBROUTINE FM_MPY(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMMPY(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MPY
SUBROUTINE FM_MPY_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MA)
CALL FMMPY_R1(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MPY_R1
SUBROUTINE FM_MPY_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MB)
CALL FMMPY_R2(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MPY_R2
SUBROUTINE FM_MPYI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMMPYI(MA%MFM,IVAL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MPYI
SUBROUTINE FM_MPYI_R1(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MA)
CALL FMMPYI_R1(MA%MFM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_MPYI_R1
SUBROUTINE FM_NEAREST(MA,MB,MC)
USE FMVALS
USE FMZM_8
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_EQ(FMNEAREST_FM(MA,MB),MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_NEAREST
SUBROUTINE FM_NINT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMNINT(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_NINT
SUBROUTINE FM_OUT(MA,LINE,LB)
USE FMVALS
IMPLICIT NONE
INTEGER :: LB
INTENT (IN) :: LB
CHARACTER :: LINE(LB)
INTENT (INOUT) :: LINE
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMOUT(MA%MFM,LINE,LB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_OUT
SUBROUTINE FM_PI(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMPI(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PI
SUBROUTINE FM_PRNT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMPRNT(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PRNT
SUBROUTINE FM_PWR(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMPWR(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PWR
SUBROUTINE FM_READ(KREAD,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KREAD
TYPE (FM) :: MA
INTENT (IN) :: KREAD
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMREAD(KREAD,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_READ
SUBROUTINE FM_RPWR(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: IVAL,JVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMRPWR(MA%MFM,IVAL,JVAL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_RPWR
SUBROUTINE FM_RRSPACING(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMABS(MA%MFM,MTFM)
MWK(START(MTFM)+2) = NDIG
CALL FMEQ(MTFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_RRSPACING
SUBROUTINE FM_SET(NPREC)
USE FMVALS
IMPLICIT NONE
INTEGER :: NPREC
INTENT (IN) :: NPREC
CALL FMSET(NPREC)
END SUBROUTINE FM_SET
SUBROUTINE FM_SETVAR(STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
CALL FMSETVAR(STRING)
END SUBROUTINE FM_SETVAR
SUBROUTINE FM_SIGN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMSIGN(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SIGN
SUBROUTINE FM_SIN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSIN(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SIN
SUBROUTINE FM_SINH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSINH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SINH
SUBROUTINE FM_SP2M(X,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
REAL :: X
INTENT (IN) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMSP2M(X,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SP2M
SUBROUTINE FM_SPACING(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMABS(MA%MFM,MTFM)
CALL FMULP(MTFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SPACING
SUBROUTINE FM_SQR(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSQR(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SQR
SUBROUTINE FM_SQR_R1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MA)
CALL FMSQR_R1(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SQR_R1
SUBROUTINE FM_SQRT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSQRT(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SQRT
SUBROUTINE FM_SQRT_R1(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MA)
CALL FMSQRT_R1(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SQRT_R1
SUBROUTINE FM_ST2M(STRING,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMST2M(STRING,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ST2M
SUBROUTINE FM_SUB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMSUB(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SUB
SUBROUTINE FM_SUB_R1(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MB
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MA)
CALL FMSUB_R1(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SUB_R1
SUBROUTINE FM_SUB_R2(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MB)
CALL FMSUB_R2(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SUB_R2
SUBROUTINE FM_TAN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMTAN(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_TAN
SUBROUTINE FM_TANH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMTANH(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_TANH
SUBROUTINE FM_TINY(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMTINY(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_TINY
SUBROUTINE FM_ULP(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMULP(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ULP
SUBROUTINE FM_VARS
USE FMVALS
IMPLICIT NONE
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMVARS
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_VARS
SUBROUTINE FM_WRIT(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
INTENT (IN) :: KWRITE
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMWRIT(KWRITE,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_WRIT
SUBROUTINE IM_ABS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMABS(MA%MIM,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_ABS
SUBROUTINE IM_ADD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMADD(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_ADD
SUBROUTINE IM_BIG(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMBIG(MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_BIG
SUBROUTINE IM_COMB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MC)
CALL IMCOMB(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_COMB
FUNCTION IM_COMP(MA,LREL,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: IM_COMP
LOGICAL, EXTERNAL :: IMCOMP
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,MB
CHARACTER(*) :: LREL
INTENT (IN) :: LREL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IM_COMP = IMCOMP(MA%MIM,LREL,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_COMP
SUBROUTINE IM_DIM(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMDIM(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_DIM
SUBROUTINE IM_DIV(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMDIV(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_DIV
SUBROUTINE IM_DIVI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMDIVI(MA%MIM,IVAL,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_DIVI
SUBROUTINE IM_DIVR(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC,MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMEQ_INDEX(MD)
CALL IMDIVR(MA%MIM,MB%MIM,MC%MIM,MD%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_DIVR
SUBROUTINE IM_DVIR(MA,IVAL,MB,IREM)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL,IREM
INTENT (IN) :: IVAL
INTENT (INOUT) :: IREM
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMDVIR(MA%MIM,IVAL,MB%MIM,IREM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_DVIR
SUBROUTINE IM_FACT(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMFACT(IVAL,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_FACT
SUBROUTINE IM_FM2I(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
TYPE (IM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMFM2I(MA%MFM,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_FM2I
SUBROUTINE IM_FORM(FORM,MA,STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM,STRING
INTENT (IN) :: FORM,MA
TYPE (IM) :: MA
INTENT (INOUT) :: STRING
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMFORM(FORM,MA%MIM,STRING)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_FORM
SUBROUTINE IM_FPRT(FORM,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM
INTENT (IN) :: FORM
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMFPRT(FORM,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_FPRT
SUBROUTINE IM_GCD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMGCD(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_GCD
SUBROUTINE IM_I2FM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMI2FM(MA%MIM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_I2FM
SUBROUTINE IM_I2M(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMI2M(IVAL,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_I2M
SUBROUTINE IM_INP(LINE,MA,LA,LB)
USE FMVALS
IMPLICIT NONE
INTEGER :: LA,LB
INTENT (IN) :: LA,LB
CHARACTER :: LINE(LB)
INTENT (IN) :: LINE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMINP(LINE,MA%MIM,LA,LB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_INP
SUBROUTINE IM_M2DP(MA,X)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
DOUBLE PRECISION :: X
INTENT (INOUT) :: X
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2DP(MA%MIM,X)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_M2DP
SUBROUTINE IM_M2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMM2I(MA%MIM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_M2I
SUBROUTINE IM_MAX(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMMAX(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MAX
SUBROUTINE IM_MIN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMMIN(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MIN
SUBROUTINE IM_MOD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMMOD(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MOD
SUBROUTINE IM_MPY(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMMPY(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MPY
SUBROUTINE IM_MPYI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMMPYI(MA%MIM,IVAL,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MPYI
SUBROUTINE IM_MPYM(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL FMEQ_INDEX(MD)
CALL IMMPYM(MA%MIM,MB%MIM,MC%MIM,MD%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MPYM
SUBROUTINE IM_OUT(MA,LINE,LB)
USE FMVALS
IMPLICIT NONE
INTEGER :: LB
INTENT (IN) :: LB
CHARACTER :: LINE(LB)
INTENT (INOUT) :: LINE
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMOUT(MA%MIM,LINE,LB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_OUT
SUBROUTINE IM_PMOD(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL FMEQ_INDEX(MD)
CALL IMPMOD(MA%MIM,MB%MIM,MC%MIM,MD%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_PMOD
SUBROUTINE IM_PRNT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMPRNT(MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_PRNT
SUBROUTINE IM_PWR(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMPWR(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_PWR
SUBROUTINE IM_READ(KREAD,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KREAD
INTENT (IN) :: KREAD
TYPE (IM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMREAD(KREAD,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_READ
SUBROUTINE IM_SIGN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMSIGN(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_SIGN
SUBROUTINE IM_SQR(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL IMSQR(MA%MIM,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_SQR
SUBROUTINE IM_ST2M(STRING,MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMST2M(STRING,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_ST2M
SUBROUTINE IM_SUB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IMSUB(MA%MIM,MB%MIM,MC%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_SUB
SUBROUTINE IM_WRIT(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
INTENT (IN) :: KWRITE
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IMWRIT(KWRITE,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_WRIT
SUBROUTINE ZM_ABS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMABS(MA%MZM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ABS
SUBROUTINE ZM_ACOS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMACOS(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ACOS
SUBROUTINE ZM_ACOSH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMACOSH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ACOSH
SUBROUTINE ZM_ADD(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMADD(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ADD
SUBROUTINE ZM_ADDI(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMADDI(MA%MZM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ADDI
SUBROUTINE ZM_ARG(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMARG(MA%MZM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ARG
SUBROUTINE ZM_ASIN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMASIN(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ASIN
SUBROUTINE ZM_ASINH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMASINH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ASINH
SUBROUTINE ZM_ATAN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMATAN(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ATAN
SUBROUTINE ZM_ATANH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMATANH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ATANH
SUBROUTINE ZM_CHSH(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL ZMCHSH(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_CHSH
SUBROUTINE ZM_CMPX(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,MB
TYPE (ZM) :: MC
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMCMPX(MA%MFM,MB%MFM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_CMPX
SUBROUTINE ZM_CONJ(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMCONJ(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_CONJ
SUBROUTINE ZM_COS(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMCOS(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_COS
SUBROUTINE ZM_COSH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMCOSH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_COSH
SUBROUTINE ZM_CSSN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL ZMCSSN(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_CSSN
SUBROUTINE ZM_DIV(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMDIV(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_DIV
SUBROUTINE ZM_DIVI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMDIVI(MA%MZM,IVAL,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_DIVI
SUBROUTINE ZM_EQU(MA,MB,NA,NB)
USE FMVALS
IMPLICIT NONE
INTEGER :: NA,NB
INTENT (IN) :: NA,NB
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMEQU(MA%MZM,MB%MZM,NA,NB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_EQU
SUBROUTINE ZM_EXP(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMEXP(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_EXP
SUBROUTINE ZM_FORM(FORM1,FORM2,MA,STRING)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM1,FORM2,STRING
INTENT (IN) :: FORM1,FORM2
INTENT (INOUT) :: STRING
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMFORM(FORM1,FORM2,MA%MZM,STRING)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_FORM
SUBROUTINE ZM_FPRT(FORM1,FORM2,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM1,FORM2
INTENT (IN) :: FORM1,FORM2
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMFPRT(FORM1,FORM2,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_FPRT
SUBROUTINE ZM_I2M(IVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMI2M(IVAL,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_I2M
SUBROUTINE ZM_2I2M(IVAL1,IVAL2,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
INTEGER :: IVAL1,IVAL2
INTENT (IN) :: IVAL1,IVAL2
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZM2I2M(IVAL1,IVAL2,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_2I2M
SUBROUTINE ZM_IMAG(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMIMAG(MA%MZM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_IMAG
SUBROUTINE ZM_INP(LINE,MA,LA,LB)
USE FMVALS
IMPLICIT NONE
INTEGER :: LA,LB
INTENT (IN) :: LA,LB
CHARACTER :: LINE(LB)
INTENT (IN) :: LINE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMINP(LINE,MA%MZM,LA,LB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_INP
SUBROUTINE ZM_INT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMINT(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_INT
SUBROUTINE ZM_IPWR(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMIPWR(MA%MZM,IVAL,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_IPWR
SUBROUTINE ZM_LG10(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMLG10(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_LG10
SUBROUTINE ZM_LN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMLN(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_LN
SUBROUTINE ZM_M2I(MA,IVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
INTEGER :: IVAL
INTENT (INOUT) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2I(MA%MZM,IVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_M2I
SUBROUTINE ZM_M2Z(MA,ZVAL)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
COMPLEX :: ZVAL
INTENT (INOUT) :: ZVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMM2Z(MA%MZM,ZVAL)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_M2Z
SUBROUTINE ZM_MPY(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMMPY(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_MPY
SUBROUTINE ZM_MPYI(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL
INTENT (IN) :: IVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMMPYI(MA%MZM,IVAL,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_MPYI
SUBROUTINE ZM_NINT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMNINT(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_NINT
SUBROUTINE ZM_OUT(MA,LINE,LB,LAST1,LAST2)
USE FMVALS
IMPLICIT NONE
INTEGER :: LB,LAST1,LAST2
INTENT (IN) :: LB
CHARACTER :: LINE(LB)
INTENT (INOUT) :: LINE,LAST1,LAST2
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMOUT(MA%MZM,LINE,LB,LAST1,LAST2)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_OUT
SUBROUTINE ZM_PRNT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMPRNT(MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_PRNT
SUBROUTINE ZM_PWR(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMPWR(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_PWR
SUBROUTINE ZM_READ(KREAD,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KREAD
INTENT (IN) :: KREAD
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMREAD(KREAD,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_READ
SUBROUTINE ZM_REAL(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TYPE (FM) :: MB
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMREAL(MA%MZM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_REAL
SUBROUTINE ZM_RPWR(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: IVAL,JVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMRPWR(MA%MZM,IVAL,JVAL,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_RPWR
SUBROUTINE ZM_SET(NPREC)
USE FMVALS
IMPLICIT NONE
INTEGER :: NPREC
INTENT (IN) :: NPREC
CALL ZMSET(NPREC)
END SUBROUTINE ZM_SET
SUBROUTINE ZM_SIN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMSIN(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_SIN
SUBROUTINE ZM_SINH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMSINH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_SINH
SUBROUTINE ZM_SQR(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMSQR(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_SQR
SUBROUTINE ZM_SQRT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMSQRT(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_SQRT
SUBROUTINE ZM_ST2M(STRING,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
CHARACTER(*) :: STRING
INTENT (IN) :: STRING
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMST2M(STRING,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_ST2M
SUBROUTINE ZM_SUB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZMSUB(MA%MZM,MB%MZM,MC%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_SUB
SUBROUTINE ZM_TAN(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMTAN(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_TAN
SUBROUTINE ZM_TANH(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZMTANH(MA%MZM,MB%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_TANH
SUBROUTINE ZM_WRIT(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
INTENT (IN) :: KWRITE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZMWRIT(KWRITE,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_WRIT
SUBROUTINE ZM_Z2M(ZVAL,MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (INOUT) :: MA
COMPLEX :: ZVAL
INTENT (IN) :: ZVAL
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL ZMZ2M(ZVAL,MA%MZM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_Z2M
SUBROUTINE FM_ATAN2(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FM_ATN2(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ATAN2
SUBROUTINE FM_COSH_SINH(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL FM_CHSH(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_COSH_SINH
FUNCTION FM_COMPARE(MA,LREL,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: FM_COMPARE
LOGICAL, EXTERNAL :: FMCOMP
CHARACTER(*) :: LREL
TYPE (FM) :: MA,MB
INTENT (IN) :: MA,LREL,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
FM_COMPARE = FMCOMP(MA%MFM,LREL,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION FM_COMPARE
SUBROUTINE FM_COS_SIN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL FM_CSSN(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_COS_SIN
SUBROUTINE FM_EULER(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FM_EULR(MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EULER
SUBROUTINE FM_FPRINT(FORM,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM
TYPE (FM) :: MA
INTENT (IN) :: FORM,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_FPRT(FORM,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FPRINT
SUBROUTINE FM_IPOWER(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FM_IPWR(MA,IVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_IPOWER
SUBROUTINE FM_LOG10(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FM_LG10(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LOG10
SUBROUTINE FM_PRINT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_PRNT(MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PRINT
SUBROUTINE FM_POWER(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FM_PWR(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_POWER
SUBROUTINE FM_RATIONAL_POWER(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: MA,IVAL,JVAL
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FM_RPWR(MA,IVAL,JVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_RATIONAL_POWER
SUBROUTINE FM_WRITE(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
TYPE (FM) :: MA
INTENT (IN) :: KWRITE,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_WRIT(KWRITE,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_WRITE
FUNCTION IM_COMPARE(MA,LREL,MB)
USE FMVALS
IMPLICIT NONE
LOGICAL :: IM_COMPARE
LOGICAL, EXTERNAL :: IMCOMP
CHARACTER(*) :: LREL
TYPE (IM) :: MA,MB
INTENT (IN) :: MA,LREL,MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
IM_COMPARE = IMCOMP(MA%MIM,LREL,MB%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END FUNCTION IM_COMPARE
SUBROUTINE IM_FPRINT(FORM,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM
TYPE (IM) :: MA
INTENT (IN) :: FORM,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IM_FPRT(FORM,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_FPRINT
SUBROUTINE IM_MPY_MOD(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL FMEQ_INDEX(MD)
CALL IM_MPYM(MA,MB,MC,MD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_MPY_MOD
SUBROUTINE IM_POWER_MOD(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL FMEQ_INDEX(MD)
CALL IM_PMOD(MA,MB,MC,MD)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_POWER_MOD
SUBROUTINE IM_PRINT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL IM_PRNT(MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_PRINT
SUBROUTINE IM_POWER(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (IM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL IM_PWR(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_POWER
SUBROUTINE IM_WRITE(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
INTENT (IN) :: KWRITE
TYPE (IM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL IMWRITE(KWRITE,MA%MIM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE IM_WRITE
SUBROUTINE ZM_COSH_SINH(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL ZM_CHSH(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_COSH_SINH
SUBROUTINE ZM_COMPLEX(MAFM,MBFM,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MAFM,MBFM
TYPE (ZM) :: MC
INTENT (IN) :: MAFM,MBFM
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MAFM)
CALL FM_UNDEF_INP(MBFM)
CALL FMEQ_INDEX(MC)
CALL ZM_CMPX(MAFM,MBFM,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_COMPLEX
SUBROUTINE ZM_CONJUGATE(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZM_CONJ(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_CONJUGATE
SUBROUTINE ZM_COS_SIN(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA
INTENT (INOUT) :: MB,MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEQ_INDEX(MC)
CALL ZM_CSSN(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_COS_SIN
SUBROUTINE ZM_FPRINT(FORM1,FORM2,MA)
USE FMVALS
IMPLICIT NONE
CHARACTER(*) :: FORM1,FORM2
TYPE (ZM) :: MA
INTENT (IN) :: FORM1,FORM2,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZM_FPRT(FORM1,FORM2,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_FPRINT
SUBROUTINE ZM_IPOWER(MA,IVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTEGER :: IVAL
INTENT (IN) :: MA,IVAL
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZM_IPWR(MA,IVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_IPOWER
SUBROUTINE ZM_LOG10(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZM_LG10(MA,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_LOG10
SUBROUTINE ZM_PRINT(MA)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA
INTENT (IN) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZM_PRNT(MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_PRINT
SUBROUTINE ZM_POWER(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL ZM_PWR(MA,MB,MC)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_POWER
SUBROUTINE ZM_RATIONAL_POWER(MA,IVAL,JVAL,MB)
USE FMVALS
IMPLICIT NONE
TYPE (ZM) :: MA,MB
INTEGER :: IVAL,JVAL
INTENT (IN) :: MA,IVAL,JVAL
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL ZM_RPWR(MA,IVAL,JVAL,MB)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_RATIONAL_POWER
SUBROUTINE ZM_WRITE(KWRITE,MA)
USE FMVALS
IMPLICIT NONE
INTEGER :: KWRITE
TYPE (ZM) :: MA
INTENT (IN) :: KWRITE,MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL ZM_WRIT(KWRITE,MA)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE ZM_WRITE
SUBROUTINE FM_BERNOULLI(N,MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMBERNOULLI(N,MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BERNOULLI
SUBROUTINE FM_BERN(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMBERN(N,MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BERN
SUBROUTINE FM_BETA(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMBETA(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BETA
SUBROUTINE FM_COMB(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMCOMB(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_COMB
SUBROUTINE FM_EULR(MA)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA
INTENT (INOUT) :: MA
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FMEQ_INDEX(MA)
CALL FMEULR(MA%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EULR
SUBROUTINE FM_FACT(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMFACT(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_FACT
SUBROUTINE FM_GAM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMGAM(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_GAM
SUBROUTINE FM_IBTA(MA,MB,MC,MD)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC,MD
INTENT (IN) :: MA,MB,MC
INTENT (INOUT) :: MD
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FM_UNDEF_INP(MC)
CALL FMEQ_INDEX(MD)
CALL FMIBTA(MA%MFM,MB%MFM,MC%MFM,MD%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_IBTA
SUBROUTINE FM_IGM1(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMIGM1(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_IGM1
SUBROUTINE FM_IGM2(MA,MB,MC)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB,MC
INTENT (IN) :: MA,MB
INTENT (INOUT) :: MC
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FM_UNDEF_INP(MB)
CALL FMEQ_INDEX(MC)
CALL FMIGM2(MA%MFM,MB%MFM,MC%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_IGM2
SUBROUTINE FM_LNGM(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMLNGM(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LNGM
SUBROUTINE FM_PGAM(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMPGAM(N,MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PGAM
SUBROUTINE FM_POCH(MA,N,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMPOCH(MA%MFM,N,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_POCH
SUBROUTINE FM_PSI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMPSI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_PSI
SUBROUTINE FM_BESJ(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMBESJ(N,MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BESJ
SUBROUTINE FM_BESY(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMBESY(N,MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_BESY
SUBROUTINE FM_CHI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMCHI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CHI
SUBROUTINE FM_CI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMCI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_CI
SUBROUTINE FM_EI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EI
SUBROUTINE FM_EN(N,MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
INTEGER :: N
INTENT (IN) :: N
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMEN(N,MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_EN
SUBROUTINE FM_C(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMC(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_C
SUBROUTINE FM_S(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMS(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_S
SUBROUTINE FM_ERF(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMERF(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ERF
SUBROUTINE FM_ERFC(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMERFC(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ERFC
SUBROUTINE FM_ERFC_SCALED(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMERFCS(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_ERFC_SCALED
SUBROUTINE FM_LERC(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMLERC(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LERC
SUBROUTINE FM_LI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMLI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_LI
SUBROUTINE FM_SHI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSHI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SHI
SUBROUTINE FM_SI(MA,MB)
USE FMVALS
IMPLICIT NONE
TYPE (FM) :: MA,MB
INTENT (IN) :: MA
INTENT (INOUT) :: MB
TEMPV_CALL_STACK = TEMPV_CALL_STACK + 1
CALL FM_UNDEF_INP(MA)
CALL FMEQ_INDEX(MB)
CALL FMSI(MA%MFM,MB%MFM)
TEMPV_CALL_STACK = TEMPV_CALL_STACK - 1
END SUBROUTINE FM_SI
END MODULE FMZM_10
MODULE FMZM
USE FMZM_1
USE FMZM_2
USE FMZM_3
USE FMZM_4
USE FMZM_5
USE FMZM_6
USE FMZM_7
USE FMZM_8
USE FMZM_9
USE FMZM_10
END MODULE FMZM
c4science · Help