From 07e8fa9d6a7f139929e7656df8af97e4382ef4cc Mon Sep 17 00:00:00 2001 From: sgeard Date: Tue, 13 Jun 2023 20:23:38 +0100 Subject: [PATCH] Change all real(8) to real(real64) --- app/main.f90 | 46 ++++++++++++++++++++++---------------------- src/amap.f90 | 13 +++++++------ src/rpn_stack.f90 | 19 +++++++++--------- src/rpn_stack_sm.f90 | 28 +++++++++++++-------------- 4 files changed, 54 insertions(+), 52 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 09715d6..cceff19 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -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. diff --git a/src/amap.f90 b/src/amap.f90 index b83b291..fab7974 100644 --- a/src/amap.f90 +++ b/src/amap.f90 @@ -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 diff --git a/src/rpn_stack.f90 b/src/rpn_stack.f90 index 8380236..88015bf 100644 --- a/src/rpn_stack.f90 +++ b/src/rpn_stack.f90 @@ -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 diff --git a/src/rpn_stack_sm.f90 b/src/rpn_stack_sm.f90 index f9e9356..68c9583 100644 --- a/src/rpn_stack_sm.f90 +++ b/src/rpn_stack_sm.f90 @@ -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