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

13
src/amap.f90
View file

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

19
src/rpn_stack.f90
View file

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

28
src/rpn_stack_sm.f90
View file

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