From afa3cdf147ff32cad988a945abd5bf6fa720b740 Mon Sep 17 00:00:00 2001 From: pmocz Date: Wed, 28 Aug 2024 16:36:44 -0400 Subject: [PATCH 1/4] clean up some warnings in astero and others (unused var, int division) --- astero/private/adipls_support.f90 | 13 ++++++------- astero/private/adipls_support_procs.f90 | 2 +- astero/private/astero_support.f90 | 12 +++++------- astero/private/extras_support.f90 | 12 +++++------- astero/private/pgstar_astero_plots.f90 | 9 +++------ astero/public/astero_def.f90 | 7 ++----- eos/private/eosdt_eval.f90 | 4 +--- eos/private/ideal.f90 | 2 -- eos/test/src/eos_support.f90 | 1 - kap/private/kap_ctrls_io.f90 | 2 -- kap/private/load_kap.f90 | 2 -- kap/private/op_eval_mombarg.f90 | 4 ++-- kap/private/op_load.f | 5 ++--- kap/private/op_load_master.f | 2 +- kap/public/kap_def.f90 | 2 +- mtx/test/src/test_mtx_support.f90 | 3 +-- num/test/src/bari_beam.f | 2 +- num/test/src/test_newton.f90 | 2 +- num/test/src/test_newuoa.f90 | 2 +- num/test/src/test_support.f90 | 3 +-- star/private/report.f90 | 1 - 21 files changed, 34 insertions(+), 58 deletions(-) diff --git a/astero/private/adipls_support.f90 b/astero/private/adipls_support.f90 index 7dbdcd4b2..457dd338c 100644 --- a/astero/private/adipls_support.f90 +++ b/astero/private/adipls_support.f90 @@ -79,9 +79,9 @@ subroutine do_adipls_get_one_el_info( & integer, intent(out) :: ierr real(dp) :: sig_fac - integer :: nsel, itrsig, nsig, irotkr, nprtkr, igm1kr, npgmkr + integer :: nsel, itrsig, nsig real(dp) :: els1, dels, sig1, sig2, dfsig - integer :: k, i, j + integer :: i, j integer, pointer :: index(:) logical, parameter :: dbg = .false. @@ -181,7 +181,7 @@ subroutine adipls_mode_info( & real(dp), intent(in) :: freq, inertia integer, intent(in) :: nn, iy, iaa, ispcpr real(dp), intent(in) :: x(1:nn), y(1:iy,1:nn), aa(1:iaa,1:nn), data(8) - integer :: iounit, ierr, i, j, skip + integer :: iounit, ierr, i, skip real(dp) :: y_r, y_h include 'formats' if (use_other_adipls_mode_info) then @@ -235,7 +235,7 @@ subroutine store_model_for_adipls (s, add_atmosphere, do_redistribute_mesh, ierr common/ccgrav/ cgrav real(dp) :: cgrav - integer :: i, iriche, iturpr + integer :: iriche, iturpr integer :: iconst, ivar, ivers, nn_in real(dp), allocatable :: global_data(:) ! (iconst) real(dp), allocatable :: point_data(:,:) ! (ivar,nn_in) @@ -707,7 +707,7 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr) integer, intent(out) :: nn, ierr ! local - integer :: i, j, nsin, iggt, inp, in, nshift, nnr, n, n1, nstart, idata8 + integer :: i, j, nsin, iggt, nshift, nnr, n, n1, idata8 logical :: sincen, sinsur real(dp), pointer :: aa1(:,:) real(dp) :: ggt @@ -926,8 +926,7 @@ subroutine read_fgong_file(fin, nn, iconst, ivar, ivers, glob, var, ierr) real(dp), pointer :: var(:,:) ! (ivar,nn) will be allocated integer, intent(out) :: ierr - real(dp), pointer :: var1(:,:) ! (ivar,nn) - integer :: ios, iounit, i, n, ir, nn1 + integer :: ios, iounit, i, n character(80) :: head 120 format(4i10) diff --git a/astero/private/adipls_support_procs.f90 b/astero/private/adipls_support_procs.f90 index b6e165908..2ef742898 100644 --- a/astero/private/adipls_support_procs.f90 +++ b/astero/private/adipls_support_procs.f90 @@ -45,7 +45,7 @@ subroutine spcout_adi(x,y,aa,data,nn,iy,iaa,ispcpr) real(dp) :: csummm(50) common/csumma/ csummm - integer :: icobs_st, nobs_st, i + integer :: icobs_st, nobs_st real(dp) :: obs_st(10,100000) ! huge 2nd dimension to satisfy bounds checking integer :: ierr, new_el, new_order, new_em, n diff --git a/astero/private/astero_support.f90 b/astero/private/astero_support.f90 index 0be7ffdc3..0d891469e 100644 --- a/astero/private/astero_support.f90 +++ b/astero/private/astero_support.f90 @@ -69,12 +69,11 @@ subroutine get_one_el_info( & character (len=*), intent(in) :: code integer, intent(out) :: ierr - real(dp) :: nu_obs, dist_j, nu, dist, min_dist, min_freq, & - R, G, M, sig_fac, b, sum_1, sum_2, sum_3, empty(0) - integer :: min_dist_j, min_order, n, cnt, int_empty(0), int_empty2(0) + real(dp) :: dist, min_dist, R, G, M, sig_fac, b, sum_1, sum_2, sum_3, empty(0) + integer :: min_dist_j, cnt, int_empty(0), int_empty2(0) integer :: nsel, itrsig, nsig real(dp) :: els1, dels, sig1, sig2, dfsig - integer :: num_l0_terms, k, i, j + integer :: i, j integer, pointer :: index(:) include 'formats' @@ -597,8 +596,7 @@ subroutine init_obs_data(ierr) integer, intent(out) :: ierr integer :: i, cnt, norders - integer, dimension(max_nl) :: orders - real(dp) :: sum_1, sum_2, sum_3, range, nmax + real(dp) :: sum_1, sum_2, range, nmax real(dp) :: x, y, isig2, sum_xy, sum_x, sum_y, sum_x2, sum_isig2, d logical, parameter :: dbg = .false. @@ -1393,7 +1391,7 @@ real(dp) function get_chi2(s, max_el, trace_okay, ierr) integer, intent(out) :: ierr integer :: i, l, n, chi2N1, chi2N2 - real(dp) :: chi2term, Teff, logL, chi2sum1, chi2sum2, frac, & + real(dp) :: chi2term, chi2sum1, chi2sum2, frac, & model_r01, model_r10, model_r02 ! calculate chi^2 following Brandao et al, 2011, eqn 11 diff --git a/astero/private/extras_support.f90 b/astero/private/extras_support.f90 index fd953c1b3..c6490b9b2 100644 --- a/astero/private/extras_support.f90 +++ b/astero/private/extras_support.f90 @@ -66,8 +66,8 @@ integer function do_astero_extras_check_model(s, id) integer :: max_el_for_chi2, ierr, i, j, l, n logical :: store_model, checking_age - real(dp) :: age_limit, model_limit, err, target_l0, X, Y, Z, & - frac, surface_X, surface_Z, chi2_freq_and_ratios_fraction, & + real(dp) :: age_limit, model_limit, & + frac, chi2_freq_and_ratios_fraction, & remaining_years, prev_max_years, min_max include 'formats' @@ -676,7 +676,7 @@ end function do_astero_extras_check_model real(dp) function get_chi2_spectro(s) type (star_info), pointer :: s integer :: cnt, i - real(dp) :: logL, sum + real(dp) :: sum include 'formats' cnt = 0 sum = 0 @@ -866,8 +866,7 @@ subroutine write_best(num) integer, intent(in) :: num integer :: ierr, iounit character (len=256) :: format_string, num_string, filename - integer, parameter :: max_len_out = 2000 - character (len=max_len_out) :: script + integer, parameter :: max_len_out = 2000 ierr = 0 iounit = alloc_iounit(ierr) if (ierr /= 0) return @@ -1094,7 +1093,6 @@ subroutine astero_data_for_extra_profile_columns( & character (len=maxlen_profile_column_name) :: astero_names(n) real(dp) :: vals(nz,n) integer, intent(out) :: ierr - integer :: k ierr = 0 call star_astero_procs% data_for_extra_profile_columns( & id, n, nz, astero_names, vals, ierr) @@ -1177,7 +1175,7 @@ subroutine move_extra_info(s,op) type (star_info), pointer :: s integer, intent(in) :: op - integer :: i, j, num_ints, num_dbls, ierr + integer :: i, num_ints, num_dbls, ierr i = 0 ! call move_int or move_flg diff --git a/astero/private/pgstar_astero_plots.f90 b/astero/private/pgstar_astero_plots.f90 index 7530c4797..154e7bc1f 100644 --- a/astero/private/pgstar_astero_plots.f90 +++ b/astero/private/pgstar_astero_plots.f90 @@ -137,9 +137,8 @@ subroutine do_echelle_plot( & integer, intent(out) :: ierr type (star_info), pointer :: s - real :: xmin, xmax, ymin, ymax, dx, dy, plot_delta_nu, freq, marker_scale, & + real :: xmin, xmax, ymin, ymax, dx, dy, plot_delta_nu, marker_scale, & x_obs, y_obs, x_model, y_model, y_txt, xpt_min, xpt_max, xmargin - character (len=256) :: str integer :: i, l, freq_color(0:3), freq_shape(0:3), model_color, model_shape include 'formats' @@ -410,9 +409,8 @@ subroutine do_ratios_plot( & integer, intent(out) :: ierr type (star_info), pointer :: s - real :: xmin, xmax, ymin, ymax, dx, dy, freq, & - x_obs, y_obs, x_model, y_model, y_txt, sig_max - character (len=256) :: str + real :: xmin, xmax, ymin, ymax, dx, dy, & + x_obs, y_obs, y_txt, sig_max logical :: show_model integer :: i, n, i0, i1, l0_first, l1_first, & r01_color, r01_shape, r10_color, r10_shape, & @@ -627,7 +625,6 @@ subroutine write_plot_to_file(s, p, file_prefix, number, ierr) integer, intent(out) :: ierr character (len=256) :: format_string, num_str, name, extension - integer :: len ierr = 0 diff --git a/astero/public/astero_def.f90 b/astero/public/astero_def.f90 index f2628cb3f..ede83e7dd 100644 --- a/astero/public/astero_def.f90 +++ b/astero/public/astero_def.f90 @@ -963,7 +963,6 @@ recursive subroutine read1_astero_pgstar_inlist(filename, level, ierr) integer, intent(out) :: ierr logical, dimension(max_extra_inlists) :: read_extra - character (len=strlen) :: message character (len=strlen), dimension(max_extra_inlists) :: extra integer :: unit, i @@ -1167,7 +1166,7 @@ subroutine show1_sample_results(i, iounit) use num_lib, only: simplex_info_str integer, intent(in) :: i, iounit - integer :: j, k, l, op_code, ierr + integer :: k, l, op_code, ierr character (len=256) :: info_str, fmt ierr = 0 @@ -1270,7 +1269,6 @@ subroutine show_all_sample_results(iounit, i_total, ierr) integer, intent(in) :: iounit, i_total integer, intent(out) :: ierr integer :: i, j - character (len=strlen) :: int_fmt, txt_fmt ierr = 0 ! sort results by increasing sample_chi2 @@ -1513,7 +1511,7 @@ subroutine read_samples_from_file(results_fname, ierr) use utils_lib character (len=*), intent(in) :: results_fname integer, intent(out) :: ierr - integer :: iounit, num, i, j, model_number + integer :: iounit, num, j character (len=strlen) :: line include 'formats' @@ -1595,7 +1593,6 @@ subroutine read1_sample_from_file(j, iounit, ierr) integer :: i, k, l character (len=256) :: info_str, fmt - real(dp) :: logR include 'formats' diff --git a/eos/private/eosdt_eval.f90 b/eos/private/eosdt_eval.f90 index fc8afd6f8..334605582 100644 --- a/eos/private/eosdt_eval.f90 +++ b/eos/private/eosdt_eval.f90 @@ -1075,14 +1075,12 @@ subroutine get_opal_scvh_alfa_and_partials( & real(dp) :: logRho1_max, logRho1, logRho2, logRho5, logRho6, logRho7, & logRho8, logT5, logT6, logT3, logT4 real(dp) :: logQ1, logQ2, logQ3, logQ4, logQmax, Z_all_HELM, Z_no_HELM - real(dp) :: beta, logRho_lo, logRho_hi, & + real(dp) :: beta, & logT1, logT2, logT7, logT8, logRho3, logRho4 real(dp) :: logQ, A, B, dA_dlnT, dA_dlnRho, dB_dlnT, dB_dlnRho real(dp) :: c_dx, c_dy, d_dx_dlogT, d_dx_dlogRho, d_dy_dlogT, d_dy_dlogRho real(dp), parameter :: tiny = 1d-20 - logical :: debug - include 'formats' logRho1_max = 3.71d0 diff --git a/eos/private/ideal.f90 b/eos/private/ideal.f90 index e1e05e4f8..44bc682fd 100644 --- a/eos/private/ideal.f90 +++ b/eos/private/ideal.f90 @@ -72,8 +72,6 @@ subroutine get_ideal_eos_results( & integer, intent(out) :: ierr real(dp), intent(out), dimension(nv) :: res, d_dlnd, d_dlnT real(dp), intent(out), dimension(nv, species) :: d_dxa - - real(dp) :: logT_ion, logT_neutral ierr = 0 diff --git a/eos/test/src/eos_support.f90 b/eos/test/src/eos_support.f90 index a00a45721..0b9a4e54a 100644 --- a/eos/test/src/eos_support.f90 +++ b/eos/test/src/eos_support.f90 @@ -104,7 +104,6 @@ subroutine Setup_eos character (len=256) :: my_mesa_dir integer :: info - real(dp) :: logT_all_HELM, logT_all_OPAL logical :: use_cache info = 0 diff --git a/kap/private/kap_ctrls_io.f90 b/kap/private/kap_ctrls_io.f90 index 50629d7a0..22fa0fdd5 100644 --- a/kap/private/kap_ctrls_io.f90 +++ b/kap/private/kap_ctrls_io.f90 @@ -144,7 +144,6 @@ subroutine read_namelist(handle, inlist, ierr) character (len=*), intent(in) :: inlist integer, intent(out) :: ierr ! 0 means AOK. type (Kap_General_Info), pointer :: rq - integer :: iz, j include 'formats' call get_kap_ptr(handle,rq,ierr) if (ierr /= 0) return @@ -161,7 +160,6 @@ recursive subroutine read_controls_file(rq, filename, level, ierr) integer, intent(in) :: level integer, intent(out) :: ierr logical, dimension(max_extra_inlists) :: read_extra - character (len=strlen) :: message character (len=strlen), dimension(max_extra_inlists) :: extra integer :: unit, i diff --git a/kap/private/load_kap.f90 b/kap/private/load_kap.f90 index e41309e27..e53e4ae2e 100644 --- a/kap/private/load_kap.f90 +++ b/kap/private/load_kap.f90 @@ -398,8 +398,6 @@ subroutine Prepare_Kap_X_Table(rq, & subroutine Setup_Kap_X_Table(ierr) integer, intent(out) :: ierr - integer :: i - xErr = abs(xin - X); zErr = abs(zz - Z) if (xErr > tiny .or. zErr > tiny) then ierr = -1 diff --git a/kap/private/op_eval_mombarg.f90 b/kap/private/op_eval_mombarg.f90 index 1d74e04b3..4de69a88f 100644 --- a/kap/private/op_eval_mombarg.f90 +++ b/kap/private/op_eval_mombarg.f90 @@ -39,7 +39,7 @@ subroutine compute_grad(k, fk, logT_face, logRho_face,l, r,lkap_ross_cell, lgrad ! eumesh: sigma_i*(1 - exp(-u(v))) - a_k,i, where u=h*nu/(kT). OP mono grid is equally spaced in variable v. a_k,i are the correction factors. (nel,1648,nptot) - integer :: n, ke, nz, id, m, ik, i + integer :: ke, id, m, ik, i real(dp):: epa_mix_cell(1648), amu_mix_cell, logRho(1648),logT(1648) ! Number of electrons per atom, mean molecular weight, density and temperature as a function of ite (temp index) and jne (density index) from the OP mono data. real(dp) :: delta(1648) @@ -55,7 +55,7 @@ subroutine compute_grad(k, fk, logT_face, logRho_face,l, r,lkap_ross_cell, lgrad integer :: ite_i, jne_i, dite, djne, i_grid(4,4) real(dp) :: logT_min, logRho_min, logT_grid(4,4), logRho_grid(4,4) integer :: offset1, offset2, tries, missing_point(4,4) - real(dp) :: log_amu_mix_cell, lkap_ross_face, gam + real(dp) :: log_amu_mix_cell, gam integer :: imin, imax logical :: retry diff --git a/kap/private/op_load.f b/kap/private/op_load.f index 3f47884da..928d73e61 100644 --- a/kap/private/op_load.f +++ b/kap/private/op_load.f @@ -43,10 +43,9 @@ subroutine op_dload(path, cache_filename, ierr) integer, intent(out) :: ierr - integer,parameter :: ipz=28 real :: am,amm,delp,dpack integer :: ios,it,ite11,ite22,ite33,itt,itte1,itte2,itte3,izz,jne,ite - integer :: jne1,jne22,jne33,jnn,k,n,ncount2,ncount3,ja,jn,jnw11 + integer :: jne1,jne22,jne33,jnn,k,n,ncount2,ncount3,ja,jn integer :: jne11,jne2,nccc,ne,nfff,ntott,nn real :: orss,um,ux,umaxx,uminn,u real,dimension(nptot):: umesh, semesh @@ -476,7 +475,7 @@ subroutine msh(dv, ntot, umesh, semesh, uf, dscat) integer, intent(out) :: ntot real, intent(out) :: dv, uf(0:100), dscat real, intent(out) :: umesh(:), semesh(:) ! (nptot) - integer :: i, k, ntotv + integer :: i, ntotv real :: dvp, dv1, umin, umax, umeshp(nptot), semeshp(nptot) common /mesh/ ntotv, dvp, dv1, umeshp, semeshp save /mesh/ diff --git a/kap/private/op_load_master.f b/kap/private/op_load_master.f index c41405cb3..6c8565169 100644 --- a/kap/private/op_load_master.f +++ b/kap/private/op_load_master.f @@ -18,7 +18,7 @@ subroutine load_op_master(emesh_data_for_op_mono_path, iz,ite,jne,epatom,amamu,s real(dp), pointer, intent(out) :: sig(:,:,:) real(dp), pointer, intent(out):: epatom(:,:),amamu(:),eumesh(:,:,:) - integer :: n, m, ke, ik + integer :: n, m, ke CHARACTER(LEN=72) :: FMT integer :: nel, nptot, np parameter(nel = 17, nptot = 10000, np=1648) !number of elements and number of u-mesh points. diff --git a/kap/public/kap_def.f90 b/kap/public/kap_def.f90 index adb1ca13f..5ebe3978c 100644 --- a/kap/public/kap_def.f90 +++ b/kap/public/kap_def.f90 @@ -507,7 +507,7 @@ subroutine kap_def_init(kap_cache_dir_in) use utils_lib, only : mkdir use const_def, only: mesa_data_dir, mesa_caches_dir, mesa_temp_caches_dir, use_mesa_temp_cache character (*), intent(in) :: kap_cache_dir_in - integer :: ierr, i + integer :: i kap_test_partials = .false. diff --git a/mtx/test/src/test_mtx_support.f90 b/mtx/test/src/test_mtx_support.f90 index cec81c1a7..603a6ea5a 100644 --- a/mtx/test/src/test_mtx_support.f90 +++ b/mtx/test/src/test_mtx_support.f90 @@ -33,8 +33,7 @@ module test_mtx_support subroutine test_format_conversion use mtx_def integer, parameter :: n = 6 - integer, parameter :: nzmax = n*n, nrow = n, ncol = n, ndns = n, ndim = n - integer, parameter :: iwk = nzmax, im = 10 + integer, parameter :: nzmax = n*n, ndim = n real(dp) :: a(ndim, n), a2(ndim, n), values(nzmax) integer, parameter :: ml = 1, mu = 2, ldbb = 2*ml + mu + 1 diff --git a/num/test/src/bari_beam.f b/num/test/src/bari_beam.f index 49ded6697..54017da05 100644 --- a/num/test/src/bari_beam.f +++ b/num/test/src/bari_beam.f @@ -37,7 +37,7 @@ subroutine beam_feval(nvar,t,th,df,ierr,rpar,ipar) use math_lib IMPLICIT real(dp) (A-H,O-Z) integer ierr,nvar,i,ipar(*) - integer, parameter :: N=40, NN=2*N, NCOM=N, NSQ=N*N, NQUATR=NSQ*NSQ, NNCOM=NN + integer, parameter :: N=40, NN=2*N, NSQ=N*N, NQUATR=NSQ*NSQ real(dp) rpar(*), an, deltas DIMENSION DF(NN),TH(150),U(150),V(150),W(150) DIMENSION ALPHA(150),BETA(150),STH(150),CTH(150) diff --git a/num/test/src/test_newton.f90 b/num/test/src/test_newton.f90 index d7167fefd..09cd4a954 100644 --- a/num/test/src/test_newton.f90 +++ b/num/test/src/test_newton.f90 @@ -479,7 +479,7 @@ subroutine diffusion_set_xscale(nvar, nz, xold, xscale, lrpar, rpar, lipar, ipar real(dp), intent(inout) :: rpar(:) ! (lrpar) integer, intent(inout) :: ipar(:) ! (lipar) integer, intent(out) :: ierr - real(dp), parameter :: xscale_min = 1d0 + ! real(dp), parameter :: xscale_min = 1d0 xscale = 1.d0 ! max(xscale_min, abs(xold)) ierr = 0 end subroutine diffusion_set_xscale diff --git a/num/test/src/test_newuoa.f90 b/num/test/src/test_newuoa.f90 index d44c3788b..83644227d 100644 --- a/num/test/src/test_newuoa.f90 +++ b/num/test/src/test_newuoa.f90 @@ -45,7 +45,7 @@ subroutine calfun(n, x, f) real(dp), intent(in) :: x(*) real(dp), intent(out) :: f - integer :: I, J, IW, MAXFUN, NP + integer :: I, J, IW, NP real(dp) :: Y(10, 10), sum nfcn = nfcn + 1 do J = 1, N diff --git a/num/test/src/test_support.f90 b/num/test/src/test_support.f90 index c0f3088d9..bbfc23f6c 100644 --- a/num/test/src/test_support.f90 +++ b/num/test/src/test_support.f90 @@ -259,7 +259,6 @@ end function interp_y ! --- prints solution at equidistant output-points ! --- by using "contd8", the continuous collocation solution real(dp) :: xout, y1, y2 - integer, parameter :: iprint = 6 integer :: ierr xout = rpar(2) irtrn = 1 @@ -420,7 +419,7 @@ subroutine test_binary_search write(*,*) 'binary_search, increasing values' loc = -1 - val = [0d0, dble(n/3)**2 +2, vec(n)+1d0] + val = [0d0, FLOOR(n/3d0)**2+2d0, vec(n)+1d0] do k=1,3 loc(k) = binary_search(n, vec, 0, val(k)) if(loc(k) == 0 .and. val(k) < vec(1))then diff --git a/star/private/report.f90 b/star/private/report.f90 index 1e2753417..751a26d45 100644 --- a/star/private/report.f90 +++ b/star/private/report.f90 @@ -153,7 +153,6 @@ subroutine do_report(s, ierr) integer :: k, nz, h1, h2, he3, he4, c12, n14, o16, ne20, si28, co56, ni56, k_min real(dp) :: radius, dr, non_fe_core_mass, nu_for_delta_Pg, v, mstar, luminosity, mass_sum - logical, parameter :: new_only = .false. integer, pointer :: net_iso(:) real(dp), pointer :: velocity(:) => null() From e18f833df816650eb36c2f10f87228511101e40d Mon Sep 17 00:00:00 2001 From: pmocz Date: Thu, 29 Aug 2024 10:44:09 -0400 Subject: [PATCH 2/4] linting star --- star/private/adjust_mesh_split_merge.f90 | 10 +++++----- star/private/adjust_xyz.f90 | 4 ++-- star/private/atm_support.f90 | 6 +++--- star/private/diffusion_procs.f90 | 2 +- star/private/element_diffusion.f90 | 4 ++-- star/private/eps_mdot.f90 | 2 +- star/private/history.f90 | 4 ++-- star/private/hydro_eqns.f90 | 1 - star/private/hydro_vars.f90 | 2 +- star/private/kap_support.f90 | 2 +- star/private/magnetic_diffusion.f90 | 2 +- star/private/mass_utils.f90 | 12 ++++++------ star/private/starspots.f90 | 2 +- star/private/turb_info.f90 | 4 ++-- star/private/winds.f90 | 2 +- 15 files changed, 29 insertions(+), 30 deletions(-) diff --git a/star/private/adjust_mesh_split_merge.f90 b/star/private/adjust_mesh_split_merge.f90 index 9b97c0e3d..ecad749cb 100644 --- a/star/private/adjust_mesh_split_merge.f90 +++ b/star/private/adjust_mesh_split_merge.f90 @@ -741,7 +741,7 @@ subroutine get_cell_energies(s, k, Etot, KE, PE, IE, Etrb) include 'formats' dm = s% dm(k) if (s% u_flag) then - KE = 0.5d0*dm*s% u(k)**2 + KE = 0.5d0*pow2(dm*s% u(k)) else if (s% v_flag) then v0 = s% v(k) if (k < s% nz) then @@ -749,7 +749,7 @@ subroutine get_cell_energies(s, k, Etot, KE, PE, IE, Etrb) else v1 = s% v_center end if - KE = 0.25d0*dm*(v0**2 + v1**2) + KE = 0.25d0*dm*(pow2(v0) + pow2(v1)) else KE = 0d0 end if @@ -1397,16 +1397,16 @@ real(dp) function total_KE(s) total_KE = 0 if (s% u_flag) then do k=1,s% nz - total_KE = total_KE + 0.5d0*s% dm(k)*s% u(k)**2 + total_KE = total_KE + 0.5d0*s% dm(k)* pow2(s% u(k)) end do else if (s% v_flag) then do k=1,s% nz-1 total_KE = total_KE + & - 0.25d0*s% dm(k)*(s% v(k)**2 + s% v(k+1)**2) + 0.25d0*s% dm(k)*(pow2(s% v(k)) + pow2(s% v(k+1))) end do k = s% nz total_KE = total_KE + & - 0.25d0*s% dm(k)*(s% v(k)**2 + s% v_center**2) + 0.25d0*s% dm(k)*(pow2(s% v(k)) +pow2(s% v_center)) end if end function total_KE diff --git a/star/private/adjust_xyz.f90 b/star/private/adjust_xyz.f90 index 92477a0ee..7929e8981 100644 --- a/star/private/adjust_xyz.f90 +++ b/star/private/adjust_xyz.f90 @@ -863,7 +863,7 @@ subroutine set_composition(id, nzlo, nzhi, num_species, xa_new, ierr) end if if (abs(1d0-sum(xa_new(1:species))) > 1d-6) then ierr = -1 - s% retry_message = 'set_composition requires new mass fractions to add to 1.' + s% retry_message = 'set_composition requires new mass fractions to add to 1' if (s% report_ierr) write(*, *) s% retry_message return end if @@ -919,7 +919,7 @@ subroutine get_xa_for_accretion(s, xa, ierr) end do if (abs(1d0 - sum(xa(1:species))) > 1d-2) then write(*,'(a)') & - 'get_xa_for_accretion: accretion species mass fractions do not add to 1.0' + 'get_xa_for_accretion: accretion species mass fractions do not add to 1' write(*,1) 'sum(xa(1:species))', sum(xa(1:species)) do j=1,s% num_accretion_species write(*,2) trim(s% accretion_species_id(j)), j, xa(j) diff --git a/star/private/atm_support.f90 b/star/private/atm_support.f90 index ea96af6a2..ff0e70825 100644 --- a/star/private/atm_support.f90 +++ b/star/private/atm_support.f90 @@ -1243,8 +1243,8 @@ subroutine eos_proc( & real(dp), intent(out) :: dres_dlnT(num_eos_basic_results) integer, intent(out) :: ierr - real(dp), parameter :: LOGRHO_TOL = 1E-11_dp - real(dp), parameter :: LOGPGAS_TOL = 1E-11_dp + real(dp), parameter :: LOGRHO_TOL = 1d-11 + real(dp), parameter :: LOGPGAS_TOL = 1d-11 real(dp) :: T real(dp) :: P @@ -1258,7 +1258,7 @@ subroutine eos_proc( & P = exp(lnP) Prad = radiation_pressure(T) - Pgas = MAX(1.E-99_dp, P - Prad) + Pgas = MAX(1.d-99, P - Prad) gamma = 5d0/3d0 call eos_gamma_PT_get_rho_energy( & diff --git a/star/private/diffusion_procs.f90 b/star/private/diffusion_procs.f90 index 6821910b1..6cafbec08 100644 --- a/star/private/diffusion_procs.f90 +++ b/star/private/diffusion_procs.f90 @@ -1250,7 +1250,7 @@ subroutine calc_g_rad_mombarg( & include 'formats' - blend_fac = (/(1._dp - FLOAT(i)/31._dp, i=1,31)/) + blend_fac = (/(1._dp - DBLE(i)/31._dp, i=1,31)/) ierr = 0 kmax = kmax_rad_accel diff --git a/star/private/element_diffusion.f90 b/star/private/element_diffusion.f90 index d86617f28..ed5b1a9cf 100644 --- a/star/private/element_diffusion.f90 +++ b/star/private/element_diffusion.f90 @@ -567,8 +567,8 @@ subroutine set1_extras(k,ierr) if (k==1) then dlnPdm(k) = 0; dlnT_dm(k) = 0; return end if - grav = -s% cgrav(k)*s% m(k)/s% r(k)**2 - area = pi4*s% r(k)**2 + grav = -s% cgrav(k)*s% m(k)/pow2(s% r(k)) + area = pi4*pow2(s% r(k)) P_face = 0.5d0*(s% Peos(k) + s% Peos(k-1)) dlnPdm(k) = grav/(area*P_face) ! estimate based on QHSE dlnT_dm(k) = s% gradT(k)*dlnPdm(k) diff --git a/star/private/eps_mdot.f90 b/star/private/eps_mdot.f90 index a43fcedb4..6c7a8e875 100644 --- a/star/private/eps_mdot.f90 +++ b/star/private/eps_mdot.f90 @@ -220,7 +220,7 @@ subroutine leak_control(nz, mass_flux, dm, mesh_intersects, ranges,& ! That is ALL it is used to do in this routine however, and the normalization ! is arbitrary (we just choose to use delta_m for convenience) so we can set it ! to anything we like. - delta_m = -1. + delta_m = -1.0d0 end if ! Calculate pass fraction: diff --git a/star/private/history.f90 b/star/private/history.f90 index 1cacb1b50..ff83bc820 100644 --- a/star/private/history.f90 +++ b/star/private/history.f90 @@ -2034,7 +2034,7 @@ subroutine history_getval(& end if case(h_mu4) deltam = 0.3d0 * msun ! Ertl et al 2016 - if (s% entropy(1) > 4.0) then + if (s% entropy(1) > 4.d0) then do k = nz - 1, 1, -1 if (s% entropy(k) > 4.d0) exit end do @@ -2045,7 +2045,7 @@ subroutine history_getval(& val = (deltam / msun) / ((s% r(k2) - s% r(k)) / 1d8) end if case(h_m4) - if (s% entropy(1) > 4.0) then + if (s% entropy(1) > 4.d0) then do k = nz - 1, 1, -1 if (s% entropy(k) > 4.d0) exit end do diff --git a/star/private/hydro_eqns.f90 b/star/private/hydro_eqns.f90 index b9aa3cb79..931d48be5 100644 --- a/star/private/hydro_eqns.f90 +++ b/star/private/hydro_eqns.f90 @@ -23,7 +23,6 @@ ! ! *********************************************************************** - module hydro_eqns use star_private_def diff --git a/star/private/hydro_vars.f90 b/star/private/hydro_vars.f90 index bd01ddcfb..d872f1e85 100644 --- a/star/private/hydro_vars.f90 +++ b/star/private/hydro_vars.f90 @@ -980,7 +980,7 @@ subroutine get_surf_PT( & P_surf_atm = exp(lnP_surf) Pextra = s% Pextra_factor*(kap_surf/tau_surf)*(L_surf/M_surf)/(6._dp*pi*clight*s% cgrav(1)) P_surf = P_surf_atm + Pextra - if (P_surf < 1E-50_dp) then + if (P_surf < 1d-50) then lnP_surf = -50*ln10 if (.not. skip_partials) then dlnP_dL = 0._dp diff --git a/star/private/kap_support.f90 b/star/private/kap_support.f90 index 2031eee4a..db754c730 100644 --- a/star/private/kap_support.f90 +++ b/star/private/kap_support.f90 @@ -431,7 +431,7 @@ subroutine get_kap( & else if (s% op_mono_method == 'mombarg') then fk = 0 - if (logT > 3.5 .and. logT < 8.0) then + if (logT > 3.5d0 .and. logT < 8.0d0) then do i=1, s% species e_name = chem_isos% name(s% chem_id(i)) if (e_name == 'h1') fk(1) = xa(i)/ chem_isos% W(s% chem_id(i)) diff --git a/star/private/magnetic_diffusion.f90 b/star/private/magnetic_diffusion.f90 index 4c52e1a81..efe118108 100644 --- a/star/private/magnetic_diffusion.f90 +++ b/star/private/magnetic_diffusion.f90 @@ -136,7 +136,7 @@ real(dp) function sige3(z,t,xgamma) rme = 8.5646d-23*t*t*t*xgamma*xgamma*xgamma/pow5(z) ! rme = rho6/mue rm23 = pow(rme,2d0/3d0) ctmp = 1d0 + 1.018d0*rm23 - xi= sqrt(3.14159d0/3.)*log(z)/3.d0 + 2.d0*log(1.32d0+2.33d0/sqrt(xgamma))/3.d0-0.484d0*rm23/ctmp + xi= sqrt(pi/3.d0)*log(z)/3.d0 + 2.d0*log(1.32d0+2.33d0/sqrt(xgamma))/3.d0-0.484d0*rm23/ctmp sige3 = 8.630d21*rme/(z*ctmp*xi) end function sige3 diff --git a/star/private/mass_utils.f90 b/star/private/mass_utils.f90 index 255b42f13..8913c2cc0 100644 --- a/star/private/mass_utils.f90 +++ b/star/private/mass_utils.f90 @@ -37,8 +37,8 @@ real(qp) function reconstruct_m(dm, nz, j) real(qp) sum, compensator integer l - sum = 0.0 - compensator = 0.0 + sum = 0d0 + compensator = 0d0 do l=nz,j,-1 call neumaier_sum(sum, compensator, dm(l)) end do @@ -58,8 +58,8 @@ real(qp) function reconstruct_xm(dm, nz, j) real(qp) sum, compensator integer l - sum = 0.0 - compensator = 0.0 + sum = 0d0 + compensator = 0d0 do l=1,j call neumaier_sum(sum, compensator, dm(l)) end do @@ -110,8 +110,8 @@ real(qp) function accurate_mass_difference(dm1, dm2, j, k, nz) real(qp) summand integer l - sum % sum = 0.0 - sum % compensator = 0.0 + sum % sum = 0d0 + sum % compensator = 0d0 if (max(j,k) <= nz) then do l=nz,max(j,k),-1 diff --git a/star/private/starspots.f90 b/star/private/starspots.f90 index da13b27b9..e52d6e887 100644 --- a/star/private/starspots.f90 +++ b/star/private/starspots.f90 @@ -64,7 +64,7 @@ subroutine starspot_tweak_gradr(s, P, gradr, gradr_spot) mu_ideal_gas = s%mu(1) !1.00794d0 ! for hydrogen, 1 gram per mole R2 = pow2(s%R(1)) Teff_local = pow(s%L(1)/(pi4*boltz_sigma*R2), 0.25d0) - PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0 - s%xspot)*Teff_local + PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0d0 - s%xspot)*Teff_local xspot_of_r = (P - PB_i)/P gradr_spot = gradr/(s%fspot*pow4(xspot_of_r) + 1d0 - s%fspot) else diff --git a/star/private/turb_info.f90 b/star/private/turb_info.f90 index 42a4889db..e6131ea12 100644 --- a/star/private/turb_info.f90 +++ b/star/private/turb_info.f90 @@ -351,7 +351,7 @@ subroutine adjust_gradT_fraction(s,k,f) real(dp), intent(in) :: f integer, intent(in) :: k include 'formats' - if (f >= 0.0 .and. f <= 1.0) then + if (f >= 0.0d0 .and. f <= 1.0d0) then if (f == 0d0) then s% gradT_ad(k) = s% gradr_ad(k) else ! mix @@ -375,7 +375,7 @@ subroutine adjust_gradT_excess(s, k) gradT_excess_alpha = s% gradT_excess_alpha s% gradT_excess_effect(k) = 0.0d0 gradT_sub_grada = s% gradT(k) - s% grada_face(k) - if (gradT_excess_alpha <= 0.0 .or. & + if (gradT_excess_alpha <= 0.0d0 .or. & gradT_sub_grada <= s% gradT_excess_f1) return if (s% lnT(k)/ln10 > s% gradT_excess_max_logT) return log_tau = log10(s% tau(k)) diff --git a/star/private/winds.f90 b/star/private/winds.f90 index 7c3ae7ea2..28fc4fac7 100644 --- a/star/private/winds.f90 +++ b/star/private/winds.f90 @@ -680,7 +680,7 @@ real(dp) function eval_rlo_wind(s, L_surf, R, Teff, xfer_ratio, ierr) ! value in if (Teff > s% rlo_wind_max_Teff) return scale_height = s% rlo_wind_scale_height if (scale_height <= 0) then - scale_height = s% Peos(1) / (s% cgrav(1)*s% m(1)*s% rho(1) / (s% r(1)**2)) / Rsun + scale_height = s% Peos(1) / (s% cgrav(1)*s% m(1)*s% rho(1) / pow2(s% r(1))) / Rsun end if roche_lobe_radius = s% rlo_wind_roche_lobe_radius ratio = R/roche_lobe_radius From 1fb94dab869ddbe161b7bbbf8eb7b0f8f5bed0f5 Mon Sep 17 00:00:00 2001 From: pmocz Date: Thu, 29 Aug 2024 11:46:55 -0400 Subject: [PATCH 3/4] Revert "linting star" This reverts commit e18f833df816650eb36c2f10f87228511101e40d. --- star/private/adjust_mesh_split_merge.f90 | 10 +++++----- star/private/adjust_xyz.f90 | 4 ++-- star/private/atm_support.f90 | 6 +++--- star/private/diffusion_procs.f90 | 2 +- star/private/element_diffusion.f90 | 4 ++-- star/private/eps_mdot.f90 | 2 +- star/private/history.f90 | 4 ++-- star/private/hydro_eqns.f90 | 1 + star/private/hydro_vars.f90 | 2 +- star/private/kap_support.f90 | 2 +- star/private/magnetic_diffusion.f90 | 2 +- star/private/mass_utils.f90 | 12 ++++++------ star/private/starspots.f90 | 2 +- star/private/turb_info.f90 | 4 ++-- star/private/winds.f90 | 2 +- 15 files changed, 30 insertions(+), 29 deletions(-) diff --git a/star/private/adjust_mesh_split_merge.f90 b/star/private/adjust_mesh_split_merge.f90 index ecad749cb..9b97c0e3d 100644 --- a/star/private/adjust_mesh_split_merge.f90 +++ b/star/private/adjust_mesh_split_merge.f90 @@ -741,7 +741,7 @@ subroutine get_cell_energies(s, k, Etot, KE, PE, IE, Etrb) include 'formats' dm = s% dm(k) if (s% u_flag) then - KE = 0.5d0*pow2(dm*s% u(k)) + KE = 0.5d0*dm*s% u(k)**2 else if (s% v_flag) then v0 = s% v(k) if (k < s% nz) then @@ -749,7 +749,7 @@ subroutine get_cell_energies(s, k, Etot, KE, PE, IE, Etrb) else v1 = s% v_center end if - KE = 0.25d0*dm*(pow2(v0) + pow2(v1)) + KE = 0.25d0*dm*(v0**2 + v1**2) else KE = 0d0 end if @@ -1397,16 +1397,16 @@ real(dp) function total_KE(s) total_KE = 0 if (s% u_flag) then do k=1,s% nz - total_KE = total_KE + 0.5d0*s% dm(k)* pow2(s% u(k)) + total_KE = total_KE + 0.5d0*s% dm(k)*s% u(k)**2 end do else if (s% v_flag) then do k=1,s% nz-1 total_KE = total_KE + & - 0.25d0*s% dm(k)*(pow2(s% v(k)) + pow2(s% v(k+1))) + 0.25d0*s% dm(k)*(s% v(k)**2 + s% v(k+1)**2) end do k = s% nz total_KE = total_KE + & - 0.25d0*s% dm(k)*(pow2(s% v(k)) +pow2(s% v_center)) + 0.25d0*s% dm(k)*(s% v(k)**2 + s% v_center**2) end if end function total_KE diff --git a/star/private/adjust_xyz.f90 b/star/private/adjust_xyz.f90 index 7929e8981..92477a0ee 100644 --- a/star/private/adjust_xyz.f90 +++ b/star/private/adjust_xyz.f90 @@ -863,7 +863,7 @@ subroutine set_composition(id, nzlo, nzhi, num_species, xa_new, ierr) end if if (abs(1d0-sum(xa_new(1:species))) > 1d-6) then ierr = -1 - s% retry_message = 'set_composition requires new mass fractions to add to 1' + s% retry_message = 'set_composition requires new mass fractions to add to 1.' if (s% report_ierr) write(*, *) s% retry_message return end if @@ -919,7 +919,7 @@ subroutine get_xa_for_accretion(s, xa, ierr) end do if (abs(1d0 - sum(xa(1:species))) > 1d-2) then write(*,'(a)') & - 'get_xa_for_accretion: accretion species mass fractions do not add to 1' + 'get_xa_for_accretion: accretion species mass fractions do not add to 1.0' write(*,1) 'sum(xa(1:species))', sum(xa(1:species)) do j=1,s% num_accretion_species write(*,2) trim(s% accretion_species_id(j)), j, xa(j) diff --git a/star/private/atm_support.f90 b/star/private/atm_support.f90 index ff0e70825..ea96af6a2 100644 --- a/star/private/atm_support.f90 +++ b/star/private/atm_support.f90 @@ -1243,8 +1243,8 @@ subroutine eos_proc( & real(dp), intent(out) :: dres_dlnT(num_eos_basic_results) integer, intent(out) :: ierr - real(dp), parameter :: LOGRHO_TOL = 1d-11 - real(dp), parameter :: LOGPGAS_TOL = 1d-11 + real(dp), parameter :: LOGRHO_TOL = 1E-11_dp + real(dp), parameter :: LOGPGAS_TOL = 1E-11_dp real(dp) :: T real(dp) :: P @@ -1258,7 +1258,7 @@ subroutine eos_proc( & P = exp(lnP) Prad = radiation_pressure(T) - Pgas = MAX(1.d-99, P - Prad) + Pgas = MAX(1.E-99_dp, P - Prad) gamma = 5d0/3d0 call eos_gamma_PT_get_rho_energy( & diff --git a/star/private/diffusion_procs.f90 b/star/private/diffusion_procs.f90 index 6cafbec08..6821910b1 100644 --- a/star/private/diffusion_procs.f90 +++ b/star/private/diffusion_procs.f90 @@ -1250,7 +1250,7 @@ subroutine calc_g_rad_mombarg( & include 'formats' - blend_fac = (/(1._dp - DBLE(i)/31._dp, i=1,31)/) + blend_fac = (/(1._dp - FLOAT(i)/31._dp, i=1,31)/) ierr = 0 kmax = kmax_rad_accel diff --git a/star/private/element_diffusion.f90 b/star/private/element_diffusion.f90 index ed5b1a9cf..d86617f28 100644 --- a/star/private/element_diffusion.f90 +++ b/star/private/element_diffusion.f90 @@ -567,8 +567,8 @@ subroutine set1_extras(k,ierr) if (k==1) then dlnPdm(k) = 0; dlnT_dm(k) = 0; return end if - grav = -s% cgrav(k)*s% m(k)/pow2(s% r(k)) - area = pi4*pow2(s% r(k)) + grav = -s% cgrav(k)*s% m(k)/s% r(k)**2 + area = pi4*s% r(k)**2 P_face = 0.5d0*(s% Peos(k) + s% Peos(k-1)) dlnPdm(k) = grav/(area*P_face) ! estimate based on QHSE dlnT_dm(k) = s% gradT(k)*dlnPdm(k) diff --git a/star/private/eps_mdot.f90 b/star/private/eps_mdot.f90 index 6c7a8e875..a43fcedb4 100644 --- a/star/private/eps_mdot.f90 +++ b/star/private/eps_mdot.f90 @@ -220,7 +220,7 @@ subroutine leak_control(nz, mass_flux, dm, mesh_intersects, ranges,& ! That is ALL it is used to do in this routine however, and the normalization ! is arbitrary (we just choose to use delta_m for convenience) so we can set it ! to anything we like. - delta_m = -1.0d0 + delta_m = -1. end if ! Calculate pass fraction: diff --git a/star/private/history.f90 b/star/private/history.f90 index ff83bc820..1cacb1b50 100644 --- a/star/private/history.f90 +++ b/star/private/history.f90 @@ -2034,7 +2034,7 @@ subroutine history_getval(& end if case(h_mu4) deltam = 0.3d0 * msun ! Ertl et al 2016 - if (s% entropy(1) > 4.d0) then + if (s% entropy(1) > 4.0) then do k = nz - 1, 1, -1 if (s% entropy(k) > 4.d0) exit end do @@ -2045,7 +2045,7 @@ subroutine history_getval(& val = (deltam / msun) / ((s% r(k2) - s% r(k)) / 1d8) end if case(h_m4) - if (s% entropy(1) > 4.d0) then + if (s% entropy(1) > 4.0) then do k = nz - 1, 1, -1 if (s% entropy(k) > 4.d0) exit end do diff --git a/star/private/hydro_eqns.f90 b/star/private/hydro_eqns.f90 index 931d48be5..b9aa3cb79 100644 --- a/star/private/hydro_eqns.f90 +++ b/star/private/hydro_eqns.f90 @@ -23,6 +23,7 @@ ! ! *********************************************************************** + module hydro_eqns use star_private_def diff --git a/star/private/hydro_vars.f90 b/star/private/hydro_vars.f90 index d872f1e85..bd01ddcfb 100644 --- a/star/private/hydro_vars.f90 +++ b/star/private/hydro_vars.f90 @@ -980,7 +980,7 @@ subroutine get_surf_PT( & P_surf_atm = exp(lnP_surf) Pextra = s% Pextra_factor*(kap_surf/tau_surf)*(L_surf/M_surf)/(6._dp*pi*clight*s% cgrav(1)) P_surf = P_surf_atm + Pextra - if (P_surf < 1d-50) then + if (P_surf < 1E-50_dp) then lnP_surf = -50*ln10 if (.not. skip_partials) then dlnP_dL = 0._dp diff --git a/star/private/kap_support.f90 b/star/private/kap_support.f90 index db754c730..2031eee4a 100644 --- a/star/private/kap_support.f90 +++ b/star/private/kap_support.f90 @@ -431,7 +431,7 @@ subroutine get_kap( & else if (s% op_mono_method == 'mombarg') then fk = 0 - if (logT > 3.5d0 .and. logT < 8.0d0) then + if (logT > 3.5 .and. logT < 8.0) then do i=1, s% species e_name = chem_isos% name(s% chem_id(i)) if (e_name == 'h1') fk(1) = xa(i)/ chem_isos% W(s% chem_id(i)) diff --git a/star/private/magnetic_diffusion.f90 b/star/private/magnetic_diffusion.f90 index efe118108..4c52e1a81 100644 --- a/star/private/magnetic_diffusion.f90 +++ b/star/private/magnetic_diffusion.f90 @@ -136,7 +136,7 @@ real(dp) function sige3(z,t,xgamma) rme = 8.5646d-23*t*t*t*xgamma*xgamma*xgamma/pow5(z) ! rme = rho6/mue rm23 = pow(rme,2d0/3d0) ctmp = 1d0 + 1.018d0*rm23 - xi= sqrt(pi/3.d0)*log(z)/3.d0 + 2.d0*log(1.32d0+2.33d0/sqrt(xgamma))/3.d0-0.484d0*rm23/ctmp + xi= sqrt(3.14159d0/3.)*log(z)/3.d0 + 2.d0*log(1.32d0+2.33d0/sqrt(xgamma))/3.d0-0.484d0*rm23/ctmp sige3 = 8.630d21*rme/(z*ctmp*xi) end function sige3 diff --git a/star/private/mass_utils.f90 b/star/private/mass_utils.f90 index 8913c2cc0..255b42f13 100644 --- a/star/private/mass_utils.f90 +++ b/star/private/mass_utils.f90 @@ -37,8 +37,8 @@ real(qp) function reconstruct_m(dm, nz, j) real(qp) sum, compensator integer l - sum = 0d0 - compensator = 0d0 + sum = 0.0 + compensator = 0.0 do l=nz,j,-1 call neumaier_sum(sum, compensator, dm(l)) end do @@ -58,8 +58,8 @@ real(qp) function reconstruct_xm(dm, nz, j) real(qp) sum, compensator integer l - sum = 0d0 - compensator = 0d0 + sum = 0.0 + compensator = 0.0 do l=1,j call neumaier_sum(sum, compensator, dm(l)) end do @@ -110,8 +110,8 @@ real(qp) function accurate_mass_difference(dm1, dm2, j, k, nz) real(qp) summand integer l - sum % sum = 0d0 - sum % compensator = 0d0 + sum % sum = 0.0 + sum % compensator = 0.0 if (max(j,k) <= nz) then do l=nz,max(j,k),-1 diff --git a/star/private/starspots.f90 b/star/private/starspots.f90 index e52d6e887..da13b27b9 100644 --- a/star/private/starspots.f90 +++ b/star/private/starspots.f90 @@ -64,7 +64,7 @@ subroutine starspot_tweak_gradr(s, P, gradr, gradr_spot) mu_ideal_gas = s%mu(1) !1.00794d0 ! for hydrogen, 1 gram per mole R2 = pow2(s%R(1)) Teff_local = pow(s%L(1)/(pi4*boltz_sigma*R2), 0.25d0) - PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0d0 - s%xspot)*Teff_local + PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0 - s%xspot)*Teff_local xspot_of_r = (P - PB_i)/P gradr_spot = gradr/(s%fspot*pow4(xspot_of_r) + 1d0 - s%fspot) else diff --git a/star/private/turb_info.f90 b/star/private/turb_info.f90 index e6131ea12..42a4889db 100644 --- a/star/private/turb_info.f90 +++ b/star/private/turb_info.f90 @@ -351,7 +351,7 @@ subroutine adjust_gradT_fraction(s,k,f) real(dp), intent(in) :: f integer, intent(in) :: k include 'formats' - if (f >= 0.0d0 .and. f <= 1.0d0) then + if (f >= 0.0 .and. f <= 1.0) then if (f == 0d0) then s% gradT_ad(k) = s% gradr_ad(k) else ! mix @@ -375,7 +375,7 @@ subroutine adjust_gradT_excess(s, k) gradT_excess_alpha = s% gradT_excess_alpha s% gradT_excess_effect(k) = 0.0d0 gradT_sub_grada = s% gradT(k) - s% grada_face(k) - if (gradT_excess_alpha <= 0.0d0 .or. & + if (gradT_excess_alpha <= 0.0 .or. & gradT_sub_grada <= s% gradT_excess_f1) return if (s% lnT(k)/ln10 > s% gradT_excess_max_logT) return log_tau = log10(s% tau(k)) diff --git a/star/private/winds.f90 b/star/private/winds.f90 index 28fc4fac7..7c3ae7ea2 100644 --- a/star/private/winds.f90 +++ b/star/private/winds.f90 @@ -680,7 +680,7 @@ real(dp) function eval_rlo_wind(s, L_surf, R, Teff, xfer_ratio, ierr) ! value in if (Teff > s% rlo_wind_max_Teff) return scale_height = s% rlo_wind_scale_height if (scale_height <= 0) then - scale_height = s% Peos(1) / (s% cgrav(1)*s% m(1)*s% rho(1) / pow2(s% r(1))) / Rsun + scale_height = s% Peos(1) / (s% cgrav(1)*s% m(1)*s% rho(1) / (s% r(1)**2)) / Rsun end if roche_lobe_radius = s% rlo_wind_roche_lobe_radius ratio = R/roche_lobe_radius From bf34d19de698c9970c763bd166bdebbbfcedb157 Mon Sep 17 00:00:00 2001 From: pmocz Date: Thu, 29 Aug 2024 11:49:34 -0400 Subject: [PATCH 4/4] 1.0 to 1.0d0 --- star/private/adjust_xyz.f90 | 4 ++-- star/private/hydro_eqns.f90 | 1 - star/private/starspots.f90 | 4 ++-- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/star/private/adjust_xyz.f90 b/star/private/adjust_xyz.f90 index 92477a0ee..7929e8981 100644 --- a/star/private/adjust_xyz.f90 +++ b/star/private/adjust_xyz.f90 @@ -863,7 +863,7 @@ subroutine set_composition(id, nzlo, nzhi, num_species, xa_new, ierr) end if if (abs(1d0-sum(xa_new(1:species))) > 1d-6) then ierr = -1 - s% retry_message = 'set_composition requires new mass fractions to add to 1.' + s% retry_message = 'set_composition requires new mass fractions to add to 1' if (s% report_ierr) write(*, *) s% retry_message return end if @@ -919,7 +919,7 @@ subroutine get_xa_for_accretion(s, xa, ierr) end do if (abs(1d0 - sum(xa(1:species))) > 1d-2) then write(*,'(a)') & - 'get_xa_for_accretion: accretion species mass fractions do not add to 1.0' + 'get_xa_for_accretion: accretion species mass fractions do not add to 1' write(*,1) 'sum(xa(1:species))', sum(xa(1:species)) do j=1,s% num_accretion_species write(*,2) trim(s% accretion_species_id(j)), j, xa(j) diff --git a/star/private/hydro_eqns.f90 b/star/private/hydro_eqns.f90 index b9aa3cb79..931d48be5 100644 --- a/star/private/hydro_eqns.f90 +++ b/star/private/hydro_eqns.f90 @@ -23,7 +23,6 @@ ! ! *********************************************************************** - module hydro_eqns use star_private_def diff --git a/star/private/starspots.f90 b/star/private/starspots.f90 index da13b27b9..12ed5c94c 100644 --- a/star/private/starspots.f90 +++ b/star/private/starspots.f90 @@ -64,9 +64,9 @@ subroutine starspot_tweak_gradr(s, P, gradr, gradr_spot) mu_ideal_gas = s%mu(1) !1.00794d0 ! for hydrogen, 1 gram per mole R2 = pow2(s%R(1)) Teff_local = pow(s%L(1)/(pi4*boltz_sigma*R2), 0.25d0) - PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0 - s%xspot)*Teff_local + PB_i = (cgas*s%rho(1)/mu_ideal_gas)*(1.0d0 - s%xspot)*Teff_local xspot_of_r = (P - PB_i)/P - gradr_spot = gradr/(s%fspot*pow4(xspot_of_r) + 1d0 - s%fspot) + gradr_spot = gradr/(s%fspot*pow4(xspot_of_r) + 1.0d0 - s%fspot) else gradr_spot = gradr end if