The Emulation Module

Contents of the Module

The emulation module, module_emulate_real_arithmetic, contains:

Definitions of the emulation types;
Overload definitions for assignment and for all arithmetic and relational operators which may operate on real or complex objects;
Overload definitions for all intrinsic functions and subroutines which may operate on real or complex objects;
The code of all of the functions and subroutines used to overload assignment, operators and intrinsics;
Wrapper functions which return the value component of expressions of the emulation types;
The system initialisation routine, initialise_emulated_arithmetic;
Any additional variables and routines required to support the emulation study.

The main file for a "vanilla" case, a case where the arithmetic is emulated but no other changes are made, is shown below:

! ***************************************************************************** ! module_emulate_real_arithmetic.f90 27-Jan-15 John Collins ! 24-Oct-17 John Collins ! ! 25-Jan-15 fpt V3.8-j First use ! 24-Jul-15 AMIN, DMIN etc. ! 24-Oct-17 Version for units and dimensions ! ! ***************************************************************************** ! MODULE module_emulate_real_arithmetic !% NO RUN-TIME TRACE ! IMPLICIT NONE PRIVATE ! ! ***************************************************************************** ! INCLUDE 'kinds.i90' INCLUDE 'em_types.i90' ! ! ***************************************************************************** ! ! Overloads ! ========= ! INTERFACE ASSIGNMENT(=) MODULE PROCEDURE assign_em_real_k4_literal_r4 MODULE PROCEDURE assign_em_real_k4_literal_r8 MODULE PROCEDURE assign_em_real_k4_literal_i1 MODULE PROCEDURE assign_em_real_k4_literal_i2 MODULE PROCEDURE assign_em_real_k4_literal_i4 MODULE PROCEDURE assign_em_real_k4_literal_i8 MODULE PROCEDURE assign_em_real_k4_em_real_k4 MODULE PROCEDURE assign_em_real_k4_em_real_k8 MODULE PROCEDURE assign_em_real_k8_literal_r4 MODULE PROCEDURE assign_em_real_k8_literal_r8 MODULE PROCEDURE assign_em_real_k8_literal_i1 MODULE PROCEDURE assign_em_real_k8_literal_i2 MODULE PROCEDURE assign_em_real_k8_literal_i4 MODULE PROCEDURE assign_em_real_k8_literal_i8 MODULE PROCEDURE assign_em_real_k8_em_real_k4 MODULE PROCEDURE assign_em_real_k8_em_real_k8 MODULE PROCEDURE assign_em_cmpx_k4_literal_r4 MODULE PROCEDURE assign_em_cmpx_k4_literal_r8 MODULE PROCEDURE assign_em_cmpx_k4_literal_i1 MODULE PROCEDURE assign_em_cmpx_k4_literal_i2 MODULE PROCEDURE assign_em_cmpx_k4_literal_i4 MODULE PROCEDURE assign_em_cmpx_k4_literal_i8 MODULE PROCEDURE assign_em_cmpx_k4_literal_x4 MODULE PROCEDURE assign_em_cmpx_k4_literal_x8 MODULE PROCEDURE assign_em_cmpx_k4_em_real_k4 MODULE PROCEDURE assign_em_cmpx_k4_em_real_k8 MODULE PROCEDURE assign_em_cmpx_k4_em_cmpx_k4 MODULE PROCEDURE assign_em_cmpx_k4_em_cmpx_k8 MODULE PROCEDURE assign_em_cmpx_k8_literal_r4 MODULE PROCEDURE assign_em_cmpx_k8_literal_r8 MODULE PROCEDURE assign_em_cmpx_k8_literal_i1 MODULE PROCEDURE assign_em_cmpx_k8_literal_i2 MODULE PROCEDURE assign_em_cmpx_k8_literal_i4 MODULE PROCEDURE assign_em_cmpx_k8_literal_i8 MODULE PROCEDURE assign_em_cmpx_k8_literal_x4 MODULE PROCEDURE assign_em_cmpx_k8_literal_x8 MODULE PROCEDURE assign_em_cmpx_k8_em_real_k4 MODULE PROCEDURE assign_em_cmpx_k8_em_real_k8 MODULE PROCEDURE assign_em_cmpx_k8_em_cmpx_k4 MODULE PROCEDURE assign_em_cmpx_k8_em_cmpx_k8 MODULE PROCEDURE assign_i1_em_real_k4 MODULE PROCEDURE assign_i2_em_real_k4 MODULE PROCEDURE assign_i4_em_real_k4 MODULE PROCEDURE assign_i8_em_real_k4 MODULE PROCEDURE assign_i1_em_real_k8 MODULE PROCEDURE assign_i2_em_real_k8 MODULE PROCEDURE assign_i4_em_real_k8 MODULE PROCEDURE assign_i8_em_real_k8 MODULE PROCEDURE assign_i1_em_complex_k4 MODULE PROCEDURE assign_i2_em_complex_k4 MODULE PROCEDURE assign_i4_em_complex_k4 MODULE PROCEDURE assign_i8_em_complex_k4 MODULE PROCEDURE assign_i1_em_complex_k8 MODULE PROCEDURE assign_i2_em_complex_k8 MODULE PROCEDURE assign_i4_em_complex_k8 MODULE PROCEDURE assign_i8_em_complex_k8 END INTERFACE ASSIGNMENT(=) ! PUBLIC ASSIGNMENT(=) ! ! ! Note that overloads are NOT commutative ! INTERFACE OPERATOR(+) ! Unary MODULE PROCEDURE unary_plus_em_real_k4 MODULE PROCEDURE unary_plus_em_real_k8 MODULE PROCEDURE unary_plus_em_cmpx_k4 MODULE PROCEDURE unary_plus_em_cmpx_k8 ! INCLUDE 'add_em_real_proc.i90' INCLUDE 'add_em_complex_proc.i90' END INTERFACE OPERATOR(+) ! PUBLIC OPERATOR(+) ! ! INTERFACE OPERATOR(-) ! Unary MODULE PROCEDURE unary_minus_em_real_k4 MODULE PROCEDURE unary_minus_em_real_k8 MODULE PROCEDURE unary_minus_em_cmpx_k4 MODULE PROCEDURE unary_minus_em_cmpx_k8 ! INCLUDE 'subtract_em_real_proc.i90' INCLUDE 'subtract_em_complex_proc.i90' END INTERFACE OPERATOR(-) ! PUBLIC OPERATOR(-) ! ! INTERFACE OPERATOR(*) INCLUDE 'multiply_em_real_proc.i90' INCLUDE 'multiply_em_complex_proc.i90' END INTERFACE OPERATOR(*) ! PUBLIC OPERATOR(*) ! ! INTERFACE OPERATOR(/) INCLUDE 'divide_em_real_proc.i90' INCLUDE 'divide_em_complex_proc.i90' END INTERFACE OPERATOR(/) ! PUBLIC OPERATOR(/) ! ! INTERFACE OPERATOR(**) INCLUDE 'power_em_real_proc.i90' INCLUDE 'power_em_complex_proc.i90' END INTERFACE OPERATOR(**) ! PUBLIC OPERATOR(**) ! ! INTERFACE OPERATOR(==) INCLUDE 'eq_em_real_proc.i90' INCLUDE 'eq_em_complex_proc.i90' END INTERFACE OPERATOR(==) ! PUBLIC OPERATOR(==) ! ! INTERFACE OPERATOR(/=) INCLUDE 'ne_em_real_proc.i90' INCLUDE 'ne_em_complex_proc.i90' END INTERFACE OPERATOR(/=) ! PUBLIC OPERATOR(/=) ! ! ! Note that complex operands are not permitted INTERFACE OPERATOR(>) INCLUDE 'gt_em_real_proc.i90' END INTERFACE OPERATOR(>) ! PUBLIC OPERATOR(>) ! ! ! Note that complex operands are not permitted INTERFACE OPERATOR(>=) INCLUDE 'ge_em_real_proc.i90' END INTERFACE OPERATOR(>=) ! PUBLIC OPERATOR(>=) ! ! ! Note that complex operands are not permitted INTERFACE OPERATOR(<) INCLUDE 'lt_em_real_proc.i90' END INTERFACE OPERATOR(<) ! PUBLIC OPERATOR(<) ! ! ! Note that complex operands are not permitted INTERFACE OPERATOR(<=) INCLUDE 'le_em_real_proc.i90' END INTERFACE OPERATOR(<=) ! PUBLIC OPERATOR(<=) ! ! ! Single argument intrinsics - SQRT, SIN, COS etc. INCLUDE 'intrinsic_elemental_1_arg_proc.i90' ! ! Conversion intrinsics - AIMAG, SNGL, DBLE etc. INCLUDE 'intrinsic_convert_1_arg_proc.i90' ! ! Special cases INCLUDE 'intrinsic_alog_alog10_proc.i90' INCLUDE 'intrinsic_amin1_amax1_proc.i90' INCLUDE 'intrinsic_atan2_proc.i90' INCLUDE 'intrinsic_cmplx_dcmplx_proc.i90' INCLUDE 'intrinsic_min_max_proc.i90' INCLUDE 'intrinsic_mod_sign_proc.i90' INCLUDE 'intrinsic_sum_minval_maxval_proc.i90' INCLUDE 'intrinsic_dp_proc.i90' PUBLIC :: initialise_emulated_arithmetic PUBLIC :: em_value_r_k4 PUBLIC :: em_value_r_k8 PUBLIC :: em_value_x_k4 PUBLIC :: em_value_x_k8 PUBLIC :: em_init_r_k4 PUBLIC :: em_init_r_k8 PUBLIC :: em_init_x_k4 PUBLIC :: em_init_x_k8 ! ! ***************************************************************************** ! ! Methods ! ======= ! CONTAINS ! ======== ! ! Wrapper functions and attribute initialisation subroutines ! ---------------------------------------------------------- INCLUDE 'value_wrapper_functions.i90' INCLUDE 'attrib_init_subroutines.i90' ! ! Operators ! --------- INCLUDE 'unary_em_real.i90' ! INCLUDE 'assign_em_real_k4.i90' INCLUDE 'assign_em_real_k8.i90' ! INCLUDE 'add_em_real.i90' INCLUDE 'subtract_em_real.i90' INCLUDE 'multiply_em_real.i90' INCLUDE 'divide_em_real.i90' INCLUDE 'power_em_real.i90' INCLUDE 'eq_em_real.i90' INCLUDE 'ne_em_real.i90' INCLUDE 'gt_em_real.i90' INCLUDE 'ge_em_real.i90' INCLUDE 'lt_em_real.i90' INCLUDE 'le_em_real.i90' ! INCLUDE 'unary_em_complex.i90' ! INCLUDE 'assign_em_complex_k4.i90' INCLUDE 'assign_em_complex_k8.i90' ! INCLUDE 'add_em_complex.i90' INCLUDE 'subtract_em_complex.i90' INCLUDE 'multiply_em_complex.i90' INCLUDE 'divide_em_complex.i90' INCLUDE 'power_em_complex.i90' INCLUDE 'eq_em_complex.i90' INCLUDE 'ne_em_complex.i90' INCLUDE 'assign_integers.i90' ! ! ! Single argument intrinsics ! -------------------------- INCLUDE 'intrinsic_elemental_1_arg_fun.i90' ! ! Conversion intrinsics ! --------------------- INCLUDE 'intrinsic_convert_1_arg_fun.i90' ! ! Special cases ! ------------- INCLUDE 'intrinsic_alog_alog10_fun.i90' INCLUDE 'intrinsic_amin1_amax1_fun.i90' INCLUDE 'intrinsic_atan2_fun.i90' INCLUDE 'intrinsic_cmplx_dcmplx_fun.i90' INCLUDE 'intrinsic_min_max_fun.i90' INCLUDE 'intrinsic_mod_sign_fun.i90' INCLUDE 'intrinsic_sum_minval_maxval_fun.i90' INCLUDE 'intrinsic_dp_fun.i90' ! ***************************************************************************** SUBROUTINE initialise_emulated_arithmetic END SUBROUTINE initialise_emulated_arithmetic ! END MODULE module_emulate_real_arithmetic ! ***********************************

