iamstupid/hp
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Change all real(8) to real(real64)

Browse source
This commit is contained in:
sgeard 2023-06-13 20:23:38 +01:00
parent bd8b75111c
commit 07e8fa9d6a
4 changed files with 54 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
app/main.f90
View file

@ -5,7 +5,7 @@ program hp15c
implicit none
real(8) :: x
real(real64) :: x
integer :: ios, i
integer :: verbosity = 0
character(100) :: buff
@ -13,16 +13,16 @@ program hp15c
integer :: argl, argc
type(llist) :: tokens
real(8), parameter :: ag = 9.80665d0
real(8), parameter :: g = 6.67430d-11
real(8), parameter :: e = exp(1.0d0)
real(8), parameter :: c = 2.99792458d8
real(real64), parameter :: ag = 9.80665d0
real(real64), parameter :: g = 6.67430d-11
real(real64), parameter :: e = exp(1.0d0)
real(real64), parameter :: c = 2.99792458d8
type(amap_t) :: constants
type(amap_t) :: stats
integer :: in_sequence = 0
logical :: seq_is_x
real(8), allocatable :: x_seq(:), y_seq(:)
real(real64), allocatable :: x_seq(:), y_seq(:)
integer :: n_seq = 0
logical :: veMode = .false.
@ -203,9 +203,9 @@ contains
character(*), intent(in) :: command
logical, intent(out) :: ok
real(8) :: r, im
real(real64) :: r, im
complex(8) :: u, z
real(8), allocatable :: tmp_seq(:)
real(real64), allocatable :: tmp_seq(:)
type(rpn_t) :: us, zs
integer :: m, idx
@ -679,8 +679,8 @@ contains
end subroutine apply_command
subroutine calculate_stats
real(8) :: a, b, c, sxy
real(8) :: s(5,2)
real(real64) :: a, b, c, sxy
real(real64) :: s(5,2)
call summary_stats(x_seq(1:n_seq),s(1,1),s(2,1),s(3,1),s(4,1),s(5,1))
call stats%set('n',real(n_seq,8))
@ -726,9 +726,9 @@ contains
end subroutine calculate_stats
subroutine calculate_regression(mean_x, mean_y, a, b, c, sxy)
real(8), intent(in) :: mean_x, mean_y
real(8), intent(out) :: a, b, c, sxy
real(8) :: sxx, syy
real(real64), intent(in) :: mean_x, mean_y
real(real64), intent(out) :: a, b, c, sxy
real(real64) :: sxx, syy
sxy = sum(x_seq(1:n_seq)*y_seq(1:n_seq))/n_seq - mean_x*mean_y
sxx = sum(x_seq(1:n_seq)*x_seq(1:n_seq))/n_seq - mean_x**2
syy = sum(y_seq(1:n_seq)*y_seq(1:n_seq))/n_seq - mean_y**2
@ -739,8 +739,8 @@ contains
subroutine print_value(name, x, y)
character(len=*), intent(in) :: name
real(8), intent(in) :: x
real(8), intent(in), optional :: y
real(real64), intent(in) :: x
real(real64), intent(in), optional :: y
character(len=:), allocatable :: fmt_x, fmt_y
call to_string(x, fmt_x)
if (present(y)) then
@ -751,10 +751,10 @@ contains
end subroutine print_value
subroutine summary_stats(a, mean, median, stddev, lower_q, upper_q)
real(8), intent(in) :: a(:)
real(8), intent(out) :: mean, median, stddev, lower_q, upper_q
real(8) :: b(size(a))
real(8) :: s, s2
real(real64), intent(in) :: a(:)
real(real64), intent(out) :: mean, median, stddev, lower_q, upper_q
real(real64) :: b(size(a))
real(real64) :: s, s2
integer :: m, n
n = size(a)
b = a
@ -778,9 +778,9 @@ contains
end subroutine summary_stats
function calc_median(a, mid) result(r)
real(8), intent(in) :: a(:)
real(real64), intent(in) :: a(:)
integer, intent(out), optional :: mid
real(8) :: r
real(real64) :: r
integer :: m, n
n = size(a)
m = n/2
@ -797,8 +797,8 @@ contains
! 'a' won't be very big so a simple n**2 algorithm will do
subroutine sort(a)
real(8), intent(inout) :: a(:)
real(8) :: b(size(a))
real(real64), intent(inout) :: a(:)
real(real64) :: b(size(a))
integer :: i, j(size(a))
logical :: mask(size(a))
mask = .true.

13
src/amap.f90
View file

@ -1,5 +1,6 @@
! Associative map string -> real(8)
! Associative map string -> real(real64)
module amap
use iso_fortran_env, only: real64
implicit none
! The key
@ -18,7 +19,7 @@ module amap
! The value
type value_t
private
real(8) :: v = huge(0.0d0) ! An out-of-band value
real(real64) :: v = huge(0.0d0) ! An out-of-band value
contains
procedure, private :: write_value_t
generic, public :: write(formatted) => write_value_t
@ -77,7 +78,7 @@ contains
subroutine set_to_value_t(this, v)
class(value_t), intent(inout) :: this
real(8), intent(in) :: v
real(real64), intent(in) :: v
this%v = v
end subroutine set_to_value_t
@ -93,7 +94,7 @@ contains
subroutine set_amap_t(this,kv,vv)
class(amap_t), intent(inout) :: this
character(len=*), intent(in) :: kv
real(8), intent(in) :: vv
real(real64), intent(in) :: vv
type(pair_t), allocatable :: tmp_pairs(:)
type(key_t) :: k
type(value_t) :: v
@ -151,7 +152,7 @@ contains
function get_value_amap_t(this, kv) result(r)
class(amap_t), intent(in) :: this
character(len=*), intent(in) :: kv
real(8) :: r
real(real64) :: r
type(value_t) :: s
s = this%get(kv)
r = s%v
@ -180,7 +181,7 @@ contains
function equals_value_t(this, v) result(r)
class(value_t), intent(in) :: this
real(8), intent(in) :: v
real(real64), intent(in) :: v
logical :: r
r = this%v == v
end function equals_value_t

