module MW_kinds
   ! Define kinds parameters for use throughout the code

   ! This modules defines four real kinds parameters (real4, real8,
   ! real10, real16), five integer kinds parameters (int1, int2, int4, int8, int16)
   !

   ! GNU Fortran compiler 4.8.4
   ! --------------------------

   ! kind  | digits | radix | range | huge
   ! ------+--------+-------+-------+-----
   ! int1  |      7 |     2 |     2 | 2^7   - 1 = 127
   ! int2  |     15 |     2 |     4 | 2^15  - 1 = 32767
   ! int4  |     31 |     2 |     9 | 2^31  - 1 = 2147483647
   ! int8  |     63 |     2 |    18 | 2^63  - 1 = 9223372036854775807
   ! int16 |    127 |     2 |    38 | 2^127 - 1 = 170141183460469231731687303715884105727 = 1.7e38

   ! kind  | dig | rad | range | prec |  max |  min |   epsilon   |     huge    |    tiny     |
   !       |     |     |       |      |  exp |  exp |             |             |             |
   ! ------+-----+-----+-------+------+-----+-----+-------------+-------------+-------------+-
   ! real4 |  24 |   2 |    37 |    6 |  128 | -125 | 1.19209E-07 | 3.40282E+38 | 1.17549E-38 |
   ! real8 |  53 |   2 |   307 |   15 | 1024 |-1021 | 2.22044E-16 | 1.79769E+308| 2.2250E-308 |
   ! real10|  64 |   2 |  4931 |   18 | 16384|-16381| 1.08420E-19 | 1.1893E+4932| 3.362E-4932 |
   ! real16| 113 |   2 |  4931 |   33 | 16384|-16381| 1.92592E-34 | 1.1897E+4932| 3.362E-4932 |

   ! See at the end of this file for a complete description of the
   ! integer and real representation model in Fortran.

   use iso_fortran_env, only: output_unit

   implicit none
   private

   public :: real4, real8  ! real kind parameters
   public :: sp, dp, wp        ! real kind parameters alias

#ifdef MW_use_real16
   public :: real16, qd  ! real kind parameters and alias
#endif
#ifdef MW_use_real10
   public :: real10, ep  ! real kind parameters and alias
#endif

   public :: int1, int2, int4, int8        ! integer kind parameters
#ifdef MW_USE_INT16
   public :: int16 ! integer kind parameters
#endif
   public :: kinds_inquire                 ! subroutine to print out number model parameters
   public :: PARTICLE_NAME_LEN


   ! real kind parameters
   integer, parameter :: real4 = selected_real_kind(p=6)
   integer, parameter :: real8 = selected_real_kind(p=15)
#ifdef MW_use_real10
   integer, parameter :: real10 = selected_real_kind(p=18)
#endif
#ifdef MW_use_real16
   integer, parameter :: real16 = selected_real_kind(p=33)
#endif
   ! real kind parameters alias
   integer, parameter :: sp = real4  ! 32 bits  single precision (equivalent to real default)
   integer, parameter :: dp = real8  ! 64 bits  double precision (equivalent to double precision)
#ifdef MW_use_real10
   integer, parameter :: ep = real10 ! 80 bits  extended precision
#endif
#ifdef MW_use_real16
   integer, parameter :: qd = real16 ! 128 bits quadruple precision
#endif
   ! integer kind parameters
   integer, parameter :: int1 = selected_int_kind(r=2)
   integer, parameter :: int2 = selected_int_kind(r=4)
   integer, parameter :: int4 = selected_int_kind(r=9)
   integer, parameter :: int8 = selected_int_kind(r=18)
#ifdef MW_USE_INT16
   integer, parameter :: int16 = selected_int_kind(r=38)
#endif

   ! working kind parameters
   integer, parameter :: wp = dp

   ! format specification to show real values with full precision
   character(len=8), parameter :: real4_fmt = "es12.5e2"
   character(len=9), parameter :: real8_fmt = "es22.14e3"
#ifdef MW_use_real10
   character(len=9), parameter :: real10_fmt = "es26.17e4"
#endif
#ifdef MW_use_real16
   character(len=9), parameter :: real16_fmt = "es41.32e4"
#endif

   ! format specification to show integer values with full precision
   character(len=2), parameter :: int1_fmt = "i4"
   character(len=2), parameter :: int2_fmt = "i5"
   character(len=3), parameter :: int4_fmt = "i10"
   character(len=3), parameter :: int8_fmt = "i19"