File Organisation

The emulation type definitions, most of the MODULE PROCEDURE statements for the overloads and all of the sub-program codes are written in INCLUDE files, and many of these INCLUDE files are generated automatically under program control. The module procedure include file for overload of the dyadic + operator for real objects, for example, is shown below:

! File: add_em_real_proc.i90 Generated by generate_operator.f90 MODULE PROCEDURE add_em_real_k4_literal_r4 MODULE PROCEDURE add_em_real_k4_literal_r8 MODULE PROCEDURE add_em_real_k4_literal_i1 MODULE PROCEDURE add_em_real_k4_literal_i2 MODULE PROCEDURE add_em_real_k4_literal_i4 MODULE PROCEDURE add_em_real_k4_literal_i8 MODULE PROCEDURE add_em_real_k8_literal_r4 MODULE PROCEDURE add_em_real_k8_literal_r8 MODULE PROCEDURE add_em_real_k8_literal_i1 MODULE PROCEDURE add_em_real_k8_literal_i2 MODULE PROCEDURE add_em_real_k8_literal_i4 MODULE PROCEDURE add_em_real_k8_literal_i8 MODULE PROCEDURE add_literal_r4_em_real_k4 MODULE PROCEDURE add_literal_r8_em_real_k4 MODULE PROCEDURE add_literal_i1_em_real_k4 MODULE PROCEDURE add_literal_i2_em_real_k4 MODULE PROCEDURE add_literal_i4_em_real_k4 MODULE PROCEDURE add_literal_i8_em_real_k4 MODULE PROCEDURE add_literal_r4_em_real_k8 MODULE PROCEDURE add_literal_r8_em_real_k8 MODULE PROCEDURE add_literal_i1_em_real_k8 MODULE PROCEDURE add_literal_i2_em_real_k8 MODULE PROCEDURE add_literal_i4_em_real_k8 MODULE PROCEDURE add_literal_i8_em_real_k8 MODULE PROCEDURE add_em_real_k4_em_real_k4 MODULE PROCEDURE add_em_real_k4_em_real_k8 MODULE PROCEDURE add_em_real_k8_em_real_k4 MODULE PROCEDURE add_em_real_k8_em_real_k8 ! End of file: add_em_real_proc.i90