19
src/rpn_stack.f90
View file

@ -1,4 +1,5 @@
module rpn_stack
use iso_fortran_env, only: real64
implicit none
! Type for the data that's going on to the stack
@ -75,7 +76,7 @@ module rpn_stack
end subroutine push_stackt
module subroutine push_r_stackt(stk, x)
class(stack_t(*)), intent(inout) :: stk
real(8) :: x
real(real64) :: x
end subroutine push_r_stackt
module subroutine push_all_stackt(stk, z, is_cart)
class(stack_t(*)), intent(inout) :: stk
@ -175,14 +176,14 @@ module rpn_stack
end function divide_rpns
module function power_rpns(this, x) result(r)
class(rpn_t), intent(in) :: this
real(8), intent(in) :: x
real(real64), intent(in) :: x
type(rpn_t) :: r
end function power_rpns
end interface
real(8), parameter :: pi = 4*atan(1.0d0)
real(8), parameter :: to_rad = pi/180
real(8), parameter :: to_deg = 180/pi
real(real64), parameter :: pi = 4*atan(1.0d0)
real(real64), parameter :: to_rad = pi/180
real(real64), parameter :: to_deg = 180/pi
character(5), private :: decimal = 'POINT'
@ -195,7 +196,7 @@ module rpn_stack
integer :: dec_places = 6
logical :: degrees_mode = .true.
logical :: complex_mode = .false.
real(8) :: eps = 1.0d-14
real(real64) :: eps = 1.0d-14
! Functions interface
interface
@ -413,8 +414,8 @@ module rpn_stack
end function atangent2_fr
module function round(x) result(r)
real(8), intent(in) :: x
real(8) ::r
real(real64), intent(in) :: x
real(real64) ::r
end function round
module subroutine init(lang)
@ -430,7 +431,7 @@ module rpn_stack
end function get_places
module subroutine to_string(x, str)
real(8), intent(in) :: x
real(real64), intent(in) :: x
character(len=:), allocatable, intent(out) :: str
end subroutine to_string
end interface

28
src/rpn_stack_sm.f90
View file

@ -45,7 +45,7 @@ contains
module subroutine push_r_stackt(stk, x)
class(stack_t(*)), intent(inout) :: stk
real(8) :: x
real(real64) :: x
type(rpn_t) :: z
z = rpn_t(cmplx(x,0.0d0))
call stk%push_stackt(z)
@ -176,7 +176,7 @@ contains
! Convert real to string inserting a leading 0 if necessary
module subroutine to_string(x, str)
real(8), intent(in) :: x
real(real64), intent(in) :: x
character(len=:), allocatable, intent(out) :: str
character(len=32) :: s
s = ' '
@ -200,7 +200,7 @@ contains
module function is_integer_rpns(this) result(r)
class(rpn_t), intent(in) :: this
logical :: r
real(8) :: x
real(real64) :: x
x = this%zdata%re
r = (abs(nint(x)-x) < eps .and. abs(this%zdata%im) < eps)
end function is_integer_rpns
@ -354,7 +354,7 @@ contains
module function power_rpns(this, x) result(r)
class(rpn_t), intent(in) :: this
real(8), intent(in) :: x
real(real64), intent(in) :: x
type(rpn_t) :: r
type(rpn_t) :: z
logical :: is_cart
@ -373,8 +373,8 @@ contains
module function to_cartesian_rpns(stk_z) result(r)
type(rpn_t), intent(in) :: stk_z
type(rpn_t) :: r
real(8) :: s
real(8) :: theta
real(real64) :: s
real(real64) :: theta
if (.not. stk_z%is_cartesian()) then
s = stk_z%zdata%re
theta = stk_z%zdata%im * merge(to_rad,1.0d0,degrees_mode)
@ -398,8 +398,8 @@ contains
contains
complex(8) function to_polar_internal(z)
complex(8), intent(in) :: z
real(8) :: r
real(8) :: theta
real(real64) :: r
real(real64) :: theta
r = sqrt(real(z * conjg(z),8))
theta = atan2(aimag(z), real(z))
to_polar_internal%re = r
@ -497,7 +497,7 @@ contains
module function swap_real_imaginary_fr(a) result(r)
type(rpn_t), intent(in) :: a
type(rpn_t) :: r
real(8) :: x
real(real64) :: x
r = a
x = r%zdata%re
r%zdata%re = r%zdata%im
@ -650,13 +650,13 @@ contains
type(rpn_t), intent(in) :: a
type(rpn_t), intent(in) :: b
type(rpn_t) :: r
real(8) :: bc
real(real64) :: bc
integer :: i
type(rpn_t) :: base
complex(8) :: z
logical :: a_is_cart
real(8) :: s, delta_theta, theta0, phi
real(8), parameter :: two_pi = 8*atan(1.0d0)
real(real64) :: s, delta_theta, theta0, phi
real(real64), parameter :: two_pi = 8*atan(1.0d0)
bc = real(b%get_value())
r = power_fr(a, rpn_t(1.0d0/bc))
@ -728,8 +728,8 @@ contains
end function atangent2_fr
module function round(x) result(r)
real(8), intent(in) :: x
real(8) :: r
real(real64), intent(in) :: x
real(real64) :: r
if (abs(x) < eps) then
r = 0
else