From 936b11fb655881a0f1dc87731c1fa863af4ac3e0 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 6 Apr 2022 14:51:32 -0400 Subject: [PATCH 1/3] Format string fixes; function index reorder This fixes several (extremely) minor issues in the source code which were detected as nonconformat by the `-pedantic` flag. None are serious, and none are likely to resolve any outstanding issues. The main benefit is that it allows us to apply the `-pedantic` flag into our testing, which can help to detect future issues. The issues which have been fixed are described below. * The `nX` edit descriptor must include the number of forward steps. The implicit single step (`1x == x`) is a compiler extension. * The no-advance line record write token `$` is a compiler extension which is not described in the standard. Non-advancement is handled with the `advance='no'` argument. * Edit descriptors in format statements must be separated by commas, even though many compilers will ignore missing commas if there is no ambiguity. * When line continuation tokens are applied to strings, they must appear at both the end of the first line and the beginning of the subsequent line. Most compilers do not require this second starting token. * In function descriptions, if a variable used in the declaration of another variable, such as an array index, then it must be declared before any other variables refers to it. For example, this is invalid: ``` function foo(i0, x) real :: x(i0:) integer :: i0 ``` and `i0` must be declared before `x`. --- .../GFDL_ocean_BGC/FMS_coupler_util.F90 | 4 +- .../GFDL_ocean_BGC/generic_tracer.F90 | 4 +- src/ALE/MOM_remapping.F90 | 26 +- src/core/MOM.F90 | 6 +- src/core/MOM_forcing_type.F90 | 4 +- src/core/MOM_open_boundary.F90 | 2 +- src/diagnostics/MOM_PointAccel.F90 | 466 +++++++++--------- src/diagnostics/MOM_debugging.F90 | 6 +- src/diagnostics/MOM_sum_output.F90 | 6 +- src/framework/MOM_checksums.F90 | 2 +- src/framework/MOM_diag_mediator.F90 | 4 +- src/framework/MOM_diag_vkernels.F90 | 8 +- src/framework/MOM_domains.F90 | 2 +- src/framework/MOM_horizontal_regridding.F90 | 2 +- src/framework/MOM_write_cputime.F90 | 2 +- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 2 +- .../vertical/MOM_ALE_sponge.F90 | 2 +- src/tracer/MOM_lateral_boundary_diffusion.F90 | 6 +- src/tracer/MOM_neutral_diffusion.F90 | 24 +- src/tracer/MOM_tracer_advect.F90 | 4 +- 20 files changed, 291 insertions(+), 291 deletions(-) diff --git a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 index e50f2ccf0b..b7ee7de684 100644 --- a/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 +++ b/config_src/external/GFDL_ocean_BGC/FMS_coupler_util.F90 @@ -11,9 +11,9 @@ module FMS_coupler_util !> Get element and index of a boundary condition subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, ilb, jlb, & is, ie, js, je, conversion) - real, dimension(ilb:,jlb:),intent(out) :: array_out !< The array being filled with the input values integer, intent(in) :: ilb !< Lower bounds integer, intent(in) :: jlb !< Lower bounds + real, dimension(ilb:,jlb:),intent(out) :: array_out !< The array being filled with the input values type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted integer, intent(in) :: BC_index !< The boundary condition number being extracted integer, intent(in) :: BC_element !< The element of the boundary condition being extracted @@ -27,9 +27,9 @@ end subroutine extract_coupler_values !> Set element and index of a boundary condition subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, ilb, jlb,& is, ie, js, je, conversion) - real, dimension(ilb:,jlb:), intent(in) :: array_in !< The array containing the values to load into the BC integer, intent(in) :: ilb !< Lower bounds integer, intent(in) :: jlb !< Lower bounds + real, dimension(ilb:,jlb:), intent(in) :: array_in !< The array containing the values to load into the BC type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type into which the data is being loaded integer, intent(in) :: BC_index !< The boundary condition number being set integer, intent(in) :: BC_element !< The element of the boundary condition being set diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 index 6bd445ae8b..42c386497a 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -69,13 +69,13 @@ end subroutine generic_tracer_coupler_accumulate subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& frunoff,grid_ht, current_wave_stress, sosga) + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Mass per unit area of each layer [kg m-2] real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth [m] - integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain - integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain integer, intent(in) :: tau !< Time step index of %field real, intent(in) :: dtts !< The time step for this call [s] real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Grid cell areas [m2] diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index 82087eea24..ebe0f81743 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -516,13 +516,13 @@ subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & u_min = min(u_l, u_c) u_max = max(u_l, u_c) if (ppoly_r_E(i0,1) < u_min) then - write(0,'(a,i4,5(x,a,1pe24.16))') 'Left edge undershoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & - 'edge=',ppoly_r_E(i0,1),'err=',ppoly_r_E(i0,1)-u_min + write(0,'(a,i4,5(1x,a,1pe24.16))') 'Left edge undershoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & + 'edge=',ppoly_r_E(i0,1),'err=',ppoly_r_E(i0,1)-u_min problem_detected = .true. endif if (ppoly_r_E(i0,1) > u_max) then - write(0,'(a,i4,5(x,a,1pe24.16))') 'Left edge overshoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & - 'edge=',ppoly_r_E(i0,1),'err=',ppoly_r_E(i0,1)-u_max + write(0,'(a,i4,5(1x,a,1pe24.16))') 'Left edge overshoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & + 'edge=',ppoly_r_E(i0,1),'err=',ppoly_r_E(i0,1)-u_max problem_detected = .true. endif endif @@ -530,27 +530,27 @@ subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, & u_min = min(u_c, u_r) u_max = max(u_c, u_r) if (ppoly_r_E(i0,2) < u_min) then - write(0,'(a,i4,5(x,a,1pe24.16))') 'Right edge undershoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, & - 'edge=',ppoly_r_E(i0,2),'err=',ppoly_r_E(i0,2)-u_min + write(0,'(a,i4,5(1x,a,1pe24.16))') 'Right edge undershoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, & + 'edge=',ppoly_r_E(i0,2),'err=',ppoly_r_E(i0,2)-u_min problem_detected = .true. endif if (ppoly_r_E(i0,2) > u_max) then - write(0,'(a,i4,5(x,a,1pe24.16))') 'Right edge overshoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, & - 'edge=',ppoly_r_E(i0,2),'err=',ppoly_r_E(i0,2)-u_max + write(0,'(a,i4,5(1x,a,1pe24.16))') 'Right edge overshoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, & + 'edge=',ppoly_r_E(i0,2),'err=',ppoly_r_E(i0,2)-u_max problem_detected = .true. endif endif if (i0 > 1) then if ( (u_c-u_l)*(ppoly_r_E(i0,1)-ppoly_r_E(i0-1,2)) < 0.) then - write(0,'(a,i4,5(x,a,1pe24.16))') 'Non-monotonic edges at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & - 'right edge=',ppoly_r_E(i0-1,2),'left edge=',ppoly_r_E(i0,1) - write(0,'(5(a,1pe24.16,x))') 'u(i0)-u(i0-1)',u_c-u_l,'edge diff=',ppoly_r_E(i0,1)-ppoly_r_E(i0-1,2) + write(0,'(a,i4,5(1x,a,1pe24.16))') 'Non-monotonic edges at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, & + 'right edge=',ppoly_r_E(i0-1,2),'left edge=',ppoly_r_E(i0,1) + write(0,'(5(a,1pe24.16,1x))') 'u(i0)-u(i0-1)',u_c-u_l,'edge diff=',ppoly_r_E(i0,1)-ppoly_r_E(i0-1,2) problem_detected = .true. endif endif if (problem_detected) then write(0,'(a,1p9e24.16)') 'Polynomial coeffs:',ppoly_r_coefs(i0,:) - write(0,'(3(a,1pe24.16,x))') 'u_l=',u_l,'u_c=',u_c,'u_r=',u_r + write(0,'(3(a,1pe24.16,1x))') 'u_l=',u_l,'u_c=',u_c,'u_r=',u_r write(0,'(a4,10a24)') 'i0','h0(i0)','u0(i0)','left edge','right edge','Polynomial coefficients' do n = 1, n0 write(0,'(i4,1p10e24.16)') n,h0(n),u0(n),ppoly_r_E(n,1),ppoly_r_E(n,2),ppoly_r_coefs(n,:) @@ -1960,7 +1960,7 @@ logical function test_answer(verbose, n, u, u_true, label, tol) if (abs(u(k) - u_true(k)) > tolerance) test_answer = .true. enddo if (test_answer .or. verbose) then - write(stdout,'(a4,2a24,x,a)') 'k','Calculated value','Correct value',label + write(stdout,'(a4,2a24,1x,a)') 'k','Calculated value','Correct value',label do k = 1, n if (abs(u(k) - u_true(k)) > tolerance) then write(stdout,'(i4,1p2e24.16,a,1pe24.16,a)') k,u(k),u_true(k),' err=',u(k)-u_true(k),' < wrong' diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f3d8869320..0703e45696 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3551,7 +3551,7 @@ subroutine extract_surface_state(CS, sfc_state_in) ig = i + G%HI%idg_offset ! Global i-index jg = j + G%HI%jdg_offset ! Global j-index if (use_temperature) then - write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),8(a,es11.4,x))') & + write(msg(1:240),'(2(a,i4,1x),4(a,f8.3,1x),8(a,es11.4,1x))') & 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & @@ -3560,7 +3560,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) else - write(msg(1:240),'(2(a,i4,x),4(a,f8.3,x),6(a,es11.4))') & + write(msg(1:240),'(2(a,i4,1x),4(a,f8.3,1x),6(a,es11.4))') & 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & @@ -3577,7 +3577,7 @@ subroutine extract_surface_state(CS, sfc_state_in) enddo ; enddo call sum_across_PEs(numberOfErrors) if (numberOfErrors>0) then - write(msg(1:240),'(3(a,i9,x))') 'There were a total of ',numberOfErrors, & + write(msg(1:240),'(3(a,i9,1x))') 'There were a total of ',numberOfErrors, & 'locations detected with extreme surface values!' call MOM_error(FATAL, trim(msg)) endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index bdf4823f81..ccd70cd9da 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -704,7 +704,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & fluxes%num_msg = fluxes%num_msg + 1 write(mesg,'("Penetrating shortwave of ",1pe17.10, & &" exceeds total shortwave of ",1pe17.10,& - &" at ",1pg11.4,"E, "1pg11.4,"N.")') & + &" at ",1pg11.4,",E,",1pg11.4,"N.")') & Pen_SW_tot(i), I_Cp_Hconvert*scale*dt * fluxes%sw(i,j), & G%geoLonT(i,j), G%geoLatT(i,j) call MOM_error(WARNING,mesg) @@ -3125,7 +3125,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & if (present(waves)) then; if (waves) then; if (.not. present(num_stk_bands)) then call MOM_error(FATAL,"Requested to & - initialize with waves, but no waves are present.") + &initialize with waves, but no waves are present.") endif if (num_stk_bands > 0) then if (.not.associated(forces%ustkb)) then diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6ce0940ddb..bda0b2df38 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4777,7 +4777,7 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) if (color(i,j) /= color2(i,j)) then fatal_error = .True. write(mesg,'("MOM_open_boundary: problem with OBC segments specification at ",I5,",",I5," during\n", & - "the masking of the outside grid points.")') i, j + &"the masking of the outside grid points.")') i, j call MOM_error(WARNING,"MOM register_tracer: "//mesg, all_print=.true.) endif if (color(i,j) == cout) G%bathyT(i,j) = min_depth diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index a4badaf8e7..e52feec697 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -147,7 +147,7 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday) write (file,'(/,"--------------------------")') write (file,'(/,"Time ",i5,i4,F6.2," U-velocity violation at ",I4,": ",2(I3), & - & " (",F7.2," E "F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & + & " (",F7.2," E ",F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') & yr, yearday, (REAL(sec)/3600.0), pe_here(), I, j, & G%geoLonCu(I,j), G%geoLatCu(I,j), ks, ke, US%T_to_s*dt @@ -156,174 +156,174 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if ((hin(i,j,k) + hin(i+1,j,k)) > 3.0*Angstrom) do_k(k) = .true. enddo - write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo - write(file,'(/,"u(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*um(I,j,k)) ; enddo + write(file,'(/,"Layers:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ")', advance='no') (k) ; enddo + write(file,'(/,"u(m): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*um(I,j,k)) ; enddo if (prev_avail) then - write(file,'(/,"u(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_prev(I,j,k)) ; enddo + write(file,'(/,"u(mp): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%u_prev(I,j,k)) ; enddo endif - write(file,'(/,"u(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%u_av(I,j,k)) ; enddo + write(file,'(/,"u(3): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%u_av(I,j,k)) ; enddo - write(file,'(/,"CFL u: ",$)') + write(file,'(/,"CFL u: ")', advance='no') do k=ks,ke ; if (do_k(k)) then CFL = abs(um(I,j,k)) * dt * G%dy_Cu(I,j) if (um(I,j,k) < 0.0) then ; CFL = CFL * G%IareaT(i+1,j) else ; CFL = CFL * G%IareaT(i,j) ; endif - write(file,'(ES10.3," ",$)') CFL + write(file,'(ES10.3," ")', advance='no') CFL endif ; enddo - write(file,'(/,"CFL0 u:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"CFL0 u:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & abs(um(I,j,k)) * dt * G%IdxCu(I,j) ; enddo if (prev_avail) then - write(file,'(/,"du: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"du: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*(um(I,j,k)-CS%u_prev(I,j,k))) ; enddo endif - write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAu(I,j,k)) ; enddo - write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFu(I,j,k)) ; enddo - write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffu(I,j,k)) ; enddo + write(file,'(/,"CAu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%CAu(I,j,k)) ; enddo + write(file,'(/,"PFu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%PFu(I,j,k)) ; enddo + write(file,'(/,"diffu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%diffu(I,j,k)) ; enddo if (associated(ADp%gradKEu)) then - write(file,'(/,"KEu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"KEu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*ADp%gradKEu(I,j,k)) ; enddo endif if (associated(ADp%rv_x_v)) then - write(file,'(/,"Coru: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"Coru: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & vel_scale*dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) ; enddo endif if (associated(ADp%du_dt_visc)) then - write(file,'(/,"ubv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"ubv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & vel_scale*(um(I,j,k) - dt*ADp%du_dt_visc(I,j,k)) ; enddo - write(file,'(/,"duv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"duv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*ADp%du_dt_visc(I,j,k)) ; enddo endif if (associated(ADp%du_other)) then - write(file,'(/,"du_other: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"du_other: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*ADp%du_other(I,j,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(I,j,k)*dt) ; enddo + write(file,'(/,"a: ")', advance='no') + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(I,j,k)*dt) ; enddo endif if (present(hv)) then - write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(I,j,k) ; enddo + write(file,'(/,"hvel: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hv(I,j,k) ; enddo endif write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%u_accel_bt)) then - write(file,'("dubt: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'("dubt: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*CS%u_accel_bt(I,j,k)) ; enddo write(file,'(/)') endif - write(file,'(/,"h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j-1,k)) ; enddo - write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j-1,k)) ; enddo - write(file,'(/,"h-0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j,k)) ; enddo - write(file,'(/,"h+0: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j,k)) ; enddo - write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i,j+1,k)) ; enddo - write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (h_scale*hin(i+1,j+1,k)) ; enddo + write(file,'(/,"h--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i,j-1,k)) ; enddo + write(file,'(/,"h+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i+1,j-1,k)) ; enddo + write(file,'(/,"h-0: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i,j,k)) ; enddo + write(file,'(/,"h+0: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i+1,j,k)) ; enddo + write(file,'(/,"h-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i,j+1,k)) ; enddo + write(file,'(/,"h++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (h_scale*hin(i+1,j+1,k)) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo - write(file,'(/,"e-: ",$)') - write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo + write(file,'(/,"e-: ")', advance='no') + write(file,'(ES10.3," ")', advance='no') e(ks) + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i+1,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i+1,j,k) ; enddo - write(file,'(/,"e+: ",$)') - write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo + write(file,'(/,"e+: ")', advance='no') + write(file,'(ES10.3," ")', advance='no') e(ks) + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then - write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo - write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i+1,j,k) ; enddo + write(file,'(/,"T-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j,k) ; enddo + write(file,'(/,"T+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i+1,j,k) ; enddo endif if (associated(CS%S)) then - write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo - write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i+1,j,k) ; enddo + write(file,'(/,"S-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j,k) ; enddo + write(file,'(/,"S+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i+1,j,k) ; enddo endif if (prev_avail) then - write(file,'(/,"v--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J-1,k)) ; enddo - write(file,'(/,"v-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo - write(file,'(/,"v+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J-1,k)) ; enddo - write(file,'(/,"v++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i+1,J,k)) ; enddo - endif - - write(file,'(/,"vh--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"v--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_prev(i,J-1,k)) ; enddo + write(file,'(/,"v-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_prev(i,J,k)) ; enddo + write(file,'(/,"v+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_prev(i+1,J-1,k)) ; enddo + write(file,'(/,"v++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_prev(i+1,J,k)) ; enddo + endif + + write(file,'(/,"vh--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%vh(i,J-1,k)*G%IdxCv(i,J-1)) ; enddo - write(file,'(/," vhC--:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhC--:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_av(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo if (prev_avail) then - write(file,'(/," vhCp--:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhCp--:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_prev(i,j-1,k)*uh_scale*(hin(i,j-1,k) + hin(i,j,k))) ; enddo endif - write(file,'(/,"vh-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"vh-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%vh(i,J,k)*G%IdxCv(i,J)) ; enddo - write(file,'(/," vhC-+:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhC-+:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_av(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then - write(file,'(/," vhCp-+:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhCp-+:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_prev(i,J,k)*uh_scale*(hin(i,j,k) + hin(i,j+1,k))) ; enddo endif - write(file,'(/,"vh+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"vh+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%vh(i+1,J-1,k)*G%IdxCv(i+1,J-1)) ; enddo - write(file,'(/," vhC+-:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhC+-:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_av(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then - write(file,'(/," vhCp+-:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhCp+-:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_prev(i+1,J-1,k)*uh_scale*(hin(i+1,j-1,k) + hin(i+1,j,k))) ; enddo endif - write(file,'(/,"vh++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"vh++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%vh(i+1,J,k)*G%IdxCv(i+1,J)) ; enddo - write(file,'(/," vhC++:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhC++:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then - write(file,'(/," vhCp++:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," vhCp++:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (0.5*CS%v_av(i+1,J,k)*uh_scale*(hin(i+1,j,k) + hin(i+1,j+1,k))) ; enddo endif @@ -337,48 +337,48 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st Inorm(k) = 1.0 / du enddo - write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo + write(file,'(2/,"Norm: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') (vel_scale / Inorm(k)) ; enddo - write(file,'(/,"du: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"du: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & ((um(I,j,k)-CS%u_prev(I,j,k)) * Inorm(k)) ; enddo - write(file,'(/,"CAu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"CAu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%CAu(I,j,k) * Inorm(k)) ; enddo - write(file,'(/,"PFu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"PFu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%PFu(I,j,k) * Inorm(k)) ; enddo - write(file,'(/,"diffu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"diffu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%diffu(I,j,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then - write(file,'(/,"KEu: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"KEu: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%gradKEu(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_v)) then - write(file,'(/,"Coru: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"Coru: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*(ADp%CAu(I,j,k)-ADp%rv_x_v(I,j,k)) * Inorm(k)) ; enddo endif if (associated(ADp%du_dt_visc)) then - write(file,'(/,"duv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"duv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%du_dt_visc(I,j,k) * Inorm(k)) ; enddo endif if (associated(ADp%du_other)) then - write(file,'(/,"du_other: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"du_other: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (ADp%du_other(I,j,k) * Inorm(k)) ; enddo endif if (associated(CS%u_accel_bt)) then - write(file,'(/,"dubt: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"dubt: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*CS%u_accel_bt(I,j,k) * Inorm(k)) ; enddo endif endif @@ -487,178 +487,178 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st if ((hin(i,j,k) + hin(i,j+1,k)) > 3.0*Angstrom) do_k(k) = .true. enddo - write(file,'(/,"Layers:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(I10," ",$)') (k) ; enddo - write(file,'(/,"v(m): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*vm(i,J,k)) ; enddo + write(file,'(/,"Layers:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(I10," ")', advance='no') (k) ; enddo + write(file,'(/,"v(m): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*vm(i,J,k)) ; enddo if (prev_avail) then - write(file,'(/,"v(mp): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_prev(i,J,k)) ; enddo + write(file,'(/,"v(mp): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_prev(i,J,k)) ; enddo endif - write(file,'(/,"v(3): ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*CS%v_av(i,J,k)) ; enddo - write(file,'(/,"CFL v: ",$)') + write(file,'(/,"v(3): ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*CS%v_av(i,J,k)) ; enddo + write(file,'(/,"CFL v: ")', advance='no') do k=ks,ke ; if (do_k(k)) then CFL = abs(vm(i,J,k)) * dt * G%dx_Cv(i,J) if (vm(i,J,k) < 0.0) then ; CFL = CFL * G%IareaT(i,j+1) else ; CFL = CFL * G%IareaT(i,j) ; endif - write(file,'(ES10.3," ",$)') CFL + write(file,'(ES10.3," ")', advance='no') CFL endif ; enddo - write(file,'(/,"CFL0 v:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"CFL0 v:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & abs(vm(i,J,k)) * dt * G%IdyCv(i,J) ; enddo if (prev_avail) then - write(file,'(/,"dv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"dv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*(vm(i,J,k)-CS%v_prev(i,J,k))) ; enddo endif - write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%CAv(i,J,k)) ; enddo + write(file,'(/,"CAv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%CAv(i,J,k)) ; enddo - write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%PFv(i,J,k)) ; enddo + write(file,'(/,"PFv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%PFv(i,J,k)) ; enddo - write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') (vel_scale*dt*ADp%diffv(i,J,k)) ; enddo + write(file,'(/,"diffv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (vel_scale*dt*ADp%diffv(i,J,k)) ; enddo if (associated(ADp%gradKEv)) then - write(file,'(/,"KEv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"KEv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*ADp%gradKEv(i,J,k)) ; enddo endif if (associated(ADp%rv_x_u)) then - write(file,'(/,"Corv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"Corv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & vel_scale*dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then - write(file,'(/,"vbv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"vbv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & vel_scale*(vm(i,J,k) - dt*ADp%dv_dt_visc(i,J,k)) ; enddo - write(file,'(/,"dvv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"dvv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*ADp%dv_dt_visc(i,J,k)) ; enddo endif if (associated(ADp%dv_other)) then - write(file,'(/,"dv_other: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"dv_other: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*ADp%dv_other(i,J,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ",$)') - do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ",$)') (US%Z_to_m*a(i,j,k)*dt) ; enddo + write(file,'(/,"a: ")', advance='no') + do k=ks,ke+1 ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(i,j,k)*dt) ; enddo endif if (present(hv)) then - write(file,'(/,"hvel: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hv(i,J,k) ; enddo + write(file,'(/,"hvel: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hv(i,J,k) ; enddo endif write(file,'(/,"Stress: ",ES10.3)') vel_scale*US%Z_to_m * (str*dt / GV%Rho0) if (associated(CS%v_accel_bt)) then - write(file,'("dvbt: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'("dvbt: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (vel_scale*dt*CS%v_accel_bt(i,J,k)) ; enddo write(file,'(/)') endif - write(file,'("h--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j,k) ; enddo - write(file,'(/,"h0-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j,k) ; enddo - write(file,'(/,"h+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j,k) ; enddo - write(file,'(/,"h-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i-1,j+1,k) ; enddo - write(file,'(/,"h0+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i,j+1,k) ; enddo - write(file,'(/,"h++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') h_scale*hin(i+1,j+1,k) ; enddo + write(file,'("h--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i-1,j,k) ; enddo + write(file,'(/,"h0-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i,j,k) ; enddo + write(file,'(/,"h+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i+1,j,k) ; enddo + write(file,'(/,"h-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i-1,j+1,k) ; enddo + write(file,'(/,"h0+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i,j+1,k) ; enddo + write(file,'(/,"h++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') h_scale*hin(i+1,j+1,k) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j,k) ; enddo - write(file,'(/,"e-: ",$)') - write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo + write(file,'(/,"e-: ")', advance='no') + write(file,'(ES10.3," ")', advance='no') e(ks) + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo e(nz+1) = -US%Z_to_m*(G%bathyT(i,j+1) + G%Z_ref) do k=nz,1,-1 ; e(K) = e(K+1) + h_scale*hin(i,j+1,k) ; enddo - write(file,'(/,"e+: ",$)') - write(file,'(ES10.3," ",$)') e(ks) - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ",$)') e(K) ; enddo + write(file,'(/,"e+: ")', advance='no') + write(file,'(ES10.3," ")', advance='no') e(ks) + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') e(K) ; enddo if (associated(CS%T)) then - write(file,'(/,"T-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j,k) ; enddo - write(file,'(/,"T+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%T(i,j+1,k) ; enddo + write(file,'(/,"T-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j,k) ; enddo + write(file,'(/,"T+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%T(i,j+1,k) ; enddo endif if (associated(CS%S)) then - write(file,'(/,"S-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j,k) ; enddo - write(file,'(/,"S+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') CS%S(i,j+1,k) ; enddo + write(file,'(/,"S-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j,k) ; enddo + write(file,'(/,"S+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') CS%S(i,j+1,k) ; enddo endif if (prev_avail) then - write(file,'(/,"u--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j,k) ; enddo - write(file,'(/,"u-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I-1,j+1,k) ; enddo - write(file,'(/,"u+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j,k) ; enddo - write(file,'(/,"u++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') vel_scale*CS%u_prev(I,j+1,k) ; enddo - endif - - write(file,'(/,"uh--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"u--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') vel_scale*CS%u_prev(I-1,j,k) ; enddo + write(file,'(/,"u-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') vel_scale*CS%u_prev(I-1,j+1,k) ; enddo + write(file,'(/,"u+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') vel_scale*CS%u_prev(I,j,k) ; enddo + write(file,'(/,"u++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') vel_scale*CS%u_prev(I,j+1,k) ; enddo + endif + + write(file,'(/,"uh--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%uh(I-1,j,k)*G%IdyCu(I-1,j)) ; enddo - write(file,'(/," uhC--: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhC--: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_av(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo if (prev_avail) then - write(file,'(/," uhCp--:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhCp--:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_prev(I-1,j,k) * uh_scale*0.5*(hin(i-1,j,k) + hin(i,j,k))) ; enddo endif - write(file,'(/,"uh-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"uh-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%uh(I-1,j+1,k)*G%IdyCu(I-1,j+1)) ; enddo - write(file,'(/," uhC-+: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhC-+: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_av(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo if (prev_avail) then - write(file,'(/," uhCp-+:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhCp-+:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_prev(I-1,j+1,k) * uh_scale*0.5*(hin(i-1,j+1,k) + hin(i,j+1,k))) ; enddo endif - write(file,'(/,"uh+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"uh+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%uh(I,j,k)*G%IdyCu(I,j)) ; enddo - write(file,'(/," uhC+-: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhC+-: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_av(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo if (prev_avail) then - write(file,'(/," uhCp+-:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhCp+-:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_prev(I,j,k) * uh_scale*0.5*(hin(i,j,k) + hin(i+1,j,k))) ; enddo endif - write(file,'(/,"uh++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/,"uh++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (uh_scale*CDp%uh(I,j+1,k)*G%IdyCu(I,j+1)) ; enddo - write(file,'(/," uhC++: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhC++: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_av(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo if (prev_avail) then - write(file,'(/," uhCp++:",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ",$)') & + write(file,'(/," uhCp++:")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(ES10.3," ")', advance='no') & (CS%u_prev(I,j+1,k) * uh_scale*0.5*(hin(i,j+1,k) + hin(i+1,j+1,k))) ; enddo endif @@ -672,44 +672,44 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st Inorm(k) = 1.0 / dv enddo - write(file,'(2/,"Norm: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') (vel_scale / Inorm(k)) ; enddo - write(file,'(/,"dv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(2/,"Norm: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') (vel_scale / Inorm(k)) ; enddo + write(file,'(/,"dv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & ((vm(i,J,k)-CS%v_prev(i,J,k)) * Inorm(k)) ; enddo - write(file,'(/,"CAv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"CAv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%CAv(i,J,k) * Inorm(k)) ; enddo - write(file,'(/,"PFv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"PFv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%PFv(i,J,k) * Inorm(k)) ; enddo - write(file,'(/,"diffv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"diffv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%diffv(i,J,k) * Inorm(k)) ; enddo if (associated(ADp%gradKEu)) then - write(file,'(/,"KEv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"KEv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%gradKEv(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%rv_x_u)) then - write(file,'(/,"Corv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"Corv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*(ADp%CAv(i,J,k)-ADp%rv_x_u(i,J,k)) * Inorm(k)) ; enddo endif if (associated(ADp%dv_dt_visc)) then - write(file,'(/,"dvv: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"dvv: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*ADp%dv_dt_visc(i,J,k) * Inorm(k)) ; enddo endif if (associated(ADp%dv_other)) then - write(file,'(/,"dv_other: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"dv_other: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (ADp%dv_other(i,J,k) * Inorm(k)) ; enddo endif if (associated(CS%v_accel_bt)) then - write(file,'(/,"dvbt: ",$)') - do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ",$)') & + write(file,'(/,"dvbt: ")', advance='no') + do k=ks,ke ; if (do_k(k)) write(file,'(F10.6," ")', advance='no') & (dt*CS%v_accel_bt(i,J,k) * Inorm(k)) ; enddo endif endif diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index fda5a97d69..3b24a3871b 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -196,7 +196,7 @@ subroutine check_redundant_vC2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if (v_resym(i,j) /= v_comp(i,j) .and. & redundant_prints(3) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & - & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)" on pe ",i4)') & + & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) @@ -386,7 +386,7 @@ subroutine check_redundant_vB2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if (v_resym(i,j) /= v_comp(i,j) .and. & redundant_prints(2) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & - & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)" on pe ",i4)') & + & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & v_comp(i,j), v_resym(i,j),v_comp(i,j)-v_resym(i,j),i,j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) @@ -549,7 +549,7 @@ subroutine check_redundant_vT2d(mesg, u_comp, v_comp, G, is, ie, js, je, & if (v_nonsym(i,j) /= v_comp(i,j) .and. & redundant_prints(1) < max_redundant_prints) then write(mesg2,'(" redundant v-comps",2(1pe12.4)," differ by ", & - & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)" on pe ",i4)') & + & 1pe12.4," at i,j = ",2i4," x,y = ",2(1pe12.4)," on pe ",i4)') & v_comp(i,j), v_nonsym(i,j),v_comp(i,j)-v_nonsym(i,j),i,j, & G%geoLonBu(i,j), G%geoLatBu(i,j), pe_here() write(0,'(A155)') trim(mesg)//trim(mesg2) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index a7cae98620..48097b40c4 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -848,13 +848,13 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci endif do m=1,nTr_stocks - write(stdout,'(" Total ",a,": ",ES24.16,X,a)') & + write(stdout,'(" Total ",a,": ",ES24.16,1X,a)') & trim(Tr_names(m)), Tr_stocks(m), trim(Tr_units(m)) if (Tr_minmax_avail(m)) then - write(stdout,'(64X,"Global Min:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & + write(stdout,'(64X,"Global Min:",ES24.16,1X,"at: (",f7.2,",",f7.2,",",f8.2,")" )') & Tr_min(m),Tr_min_x(m),Tr_min_y(m),Tr_min_z(m) - write(stdout,'(64X,"Global Max:",ES24.16,X,"at: (", f7.2,","f7.2,","f8.2,")" )') & + write(stdout,'(64X,"Global Max:",ES24.16,1X,"at: (",f7.2,",",f7.2,",",f8.2,")" )') & Tr_max(m),Tr_max_x(m),Tr_max_y(m),Tr_max_z(m) endif diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index d1a8102fc1..15db6abce9 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -2196,7 +2196,7 @@ subroutine chk_sum_msg1(fmsg, bc0, mesg, iounit) integer, intent(in) :: iounit !< Checksum logger IO unit if (is_root_pe()) & - write(iounit, '(A,1(A,I10,X),A)') fmsg, " c=", bc0, trim(mesg) + write(iounit, '(a,1(a,i10,1x),a)') fmsg, " c=", bc0, trim(mesg) end subroutine chk_sum_msg1 !> Write a message including checksums of non-shifted and diagonally shifted arrays diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 92d53330a7..1ed89ec47e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3732,7 +3732,7 @@ subroutine log_available_diag(used, module_name, field_name, cell_methods_string mesg = '"'//trim(field_name)//'" [Unused]' endif if (len(trim((comment)))>0) then - write(diag_CS%available_diag_doc_unit, '(a,x,"(",a,")")') trim(mesg),trim(comment) + write(diag_CS%available_diag_doc_unit, '(a,1x,"(",a,")")') trim(mesg),trim(comment) else write(diag_CS%available_diag_doc_unit, '(a)') trim(mesg) endif @@ -3754,7 +3754,7 @@ subroutine log_chksum_diag(docunit, description, chksum) character(len=*), intent(in) :: description !< Name of the diagnostic module integer, intent(in) :: chksum !< chksum of the diagnostic - write(docunit, '(a,x,i9.8)') description, chksum + write(docunit, '(a,1x,i9.8)') description, chksum flush(docunit) end subroutine log_chksum_diag diff --git a/src/framework/MOM_diag_vkernels.F90 b/src/framework/MOM_diag_vkernels.F90 index 3d6e3e3f65..24ff07e7d0 100644 --- a/src/framework/MOM_diag_vkernels.F90 +++ b/src/framework/MOM_diag_vkernels.F90 @@ -311,8 +311,8 @@ logical function test_interp(verbose, missing_value, msg, nsrc, h_src, u_src, nd if (error==0.) then write(stdout,'(i3,3(1pe24.16))') k,u_dest(k),u_true(k),u_dest(k)-u_true(k) else - write(stdout,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,u_dest(k),u_true(k),u_dest(k)-u_true(k),'<--- WRONG!' endif enddo endif @@ -350,8 +350,8 @@ logical function test_reintegrate(verbose, missing_value, msg, nsrc, h_src, uh_s if (error==0.) then write(stdout,'(i3,3(1pe24.16))') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k) else - write(stdout,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' - write(stderr,'(i3,3(1pe24.16),x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stdout,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' + write(stderr,'(i3,3(1pe24.16),1x,a)') k,uh_dest(k),uh_true(k),uh_dest(k)-uh_true(k),'<--- WRONG!' endif enddo endif diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index dc6c0a8996..00c42727e1 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -343,7 +343,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! Idiot check that fewer PEs than columns have been requested if (layout(1)*layout(2) > n_global(1)*n_global(2)) then - write(mesg,'(a,2(i5,x,a))') 'You requested to use',layout(1)*layout(2), & + write(mesg,'(a,2(i5,1x,a))') 'You requested to use', layout(1)*layout(2), & 'PEs but there are only', n_global(1)*n_global(2), 'columns in the model' call MOM_error(FATAL, mesg) endif diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index de511688a9..5a125d5abd 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -66,7 +66,7 @@ subroutine myStats(array, missing, is, ie, js, je, k, mesg) call min_across_PEs(minA) call max_across_PEs(maxA) if (is_root_pe()) then - write(lMesg(1:120),'(2(a,es12.4),a,i3,x,a)') & + write(lMesg(1:120),'(2(a,es12.4),a,i3,1x,a)') & 'init_from_Z: min=',minA,' max=',maxA,' Level=',k,trim(mesg) call MOM_mesg(lMesg,2) endif diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index 9df994448b..cc43ec19ea 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -200,7 +200,7 @@ subroutine write_cputime(day, n, CS, nmax, call_end) (CS%startup_cputime / CLOCKS_PER_SEC), num_pes() write(CS%fileCPU_ascii,*)" Day, Step number, CPU time, CPU time change" endif - write(CS%fileCPU_ascii,'(F12.3,", "I11,", ", F12.3,", ", F12.3)') & + write(CS%fileCPU_ascii,'(F12.3,", ",I11,", ",F12.3,", ",F12.3)') & reday, n, (CS%cputime2 / real(CLOCKS_PER_SEC)), & d_cputime / real(CLOCKS_PER_SEC) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 608a672a46..e1ecd45347 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -2901,10 +2901,10 @@ end subroutine bilinear_shape_fn_grid subroutine bilinear_shape_functions_subgrid(Phisub, nsub) + integer, intent(in) :: nsub !< The number of subgridscale quadrature locations in each direction real, dimension(nsub,nsub,2,2,2,2), & intent(inout) :: Phisub !< Quadrature structure weights at subgridscale !! locations for finite element calculations [nondim] - integer, intent(in) :: nsub !< The number of subgridscale quadrature locations in each direction ! this subroutine is a helper for interpolation of floatation condition ! for the purposes of evaluating the terms \int (u,v) \phi_i dx dy in a cell that is diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 6b89a86b30..f711ef3f87 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -691,7 +691,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, CS%fldno = CS%fldno + 1 if (CS%fldno > MAX_FIELDS_) then write(mesg, '("Increase MAX_FIELDS_ to at least ",I3," in MOM_memory.h or decrease "//& - "the number of fields to be damped in the call to initialize_ALE_sponge." )') CS%fldno + &"the number of fields to be damped in the call to initialize_ALE_sponge." )') CS%fldno call MOM_error(FATAL,"set_up_ALE_sponge_field: "//mesg) endif ! get a unique time interp id for this field. If sponge data is on-grid, then setup diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 227e3ffb06..7296640560 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -343,8 +343,8 @@ end subroutine swap !> Receives a 1D array x and sorts it into ascending order. subroutine sort(x, n) - real, dimension(n), intent(inout) :: x !< 1D array to be sorted integer, intent(in ) :: n !< # of pts in the array + real, dimension(n), intent(inout) :: x !< 1D array to be sorted ! local variables integer :: i, location @@ -1012,8 +1012,8 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a write(stdout,30) "zeta_bot", zeta_bot, "zeta_bot_ans", zeta_bot_ans endif - 20 format(A,"=",i3,X,A,"=",i3) - 30 format(A,"=",f20.16,X,A,"=",f20.16) + 20 format(A,"=",i3,1X,A,"=",i3) + 30 format(A,"=",f20.16,1X,A,"=",f20.16) end function test_boundary_k_range diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 1a80829255..61715e044b 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -1364,7 +1364,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & if (CS%debug) then write(stdout,'(A,I2)') "Searching left layer ", kl_left - write(stdout,'(A,I2,X,I2)') "Searching from right: ", kl_right, ki_right + write(stdout,'(A,I2,1X,I2)') "Searching from right: ", kl_right, ki_right write(stdout,*) "Temp/Salt Reference: ", Tr(kl_right,ki_right), Sr(kl_right,ki_right) write(stdout,*) "Temp/Salt Top L: ", Tl(kl_left,1), Sl(kl_left,1) write(stdout,*) "Temp/Salt Bot L: ", Tl(kl_left,2), Sl(kl_left,2) @@ -1387,7 +1387,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, & if (CS%debug) then write(stdout,'(A,I2)') "Searching right layer ", kl_right - write(stdout,'(A,I2,X,I2)') "Searching from left: ", kl_left, ki_left + write(stdout,'(A,I2,1X,I2)') "Searching from left: ", kl_left, ki_left write(stdout,*) "Temp/Salt Reference: ", Tl(kl_left,ki_left), Sl(kl_left,ki_left) write(stdout,*) "Temp/Salt Top L: ", Tr(kl_right,1), Sr(kl_right,1) write(stdout,*) "Temp/Salt Bot L: ", Tr(kl_right,2), Sr(kl_right,2) @@ -2651,9 +2651,9 @@ logical function test_fv_diff(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue, ti if (test_fv_diff) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fv_diff) then - write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' + write(stdunit,'(2(1x,a,f20.16),1x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(2(x,a,f20.16))') 'pRet=',Pret,'pTrue=',Ptrue + write(stdunit,'(2(1x,a,f20.16))') 'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2683,9 +2683,9 @@ logical function test_fvlsq_slope(verbose, hkm1, hk, hkp1, Skm1, Sk, Skp1, Ptrue if (test_fvlsq_slope) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_fvlsq_slope) then - write(stdunit,'(2(x,a,f20.16),x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' + write(stdunit,'(2(1x,a,f20.16),1x,a)') 'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(2(x,a,f20.16))') 'pRet=',Pret,'pTrue=',Ptrue + write(stdunit,'(2(1x,a,f20.16))') 'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2713,10 +2713,10 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) if (test_ifndp) stdunit = stderr ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & + write(stdunit,'(4(1x,a,f20.16),2(1x,a,1pe22.15),1x,a)') & 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') & + write(stdunit,'(4(1x,a,f20.16),2(1x,a,1pe22.15))') & 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2746,11 +2746,11 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) do k = 1,nk if (Po(k) /= Ptrue(k)) then test_data1d = .true. - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') & + write(stdunit,'(a,i2,2(1x,a,f20.16),1x,a,1pe22.15,1x,a)') & 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' else if (verbose) & - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') & + write(stdunit,'(a,i2,2(1x,a,f20.16),1x,a,1pe22.15)') & 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) endif enddo @@ -2781,10 +2781,10 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) do k = 1,nk if (Po(k) /= Ptrue(k)) then test_data1di = .true. - write(stdunit,'(a,i2,2(x,a,i5),x,a)') 'k=',k,'Io=',Po(k),'Itrue=',Ptrue(k),'WRONG!' + write(stdunit,'(a,i2,2(1x,a,i5),1x,a)') 'k=',k,'Io=',Po(k),'Itrue=',Ptrue(k),'WRONG!' else if (verbose) & - write(stdunit,'(a,i2,2(x,a,i5))') 'k=',k,'Io=',Po(k),'Itrue=',Ptrue(k) + write(stdunit,'(a,i2,2(1x,a,i5))') 'k=',k,'Io=',Po(k),'Itrue=',Ptrue(k) endif enddo endif diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 79fd4f3cbf..42e09b574e 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -326,6 +326,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & is, ie, js, je, k, G, GV, US, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + integer, intent(in) :: ntr !< The number of tracers type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hprev !< cell volume at the end of previous !! tracer change [H L2 ~> m3 or kg] @@ -337,7 +338,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & logical, dimension(SZJ_(G),SZK_(GV)), intent(inout) :: domore_u !< If true, there is more advection to be !! done in this u-row real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] - integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on integer, intent(in) :: js !< The starting tracer j-index to work on @@ -698,6 +698,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & is, ie, js, je, k, G, GV, US, usePPM, useHuynh) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + integer, intent(in) :: ntr !< The number of tracers type(tracer_type), dimension(ntr), intent(inout) :: Tr !< The array of registered tracers to work on real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hprev !< cell volume at the end of previous !! tracer change [H L2 ~> m3 or kg] @@ -709,7 +710,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & logical, dimension(SZJB_(G),SZK_(GV)), intent(inout) :: domore_v !< If true, there is more advection to be !! done in this v-row real, intent(in) :: Idt !< The inverse of dt [T-1 ~> s-1] - integer, intent(in) :: ntr !< The number of tracers integer, intent(in) :: is !< The starting tracer i-index to work on integer, intent(in) :: ie !< The ending tracer i-index to work on integer, intent(in) :: js !< The starting tracer j-index to work on From a5350219b34005dc68fa0838ed788de8bc71d207 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 6 Apr 2022 15:59:30 -0400 Subject: [PATCH 2/3] Mixed layer restrat statement function refactor Statement functions are obsolescent in the current language standard, and can be redefined as an internal function within a subprogram. This patch replaces the statement function `psi` (streamfunction) in `mixedlayer_restrat_general` as an explicit internal function. --- .../lateral/MOM_mixed_layer_restrat.F90 | 27 ++++++++++++------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index d8da752a1f..e1dff4f5bd 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -178,7 +178,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer ! densities [R L2 T-2 ~> Pa]. - real :: aFac, bFac ! Nondimensional ratios [nondim] + real :: aFac, bFac ! Nondimensional ratios [nondim] real :: ddRho ! A density difference [R ~> kg m-3] real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] real :: zpa ! Fractional position within the mixed layer of the interface above a layer [nondim] @@ -190,15 +190,6 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions [nondim] - ! Stream function as a function of non-dimensional position within mixed-layer (F77 statement function) - !PSI1(z) = max(0., (1. - (2.*z+1.)**2 ) ) - PSI1(z) = max(0., (1. - (2.*z+1.)**2 ) * (1. + (5./21.)*(2.*z+1.)**2) ) - BOTTOP(z) = 0.5*(1.-SIGN(1.,z+0.5)) ! =0 for z>-0.5, =1 for z<-0.5 - XP(z) = max(0., min(1., (-z-0.5)*2./(1.+2.*CS%MLE_tail_dh) ) ) - DD(z) = (1.-3.*(XP(z)**2)+2.*(XP(z)**3))**(1.+2.*CS%MLE_tail_dh) - PSI(z) = max( PSI1(z), DD(z)*BOTTOP(z) ) ! Combines original PSI1 with tail - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -557,6 +548,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! This needs to happen after the H update and before the next post_data. call diag_update_remap_grids(CS%diag) +contains + !> Stream function as a function of non-dimensional position within mixed-layer + real function psi(z) + real, intent(in) :: z !< Fractional mixed layer depth [nondim] + real :: psi1, bottop, xp, dd + + !psi1 = max(0., (1. - (2.*z + 1.)**2)) + psi1 = max(0., (1. - (2.*z + 1.)**2) * (1. + (5./21.)*(2.*z + 1.)**2)) + + xp = max(0., min(1., (-z - 0.5)*2. / (1. + 2.*CS%MLE_tail_dh))) + dd = (1. - 3.*(xp**2) + 2.*(xp**3))**(1. + 2.*CS%MLE_tail_dh) + bottop = 0.5*(1. - sign(1., z + 0.5)) ! =0 for z>-0.5, =1 for z<-0.5 + + psi = max(psi1, dd*bottop) ! Combines original psi1 with tail + end function psi + end subroutine mixedlayer_restrat_general From d2fb2d0edd955aeb4382c069df6764eeb5b0379e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 7 Apr 2022 09:08:59 -0400 Subject: [PATCH 3/3] MOM_random: Set mask with bits rather than integer The MOM_random generator used bit masks which were set with integer values. This is problematic for the sequence 0x8000 0000, because it must be set with a value of -2**31. In 4-byte integers, this is strictly not representable in Fortran, which requires symmetric signed domains for its variables. Since the upper bound is 2**31 - 1, the lower bound must be -2**31 + 1, which is larger than -2**31. Any value assigned to the 0x80000000 bit sequence is considered a noncompliant compiler extension. The current implementation seems to resolve this by using a kind=8 value (itself problematic, since 8-byte is not assured), but it still requires assigning this value to a 4-byte integer which cannot (strictly) represent the value. This patch averts the whole issue by explicitly setting the bits, and makes no reference to its integer value. It leaves the compiler to decide its interpretation. And since the variable is only used in bit operations, there is no ambiguity in behavior. Note that GCC 9 does not support BOZ conversion from z'80000000' to int, since it still expects BOZ literals to be within the bounds. This is why we use ibset() in place of a literal. Later GCC versions do not have this objection. --- src/framework/MOM_random.F90 | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index bef78a433a..cf649c32f7 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -7,6 +7,7 @@ module MOM_random use MOM_time_manager, only : time_type, set_date, get_date use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit +use iso_fortran_env, only : int32 implicit none ; private @@ -20,11 +21,13 @@ module MOM_random public :: random_unit_tests ! Private period parameters for the Mersenne Twister -integer, parameter :: blockSize = 624, & !< Size of the state vector - M = 397, & !< Pivot element in state vector - MATRIX_A = -1727483681, & !< constant vector a (0x9908b0dfUL) - UMASK = -2147483648_8, & !< most significant w-r bits (0x80000000UL) - LMASK = 2147483647 !< least significant r bits (0x7fffffffUL) +integer, parameter :: & + blockSize = 624, & !< Size of the state vector + M = 397, & !< Pivot element in state vector + MATRIX_A = -1727483681, & !< constant vector a (0x9908b0dfUL) + UMASK = ibset(0, 31), & !< most significant w-r bits (0x80000000UL) + LMASK = 2147483647 !< least significant r bits (0x7fffffffUL) + ! Private tempering parameters for the Mersenne Twister integer, parameter :: TMASKB= -1658038656, & !< (0x9d2c5680UL) TMASKC= -272236544 !< (0xefc60000UL)