There is a corresponding file for addition of complex objects, and files for all of the other arithmetic and relational operators.

The file which contains the code of the functions for addition of real objects is:

! File: add_em_real.i90 Generated by generate_operator.f90 ELEMENTAL FUNCTION add_em_real_k4_literal_r4(a1mr4,a2lr4) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_literal_r4 TYPE (em_real_k4),INTENT(IN) :: a1mr4 REAL(KIND=kr4),INTENT(IN) :: a2lr4 add_em_real_k4_literal_r4%value = a1mr4%value + a2lr4 END FUNCTION add_em_real_k4_literal_r4 ELEMENTAL FUNCTION add_em_real_k4_literal_r8(a1mr4,a2lr8) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k4_literal_r8 TYPE (em_real_k4),INTENT(IN) :: a1mr4 REAL(KIND=kr8),INTENT(IN) :: a2lr8 add_em_real_k4_literal_r8%value = a1mr4%value + a2lr8 END FUNCTION add_em_real_k4_literal_r8 ELEMENTAL FUNCTION add_em_real_k4_literal_i1(a1mr4,a2li1) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_literal_i1 TYPE (em_real_k4),INTENT(IN) :: a1mr4 INTEGER(KIND=ki1),INTENT(IN) :: a2li1 add_em_real_k4_literal_i1%value = a1mr4%value + a2li1 END FUNCTION add_em_real_k4_literal_i1 ELEMENTAL FUNCTION add_em_real_k4_literal_i2(a1mr4,a2li2) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_literal_i2 TYPE (em_real_k4),INTENT(IN) :: a1mr4 INTEGER(KIND=ki2),INTENT(IN) :: a2li2 add_em_real_k4_literal_i2%value = a1mr4%value + a2li2 END FUNCTION add_em_real_k4_literal_i2 ELEMENTAL FUNCTION add_em_real_k4_literal_i4(a1mr4,a2li4) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_literal_i4 TYPE (em_real_k4),INTENT(IN) :: a1mr4 INTEGER(KIND=ki4),INTENT(IN) :: a2li4 add_em_real_k4_literal_i4%value = a1mr4%value + a2li4 END FUNCTION add_em_real_k4_literal_i4 ELEMENTAL FUNCTION add_em_real_k4_literal_i8(a1mr4,a2li8) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_literal_i8 TYPE (em_real_k4),INTENT(IN) :: a1mr4 INTEGER(KIND=ki8),INTENT(IN) :: a2li8 add_em_real_k4_literal_i8%value = a1mr4%value + a2li8 END FUNCTION add_em_real_k4_literal_i8 ELEMENTAL FUNCTION add_em_real_k8_literal_r4(a1mr8,a2lr4) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_r4 TYPE (em_real_k8),INTENT(IN) :: a1mr8 REAL(KIND=kr4),INTENT(IN) :: a2lr4 add_em_real_k8_literal_r4%value = a1mr8%value + a2lr4 END FUNCTION add_em_real_k8_literal_r4 ELEMENTAL FUNCTION add_em_real_k8_literal_r8(a1mr8,a2lr8) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_r8 TYPE (em_real_k8),INTENT(IN) :: a1mr8 REAL(KIND=kr8),INTENT(IN) :: a2lr8 add_em_real_k8_literal_r8%value = a1mr8%value + a2lr8 END FUNCTION add_em_real_k8_literal_r8 ELEMENTAL FUNCTION add_em_real_k8_literal_i1(a1mr8,a2li1) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_i1 TYPE (em_real_k8),INTENT(IN) :: a1mr8 INTEGER(KIND=ki1),INTENT(IN) :: a2li1 add_em_real_k8_literal_i1%value = a1mr8%value + a2li1 END FUNCTION add_em_real_k8_literal_i1 ELEMENTAL FUNCTION add_em_real_k8_literal_i2(a1mr8,a2li2) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_i2 TYPE (em_real_k8),INTENT(IN) :: a1mr8 INTEGER(KIND=ki2),INTENT(IN) :: a2li2 add_em_real_k8_literal_i2%value = a1mr8%value + a2li2 END FUNCTION add_em_real_k8_literal_i2 ELEMENTAL FUNCTION add_em_real_k8_literal_i4(a1mr8,a2li4) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_i4 TYPE (em_real_k8),INTENT(IN) :: a1mr8 INTEGER(KIND=ki4),INTENT(IN) :: a2li4 add_em_real_k8_literal_i4%value = a1mr8%value + a2li4 END FUNCTION add_em_real_k8_literal_i4 ELEMENTAL FUNCTION add_em_real_k8_literal_i8(a1mr8,a2li8) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_literal_i8 TYPE (em_real_k8),INTENT(IN) :: a1mr8 INTEGER(KIND=ki8),INTENT(IN) :: a2li8 add_em_real_k8_literal_i8%value = a1mr8%value + a2li8 END FUNCTION add_em_real_k8_literal_i8 ELEMENTAL FUNCTION add_literal_r4_em_real_k4(a1lr4,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_literal_r4_em_real_k4 REAL(KIND=kr4),INTENT(IN) :: a1lr4 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_r4_em_real_k4%value = a1lr4 + a2mr4%value END FUNCTION add_literal_r4_em_real_k4 ELEMENTAL FUNCTION add_literal_r8_em_real_k4(a1lr8,a2mr4) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_r8_em_real_k4 REAL(KIND=kr8),INTENT(IN) :: a1lr8 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_r8_em_real_k4%value = a1lr8 + a2mr4%value END FUNCTION add_literal_r8_em_real_k4 ELEMENTAL FUNCTION add_literal_i1_em_real_k4(a1li1,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_literal_i1_em_real_k4 INTEGER(KIND=ki1),INTENT(IN) :: a1li1 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_i1_em_real_k4%value = a1li1 + a2mr4%value END FUNCTION add_literal_i1_em_real_k4 ELEMENTAL FUNCTION add_literal_i2_em_real_k4(a1li2,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_literal_i2_em_real_k4 INTEGER(KIND=ki2),INTENT(IN) :: a1li2 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_i2_em_real_k4%value = a1li2 + a2mr4%value END FUNCTION add_literal_i2_em_real_k4 ELEMENTAL FUNCTION add_literal_i4_em_real_k4(a1li4,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_literal_i4_em_real_k4 INTEGER(KIND=ki4),INTENT(IN) :: a1li4 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_i4_em_real_k4%value = a1li4 + a2mr4%value END FUNCTION add_literal_i4_em_real_k4 ELEMENTAL FUNCTION add_literal_i8_em_real_k4(a1li8,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_literal_i8_em_real_k4 INTEGER(KIND=ki8),INTENT(IN) :: a1li8 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_literal_i8_em_real_k4%value = a1li8 + a2mr4%value END FUNCTION add_literal_i8_em_real_k4 ELEMENTAL FUNCTION add_literal_r4_em_real_k8(a1lr4,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_r4_em_real_k8 REAL(KIND=kr4),INTENT(IN) :: a1lr4 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_r4_em_real_k8%value = a1lr4 + a2mr8%value END FUNCTION add_literal_r4_em_real_k8 ELEMENTAL FUNCTION add_literal_r8_em_real_k8(a1lr8,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_r8_em_real_k8 REAL(KIND=kr8),INTENT(IN) :: a1lr8 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_r8_em_real_k8%value = a1lr8 + a2mr8%value END FUNCTION add_literal_r8_em_real_k8 ELEMENTAL FUNCTION add_literal_i1_em_real_k8(a1li1,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_i1_em_real_k8 INTEGER(KIND=ki1),INTENT(IN) :: a1li1 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_i1_em_real_k8%value = a1li1 + a2mr8%value END FUNCTION add_literal_i1_em_real_k8 ELEMENTAL FUNCTION add_literal_i2_em_real_k8(a1li2,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_i2_em_real_k8 INTEGER(KIND=ki2),INTENT(IN) :: a1li2 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_i2_em_real_k8%value = a1li2 + a2mr8%value END FUNCTION add_literal_i2_em_real_k8 ELEMENTAL FUNCTION add_literal_i4_em_real_k8(a1li4,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_i4_em_real_k8 INTEGER(KIND=ki4),INTENT(IN) :: a1li4 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_i4_em_real_k8%value = a1li4 + a2mr8%value END FUNCTION add_literal_i4_em_real_k8 ELEMENTAL FUNCTION add_literal_i8_em_real_k8(a1li8,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_literal_i8_em_real_k8 INTEGER(KIND=ki8),INTENT(IN) :: a1li8 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_literal_i8_em_real_k8%value = a1li8 + a2mr8%value END FUNCTION add_literal_i8_em_real_k8 ELEMENTAL FUNCTION add_em_real_k4_em_real_k4(a1mr4,a2mr4) IMPLICIT NONE TYPE (em_real_k4) :: add_em_real_k4_em_real_k4 TYPE (em_real_k4),INTENT(IN) :: a1mr4 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_em_real_k4_em_real_k4%value = a1mr4%value + a2mr4%value END FUNCTION add_em_real_k4_em_real_k4 ELEMENTAL FUNCTION add_em_real_k4_em_real_k8(a1mr4,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k4_em_real_k8 TYPE (em_real_k4),INTENT(IN) :: a1mr4 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_em_real_k4_em_real_k8%value = a1mr4%value + a2mr8%value END FUNCTION add_em_real_k4_em_real_k8 ELEMENTAL FUNCTION add_em_real_k8_em_real_k4(a1mr8,a2mr4) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_em_real_k4 TYPE (em_real_k8),INTENT(IN) :: a1mr8 TYPE (em_real_k4),INTENT(IN) :: a2mr4 add_em_real_k8_em_real_k4%value = a1mr8%value + a2mr4%value END FUNCTION add_em_real_k8_em_real_k4 ELEMENTAL FUNCTION add_em_real_k8_em_real_k8(a1mr8,a2mr8) IMPLICIT NONE TYPE (em_real_k8) :: add_em_real_k8_em_real_k8 TYPE (em_real_k8),INTENT(IN) :: a1mr8 TYPE (em_real_k8),INTENT(IN) :: a2mr8 add_em_real_k8_em_real_k8%value = a1mr8%value + a2mr8%value END FUNCTION add_em_real_k8_em_real_k8 ! End of file: add_em_real.i90

Again, there is a corresponding file for complex additions and there are similar files for all of the arithmetic and relational codes.

The Size of the Emulation Module

An analysis by fpt shows:

Files Primary files 1 Include files 67 Code and comments Declaration lines 6669 Executable lines 2481 Total code lines 9150 Comment text lines 312 Comment separator lines 77 Blank lines 1315 Total comment lines 1704 Total lines 10854 Program Units Module subroutines 61 Module Functions 983 Generic interfaces 56 Specific interfaces 12

This is quite a large piece of code.

Downloading the Code

A version of the emulation module with single component emulation types will be found in the examples directory in fpt version 4.0-f, which is available for download at simconglobal.com. The module with two-component emulation types will be released shortly with fpt version 4.0-g.