#ifdef MW_USE_INT16
   character(len=3), parameter :: int16_fmt = "i39"
#endif

   ! generic interface to kinds_inquire subroutines
   interface kinds_inquire
      module procedure kinds_inquire_real4
      module procedure kinds_inquire_real8
#ifdef MW_use_real10
      module procedure kinds_inquire_real10
#endif
#ifdef MW_use_real16
      module procedure kinds_inquire_real16
#endif
      module procedure kinds_inquire_int1
      module procedure kinds_inquire_int2
      module procedure kinds_inquire_int4
      module procedure kinds_inquire_int8
#ifdef MW_USE_INT16
      module procedure kinds_inquire_int16
#endif
   end interface kinds_inquire

   ! character length
   integer, parameter :: PARTICLE_NAME_LEN = 8

contains

   subroutine kinds_inquire_real4(x, funit)
      real(kind=real4),  intent(in) :: x
      integer, optional, intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for real(kind=real4):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  precision(x)   = ", i9)') precision(x)
      write(ounit,'("  maxexponent(x) = ", i9)') maxexponent(x)
      write(ounit,'("  minexponent(x) = ", i9)') minexponent(x)
      write(ounit,'("  epsilon(x)     = ",'// real4_fmt //')') epsilon(x)
      write(ounit,'("  huge(x)        = ",'// real4_fmt //')') huge(x)
      write(ounit,'("  tiny(x)        = ",'// real4_fmt //')') tiny(x)
      write(ounit,*)

   end subroutine kinds_inquire_real4

   subroutine kinds_inquire_real8(x, funit)
      real(kind=real8), intent(in) :: x
      integer, optional, intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for real(kind=real8):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  precision(x)   = ", i9)') precision(x)
      write(ounit,'("  maxexponent(x) = ", i9)') maxexponent(x)
      write(ounit,'("  minexponent(x) = ", i9)') minexponent(x)
      write(ounit,'("  epsilon(x)     = ",'// real8_fmt //')') epsilon(x)
      write(ounit,'("  huge(x)        = ",'// real8_fmt //')') huge(x)
      write(ounit,'("  tiny(x)        = ",'// real8_fmt //')') tiny(x)
      write(ounit,*)

   end subroutine kinds_inquire_real8

#ifdef MW_USE_real10
   subroutine kinds_inquire_real10(x, funit)
      real(kind=real10), intent(in) :: x
      integer, optional, intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for real(kind=real10):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  precision(x)   = ", i9)') precision(x)
      write(ounit,'("  maxexponent(x) = ", i9)') maxexponent(x)
      write(ounit,'("  minexponent(x) = ", i9)') minexponent(x)
      write(ounit,'("  epsilon(x)     = ",'// real10_fmt //')') epsilon(x)
      write(ounit,'("  huge(x)        = ",'// real10_fmt //')') huge(x)
      write(ounit,'("  tiny(x)        = ",'// real10_fmt //')') tiny(x)
      write(ounit,*)

   end subroutine kinds_inquire_real10
#endif
#ifdef MW_use_real16
   subroutine kinds_inquire_real16(x, funit)
      real(kind=real16), intent(in) :: x
      integer, optional, intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for real(kind=real16):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  precision(x)   = ", i9)') precision(x)
      write(ounit,'("  maxexponent(x) = ", i9)') maxexponent(x)
      write(ounit,'("  minexponent(x) = ", i9)') minexponent(x)
      write(ounit,'("  epsilon(x)     = ",'// real16_fmt //')') epsilon(x)
      write(ounit,'("  huge(x)        = ",'// real16_fmt //')') huge(x)
      write(ounit,'("  tiny(x)        = ",'// real16_fmt //')') tiny(x)
      write(ounit,*)

   end subroutine kinds_inquire_real16
#endif

   subroutine kinds_inquire_int1(x, funit)
      integer(kind=int1), intent(in) :: x
      integer, optional,  intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for integer(kind=int1):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  huge(x)        = ",'// int1_fmt //')') huge(x)
      write(ounit,*)

   end subroutine kinds_inquire_int1

   subroutine kinds_inquire_int2(x, funit)
      integer(kind=int2), intent(in) :: x
      integer, optional,  intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for integer(kind=int2):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  huge(x)        = ",'// int2_fmt //')') huge(x)
      write(ounit,*)

   end subroutine kinds_inquire_int2

   subroutine kinds_inquire_int4(x, funit)
      integer(kind=int4), intent(in) :: x
      integer, optional,  intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for integer(kind=int4):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  huge(x)        = ",'// int4_fmt //')') huge(x)
      write(ounit,*)

   end subroutine kinds_inquire_int4

   subroutine kinds_inquire_int8(x, funit)
      integer(kind=int8), intent(in) :: x
      integer, optional,  intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for integer(kind=int8):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  huge(x)        = ",'// int8_fmt //')') huge(x)
      write(ounit,*)

   end subroutine kinds_inquire_int8

#ifdef MW_USE_INT16
   subroutine kinds_inquire_int16(x, funit)
      integer(kind=int16), intent(in) :: x
      integer, optional,   intent(in) :: funit

      integer :: ounit

      if (present(funit)) then
         ounit = funit
      else
         ounit = output_unit
      end if

      write(ounit,'("Model parameters for integer(kind=int16):")')
      write(ounit,'("  digits(x)      = ", i9)') digits(x)
      write(ounit,'("  radix(x)       = ", i9)') radix(x)
      write(ounit,'("  range(x)       = ", i9)') range(x)
      write(ounit,'("  huge(x)        = ",'// int16_fmt //')') huge(x)
      write(ounit,*)

   end subroutine kinds_inquire_int16
#endif
end module MW_kinds


! "The Fortran 2003 Handbook
! The Complete Syntax, Features and Procedures"
! Jeanne C. Adams, Walter S. Brainerd, Richard A. Hendrickson, Richard
! E. Maine, Jeanne T. Martin, Brian T. Smith
! Springer
! DOI: 10.1007/978-1-84628-746-6
!
! Representation Models
! =====================

! Some of the intrinsic functions compute values related to how data
! is represented.  These values are based upon and determined by the
! underlying *representation model*.  There are three such models :
! the *bit model*, the *integer number system model*, and the *real
! number system model*.

! These models, and the corresponding functions, return values related
! to the models, allowing development of robust and portable code.
! For example, by obtaining information about the spacing of real
! numbers, the convergence of a numerical algorithm can be controlled
! so that maximum accuracy may be achieved while attaining
! convergence.

! In a given implementation the model parameters are chosen to match
! the implementation as closely as possible, but an exact match is not
! required and the model does not impose any particular arithmetic on
! the implementation.

! The Integer Number System Model
! -------------------------------

! The integer number system is modeled by
!
! i = s * sum_{k=0}^{q-1}(w_k * r^k)
!
! where
!
!   i   is the integer value
!   s   is the sign (+1 or -1)
!   r   is the base and is an integer greater than 1
!   q   is the number of digits and is an integer greater than 0
!   w_k is the kth digit and is an integer in [0,r[
!
! A common model for processors that use 4 bytes for integers is: q=31
! and r=2.

! The Real Number System Model
! ----------------------------

! The real number system is modeled by
!
! x = s * b^e * sum_{k=1}^{p}(f_k * b^{-k})
!
! where
!
!   x   is the real value
!   s   is the sign (+1 or -1)
!   b   is the base (real radix) and is an integer greater than 1
!   e   is an integer between some minimum and maximum value
!   p   is the number of mantissa digits and is an integer greater than 1
!   f_k is the kth digit and is an integer in [0,b[
!          but f_1 may be zero only if e and all the f_k are zero

! One common implementation is the IEEE binary floating-point standard
! which has single precision model numbers with:

!   b = 2
!   p = 24
!   -125 <= e <= 128

! This IEEE standard does not represent f_1, which is presumed to be
! 1. Thus, the mantissa, including its sign, can be represented in 24
! bits. The exponent, including its sign, takes 8 bits, for a total of
! 32 bits in the single precision representation.  What normally would
! be an exponent value of -127 or -126 is not included in the exponent
! range; rather, IEEE uses these cases to identify the real value zero
! (the one case in which f_1 is 0), out-of-range values (infinites),
! or NaNs (not a number, illegal values). It should be noted that the
! specific model described above where b=2, p=24, e_max=128 and
! e_min=-125 is not the specific model used in the Fortran 2003
! standard where b=2, p=24, e_min=-126 and e_max=127.

! The numeric inquiry and manipulation functions return information
! about the real number system model pertaining to an
! implementation. The IEEE intrinsic module procedures permit a more
! precise manipulation of floating-point values that are of IEEE
! (arithmetic type). On the other hand, the numeric computation and
! manipulation intrinsic functions assume or in some cases specify
! that the results are processor dependent when the result value would
! exceed the range of floating-point representable values.
