MODULE FMZM ! FMZM 1.1 David M. Smith 3-23-97 ! This module extends the definition of Fortran-90 arithmetic and ! function operations so they also apply to multiple precision ! numbers, using version 1.1 of FMLIB and ZMLIB. ! There are three multiple precision data types: ! FM (multiple precision real) ! IM (multiple precision integer) ! ZM (multiple precision complex) ! Some the the interface routines assume that the precision chosen ! in the calling program (using FMSET or ZMSET) represents more ! significant digits than does the machine's double precision. ! All the functions defined in this module are standard Fortran-90 ! functions, except for several direct conversion 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. 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 ! 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-90 intrinsics, such as the formatting ! subroutine FMFORM. In a program using this module, suppose MAFM ! has been declared with TYPE ( FM ) MAFM. To use the routine FMFORM, ! which expects the second argument to be an array and not a derived ! type, the call would have to be CALL FMFORM('F65.60',MAFM%MFM,ST1) ! so that the array contained in MAFM is passed. ! As an alternative so the user can refer directly to the FM-, IM-, ! and ZM-type variables and avoid the cumbersome "%MFM" suffixes, ! this module contains a collection of interface routines to supply ! any needed argument conversions. For each FM, IM, and ZM routine ! that is designed to be called by the user, there is also a version ! that assumes any multiple-precision arguments are derived types ! instead of arrays. Each interface routine has the same name as ! the original with an underscore after the first two letters of the ! routine name. To convert the number to a character string with ! F65.60 format, use CALL FM_FORM('F65.60',MAFM,ST1) if MAFM is of ! TYPE ( FM ), or use CALL FMFORM('F65.60',MA,ST1) if MA is declared ! as an array. All the routines shown below may be used this way. ! For each of the operations =, .EQ., .NE., .GT., .GE., .LT., .LE., ! +, -, *, /, 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).LT.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. ! AVAILABLE OPERATIONS: ! = ! + ! - ! * ! / ! ** ! .EQ. ! .NE. ! .GT. ! .GE. ! .LT. ! .LE. ! ABS real integer complex ! ACOS real complex ! AIMAG complex ! AINT real complex ! ANINT real complex ! ASIN real complex ! ATAN real complex ! ATAN2 real ! BTEST integer ! CEILING real complex ! CMPLX real integer ! CONJ complex ! COS real complex ! COSH real complex ! DBLE real integer complex ! DIGITS real integer complex ! DIM real integer ! DINT real complex ! DOTPRODUCT real integer complex ! EPSILON real ! EXP real complex ! EXPONENT real ! FLOOR real integer complex ! FRACTION real complex ! HUGE real integer complex ! INT real integer complex ! LOG real complex ! LOG10 real complex ! MATMUL real integer complex ! MAX real integer ! MAXEXPONENT real ! MIN real integer ! MINEXPONENT real ! MOD real integer ! MODULO real integer ! NEAREST real ! NINT real integer complex ! 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 USE FMZMCOMMON TYPE FM SEQUENCE DOUBLE PRECISION MFM(0:LUNPCK) END TYPE TYPE IM SEQUENCE DOUBLE PRECISION MIM(0:LUNPCK) END TYPE TYPE ZM SEQUENCE DOUBLE PRECISION MZM(0:LUNPKZ) END TYPE TYPE ( FM ), PRIVATE :: MTFM,MUFM TYPE ( IM ), PRIVATE :: MTIM,MUIM TYPE ( ZM ), PRIVATE :: MTZM,MUZM ! 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. 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 END INTERFACE INTERFACE OPERATOR (.EQ.) 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 INTERFACE OPERATOR (.NE.) 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 (.GT.) 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 (.GE.) 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 (.LT.) 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 (.LE.) 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 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 END INTERFACE 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 END INTERFACE 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 END INTERFACE 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 END INTERFACE 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 END INTERFACE INTERFACE ACOS MODULE PROCEDURE FMACOS_FM MODULE PROCEDURE FMACOS_ZM END INTERFACE INTERFACE AIMAG MODULE PROCEDURE FMAIMAG_ZM END INTERFACE INTERFACE AINT MODULE PROCEDURE FMAINT_FM MODULE PROCEDURE FMAINT_ZM END INTERFACE INTERFACE ANINT MODULE PROCEDURE FMANINT_FM MODULE PROCEDURE FMANINT_ZM END INTERFACE INTERFACE ASIN MODULE PROCEDURE FMASIN_FM MODULE PROCEDURE FMASIN_ZM END INTERFACE INTERFACE ATAN MODULE PROCEDURE FMATAN_FM MODULE PROCEDURE FMATAN_ZM 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_ZM END INTERFACE INTERFACE CMPLX MODULE PROCEDURE FMCMPLX_FM MODULE PROCEDURE FMCMPLX_IM END INTERFACE INTERFACE CONJG MODULE PROCEDURE FMCONJG_ZM END INTERFACE INTERFACE COS MODULE PROCEDURE FMCOS_FM MODULE PROCEDURE FMCOS_ZM END INTERFACE INTERFACE COSH MODULE PROCEDURE FMCOSH_FM MODULE PROCEDURE FMCOSH_ZM 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 DOTPRODUCT 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 END INTERFACE INTERFACE EXPONENT MODULE PROCEDURE FMEXPONENT_FM END INTERFACE INTERFACE FLOOR MODULE PROCEDURE FMFLOOR_FM MODULE PROCEDURE FMFLOOR_IM MODULE PROCEDURE FMFLOOR_ZM END INTERFACE INTERFACE FRACTION MODULE PROCEDURE FMFRACTION_FM MODULE PROCEDURE FMFRACTION_ZM END INTERFACE INTERFACE HUGE MODULE PROCEDURE FMHUGE_FM MODULE PROCEDURE FMHUGE_IM MODULE PROCEDURE FMHUGE_ZM END INTERFACE INTERFACE INT MODULE PROCEDURE FMINT_FM MODULE PROCEDURE FMINT_IM MODULE PROCEDURE FMINT_ZM END INTERFACE INTERFACE LOG MODULE PROCEDURE FMLOG_FM MODULE PROCEDURE FMLOG_ZM END INTERFACE INTERFACE LOG10 MODULE PROCEDURE FMLOG10_FM MODULE PROCEDURE FMLOG10_ZM END INTERFACE INTERFACE MATMUL MODULE PROCEDURE FMMATMUL_FM MODULE PROCEDURE FMMATMUL_IM MODULE PROCEDURE FMMATMUL_ZM END INTERFACE INTERFACE MAX MODULE PROCEDURE FMMAX_FM MODULE PROCEDURE FMMAX_IM END INTERFACE INTERFACE MAXEXPONENT MODULE PROCEDURE FMMAXEXPONENT_FM END INTERFACE INTERFACE MIN MODULE PROCEDURE FMMIN_FM MODULE PROCEDURE FMMIN_IM END INTERFACE INTERFACE MINEXPONENT MODULE PROCEDURE FMMINEXPONENT_FM 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 END INTERFACE INTERFACE PRECISION MODULE PROCEDURE FMPRECISION_FM MODULE PROCEDURE FMPRECISION_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 INTERFACE SIN MODULE PROCEDURE FMSIN_FM MODULE PROCEDURE FMSIN_ZM END INTERFACE INTERFACE SINH MODULE PROCEDURE FMSINH_FM MODULE PROCEDURE FMSINH_ZM END INTERFACE INTERFACE SPACING MODULE PROCEDURE FMSPACING_FM END INTERFACE INTERFACE SQRT MODULE PROCEDURE FMSQRT_FM MODULE PROCEDURE FMSQRT_ZM END INTERFACE INTERFACE TAN MODULE PROCEDURE FMTAN_FM MODULE PROCEDURE FMTAN_ZM END INTERFACE INTERFACE TANH MODULE PROCEDURE FMTANH_FM MODULE PROCEDURE FMTANH_ZM END INTERFACE INTERFACE TINY MODULE PROCEDURE FMTINY_FM MODULE PROCEDURE FMTINY_IM MODULE PROCEDURE FMTINY_ZM END INTERFACE INTERFACE TO_FM MODULE PROCEDURE FM_I MODULE PROCEDURE FM_R MODULE PROCEDURE FM_D MODULE PROCEDURE FM_Z MODULE PROCEDURE FM_C MODULE PROCEDURE FM_FM MODULE PROCEDURE FM_IM MODULE PROCEDURE FM_ZM MODULE PROCEDURE FM_ST 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 END INTERFACE INTERFACE TO_ZM MODULE PROCEDURE ZM_I MODULE PROCEDURE ZM_R MODULE PROCEDURE ZM_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 END INTERFACE INTERFACE TO_INT MODULE PROCEDURE FM_2INT MODULE PROCEDURE IM_2INT MODULE PROCEDURE ZM_2INT END INTERFACE INTERFACE TO_SP MODULE PROCEDURE FM_2SP MODULE PROCEDURE IM_2SP MODULE PROCEDURE ZM_2SP END INTERFACE INTERFACE TO_DP MODULE PROCEDURE FM_2DP MODULE PROCEDURE IM_2DP MODULE PROCEDURE ZM_2DP END INTERFACE INTERFACE TO_SPZ MODULE PROCEDURE FM_2SPZ MODULE PROCEDURE IM_2SPZ MODULE PROCEDURE ZM_2SPZ END INTERFACE INTERFACE TO_DPZ MODULE PROCEDURE FM_2DPZ MODULE PROCEDURE IM_2DPZ MODULE PROCEDURE ZM_2DPZ END INTERFACE CONTAINS ! = SUBROUTINE FMEQ_IFM(IVAL,MA) TYPE ( FM ) MA INTEGER IVAL INTENT (INOUT) :: IVAL INTENT (IN) :: MA CALL FMM2I(MA%MFM,IVAL) END SUBROUTINE SUBROUTINE FMEQ_IIM(IVAL,MA) TYPE ( IM ) MA INTEGER IVAL INTENT (INOUT) :: IVAL INTENT (IN) :: MA CALL IMM2I(MA%MIM,IVAL) END SUBROUTINE SUBROUTINE FMEQ_IZM(IVAL,MA) TYPE ( ZM ) MA INTEGER IVAL INTENT (INOUT) :: IVAL INTENT (IN) :: MA CALL ZMM2I(MA%MZM,IVAL) END SUBROUTINE SUBROUTINE FMEQ_RFM(R,MA) TYPE ( FM ) MA REAL R INTENT (INOUT) :: R INTENT (IN) :: MA CALL FMM2SP(MA%MFM,R) END SUBROUTINE SUBROUTINE FMEQ_RIM(R,MA) TYPE ( IM ) MA REAL R INTENT (INOUT) :: R INTENT (IN) :: MA CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMM2SP(MTFM%MFM,R) END SUBROUTINE SUBROUTINE FMEQ_RZM(R,MA) TYPE ( ZM ) MA REAL R INTENT (INOUT) :: R INTENT (IN) :: MA CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMM2SP(MTFM%MFM,R) END SUBROUTINE SUBROUTINE FMEQ_DFM(D,MA) TYPE ( FM ) MA DOUBLE PRECISION D INTENT (INOUT) :: D INTENT (IN) :: MA CALL FMM2DP(MA%MFM,D) END SUBROUTINE SUBROUTINE FMEQ_DIM(D,MA) TYPE ( IM ) MA DOUBLE PRECISION D INTENT (INOUT) :: D INTENT (IN) :: MA CALL IMM2DP(MA%MIM,D) END SUBROUTINE SUBROUTINE FMEQ_DZM(D,MA) TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (INOUT) :: D INTENT (IN) :: MA CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMM2DP(MTFM%MFM,D) END SUBROUTINE SUBROUTINE FMEQ_ZFM(Z,MA) TYPE ( FM ) MA COMPLEX Z REAL R INTENT (INOUT) :: Z INTENT (IN) :: MA CALL FMM2SP(MA%MFM,R) Z = CMPLX( R , 0.0 ) END SUBROUTINE SUBROUTINE FMEQ_ZIM(Z,MA) TYPE ( IM ) MA COMPLEX Z DOUBLE PRECISION D INTENT (INOUT) :: Z INTENT (IN) :: MA CALL IMM2DP(MA%MIM,D) Z = CMPLX( REAL(D) , 0.0 ) END SUBROUTINE SUBROUTINE FMEQ_ZZM(Z,MA) TYPE ( ZM ) MA COMPLEX Z INTENT (INOUT) :: Z INTENT (IN) :: MA CALL ZMM2Z(MA%MZM,Z) END SUBROUTINE SUBROUTINE FMEQ_CFM(C,MA) TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C DOUBLE PRECISION D INTENT (INOUT) :: C INTENT (IN) :: MA CALL FMM2DP(MA%MFM,D) C = CMPLX( D , 0.0D0 , KIND(0.0D0) ) END SUBROUTINE SUBROUTINE FMEQ_CIM(C,MA) TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C DOUBLE PRECISION D INTENT (INOUT) :: C INTENT (IN) :: MA CALL IMM2DP(MA%MIM,D) C = CMPLX( D , 0.0D0 , KIND(0.0D0) ) END SUBROUTINE SUBROUTINE FMEQ_CZM(C,MA) TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C DOUBLE PRECISION D1,D2 INTENT (INOUT) :: C INTENT (IN) :: MA CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMM2DP(MTFM%MFM,D1) CALL ZMIMAG(MA%MZM,MTFM%MFM) CALL FMM2DP(MTFM%MFM,D2) C = CMPLX( D1 , D2 , KIND(0.0D0) ) END SUBROUTINE SUBROUTINE FMEQ_FMI(MA,IVAL) TYPE ( FM ) MA INTEGER IVAL INTENT (INOUT) :: MA INTENT (IN) :: IVAL CALL FMI2M(IVAL,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMR(MA,R) TYPE ( FM ) MA REAL R INTENT (INOUT) :: MA INTENT (IN) :: R CALL FMSP2M(R,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMD(MA,D) TYPE ( FM ) MA DOUBLE PRECISION D INTENT (INOUT) :: MA INTENT (IN) :: D CALL FMDP2M(D,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMZ(MA,Z) TYPE ( FM ) MA COMPLEX Z REAL R INTENT (INOUT) :: MA INTENT (IN) :: Z R = REAL(Z) CALL FMSP2M(R,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMC(MA,C) TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C DOUBLE PRECISION D INTENT (INOUT) :: MA INTENT (IN) :: C D = REAL(C,KIND(0.0D0)) CALL FMDP2M(D,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMFM(MA,MB) TYPE ( FM ) MA,MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL FMEQ(MB%MFM,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMIM(MA,MB) TYPE ( FM ) MA TYPE ( IM ) MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL IMI2FM(MB%MIM,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_FMZM(MA,MB) TYPE ( FM ) MA TYPE ( ZM ) MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL ZMREAL(MB%MZM,MA%MFM) END SUBROUTINE SUBROUTINE FMEQ_IMI(MA,IVAL) TYPE ( IM ) MA INTEGER IVAL INTENT (INOUT) :: MA INTENT (IN) :: IVAL CALL IMI2M(IVAL,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMR(MA,R) TYPE ( IM ) MA INTEGER IVAL REAL R INTENT (INOUT) :: MA INTENT (IN) :: R IVAL = INT(R) CALL IMI2M(IVAL,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMD(MA,D) TYPE ( IM ) MA INTEGER IVAL DOUBLE PRECISION D INTENT (INOUT) :: MA INTENT (IN) :: D IVAL = INT(D) CALL IMI2M(IVAL,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMZ(MA,Z) TYPE ( IM ) MA COMPLEX Z INTENT (INOUT) :: MA INTENT (IN) :: Z CALL FMSP2M(REAL(Z),MTFM%MFM) CALL IMFM2I(MTFM%MFM,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMC(MA,C) TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (INOUT) :: MA INTENT (IN) :: C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL IMFM2I(MTFM%MFM,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMFM(MA,MB) TYPE ( IM ) MA TYPE ( FM ) MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL IMFM2I(MB%MFM,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMIM(MA,MB) TYPE ( IM ) MA,MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL IMEQ(MB%MIM,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_IMZM(MA,MB) TYPE ( IM ) MA TYPE ( ZM ) MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL ZMREAL(MB%MZM,MTFM%MFM) CALL IMFM2I(MTFM%MFM,MA%MIM) END SUBROUTINE SUBROUTINE FMEQ_ZMI(MA,IVAL) TYPE ( ZM ) MA INTEGER IVAL INTENT (INOUT) :: MA INTENT (IN) :: IVAL CALL ZMI2M(IVAL,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMR(MA,R) TYPE ( ZM ) MA REAL R COMPLEX Z INTENT (INOUT) :: MA INTENT (IN) :: R Z = CMPLX(R,0.0) CALL ZMZ2M(Z,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMD(MA,D) TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (INOUT) :: MA INTENT (IN) :: D CALL FMDP2M(D,MTFM%MFM) CALL FMDP2M(0.0D0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMZ(MA,Z) TYPE ( ZM ) MA COMPLEX Z INTENT (INOUT) :: MA INTENT (IN) :: Z CALL ZMZ2M(Z,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMC(MA,C) TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C DOUBLE PRECISION D INTENT (INOUT) :: MA INTENT (IN) :: C D = REAL(C,KIND(0.0D0)) CALL FMDP2M(D,MTFM%MFM) D = AIMAG(C) CALL FMDP2M(D,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMFM(MA,MB) TYPE ( FM ) MB TYPE ( ZM ) MA INTENT (INOUT) :: MA INTENT (IN) :: MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MB%MFM,MTFM%MFM,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMIM(MA,MB) TYPE ( IM ) MB TYPE ( ZM ) MA INTENT (INOUT) :: MA INTENT (IN) :: MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MA%MZM) END SUBROUTINE SUBROUTINE FMEQ_ZMZM(MA,MB) TYPE ( ZM ) MA,MB INTENT (INOUT) :: MA INTENT (IN) :: MB CALL ZMEQ(MB%MZM,MA%MZM) END SUBROUTINE ! Reference: The 39 Steps, John Buchan, 1915, Curtis Publishers. ! .EQ. FUNCTION FMLEQ_IFM(IVAL,MA) LOGICAL FMLEQ_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLEQ_IFM = FMCOMP(MTFM%MFM,'EQ',MA%MFM) END FUNCTION FUNCTION FMLEQ_IIM(IVAL,MA) LOGICAL FMLEQ_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLEQ_IIM = IMCOMP(MTIM%MIM,'EQ',MA%MIM) END FUNCTION FUNCTION FMLEQ_IZM(IVAL,MA) LOGICAL FMLEQ_IZM,FMCOMP,L1,L2 TYPE ( ZM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_IZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_RFM(R,MA) LOGICAL FMLEQ_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLEQ_RFM = FMCOMP(MTFM%MFM,'EQ',MA%MFM) END FUNCTION FUNCTION FMLEQ_RIM(R,MA) LOGICAL FMLEQ_RIM,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLEQ_RIM = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLEQ_RZM(R,MA) LOGICAL FMLEQ_RZM,FMCOMP,L1,L2 TYPE ( ZM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_RZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_DFM(D,MA) LOGICAL FMLEQ_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLEQ_DFM = FMCOMP(MTFM%MFM,'EQ',MA%MFM) END FUNCTION FUNCTION FMLEQ_DIM(D,MA) LOGICAL FMLEQ_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLEQ_DIM = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLEQ_DZM(D,MA) LOGICAL FMLEQ_DZM,FMCOMP,L1,L2 TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_DZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZFM(Z,MA) LOGICAL FMLEQ_ZFM,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL FMSP2M(REAL(Z),MTFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MA%MFM) L2 = .TRUE. IF (AIMAG(Z).NE.0.0) L2 = .FALSE. FMLEQ_ZFM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZIM(Z,MA) LOGICAL FMLEQ_ZIM,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX Z INTEGER KA,NDSAVE INTENT (IN) :: Z,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(REAL(Z),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) NDIG = NDSAVE L2 = .TRUE. IF (AIMAG(Z).NE.0.0) L2 = .FALSE. FMLEQ_ZIM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZZM(Z,MA) LOGICAL FMLEQ_ZZM,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL FMSP2M(REAL(Z),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMSP2M(AIMAG(Z),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_CFM(C,MA) LOGICAL FMLEQ_CFM,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MA%MFM) L2 = .TRUE. IF (AIMAG(C).NE.0.0) L2 = .FALSE. FMLEQ_CFM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_CIM(C,MA) LOGICAL FMLEQ_CIM,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTEGER KA,NDSAVE INTENT (IN) :: C,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) NDIG = NDSAVE L2 = .TRUE. IF (AIMAG(C).NE.0.0) L2 = .FALSE. FMLEQ_CIM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_CZM(C,MA) LOGICAL FMLEQ_CZM,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMDP2M(AIMAG(C),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_CZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_FMI(MA,IVAL) LOGICAL FMLEQ_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLEQ_FMI = FMCOMP(MA%MFM,'EQ',MTFM%MFM) END FUNCTION FUNCTION FMLEQ_FMR(MA,R) LOGICAL FMLEQ_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLEQ_FMR = FMCOMP(MA%MFM,'EQ',MTFM%MFM) END FUNCTION FUNCTION FMLEQ_FMD(MA,D) LOGICAL FMLEQ_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLEQ_FMD = FMCOMP(MA%MFM,'EQ',MTFM%MFM) END FUNCTION FUNCTION FMLEQ_FMZ(MA,Z) LOGICAL FMLEQ_FMZ,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL FMSP2M(REAL(Z),MTFM%MFM) L1 = FMCOMP(MA%MFM,'EQ',MTFM%MFM) L2 = .TRUE. IF (AIMAG(Z).NE.0.0) L2 = .FALSE. FMLEQ_FMZ = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_FMC(MA,C) LOGICAL FMLEQ_FMC,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) L1 = FMCOMP(MA%MFM,'EQ',MTFM%MFM) L2 = .TRUE. IF (AIMAG(C).NE.0.0) L2 = .FALSE. FMLEQ_FMC = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_FMFM(MA,MB) LOGICAL FMLEQ_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLEQ_FMFM = FMCOMP(MA%MFM,'EQ',MB%MFM) END FUNCTION FUNCTION FMLEQ_FMIM(MA,MB) LOGICAL FMLEQ_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL FMINT(MA%MFM,MTFM%MFM) IF (FMCOMP(MA%MFM,'EQ',MTFM%MFM)) THEN CALL IMI2FM(MB%MIM,MTFM%MFM) FMLEQ_FMIM = FMCOMP(MA%MFM,'EQ',MTFM%MFM) ELSE FMLEQ_FMIM = .FALSE. ENDIF END FUNCTION FUNCTION FMLEQ_FMZM(MA,MB) LOGICAL FMLEQ_FMZM,FMCOMP,L1,L2 TYPE ( FM ) MA TYPE ( ZM ) MB INTENT (IN) :: MA,MB CALL ZMREAL(MB%MZM,MTFM%MFM) L1 = FMCOMP(MA%MFM,'EQ',MTFM%MFM) L2 = .TRUE. IF (MB%MZM(KPTIMU+2).NE.0) L2 = .FALSE. FMLEQ_FMZM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_IMI(MA,IVAL) LOGICAL FMLEQ_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLEQ_IMI = IMCOMP(MA%MIM,'EQ',MTIM%MIM) END FUNCTION FUNCTION FMLEQ_IMR(MA,R) LOGICAL FMLEQ_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLEQ_IMR = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLEQ_IMD(MA,D) LOGICAL FMLEQ_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLEQ_IMD = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLEQ_IMZ(MA,Z) LOGICAL FMLEQ_IMZ,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX Z INTEGER KA,NDSAVE INTENT (IN) :: MA,Z NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(REAL(Z),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) NDIG = NDSAVE L2 = .TRUE. IF (AIMAG(Z).NE.0.0) L2 = .FALSE. FMLEQ_IMZ = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_IMC(MA,C) LOGICAL FMLEQ_IMC,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTEGER KA,NDSAVE INTENT (IN) :: MA,C NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) NDIG = NDSAVE L2 = .TRUE. IF (AIMAG(C).NE.0.0) L2 = .FALSE. FMLEQ_IMC = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_IMFM(MA,MB) LOGICAL FMLEQ_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTENT (IN) :: MA,MB CALL FMINT(MB%MFM,MTFM%MFM) IF (FMCOMP(MB%MFM,'EQ',MTFM%MFM)) THEN CALL IMI2FM(MA%MIM,MTFM%MFM) FMLEQ_IMFM = FMCOMP(MB%MFM,'EQ',MTFM%MFM) ELSE FMLEQ_IMFM = .FALSE. ENDIF END FUNCTION FUNCTION FMLEQ_IMIM(MA,MB) LOGICAL FMLEQ_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLEQ_IMIM = IMCOMP(MA%MIM,'EQ',MB%MIM) END FUNCTION FUNCTION FMLEQ_IMZM(MA,MB) LOGICAL FMLEQ_IMZM,FMCOMP TYPE ( IM ) MA TYPE ( ZM ) MB INTENT (IN) :: MA,MB CALL ZMREAL(MB%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MB%MZM(KPTIMU+2).EQ.0) THEN CALL IMI2FM(MA%MIM,MUFM%MFM) FMLEQ_IMZM = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) ELSE FMLEQ_IMZM = .FALSE. ENDIF END FUNCTION FUNCTION FMLEQ_ZMI(MA,IVAL) LOGICAL FMLEQ_ZMI,FMCOMP TYPE ( ZM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MA%MZM(KPTIMU+2).EQ.0) THEN CALL FMI2M(IVAL,MUFM%MFM) FMLEQ_ZMI = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) ELSE FMLEQ_ZMI = .FALSE. ENDIF END FUNCTION FUNCTION FMLEQ_ZMR(MA,R) LOGICAL FMLEQ_ZMR,FMCOMP,L1,L2 TYPE ( ZM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZMR = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZMD(MA,D) LOGICAL FMLEQ_ZMD,FMCOMP,L1,L2 TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZMD = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZMZ(MA,Z) LOGICAL FMLEQ_ZMZ,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL FMSP2M(REAL(Z),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMSP2M(AIMAG(Z),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZMZ = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZMC(MA,C) LOGICAL FMLEQ_ZMC,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL FMDP2M(AIMAG(C),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZMC = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZMFM(MA,MB) LOGICAL FMLEQ_ZMFM,FMCOMP,L1,L2 TYPE ( FM ) MB TYPE ( ZM ) MA INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) L1 = FMCOMP(MB%MFM,'EQ',MTFM%MFM) L2 = .TRUE. IF (MA%MZM(KPTIMU+2).NE.0) L2 = .FALSE. FMLEQ_ZMFM = L1.AND.L2 END FUNCTION FUNCTION FMLEQ_ZMIM(MA,MB) LOGICAL FMLEQ_ZMIM,FMCOMP TYPE ( IM ) MB TYPE ( ZM ) MA INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MA%MZM(KPTIMU+2).EQ.0) THEN CALL IMI2FM(MB%MIM,MUFM%MFM) FMLEQ_ZMIM = FMCOMP(MUFM%MFM,'EQ',MTFM%MFM) ELSE FMLEQ_ZMIM = .FALSE. ENDIF END FUNCTION FUNCTION FMLEQ_ZMZM(MA,MB) LOGICAL FMLEQ_ZMZM,FMCOMP,L1,L2 TYPE ( ZM ) MA,MB INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) CALL ZMREAL(MB%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) CALL ZMIMAG(MA%MZM,MTFM%MFM) CALL ZMIMAG(MB%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'EQ',MUFM%MFM) FMLEQ_ZMZM = L1.AND.L2 END FUNCTION ! .NE. FUNCTION FMLNE_IFM(IVAL,MA) LOGICAL FMLNE_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLNE_IFM = FMCOMP(MTFM%MFM,'NE',MA%MFM) END FUNCTION FUNCTION FMLNE_IIM(IVAL,MA) LOGICAL FMLNE_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLNE_IIM = IMCOMP(MTIM%MIM,'NE',MA%MIM) END FUNCTION FUNCTION FMLNE_IZM(IVAL,MA) LOGICAL FMLNE_IZM,FMCOMP,L1,L2 TYPE ( ZM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_IZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_RFM(R,MA) LOGICAL FMLNE_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLNE_RFM = FMCOMP(MTFM%MFM,'NE',MA%MFM) END FUNCTION FUNCTION FMLNE_RIM(R,MA) LOGICAL FMLNE_RIM,FMCOMP TYPE ( IM ) MA REAL R INTEGER KA,NDSAVE INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLNE_RIM = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLNE_RZM(R,MA) LOGICAL FMLNE_RZM,FMCOMP,L1,L2 TYPE ( ZM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_RZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_DFM(D,MA) LOGICAL FMLNE_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLNE_DFM = FMCOMP(MTFM%MFM,'NE',MA%MFM) END FUNCTION FUNCTION FMLNE_DIM(D,MA) LOGICAL FMLNE_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLNE_DIM = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLNE_DZM(D,MA) LOGICAL FMLNE_DZM,FMCOMP,L1,L2 TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_DZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZFM(Z,MA) LOGICAL FMLNE_ZFM,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL FMSP2M(REAL(Z),MTFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MA%MFM) L2 = .FALSE. IF (AIMAG(Z).NE.0.0) L2 = .TRUE. FMLNE_ZFM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZIM(Z,MA) LOGICAL FMLNE_ZIM,FMCOMP,L1,L2 TYPE ( IM ) MA INTEGER KA,NDSAVE COMPLEX Z INTENT (IN) :: Z,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(REAL(Z),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) NDIG = NDSAVE L2 = .FALSE. IF (AIMAG(Z).NE.0.0) L2 = .TRUE. FMLNE_ZIM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZZM(Z,MA) LOGICAL FMLNE_ZZM,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL FMSP2M(REAL(Z),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMSP2M(AIMAG(Z),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_CFM(C,MA) LOGICAL FMLNE_CFM,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MA%MFM) L2 = .FALSE. IF (AIMAG(C).NE.0.0) L2 = .TRUE. FMLNE_CFM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_CIM(C,MA) LOGICAL FMLNE_CIM,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTEGER KA,NDSAVE INTENT (IN) :: C,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) NDIG = NDSAVE L2 = .FALSE. IF (AIMAG(C).NE.0.0) L2 = .TRUE. FMLNE_CIM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_CZM(C,MA) LOGICAL FMLNE_CZM,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMDP2M(AIMAG(C),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_CZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_FMI(MA,IVAL) LOGICAL FMLNE_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLNE_FMI = FMCOMP(MA%MFM,'NE',MTFM%MFM) END FUNCTION FUNCTION FMLNE_FMR(MA,R) LOGICAL FMLNE_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLNE_FMR = FMCOMP(MA%MFM,'NE',MTFM%MFM) END FUNCTION FUNCTION FMLNE_FMD(MA,D) LOGICAL FMLNE_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLNE_FMD = FMCOMP(MA%MFM,'NE',MTFM%MFM) END FUNCTION FUNCTION FMLNE_FMZ(MA,Z) LOGICAL FMLNE_FMZ,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL FMSP2M(REAL(Z),MTFM%MFM) L1 = FMCOMP(MA%MFM,'NE',MTFM%MFM) L2 = .FALSE. IF (AIMAG(Z).NE.0.0) L2 = .TRUE. FMLNE_FMZ = L1.OR.L2 END FUNCTION FUNCTION FMLNE_FMC(MA,C) LOGICAL FMLNE_FMC,FMCOMP,L1,L2 TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) L1 = FMCOMP(MA%MFM,'NE',MTFM%MFM) L2 = .FALSE. IF (AIMAG(C).NE.0.0) L2 = .TRUE. FMLNE_FMC = L1.OR.L2 END FUNCTION FUNCTION FMLNE_FMFM(MA,MB) LOGICAL FMLNE_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLNE_FMFM = FMCOMP(MA%MFM,'NE',MB%MFM) END FUNCTION FUNCTION FMLNE_FMIM(MA,MB) LOGICAL FMLNE_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL FMINT(MA%MFM,MTFM%MFM) IF (FMCOMP(MA%MFM,'EQ',MTFM%MFM)) THEN CALL IMI2FM(MB%MIM,MTFM%MFM) FMLNE_FMIM = FMCOMP(MA%MFM,'NE',MTFM%MFM) ELSE FMLNE_FMIM = .TRUE. ENDIF END FUNCTION FUNCTION FMLNE_FMZM(MA,MB) LOGICAL FMLNE_FMZM,FMCOMP,L1,L2 TYPE ( FM ) MA TYPE ( ZM ) MB INTENT (IN) :: MA,MB CALL ZMREAL(MB%MZM,MTFM%MFM) L1 = FMCOMP(MA%MFM,'NE',MTFM%MFM) L2 = .FALSE. IF (MB%MZM(KPTIMU+2).NE.0) L2 = .TRUE. FMLNE_FMZM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_IMI(MA,IVAL) LOGICAL FMLNE_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLNE_IMI = IMCOMP(MA%MIM,'NE',MTIM%MIM) END FUNCTION FUNCTION FMLNE_IMR(MA,R) LOGICAL FMLNE_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLNE_IMR = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLNE_IMD(MA,D) LOGICAL FMLNE_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLNE_IMD = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLNE_IMZ(MA,Z) LOGICAL FMLNE_IMZ,FMCOMP,L1,L2 TYPE ( IM ) MA INTEGER KA,NDSAVE COMPLEX Z INTENT (IN) :: MA,Z NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(REAL(Z),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) NDIG = NDSAVE L2 = .FALSE. IF (AIMAG(Z).NE.0.0) L2 = .TRUE. FMLNE_IMZ = L1.OR.L2 END FUNCTION FUNCTION FMLNE_IMC(MA,C) LOGICAL FMLNE_IMC,FMCOMP,L1,L2 TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTEGER KA,NDSAVE INTENT (IN) :: MA,C NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) L1 = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) NDIG = NDSAVE L2 = .FALSE. IF (AIMAG(C).NE.0.0) L2 = .TRUE. FMLNE_IMC = L1.OR.L2 END FUNCTION FUNCTION FMLNE_IMFM(MA,MB) LOGICAL FMLNE_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTENT (IN) :: MA,MB CALL FMINT(MB%MFM,MTFM%MFM) IF (FMCOMP(MB%MFM,'EQ',MTFM%MFM)) THEN CALL IMI2FM(MA%MIM,MTFM%MFM) FMLNE_IMFM = FMCOMP(MB%MFM,'NE',MTFM%MFM) ELSE FMLNE_IMFM = .TRUE. ENDIF END FUNCTION FUNCTION FMLNE_IMIM(MA,MB) LOGICAL FMLNE_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLNE_IMIM = IMCOMP(MA%MIM,'NE',MB%MIM) END FUNCTION FUNCTION FMLNE_IMZM(MA,MB) LOGICAL FMLNE_IMZM,FMCOMP TYPE ( IM ) MA TYPE ( ZM ) MB INTENT (IN) :: MA,MB CALL ZMREAL(MB%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MB%MZM(KPTIMU+2).EQ.0) THEN CALL IMI2FM(MA%MIM,MUFM%MFM) FMLNE_IMZM = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) ELSE FMLNE_IMZM = .TRUE. ENDIF END FUNCTION FUNCTION FMLNE_ZMI(MA,IVAL) LOGICAL FMLNE_ZMI,FMCOMP TYPE ( ZM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MA%MZM(KPTIMU+2).EQ.0) THEN CALL FMI2M(IVAL,MUFM%MFM) FMLNE_ZMI = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) ELSE FMLNE_ZMI = .TRUE. ENDIF END FUNCTION FUNCTION FMLNE_ZMR(MA,R) LOGICAL FMLNE_ZMR,FMCOMP,L1,L2 TYPE ( ZM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZMR = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZMD(MA,D) LOGICAL FMLNE_ZMD,FMCOMP,L1,L2 TYPE ( ZM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMI2M(0,MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZMD = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZMZ(MA,Z) LOGICAL FMLNE_ZMZ,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL FMSP2M(REAL(Z),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMSP2M(AIMAG(Z),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZMZ = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZMC(MA,C) LOGICAL FMLNE_ZMC,FMCOMP,L1,L2 TYPE ( ZM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL ZMREAL(MA%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL FMDP2M(AIMAG(C),MTFM%MFM) CALL ZMIMAG(MA%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZMC = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZMFM(MA,MB) LOGICAL FMLNE_ZMFM,FMCOMP,L1,L2 TYPE ( FM ) MB TYPE ( ZM ) MA INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) L1 = FMCOMP(MB%MFM,'NE',MTFM%MFM) L2 = .FALSE. IF (MA%MZM(KPTIMU+2).NE.0) L2 = .TRUE. FMLNE_ZMFM = L1.OR.L2 END FUNCTION FUNCTION FMLNE_ZMIM(MA,MB) LOGICAL FMLNE_ZMIM,FMCOMP TYPE ( IM ) MB TYPE ( ZM ) MA INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) CALL FMINT(MTFM%MFM,MUFM%MFM) IF (FMCOMP(MUFM%MFM,'EQ',MTFM%MFM).AND.MA%MZM(KPTIMU+2).EQ.0) THEN CALL IMI2FM(MB%MIM,MUFM%MFM) FMLNE_ZMIM = FMCOMP(MUFM%MFM,'NE',MTFM%MFM) ELSE FMLNE_ZMIM = .TRUE. ENDIF END FUNCTION FUNCTION FMLNE_ZMZM(MA,MB) LOGICAL FMLNE_ZMZM,FMCOMP,L1,L2 TYPE ( ZM ) MA,MB INTENT (IN) :: MA,MB CALL ZMREAL(MA%MZM,MTFM%MFM) CALL ZMREAL(MB%MZM,MUFM%MFM) L1 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) CALL ZMIMAG(MA%MZM,MTFM%MFM) CALL ZMIMAG(MB%MZM,MUFM%MFM) L2 = FMCOMP(MTFM%MFM,'NE',MUFM%MFM) FMLNE_ZMZM = L1.OR.L2 END FUNCTION ! .GT. FUNCTION FMLGT_IFM(IVAL,MA) LOGICAL FMLGT_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLGT_IFM = FMCOMP(MTFM%MFM,'GT',MA%MFM) END FUNCTION FUNCTION FMLGT_IIM(IVAL,MA) LOGICAL FMLGT_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLGT_IIM = IMCOMP(MTIM%MIM,'GT',MA%MIM) END FUNCTION FUNCTION FMLGT_RFM(R,MA) LOGICAL FMLGT_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLGT_RFM = FMCOMP(MTFM%MFM,'GT',MA%MFM) END FUNCTION FUNCTION FMLGT_RIM(R,MA) LOGICAL FMLGT_RIM,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGT_RIM = FMCOMP(MTFM%MFM,'GT',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_DFM(D,MA) LOGICAL FMLGT_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLGT_DFM = FMCOMP(MTFM%MFM,'GT',MA%MFM) END FUNCTION FUNCTION FMLGT_DIM(D,MA) LOGICAL FMLGT_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGT_DIM = FMCOMP(MTFM%MFM,'GT',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_FMI(MA,IVAL) LOGICAL FMLGT_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLGT_FMI = FMCOMP(MA%MFM,'GT',MTFM%MFM) END FUNCTION FUNCTION FMLGT_FMR(MA,R) LOGICAL FMLGT_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLGT_FMR = FMCOMP(MA%MFM,'GT',MTFM%MFM) END FUNCTION FUNCTION FMLGT_FMD(MA,D) LOGICAL FMLGT_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLGT_FMD = FMCOMP(MA%MFM,'GT',MTFM%MFM) END FUNCTION FUNCTION FMLGT_FMFM(MA,MB) LOGICAL FMLGT_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLGT_FMFM = FMCOMP(MA%MFM,'GT',MB%MFM) END FUNCTION FUNCTION FMLGT_FMIM(MA,MB) LOGICAL FMLGT_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MB%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MB%MIM,MTFM%MFM) FMLGT_FMIM = FMCOMP(MA%MFM,'GT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_IMI(MA,IVAL) LOGICAL FMLGT_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLGT_IMI = IMCOMP(MA%MIM,'GT',MTIM%MIM) END FUNCTION FUNCTION FMLGT_IMR(MA,R) LOGICAL FMLGT_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGT_IMR = FMCOMP(MUFM%MFM,'GT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_IMD(MA,D) LOGICAL FMLGT_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGT_IMD = FMCOMP(MUFM%MFM,'GT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_IMFM(MA,MB) LOGICAL FMLGT_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MA%MIM,MTFM%MFM) FMLGT_IMFM = FMCOMP(MTFM%MFM,'GT',MB%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGT_IMIM(MA,MB) LOGICAL FMLGT_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLGT_IMIM = IMCOMP(MA%MIM,'GT',MB%MIM) END FUNCTION ! .GE. FUNCTION FMLGE_IFM(IVAL,MA) LOGICAL FMLGE_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLGE_IFM = FMCOMP(MTFM%MFM,'GE',MA%MFM) END FUNCTION FUNCTION FMLGE_IIM(IVAL,MA) LOGICAL FMLGE_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLGE_IIM = IMCOMP(MTIM%MIM,'GE',MA%MIM) END FUNCTION FUNCTION FMLGE_RFM(R,MA) LOGICAL FMLGE_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLGE_RFM = FMCOMP(MTFM%MFM,'GE',MA%MFM) END FUNCTION FUNCTION FMLGE_RIM(R,MA) LOGICAL FMLGE_RIM,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGE_RIM = FMCOMP(MTFM%MFM,'GE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_DFM(D,MA) LOGICAL FMLGE_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLGE_DFM = FMCOMP(MTFM%MFM,'GE',MA%MFM) END FUNCTION FUNCTION FMLGE_DIM(D,MA) LOGICAL FMLGE_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGE_DIM = FMCOMP(MTFM%MFM,'GE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_FMI(MA,IVAL) LOGICAL FMLGE_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLGE_FMI = FMCOMP(MA%MFM,'GE',MTFM%MFM) END FUNCTION FUNCTION FMLGE_FMR(MA,R) LOGICAL FMLGE_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLGE_FMR = FMCOMP(MA%MFM,'GE',MTFM%MFM) END FUNCTION FUNCTION FMLGE_FMD(MA,D) LOGICAL FMLGE_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLGE_FMD = FMCOMP(MA%MFM,'GE',MTFM%MFM) END FUNCTION FUNCTION FMLGE_FMFM(MA,MB) LOGICAL FMLGE_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLGE_FMFM = FMCOMP(MA%MFM,'GE',MB%MFM) END FUNCTION FUNCTION FMLGE_FMIM(MA,MB) LOGICAL FMLGE_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MB%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MB%MIM,MTFM%MFM) FMLGE_FMIM = FMCOMP(MA%MFM,'GE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_IMI(MA,IVAL) LOGICAL FMLGE_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLGE_IMI = IMCOMP(MA%MIM,'GE',MTIM%MIM) END FUNCTION FUNCTION FMLGE_IMR(MA,R) LOGICAL FMLGE_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGE_IMR = FMCOMP(MUFM%MFM,'GE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_IMD(MA,D) LOGICAL FMLGE_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLGE_IMD = FMCOMP(MUFM%MFM,'GE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_IMFM(MA,MB) LOGICAL FMLGE_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MA%MIM,MTFM%MFM) FMLGE_IMFM = FMCOMP(MTFM%MFM,'GE',MB%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLGE_IMIM(MA,MB) LOGICAL FMLGE_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLGE_IMIM = IMCOMP(MA%MIM,'GE',MB%MIM) END FUNCTION ! .LT. FUNCTION FMLLT_IFM(IVAL,MA) LOGICAL FMLLT_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLLT_IFM = FMCOMP(MTFM%MFM,'LT',MA%MFM) END FUNCTION FUNCTION FMLLT_IIM(IVAL,MA) LOGICAL FMLLT_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLLT_IIM = IMCOMP(MTIM%MIM,'LT',MA%MIM) END FUNCTION FUNCTION FMLLT_RFM(R,MA) LOGICAL FMLLT_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLLT_RFM = FMCOMP(MTFM%MFM,'LT',MA%MFM) END FUNCTION FUNCTION FMLLT_RIM(R,MA) LOGICAL FMLLT_RIM,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLT_RIM = FMCOMP(MTFM%MFM,'LT',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_DFM(D,MA) LOGICAL FMLLT_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLLT_DFM = FMCOMP(MTFM%MFM,'LT',MA%MFM) END FUNCTION FUNCTION FMLLT_DIM(D,MA) LOGICAL FMLLT_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLT_DIM = FMCOMP(MTFM%MFM,'LT',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_FMI(MA,IVAL) LOGICAL FMLLT_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLLT_FMI = FMCOMP(MA%MFM,'LT',MTFM%MFM) END FUNCTION FUNCTION FMLLT_FMR(MA,R) LOGICAL FMLLT_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLLT_FMR = FMCOMP(MA%MFM,'LT',MTFM%MFM) END FUNCTION FUNCTION FMLLT_FMD(MA,D) LOGICAL FMLLT_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLLT_FMD = FMCOMP(MA%MFM,'LT',MTFM%MFM) END FUNCTION FUNCTION FMLLT_FMFM(MA,MB) LOGICAL FMLLT_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLLT_FMFM = FMCOMP(MA%MFM,'LT',MB%MFM) END FUNCTION FUNCTION FMLLT_FMIM(MA,MB) LOGICAL FMLLT_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MB%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MB%MIM,MTFM%MFM) FMLLT_FMIM = FMCOMP(MA%MFM,'LT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_IMI(MA,IVAL) LOGICAL FMLLT_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLLT_IMI = IMCOMP(MA%MIM,'LT',MTIM%MIM) END FUNCTION FUNCTION FMLLT_IMR(MA,R) LOGICAL FMLLT_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLT_IMR = FMCOMP(MUFM%MFM,'LT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_IMD(MA,D) LOGICAL FMLLT_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLT_IMD = FMCOMP(MUFM%MFM,'LT',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_IMFM(MA,MB) LOGICAL FMLLT_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MA%MIM,MTFM%MFM) FMLLT_IMFM = FMCOMP(MTFM%MFM,'LT',MB%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLT_IMIM(MA,MB) LOGICAL FMLLT_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLLT_IMIM = IMCOMP(MA%MIM,'LT',MB%MIM) END FUNCTION ! .LE. FUNCTION FMLLE_IFM(IVAL,MA) LOGICAL FMLLE_IFM,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) FMLLE_IFM = FMCOMP(MTFM%MFM,'LE',MA%MFM) END FUNCTION FUNCTION FMLLE_IIM(IVAL,MA) LOGICAL FMLLE_IIM,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) FMLLE_IIM = IMCOMP(MTIM%MIM,'LE',MA%MIM) END FUNCTION FUNCTION FMLLE_RFM(R,MA) LOGICAL FMLLE_RFM,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) FMLLE_RFM = FMCOMP(MTFM%MFM,'LE',MA%MFM) END FUNCTION FUNCTION FMLLE_RIM(R,MA) LOGICAL FMLLE_RIM,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: R,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLE_RIM = FMCOMP(MTFM%MFM,'LE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_DFM(D,MA) LOGICAL FMLLE_DFM,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) FMLLE_DFM = FMCOMP(MTFM%MFM,'LE',MA%MFM) END FUNCTION FUNCTION FMLLE_DIM(D,MA) LOGICAL FMLLE_DIM,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: D,MA NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLE_DIM = FMCOMP(MTFM%MFM,'LE',MUFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_FMI(MA,IVAL) LOGICAL FMLLE_FMI,FMCOMP TYPE ( FM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) FMLLE_FMI = FMCOMP(MA%MFM,'LE',MTFM%MFM) END FUNCTION FUNCTION FMLLE_FMR(MA,R) LOGICAL FMLLE_FMR,FMCOMP TYPE ( FM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) FMLLE_FMR = FMCOMP(MA%MFM,'LE',MTFM%MFM) END FUNCTION FUNCTION FMLLE_FMD(MA,D) LOGICAL FMLLE_FMD,FMCOMP TYPE ( FM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) FMLLE_FMD = FMCOMP(MA%MFM,'LE',MTFM%MFM) END FUNCTION FUNCTION FMLLE_FMFM(MA,MB) LOGICAL FMLLE_FMFM,FMCOMP TYPE ( FM ) MA,MB INTENT (IN) :: MA,MB FMLLE_FMFM = FMCOMP(MA%MFM,'LE',MB%MFM) END FUNCTION FUNCTION FMLLE_FMIM(MA,MB) LOGICAL FMLLE_FMIM,FMCOMP TYPE ( FM ) MA TYPE ( IM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MB%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MB%MIM,MTFM%MFM) FMLLE_FMIM = FMCOMP(MA%MFM,'LE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_IMI(MA,IVAL) LOGICAL FMLLE_IMI,IMCOMP TYPE ( IM ) MA INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) FMLLE_IMI = IMCOMP(MA%MIM,'LE',MTIM%MIM) END FUNCTION FUNCTION FMLLE_IMR(MA,R) LOGICAL FMLLE_IMR,FMCOMP TYPE ( IM ) MA INTEGER KA,NDSAVE REAL R INTENT (IN) :: MA,R NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLE_IMR = FMCOMP(MUFM%MFM,'LE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_IMD(MA,D) LOGICAL FMLLE_IMD,FMCOMP TYPE ( IM ) MA DOUBLE PRECISION D INTEGER KA,NDSAVE INTENT (IN) :: MA,D NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) FMLLE_IMD = FMCOMP(MUFM%MFM,'LE',MTFM%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_IMFM(MA,MB) LOGICAL FMLLE_IMFM,FMCOMP TYPE ( IM ) MA TYPE ( FM ) MB INTEGER KA,NDSAVE INTENT (IN) :: MA,MB NDSAVE = NDIG KA = MA%MIM(1) NDIG = MAX(KA+NGRD52,NDIG) CALL IMI2FM(MA%MIM,MTFM%MFM) FMLLE_IMFM = FMCOMP(MTFM%MFM,'LE',MB%MFM) NDIG = NDSAVE END FUNCTION FUNCTION FMLLE_IMIM(MA,MB) LOGICAL FMLLE_IMIM,IMCOMP TYPE ( IM ) MA,MB INTENT (IN) :: MA,MB FMLLE_IMIM = IMCOMP(MA%MIM,'LE',MB%MIM) END FUNCTION ! + FUNCTION FMADD_IFM(IVAL,MA) TYPE ( FM ) MA,FMADD_IFM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMADD(MTFM%MFM,MA%MFM,FMADD_IFM%MFM) END FUNCTION FUNCTION FMADD_IIM(IVAL,MA) TYPE ( IM ) MA,FMADD_IIM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) CALL IMADD(MTIM%MIM,MA%MIM,FMADD_IIM%MIM) END FUNCTION FUNCTION FMADD_IZM(IVAL,MA) TYPE ( ZM ) MA,FMADD_IZM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MTZM%MZM,MA%MZM,FMADD_IZM%MZM) END FUNCTION FUNCTION FMADD_RFM(R,MA) TYPE ( FM ) MA,FMADD_RFM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMADD(MTFM%MFM,MA%MFM,FMADD_RFM%MFM) END FUNCTION FUNCTION FMADD_RIM(R,MA) TYPE ( FM ) FMADD_RIM TYPE ( IM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMADD(MTFM%MFM,MUFM%MFM,FMADD_RIM%MFM) END FUNCTION FUNCTION FMADD_RZM(R,MA) TYPE ( ZM ) MA,FMADD_RZM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MTZM%MZM,MA%MZM,FMADD_RZM%MZM) END FUNCTION FUNCTION FMADD_DFM(D,MA) TYPE ( FM ) MA,FMADD_DFM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMADD(MTFM%MFM,MA%MFM,FMADD_DFM%MFM) END FUNCTION FUNCTION FMADD_DIM(D,MA) TYPE ( FM ) FMADD_DIM TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMADD(MTFM%MFM,MUFM%MFM,FMADD_DIM%MFM) END FUNCTION FUNCTION FMADD_DZM(D,MA) TYPE ( ZM ) MA,FMADD_DZM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MTZM%MZM,MA%MZM,FMADD_DZM%MZM) END FUNCTION FUNCTION FMADD_ZFM(Z,MA) TYPE ( ZM ) FMADD_ZFM TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MTZM%MZM,MUZM%MZM,FMADD_ZFM%MZM) END FUNCTION FUNCTION FMADD_ZIM(Z,MA) TYPE ( ZM ) FMADD_ZIM TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MTZM%MZM,MUZM%MZM,FMADD_ZIM%MZM) END FUNCTION FUNCTION FMADD_ZZM(Z,MA) TYPE ( ZM ) MA,FMADD_ZZM COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL ZMADD(MTZM%MZM,MA%MZM,FMADD_ZZM%MZM) END FUNCTION FUNCTION FMADD_CFM(C,MA) TYPE ( ZM ) FMADD_CFM TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MTZM%MZM,MUZM%MZM,FMADD_CFM%MZM) END FUNCTION FUNCTION FMADD_CIM(C,MA) TYPE ( ZM ) FMADD_CIM TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MTZM%MZM,MUZM%MZM,FMADD_CIM%MZM) END FUNCTION FUNCTION FMADD_CZM(C,MA) TYPE ( ZM ) MA,FMADD_CZM COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MTZM%MZM,MA%MZM,FMADD_CZM%MZM) END FUNCTION FUNCTION FMADD_FMI(MA,IVAL) TYPE ( FM ) MA,FMADD_FMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) CALL FMADD(MA%MFM,MTFM%MFM,FMADD_FMI%MFM) END FUNCTION FUNCTION FMADD_FMR(MA,R) TYPE ( FM ) MA,FMADD_FMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMADD(MA%MFM,MTFM%MFM,FMADD_FMR%MFM) END FUNCTION FUNCTION FMADD_FMD(MA,D) TYPE ( FM ) MA,FMADD_FMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMADD(MA%MFM,MTFM%MFM,FMADD_FMD%MFM) END FUNCTION FUNCTION FMADD_FMZ(MA,Z) TYPE ( ZM ) FMADD_FMZ TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MUZM%MZM,MTZM%MZM,FMADD_FMZ%MZM) END FUNCTION FUNCTION FMADD_FMC(MA,C) TYPE ( ZM ) FMADD_FMC TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MUZM%MZM,MTZM%MZM,FMADD_FMC%MZM) END FUNCTION FUNCTION FMADD_FMFM(MA,MB) TYPE ( FM ) MA,MB,FMADD_FMFM INTENT (IN) :: MA,MB CALL FMADD(MA%MFM,MB%MFM,FMADD_FMFM%MFM) END FUNCTION FUNCTION FMADD_FMIM(MA,MB) TYPE ( FM ) MA,FMADD_FMIM TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMADD(MA%MFM,MTFM%MFM,FMADD_FMIM%MFM) END FUNCTION FUNCTION FMADD_FMZM(MA,MB) TYPE ( FM ) MA TYPE ( ZM ) MB,FMADD_FMZM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MA%MFM,MTFM%MFM,MTZM%MZM) CALL ZMADD(MTZM%MZM,MB%MZM,FMADD_FMZM%MZM) END FUNCTION FUNCTION FMADD_IMI(MA,IVAL) TYPE ( IM ) MA,FMADD_IMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) CALL IMADD(MA%MIM,MTIM%MIM,FMADD_IMI%MIM) END FUNCTION FUNCTION FMADD_IMR(MA,R) TYPE ( FM ) FMADD_IMR TYPE ( IM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMADD(MUFM%MFM,MTFM%MFM,FMADD_IMR%MFM) END FUNCTION FUNCTION FMADD_IMD(MA,D) TYPE ( FM ) FMADD_IMD TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMADD(MUFM%MFM,MTFM%MFM,FMADD_IMD%MFM) END FUNCTION FUNCTION FMADD_IMZ(MA,Z) TYPE ( ZM ) FMADD_IMZ TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MUZM%MZM,MTZM%MZM,FMADD_IMZ%MZM) END FUNCTION FUNCTION FMADD_IMC(MA,C) TYPE ( ZM ) FMADD_IMC TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MUZM%MZM,MTZM%MZM,FMADD_IMC%MZM) END FUNCTION FUNCTION FMADD_IMFM(MA,MB) TYPE ( IM ) MA TYPE ( FM ) MB,FMADD_IMFM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMADD(MTFM%MFM,MB%MFM,FMADD_IMFM%MFM) END FUNCTION FUNCTION FMADD_IMIM(MA,MB) TYPE ( IM ) MA,MB,FMADD_IMIM INTENT (IN) :: MA,MB CALL IMADD(MA%MIM,MB%MIM,FMADD_IMIM%MIM) END FUNCTION FUNCTION FMADD_IMZM(MA,MB) TYPE ( IM ) MA TYPE ( ZM ) MB,FMADD_IMZM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MUZM%MZM,MB%MZM,FMADD_IMZM%MZM) END FUNCTION FUNCTION FMADD_ZMI(MA,IVAL) TYPE ( ZM ) MA,FMADD_ZMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMI%MZM) END FUNCTION FUNCTION FMADD_ZMR(MA,R) TYPE ( ZM ) MA,FMADD_ZMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMR%MZM) END FUNCTION FUNCTION FMADD_ZMD(MA,D) TYPE ( ZM ) MA,FMADD_ZMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMD%MZM) END FUNCTION FUNCTION FMADD_ZMZ(MA,Z) TYPE ( ZM ) MA,FMADD_ZMZ COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMZ%MZM) END FUNCTION FUNCTION FMADD_ZMC(MA,C) TYPE ( ZM ) MA,FMADD_ZMC COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMC%MZM) END FUNCTION FUNCTION FMADD_ZMFM(MA,MB) TYPE ( FM ) MB TYPE ( ZM ) MA,FMADD_ZMFM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MB%MFM,MTFM%MFM,MTZM%MZM) CALL ZMADD(MA%MZM,MTZM%MZM,FMADD_ZMFM%MZM) END FUNCTION FUNCTION FMADD_ZMIM(MA,MB) TYPE ( IM ) MB TYPE ( ZM ) MA,FMADD_ZMIM INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMADD(MA%MZM,MUZM%MZM,FMADD_ZMIM%MZM) END FUNCTION FUNCTION FMADD_ZMZM(MA,MB) TYPE ( ZM ) MA,MB,FMADD_ZMZM INTENT (IN) :: MA,MB CALL ZMADD(MA%MZM,MB%MZM,FMADD_ZMZM%MZM) END FUNCTION FUNCTION FMADD_FM(MA) TYPE ( FM ) MA,FMADD_FM INTENT (IN) :: MA CALL FMEQ(MA%MFM,FMADD_FM%MFM) END FUNCTION FUNCTION FMADD_IM(MA) TYPE ( IM ) MA,FMADD_IM INTENT (IN) :: MA CALL IMEQ(MA%MIM,FMADD_IM%MIM) END FUNCTION FUNCTION FMADD_ZM(MA) TYPE ( ZM ) MA,FMADD_ZM INTENT (IN) :: MA CALL ZMEQ(MA%MZM,FMADD_ZM%MZM) END FUNCTION ! - FUNCTION FMSUB_IFM(IVAL,MA) TYPE ( FM ) MA,FMSUB_IFM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMSUB(MTFM%MFM,MA%MFM,FMSUB_IFM%MFM) END FUNCTION FUNCTION FMSUB_IIM(IVAL,MA) TYPE ( IM ) MA,FMSUB_IIM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) CALL IMSUB(MTIM%MIM,MA%MIM,FMSUB_IIM%MIM) END FUNCTION FUNCTION FMSUB_IZM(IVAL,MA) TYPE ( ZM ) MA,FMSUB_IZM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MA%MZM,FMSUB_IZM%MZM) END FUNCTION FUNCTION FMSUB_RFM(R,MA) TYPE ( FM ) MA,FMSUB_RFM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMSUB(MTFM%MFM,MA%MFM,FMSUB_RFM%MFM) END FUNCTION FUNCTION FMSUB_RIM(R,MA) TYPE ( FM ) FMSUB_RIM TYPE ( IM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMSUB(MTFM%MFM,MUFM%MFM,FMSUB_RIM%MFM) END FUNCTION FUNCTION FMSUB_RZM(R,MA) TYPE ( ZM ) MA,FMSUB_RZM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MA%MZM,FMSUB_RZM%MZM) END FUNCTION FUNCTION FMSUB_DFM(D,MA) TYPE ( FM ) MA,FMSUB_DFM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMSUB(MTFM%MFM,MA%MFM,FMSUB_DFM%MFM) END FUNCTION FUNCTION FMSUB_DIM(D,MA) TYPE ( FM ) FMSUB_DIM TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMSUB(MTFM%MFM,MUFM%MFM,FMSUB_DIM%MFM) END FUNCTION FUNCTION FMSUB_DZM(D,MA) TYPE ( ZM ) MA,FMSUB_DZM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MA%MZM,FMSUB_DZM%MZM) END FUNCTION FUNCTION FMSUB_ZFM(Z,MA) TYPE ( ZM ) FMSUB_ZFM TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MTZM%MZM,MUZM%MZM,FMSUB_ZFM%MZM) END FUNCTION FUNCTION FMSUB_ZIM(Z,MA) TYPE ( ZM ) FMSUB_ZIM TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MTZM%MZM,MUZM%MZM,FMSUB_ZIM%MZM) END FUNCTION FUNCTION FMSUB_ZZM(Z,MA) TYPE ( ZM ) MA,FMSUB_ZZM COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MA%MZM,FMSUB_ZZM%MZM) END FUNCTION FUNCTION FMSUB_CFM(C,MA) TYPE ( ZM ) FMSUB_CFM TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MTZM%MZM,MUZM%MZM,FMSUB_CFM%MZM) END FUNCTION FUNCTION FMSUB_CIM(C,MA) TYPE ( ZM ) FMSUB_CIM TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MTZM%MZM,MUZM%MZM,FMSUB_CIM%MZM) END FUNCTION FUNCTION FMSUB_CZM(C,MA) TYPE ( ZM ) MA,FMSUB_CZM COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MA%MZM,FMSUB_CZM%MZM) END FUNCTION FUNCTION FMSUB_FMI(MA,IVAL) TYPE ( FM ) MA,FMSUB_FMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) CALL FMSUB(MA%MFM,MTFM%MFM,FMSUB_FMI%MFM) END FUNCTION FUNCTION FMSUB_FMR(MA,R) TYPE ( FM ) MA,FMSUB_FMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMSUB(MA%MFM,MTFM%MFM,FMSUB_FMR%MFM) END FUNCTION FUNCTION FMSUB_FMD(MA,D) TYPE ( FM ) MA,FMSUB_FMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMSUB(MA%MFM,MTFM%MFM,FMSUB_FMD%MFM) END FUNCTION FUNCTION FMSUB_FMZ(MA,Z) TYPE ( ZM ) FMSUB_FMZ TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MUZM%MZM,MTZM%MZM,FMSUB_FMZ%MZM) END FUNCTION FUNCTION FMSUB_FMC(MA,C) TYPE ( ZM ) FMSUB_FMC TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MUZM%MZM,MTZM%MZM,FMSUB_FMC%MZM) END FUNCTION FUNCTION FMSUB_FMFM(MA,MB) TYPE ( FM ) MA,MB,FMSUB_FMFM INTENT (IN) :: MA,MB CALL FMSUB(MA%MFM,MB%MFM,FMSUB_FMFM%MFM) END FUNCTION FUNCTION FMSUB_FMIM(MA,MB) TYPE ( FM ) MA,FMSUB_FMIM TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMSUB(MA%MFM,MTFM%MFM,FMSUB_FMIM%MFM) END FUNCTION FUNCTION FMSUB_FMZM(MA,MB) TYPE ( FM ) MA TYPE ( ZM ) MB,FMSUB_FMZM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MA%MFM,MTFM%MFM,MTZM%MZM) CALL ZMSUB(MTZM%MZM,MB%MZM,FMSUB_FMZM%MZM) END FUNCTION FUNCTION FMSUB_IMI(MA,IVAL) TYPE ( IM ) MA,FMSUB_IMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMI2M(IVAL,MTIM%MIM) CALL IMSUB(MA%MIM,MTIM%MIM,FMSUB_IMI%MIM) END FUNCTION FUNCTION FMSUB_IMR(MA,R) TYPE ( FM ) FMSUB_IMR TYPE ( IM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMSUB(MUFM%MFM,MTFM%MFM,FMSUB_IMR%MFM) END FUNCTION FUNCTION FMSUB_IMD(MA,D) TYPE ( FM ) FMSUB_IMD TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMSUB(MUFM%MFM,MTFM%MFM,FMSUB_IMD%MFM) END FUNCTION FUNCTION FMSUB_IMZ(MA,Z) TYPE ( ZM ) FMSUB_IMZ TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MUZM%MZM,MTZM%MZM,FMSUB_IMZ%MZM) END FUNCTION FUNCTION FMSUB_IMC(MA,C) TYPE ( ZM ) FMSUB_IMC TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MUZM%MZM,MTZM%MZM,FMSUB_IMC%MZM) END FUNCTION FUNCTION FMSUB_IMFM(MA,MB) TYPE ( IM ) MA TYPE ( FM ) MB,FMSUB_IMFM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMSUB(MTFM%MFM,MB%MFM,FMSUB_IMFM%MFM) END FUNCTION FUNCTION FMSUB_IMIM(MA,MB) TYPE ( IM ) MA,MB,FMSUB_IMIM INTENT (IN) :: MA,MB CALL IMSUB(MA%MIM,MB%MIM,FMSUB_IMIM%MIM) END FUNCTION FUNCTION FMSUB_IMZM(MA,MB) TYPE ( IM ) MA TYPE ( ZM ) MB,FMSUB_IMZM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MUZM%MZM,MB%MZM,FMSUB_IMZM%MZM) END FUNCTION FUNCTION FMSUB_ZMI(MA,IVAL) TYPE ( ZM ) MA,FMSUB_ZMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMI%MZM) END FUNCTION FUNCTION FMSUB_ZMR(MA,R) TYPE ( ZM ) MA,FMSUB_ZMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMR%MZM) END FUNCTION FUNCTION FMSUB_ZMD(MA,D) TYPE ( ZM ) MA,FMSUB_ZMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMD%MZM) END FUNCTION FUNCTION FMSUB_ZMZ(MA,Z) TYPE ( ZM ) MA,FMSUB_ZMZ COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMZ%MZM) END FUNCTION FUNCTION FMSUB_ZMC(MA,C) TYPE ( ZM ) MA,FMSUB_ZMC COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMC%MZM) END FUNCTION FUNCTION FMSUB_ZMFM(MA,MB) TYPE ( FM ) MB TYPE ( ZM ) MA,FMSUB_ZMFM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MB%MFM,MTFM%MFM,MTZM%MZM) CALL ZMSUB(MA%MZM,MTZM%MZM,FMSUB_ZMFM%MZM) END FUNCTION FUNCTION FMSUB_ZMIM(MA,MB) TYPE ( IM ) MB TYPE ( ZM ) MA,FMSUB_ZMIM INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMSUB(MA%MZM,MUZM%MZM,FMSUB_ZMIM%MZM) END FUNCTION FUNCTION FMSUB_ZMZM(MA,MB) TYPE ( ZM ) MA,MB,FMSUB_ZMZM INTENT (IN) :: MA,MB CALL ZMSUB(MA%MZM,MB%MZM,FMSUB_ZMZM%MZM) END FUNCTION FUNCTION FMSUB_FM(MA) TYPE ( FM ) MA,FMSUB_FM INTENT (IN) :: MA CALL FMEQ(MA%MFM,MTFM%MFM) IF (MTFM%MFM(1).NE.MUNKNO) MTFM%MFM(2) = -MTFM%MFM(2) CALL FMEQ(MTFM%MFM,FMSUB_FM%MFM) END FUNCTION FUNCTION FMSUB_IM(MA) TYPE ( IM ) MA,FMSUB_IM INTENT (IN) :: MA CALL IMEQ(MA%MIM,MTIM%MIM) IF (MTIM%MIM(1).NE.MUNKNO) MTIM%MIM(2) = -MTIM%MIM(2) CALL IMEQ(MTIM%MIM,FMSUB_IM%MIM) END FUNCTION FUNCTION FMSUB_ZM(MA) TYPE ( ZM ) MA,FMSUB_ZM INTENT (IN) :: MA CALL ZMEQ(MA%MZM,MTZM%MZM) IF (MTZM%MZM(1).NE.MUNKNO) MTZM%MZM(2) = -MTZM%MZM(2) IF (MTZM%MZM(KPTIMU+1).NE.MUNKNO) THEN MTZM%MZM(KPTIMU+2) = -MTZM%MZM(KPTIMU+2) ENDIF CALL ZMEQ(MTZM%MZM,FMSUB_ZM%MZM) END FUNCTION ! * FUNCTION FMMPY_IFM(IVAL,MA) TYPE ( FM ) MA,FMMPY_IFM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMMPYI(MA%MFM,IVAL,FMMPY_IFM%MFM) END FUNCTION FUNCTION FMMPY_IIM(IVAL,MA) TYPE ( IM ) MA,FMMPY_IIM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMMPYI(MA%MIM,IVAL,FMMPY_IIM%MIM) END FUNCTION FUNCTION FMMPY_IZM(IVAL,MA) TYPE ( ZM ) MA,FMMPY_IZM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL ZMMPYI(MA%MZM,IVAL,FMMPY_IZM%MZM) END FUNCTION FUNCTION FMMPY_RFM(R,MA) TYPE ( FM ) MA,FMMPY_RFM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMMPY(MTFM%MFM,MA%MFM,FMMPY_RFM%MFM) END FUNCTION FUNCTION FMMPY_RIM(R,MA) TYPE ( FM ) FMMPY_RIM TYPE ( IM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMMPY(MTFM%MFM,MUFM%MFM,FMMPY_RIM%MFM) END FUNCTION FUNCTION FMMPY_RZM(R,MA) TYPE ( ZM ) MA,FMMPY_RZM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MTZM%MZM,MA%MZM,FMMPY_RZM%MZM) END FUNCTION FUNCTION FMMPY_DFM(D,MA) TYPE ( FM ) MA,FMMPY_DFM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMMPY(MTFM%MFM,MA%MFM,FMMPY_DFM%MFM) END FUNCTION FUNCTION FMMPY_DIM(D,MA) TYPE ( FM ) FMMPY_DIM TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMMPY(MTFM%MFM,MUFM%MFM,FMMPY_DIM%MFM) END FUNCTION FUNCTION FMMPY_DZM(D,MA) TYPE ( ZM ) MA,FMMPY_DZM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MTZM%MZM,MA%MZM,FMMPY_DZM%MZM) END FUNCTION FUNCTION FMMPY_ZFM(Z,MA) TYPE ( ZM ) FMMPY_ZFM TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MTZM%MZM,MUZM%MZM,FMMPY_ZFM%MZM) END FUNCTION FUNCTION FMMPY_ZIM(Z,MA) TYPE ( ZM ) FMMPY_ZIM TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MTZM%MZM,MUZM%MZM,FMMPY_ZIM%MZM) END FUNCTION FUNCTION FMMPY_ZZM(Z,MA) TYPE ( ZM ) MA,FMMPY_ZZM COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL ZMMPY(MTZM%MZM,MA%MZM,FMMPY_ZZM%MZM) END FUNCTION FUNCTION FMMPY_CFM(C,MA) TYPE ( ZM ) FMMPY_CFM TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MTZM%MZM,MUZM%MZM,FMMPY_CFM%MZM) END FUNCTION FUNCTION FMMPY_CIM(C,MA) TYPE ( ZM ) FMMPY_CIM TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MTZM%MZM,MUZM%MZM,FMMPY_CIM%MZM) END FUNCTION FUNCTION FMMPY_CZM(C,MA) TYPE ( ZM ) MA,FMMPY_CZM COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MTZM%MZM,MA%MZM,FMMPY_CZM%MZM) END FUNCTION FUNCTION FMMPY_FMI(MA,IVAL) TYPE ( FM ) MA,FMMPY_FMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMMPYI(MA%MFM,IVAL,FMMPY_FMI%MFM) END FUNCTION FUNCTION FMMPY_FMR(MA,R) TYPE ( FM ) MA,FMMPY_FMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMMPY(MA%MFM,MTFM%MFM,FMMPY_FMR%MFM) END FUNCTION FUNCTION FMMPY_FMD(MA,D) TYPE ( FM ) MA,FMMPY_FMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMMPY(MA%MFM,MTFM%MFM,FMMPY_FMD%MFM) END FUNCTION FUNCTION FMMPY_FMZ(MA,Z) TYPE ( ZM ) FMMPY_FMZ TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MUZM%MZM,MTZM%MZM,FMMPY_FMZ%MZM) END FUNCTION FUNCTION FMMPY_FMC(MA,C) TYPE ( ZM ) FMMPY_FMC TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MUZM%MZM,MTZM%MZM,FMMPY_FMC%MZM) END FUNCTION FUNCTION FMMPY_FMFM(MA,MB) TYPE ( FM ) MA,MB,FMMPY_FMFM INTENT (IN) :: MA,MB CALL FMMPY(MA%MFM,MB%MFM,FMMPY_FMFM%MFM) END FUNCTION FUNCTION FMMPY_FMIM(MA,MB) TYPE ( FM ) MA,FMMPY_FMIM TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMMPY(MA%MFM,MTFM%MFM,FMMPY_FMIM%MFM) END FUNCTION FUNCTION FMMPY_FMZM(MA,MB) TYPE ( FM ) MA TYPE ( ZM ) MB,FMMPY_FMZM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MA%MFM,MTFM%MFM,MTZM%MZM) CALL ZMMPY(MTZM%MZM,MB%MZM,FMMPY_FMZM%MZM) END FUNCTION FUNCTION FMMPY_IMI(MA,IVAL) TYPE ( IM ) MA,FMMPY_IMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMMPYI(MA%MIM,IVAL,FMMPY_IMI%MIM) END FUNCTION FUNCTION FMMPY_IMR(MA,R) TYPE ( FM ) FMMPY_IMR TYPE ( IM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMMPY(MUFM%MFM,MTFM%MFM,FMMPY_IMR%MFM) END FUNCTION FUNCTION FMMPY_IMD(MA,D) TYPE ( FM ) FMMPY_IMD TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMMPY(MUFM%MFM,MTFM%MFM,FMMPY_IMD%MFM) END FUNCTION FUNCTION FMMPY_IMZ(MA,Z) TYPE ( ZM ) FMMPY_IMZ TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MUZM%MZM,MTZM%MZM,FMMPY_IMZ%MZM) END FUNCTION FUNCTION FMMPY_IMC(MA,C) TYPE ( ZM ) FMMPY_IMC TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MUZM%MZM,MTZM%MZM,FMMPY_IMC%MZM) END FUNCTION FUNCTION FMMPY_IMFM(MA,MB) TYPE ( IM ) MA TYPE ( FM ) MB,FMMPY_IMFM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMMPY(MTFM%MFM,MB%MFM,FMMPY_IMFM%MFM) END FUNCTION FUNCTION FMMPY_IMIM(MA,MB) TYPE ( IM ) MA,MB,FMMPY_IMIM INTENT (IN) :: MA,MB CALL IMMPY(MA%MIM,MB%MIM,FMMPY_IMIM%MIM) END FUNCTION FUNCTION FMMPY_IMZM(MA,MB) TYPE ( IM ) MA TYPE ( ZM ) MB,FMMPY_IMZM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MUZM%MZM,MB%MZM,FMMPY_IMZM%MZM) END FUNCTION FUNCTION FMMPY_ZMI(MA,IVAL) TYPE ( ZM ) MA,FMMPY_ZMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL ZMMPYI(MA%MZM,IVAL,FMMPY_ZMI%MZM) END FUNCTION FUNCTION FMMPY_ZMR(MA,R) TYPE ( ZM ) MA,FMMPY_ZMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MA%MZM,MTZM%MZM,FMMPY_ZMR%MZM) END FUNCTION FUNCTION FMMPY_ZMD(MA,D) TYPE ( ZM ) MA,FMMPY_ZMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MA%MZM,MTZM%MZM,FMMPY_ZMD%MZM) END FUNCTION FUNCTION FMMPY_ZMZ(MA,Z) TYPE ( ZM ) MA,FMMPY_ZMZ COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL ZMMPY(MA%MZM,MTZM%MZM,FMMPY_ZMZ%MZM) END FUNCTION FUNCTION FMMPY_ZMC(MA,C) TYPE ( ZM ) MA,FMMPY_ZMC COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMMPY(MA%MZM,MTZM%MZM,FMMPY_ZMC%MZM) END FUNCTION FUNCTION FMMPY_ZMFM(MA,MB) TYPE ( FM ) MB TYPE ( ZM ) MA,FMMPY_ZMFM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MB%MFM,MTFM%MFM,MTZM%MZM) CALL ZMMPY(MA%MZM,MTZM%MZM,FMMPY_ZMFM%MZM) END FUNCTION FUNCTION FMMPY_ZMIM(MA,MB) TYPE ( IM ) MB TYPE ( ZM ) MA,FMMPY_ZMIM INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMMPY(MA%MZM,MUZM%MZM,FMMPY_ZMIM%MZM) END FUNCTION FUNCTION FMMPY_ZMZM(MA,MB) TYPE ( ZM ) MA,MB,FMMPY_ZMZM INTENT (IN) :: MA,MB CALL ZMMPY(MA%MZM,MB%MZM,FMMPY_ZMZM%MZM) END FUNCTION ! / FUNCTION FMDIV_IFM(IVAL,MA) TYPE ( FM ) MA,FMDIV_IFM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMDIV(MTFM%MFM,MA%MFM,FMDIV_IFM%MFM) END FUNCTION FUNCTION FMDIV_IIM(IVAL,MA) TYPE ( IM ) MA,FMDIV_IIM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) CALL IMDIV(MTIM%MIM,MA%MIM,FMDIV_IIM%MIM) END FUNCTION FUNCTION FMDIV_IZM(IVAL,MA) TYPE ( ZM ) MA,FMDIV_IZM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MA%MZM,FMDIV_IZM%MZM) END FUNCTION FUNCTION FMDIV_RFM(R,MA) TYPE ( FM ) MA,FMDIV_RFM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMDIV(MTFM%MFM,MA%MFM,FMDIV_RFM%MFM) END FUNCTION FUNCTION FMDIV_RIM(R,MA) TYPE ( FM ) FMDIV_RIM TYPE ( IM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMDIV(MTFM%MFM,MUFM%MFM,FMDIV_RIM%MFM) END FUNCTION FUNCTION FMDIV_RZM(R,MA) TYPE ( ZM ) MA,FMDIV_RZM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MA%MZM,FMDIV_RZM%MZM) END FUNCTION FUNCTION FMDIV_DFM(D,MA) TYPE ( FM ) MA,FMDIV_DFM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMDIV(MTFM%MFM,MA%MFM,FMDIV_DFM%MFM) END FUNCTION FUNCTION FMDIV_DIM(D,MA) TYPE ( FM ) FMDIV_DIM TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMDIV(MTFM%MFM,MUFM%MFM,FMDIV_DIM%MFM) END FUNCTION FUNCTION FMDIV_DZM(D,MA) TYPE ( ZM ) MA,FMDIV_DZM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MA%MZM,FMDIV_DZM%MZM) END FUNCTION FUNCTION FMDIV_ZFM(Z,MA) TYPE ( ZM ) FMDIV_ZFM TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MTZM%MZM,MUZM%MZM,FMDIV_ZFM%MZM) END FUNCTION FUNCTION FMDIV_ZIM(Z,MA) TYPE ( ZM ) FMDIV_ZIM TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MTZM%MZM,MUZM%MZM,FMDIV_ZIM%MZM) END FUNCTION FUNCTION FMDIV_ZZM(Z,MA) TYPE ( ZM ) MA,FMDIV_ZZM COMPLEX Z INTENT (IN) :: Z,MA CALL ZMZ2M(Z,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MA%MZM,FMDIV_ZZM%MZM) END FUNCTION FUNCTION FMDIV_CFM(C,MA) TYPE ( ZM ) FMDIV_CFM TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MTZM%MZM,MUZM%MZM,FMDIV_CFM%MZM) END FUNCTION FUNCTION FMDIV_CIM(C,MA) TYPE ( ZM ) FMDIV_CIM TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MTZM%MZM,MUZM%MZM,FMDIV_CIM%MZM) END FUNCTION FUNCTION FMDIV_CZM(C,MA) TYPE ( ZM ) MA,FMDIV_CZM COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: C,MA CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MA%MZM,FMDIV_CZM%MZM) END FUNCTION FUNCTION FMDIV_FMI(MA,IVAL) TYPE ( FM ) MA,FMDIV_FMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL FMDIVI(MA%MFM,IVAL,FMDIV_FMI%MFM) END FUNCTION FUNCTION FMDIV_FMR(MA,R) TYPE ( FM ) MA,FMDIV_FMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMDIV(MA%MFM,MTFM%MFM,FMDIV_FMR%MFM) END FUNCTION FUNCTION FMDIV_FMD(MA,D) TYPE ( FM ) MA,FMDIV_FMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMDIV(MA%MFM,MTFM%MFM,FMDIV_FMD%MFM) END FUNCTION FUNCTION FMDIV_FMZ(MA,Z) TYPE ( ZM ) FMDIV_FMZ TYPE ( FM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MUZM%MZM,MTZM%MZM,FMDIV_FMZ%MZM) END FUNCTION FUNCTION FMDIV_FMC(MA,C) TYPE ( ZM ) FMDIV_FMC TYPE ( FM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MA%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MUZM%MZM,MTZM%MZM,FMDIV_FMC%MZM) END FUNCTION FUNCTION FMDIV_FMFM(MA,MB) TYPE ( FM ) MA,MB,FMDIV_FMFM INTENT (IN) :: MA,MB CALL FMDIV(MA%MFM,MB%MFM,FMDIV_FMFM%MFM) END FUNCTION FUNCTION FMDIV_FMIM(MA,MB) TYPE ( FM ) MA,FMDIV_FMIM TYPE ( IM ) MB INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMDIV(MA%MFM,MTFM%MFM,FMDIV_FMIM%MFM) END FUNCTION FUNCTION FMDIV_FMZM(MA,MB) TYPE ( FM ) MA TYPE ( ZM ) MB,FMDIV_FMZM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MA%MFM,MTFM%MFM,MTZM%MZM) CALL ZMDIV(MTZM%MZM,MB%MZM,FMDIV_FMZM%MZM) END FUNCTION FUNCTION FMDIV_IMI(MA,IVAL) TYPE ( IM ) MA,FMDIV_IMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL IMDIVI(MA%MIM,IVAL,FMDIV_IMI%MIM) END FUNCTION FUNCTION FMDIV_IMR(MA,R) TYPE ( FM ) FMDIV_IMR TYPE ( IM ) MA REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMDIV(MUFM%MFM,MTFM%MFM,FMDIV_IMR%MFM) END FUNCTION FUNCTION FMDIV_IMD(MA,D) TYPE ( FM ) FMDIV_IMD TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMDIV(MUFM%MFM,MTFM%MFM,FMDIV_IMD%MFM) END FUNCTION FUNCTION FMDIV_IMZ(MA,Z) TYPE ( ZM ) FMDIV_IMZ TYPE ( IM ) MA COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MUZM%MZM,MTZM%MZM,FMDIV_IMZ%MZM) END FUNCTION FUNCTION FMDIV_IMC(MA,C) TYPE ( ZM ) FMDIV_IMC TYPE ( IM ) MA COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MUZM%MZM,MTZM%MZM,FMDIV_IMC%MZM) END FUNCTION FUNCTION FMDIV_IMFM(MA,MB) TYPE ( IM ) MA TYPE ( FM ) MB,FMDIV_IMFM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMDIV(MTFM%MFM,MB%MFM,FMDIV_IMFM%MFM) END FUNCTION FUNCTION FMDIV_IMIM(MA,MB) TYPE ( IM ) MA,MB,FMDIV_IMIM INTENT (IN) :: MA,MB CALL IMDIV(MA%MIM,MB%MIM,FMDIV_IMIM%MIM) END FUNCTION FUNCTION FMDIV_IMZM(MA,MB) TYPE ( IM ) MA TYPE ( ZM ) MB,FMDIV_IMZM INTENT (IN) :: MA,MB CALL IMI2FM(MA%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MUZM%MZM,MB%MZM,FMDIV_IMZM%MZM) END FUNCTION FUNCTION FMDIV_ZMI(MA,IVAL) TYPE ( ZM ) MA,FMDIV_ZMI INTEGER IVAL INTENT (IN) :: MA,IVAL CALL ZMDIVI(MA%MZM,IVAL,FMDIV_ZMI%MZM) END FUNCTION FUNCTION FMDIV_ZMR(MA,R) TYPE ( ZM ) MA,FMDIV_ZMR REAL R INTENT (IN) :: MA,R CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MA%MZM,MTZM%MZM,FMDIV_ZMR%MZM) END FUNCTION FUNCTION FMDIV_ZMD(MA,D) TYPE ( ZM ) MA,FMDIV_ZMD DOUBLE PRECISION D INTENT (IN) :: MA,D CALL FMDP2M(D,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MA%MZM,MTZM%MZM,FMDIV_ZMD%MZM) END FUNCTION FUNCTION FMDIV_ZMZ(MA,Z) TYPE ( ZM ) MA,FMDIV_ZMZ COMPLEX Z INTENT (IN) :: MA,Z CALL ZMZ2M(Z,MTZM%MZM) CALL ZMDIV(MA%MZM,MTZM%MZM,FMDIV_ZMZ%MZM) END FUNCTION FUNCTION FMDIV_ZMC(MA,C) TYPE ( ZM ) MA,FMDIV_ZMC COMPLEX (KIND(0.0D0)) :: C INTENT (IN) :: MA,C CALL FMDP2M(REAL(C,KIND(0.0D0)),MTFM%MFM) CALL FMDP2M(AIMAG(C),MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMDIV(MA%MZM,MTZM%MZM,FMDIV_ZMC%MZM) END FUNCTION FUNCTION FMDIV_ZMFM(MA,MB) TYPE ( FM ) MB TYPE ( ZM ) MA,FMDIV_ZMFM INTENT (IN) :: MA,MB CALL FMI2M(0,MTFM%MFM) CALL ZMCMPX(MB%MFM,MTFM%MFM,MTZM%MZM) CALL ZMDIV(MA%MZM,MTZM%MZM,FMDIV_ZMFM%MZM) END FUNCTION FUNCTION FMDIV_ZMIM(MA,MB) TYPE ( IM ) MB TYPE ( ZM ) MA,FMDIV_ZMIM INTENT (IN) :: MA,MB CALL IMI2FM(MB%MIM,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MUZM%MZM) CALL ZMDIV(MA%MZM,MUZM%MZM,FMDIV_ZMIM%MZM) END FUNCTION FUNCTION FMDIV_ZMZM(MA,MB) TYPE ( ZM ) MA,MB,FMDIV_ZMZM INTENT (IN) :: MA,MB CALL ZMDIV(MA%MZM,MB%MZM,FMDIV_ZMZM%MZM) END FUNCTION ! ** FUNCTION FMPWR_IFM(IVAL,MA) TYPE ( FM ) MA,FMPWR_IFM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMPWR(MTFM%MFM,MA%MFM,FMPWR_IFM%MFM) END FUNCTION FUNCTION FMPWR_IIM(IVAL,MA) TYPE ( IM ) MA,FMPWR_IIM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL IMI2M(IVAL,MTIM%MIM) CALL IMPWR(MTIM%MIM,MA%MIM,FMPWR_IIM%MIM) END FUNCTION FUNCTION FMPWR_IZM(IVAL,MA) TYPE ( ZM ) MA,FMPWR_IZM INTEGER IVAL INTENT (IN) :: IVAL,MA CALL FMI2M(IVAL,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMPWR(MTZM%MZM,MA%MZM,FMPWR_IZM%MZM) END FUNCTION FUNCTION FMPWR_RFM(R,MA) TYPE ( FM ) MA,FMPWR_RFM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMPWR(MTFM%MFM,MA%MFM,FMPWR_RFM%MFM) END FUNCTION FUNCTION FMPWR_RIM(R,MA) TYPE ( FM ) FMPWR_RIM TYPE ( IM ) MA REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMPWR(MTFM%MFM,MUFM%MFM,FMPWR_RIM%MFM) END FUNCTION FUNCTION FMPWR_RZM(R,MA) TYPE ( ZM ) MA,FMPWR_RZM REAL R INTENT (IN) :: R,MA CALL FMSP2M(R,MTFM%MFM) CALL FMI2M(0,MUFM%MFM) CALL ZMCMPX(MTFM%MFM,MUFM%MFM,MTZM%MZM) CALL ZMPWR(MTZM%MZM,MA%MZM,FMPWR_RZM%MZM) END FUNCTION FUNCTION FMPWR_DFM(D,MA) TYPE ( FM ) MA,FMPWR_DFM DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL FMPWR(MTFM%MFM,MA%MFM,FMPWR_DFM%MFM) END FUNCTION FUNCTION FMPWR_DIM(D,MA) TYPE ( FM ) FMPWR_DIM TYPE ( IM ) MA DOUBLE PRECISION D INTENT (IN) :: D,MA CALL FMDP2M(D,MTFM%MFM) CALL IMI2FM(MA%MIM,MUFM%MFM) CALL FMPWR(MTFM%MFM,MUFM%MFM,FMPWR_DIM%MFM) END FUNCTION FUNCTION FMPWR_DZM(D,MA)