Merge pull request #727 from MESAHub/chore/pmocz/format

(minor) clean up some warnings in astero, eos, kappa, num (unused var, int division)

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)

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

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

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 

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
 

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'
 

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

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
 

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

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
 

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

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
 

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/

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.

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.
 

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

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)

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

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

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

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)