Skip to content

Instantly share code, notes, and snippets.

@tailriver
Created March 30, 2013 17:49
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tailriver/5277648 to your computer and use it in GitHub Desktop.
Save tailriver/5277648 to your computer and use it in GitHub Desktop.
Polymorphic Fortran by using preprocessor
#ifndef _MYCALC_F90
#define _MYCALC_F90
module mycalc
implicit none
interface mysum
module procedure mysum_I
module procedure mysum_S, mysum_SI
module procedure mysum_C, mysum_CI, mysum_CS
module procedure mysum_D, mysum_DI, mysum_DS, mysum_DC
module procedure mysum_Z, mysum_ZI, mysum_ZS, mysum_ZC, mysum_ZD
module procedure mysum_Q, mysum_QI, mysum_QS, mysum_QC, mysum_QD, mysum_QZ
module procedure mysum_X, mysum_XI, mysum_XS, mysum_XC, mysum_XD, mysum_XZ, mysum_XQ
end interface
interface mymul
module procedure mymul_I
module procedure mymul_S, mymul_SI
module procedure mymul_C, mymul_CI, mymul_CS
module procedure mymul_D, mymul_DI, mymul_DS, mymul_DC
module procedure mymul_Z, mymul_ZI, mymul_ZS, mymul_ZC, mymul_ZD
module procedure mymul_Q, mymul_QI, mymul_QS, mymul_QC, mymul_QD, mymul_QZ
module procedure mymul_X, mymul_XI, mymul_XS, mymul_XC, mymul_XD, mymul_XZ, mymul_XQ
end interface
contains
#define MYSUM mysum_I
#define MYMUL mymul_I
#define TYPE1 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_S
#define MYMUL mymul_S
#define TYPE1 REAL
#include "mycalc.F90"
#define MYSUM mysum_SI
#define MYMUL mymul_SI
#define TYPE1 REAL
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_C
#define MYMUL mymul_C
#define TYPE1 COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_CI
#define MYMUL mymul_CI
#define TYPE1 COMPLEX
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_CS
#define MYMUL mymul_CS
#define TYPE1 COMPLEX
#define TYPE3 REAL
#include "mycalc.F90"
#define MYSUM mysum_D
#define MYMUL mymul_D
#define TYPE1 DOUBLE PRECISION
#include "mycalc.F90"
#define MYSUM mysum_DI
#define MYMUL mymul_DI
#define TYPE1 DOUBLE PRECISION
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_DS
#define MYMUL mymul_DS
#define TYPE1 DOUBLE PRECISION
#define TYPE3 REAL
#include "mycalc.F90"
#define MYSUM mysum_DC
#define MYMUL mymul_DC
#define TYPE1 DOUBLE COMPLEX
#define TYPE2 DOUBLE PRECISION
#define TYPE3 COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_Z
#define MYMUL mymul_Z
#define TYPE1 DOUBLE COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_ZI
#define MYMUL mymul_ZI
#define TYPE1 DOUBLE COMPLEX
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_ZS
#define MYMUL mymul_ZS
#define TYPE1 DOUBLE COMPLEX
#define TYPE3 REAL
#include "mycalc.F90"
#define MYSUM mysum_ZC
#define MYMUL mymul_ZC
#define TYPE1 DOUBLE COMPLEX
#define TYPE3 COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_ZD
#define MYMUL mymul_ZD
#define TYPE1 DOUBLE COMPLEX
#define TYPE3 DOUBLE PRECISION
#include "mycalc.F90"
#define MYSUM mysum_Q
#define MYMUL mymul_Q
#define TYPE1 REAL(16)
#include "mycalc.F90"
#define MYSUM mysum_QI
#define MYMUL mymul_QI
#define TYPE1 REAL(16)
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_QS
#define MYMUL mymul_QS
#define TYPE1 REAL(16)
#define TYPE3 REAL
#include "mycalc.F90"
#define MYSUM mysum_QC
#define MYMUL mymul_QC
#define TYPE1 COMPLEX(16)
#define TYPE2 REAL(16)
#define TYPE3 COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_QD
#define MYMUL mymul_QD
#define TYPE1 REAL(16)
#define TYPE3 DOUBLE PRECISION
#include "mycalc.F90"
#define MYSUM mysum_QZ
#define MYMUL mymul_QZ
#define TYPE1 COMPLEX(16)
#define TYPE2 REAL(16)
#define TYPE3 DOUBLE COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_X
#define MYMUL mymul_X
#define TYPE1 COMPLEX(16)
#include "mycalc.F90"
#define MYSUM mysum_XI
#define MYMUL mymul_XI
#define TYPE1 COMPLEX(16)
#define TYPE3 INTEGER
#include "mycalc.F90"
#define MYSUM mysum_XS
#define MYMUL mymul_XS
#define TYPE1 COMPLEX(16)
#define TYPE3 REAL
#include "mycalc.F90"
#define MYSUM mysum_XC
#define MYMUL mymul_XC
#define TYPE1 COMPLEX(16)
#define TYPE3 COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_XD
#define MYMUL mymul_XD
#define TYPE1 COMPLEX(16)
#define TYPE3 DOUBLE PRECISION
#include "mycalc.F90"
#define MYSUM mysum_XZ
#define MYMUL mymul_XZ
#define TYPE1 COMPLEX(16)
#define TYPE3 DOUBLE COMPLEX
#include "mycalc.F90"
#define MYSUM mysum_XQ
#define MYMUL mymul_XQ
#define TYPE1 COMPLEX(16)
#define TYPE3 REAL(16)
#include "mycalc.F90"
end module
program main
use mycalc
implicit none
double precision :: a, b
double complex :: c
real(16) :: q
a = 3.5d0
b = 4.2d0
c = (3.2d0, -1.2d0)
q = 1.0q0 + 1.0q-30
print *, mysum(a, b)
print *, mymul(c, a)
print *, mysum(q, c)
end program
#endif
! END OF PROGRAM BODY
#ifdef TYPE1
#ifndef TYPE2
#define TYPE2 TYPE1
#endif
#ifndef TYPE3
#define TYPE3 TYPE1
#endif
#ifdef MYSUM
TYPE1 function MYSUM (x, y)
TYPE2, intent(in) :: x
TYPE3, intent(in) :: y
MYSUM = x + y
return
end function
#undef MYSUM
#endif
#ifdef MYMUL
TYPE1 function MYMUL (x, y)
TYPE2, intent(in) :: x
TYPE3, intent(in) :: y
MYMUL = x * y
return
end function
#undef MYMUL
#endif
#undef TYPE1
#undef TYPE2
#undef TYPE3
#endif
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment