+Use I0 format to simplify integer output

  Use the I0 format that was introduced with Fortran 95 in 155 lines scattered
across 40 files to simplify or shorten some error messages.  In 21 cases,
adjustl() calls that are no longer necessary for intended formatting were also
eliminated.  These changes have the effect of ensuring that there are still
appropriate messages if there are, for example, more than 99 vertical layers or
9999 points (total) in a horizontal directions or more than 9999 PEs.  In 15
cases, this change allowed for the elimination or reduction of if tests that
formatted output based on the size of an integer.  All answers are bitwise
identical but there there may be some minor formatting changes in some error
messages.

Author: Hallberg-NOAA

src/ALE/MOM_hybgen_regrid.F90

@@ -988,12 +988,12 @@ subroutine hybgen_column_regrid(CS, nk, thkbot, Rcv_tgt, &
     ! Verify that everything is consistent.
     do k=1,nk
       if (abs((h_col(k) - h_in(k)) + (dp_int(K) - dp_int(K+1))) > 1.0e-13*max(p_int(nk+1), CS%onem)) then
-        write(mesg, '("k ",i4," h ",es13.4," h_in ",es13.4, " dp ",2es13.4," err ",es13.4)') &
+        write(mesg, '("k ",I0," h ",es13.4," h_in ",es13.4, " dp ",2es13.4," err ",es13.4)') &
               k, h_col(k), h_in(k), dp_int(K), dp_int(K+1), (h_col(k) - h_in(k)) + (dp_int(K) - dp_int(K+1))
         call MOM_error(FATAL, "Mismatched thickness changes in hybgen_regrid: "//trim(mesg))
       endif
       if (h_col(k) < 0.0) then ! Could instead do: -1.0e-15*max(p_int(nk+1), CS%onem)) then
-        write(mesg, '("k ",i4," h ",es13.4," h_in ",es13.4, " dp ",2es13.4, " fixlay ",i4)') &
+        write(mesg, '("k ",I0," h ",es13.4," h_in ",es13.4, " dp ",2es13.4, " fixlay ",I0)') &
               k, h_col(k), h_in(k), dp_int(K), dp_int(K+1), fixlay
         call MOM_error(FATAL, "Significantly negative final thickness in hybgen_regrid: "//trim(mesg))
       endif

src/ALE/MOM_hybgen_unmix.F90

@@ -274,18 +274,18 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h)
         Trh_tot_out(m) = Trh_tot_out(m) + h_col(k)*tracer(k,m)
       enddo ; enddo
       if (abs(Sh_tot_in - Sh_tot_out) > 1.e-15*(abs(Sh_tot_in) + abs(Sh_tot_out))) then
-        write(mesg, '("i,j=",2i8,"Sh_tot = ",2es17.8," err = ",es13.4)') &
+        write(mesg, '("i,j=",I0,",",I0," Sh_tot = ",2es17.8," err = ",es13.4)') &
               i, j, Sh_tot_in, Sh_tot_out, (Sh_tot_in - Sh_tot_out)
         call MOM_error(FATAL, "Mismatched column salinity in hybgen_unmix: "//trim(mesg))
       endif
       if (abs(Th_tot_in - Th_tot_out) > 1.e-10*(abs(Th_tot_in) + abs(Th_tot_out))) then
-        write(mesg, '("i,j=",2i8,"Th_tot = ",2es17.8," err = ",es13.4)') &
+        write(mesg, '("i,j=",I0,",",I0," Th_tot = ",2es17.8," err = ",es13.4)') &
               i, j, Th_tot_in, Th_tot_out, (Th_tot_in - Th_tot_out)
         call MOM_error(FATAL, "Mismatched column temperature in hybgen_unmix: "//trim(mesg))
       endif
       do m=1,ntr
         if (abs(Trh_tot_in(m) - Trh_tot_out(m)) > 1.e-10*(abs(Trh_tot_in(m)) + abs(Trh_tot_out(m)))) then
-          write(mesg, '("i,j=",2i8,"Trh_tot(",i2,") = ",2es17.8," err = ",es13.4)') &
+          write(mesg, '("i,j=",I0,",",I0," Trh_tot(",i0,") = ",2es17.8," err = ",es13.4)') &
                 i, j, m, Trh_tot_in(m), Trh_tot_out(m), (Trh_tot_in(m) - Trh_tot_out(m))
           call MOM_error(FATAL, "Mismatched column tracer in hybgen_unmix: "//trim(mesg))
         endif

src/ALE/MOM_remapping.F90

@@ -574,12 +574,12 @@ 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(1x,a,1pe24.16))') 'Left edge undershoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, &
+        write(0,'(a,I0,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(1x,a,1pe24.16))') 'Left edge overshoot at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, &
+        write(0,'(a,I0,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
@@ -588,19 +588,19 @@ 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(1x,a,1pe24.16))') 'Right edge undershoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, &
+        write(0,'(a,I0,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(1x,a,1pe24.16))') 'Right edge overshoot at',i0,'u(i0)=',u_c,'u(i0+1)=',u_r, &
+        write(0,'(a,I0,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(1x,a,1pe24.16))') 'Non-monotonic edges at',i0,'u(i0-1)=',u_l,'u(i0)=',u_c, &
+        write(0,'(a,I0,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.
@@ -611,7 +611,7 @@ subroutine check_reconstructions_1d(n0, h0, u0, deg, boundary_extrapolation, &
       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,:)
+        write(0,'(I0,1p10e24.16)') n,h0(n),u0(n),ppoly_r_E(n,1),ppoly_r_E(n,2),ppoly_r_coefs(n,:)
       enddo
       call MOM_error(FATAL, 'MOM_remapping, check_reconstructions_1d: '// &
                    'Edge values or polynomial coefficients were inconsistent!')
@@ -1861,7 +1861,7 @@ subroutine test_recon_consistency(test, scheme, n0, niter, h_neglect)
   integer :: iter ! Loop counter
   integer :: seed_size ! Number of integers used by seed
   integer, allocatable :: seed(:) ! Random number seed
-  character(len=8) :: label ! Generated label
+  character(len=16) :: label ! Generated label
 
   call initialize_remapping(remapCS, scheme, nk=n0, h_neglect=h_neglect, &
                             force_bounds_in_subcell=.false. )
@@ -1889,8 +1889,8 @@ subroutine test_recon_consistency(test, scheme, n0, niter, h_neglect)
 
   enddo
 
-  write(label(1:8),'(i8)') niter
-  call test%test( error, trim(adjustl(label))//' consistency tests of '//scheme )
+  write(label,'(I0)') niter
+  call test%test( error, trim(label)//' consistency tests of '//scheme )
 
   call remapCS%reconstruction%destroy()
 
@@ -1911,7 +1911,7 @@ subroutine test_preserve_uniform(test, scheme, n0, niter, h_neglect)
   integer :: iter ! Loop counter
   integer :: seed_size ! Number of integers used by seed
   integer, allocatable :: seed(:) ! Random number seed
-  character(len=8) :: label ! Generated label
+  character(len=16) :: label ! Generated label
 
   call initialize_remapping(remapCS, scheme, nk=n0, h_neglect=h_neglect, &
                             force_bounds_in_subcell=.true., &
@@ -1947,8 +1947,8 @@ subroutine test_preserve_uniform(test, scheme, n0, niter, h_neglect)
 
   enddo
 
-  write(label(1:8),'(i8)') niter
-  call test%test( error, trim(adjustl(label))//' uniformity tests of '//scheme )
+  write(label,'(I0)') niter
+  call test%test( error, trim(label)//' uniformity tests of '//scheme )
 
 end subroutine test_preserve_uniform
 
@@ -1970,7 +1970,7 @@ subroutine test_unchanged_grid(test, scheme, n0, niter, h_neglect)
   real :: u0(n0), u1(n0) ! Source and target values [A]
   logical :: error ! Indicates a divergence
   integer :: iter ! Loop counter
-  character(len=8) :: label ! Generated label
+  character(len=16) :: label ! Generated label
 
   call initialize_remapping(remapCS, scheme, nk=n0, h_neglect=h_neglect, &
                             force_bounds_in_subcell=.true., &
@@ -2000,8 +2000,8 @@ subroutine test_unchanged_grid(test, scheme, n0, niter, h_neglect)
 
   enddo
 
-  write(label(1:8),'(i8)') niter
-  call test%test( error, trim(adjustl(label))//' unchanged grid tests of '//scheme )
+  write(label,'(I0)') niter
+  call test%test( error, trim(label)//' unchanged grid tests of '//scheme )
 
   call remapCS%reconstruction%destroy()
 
@@ -2025,7 +2025,7 @@ subroutine compare_two_schemes(test, CS1, CS2, n0, n1, niter, msg)
   integer :: iter ! Loop counter
   integer :: seed_size ! Number of integers used by seed
   integer, allocatable :: seed(:) ! Random number seed
-  character(len=8) :: label ! Generated label
+  character(len=16) :: label ! Generated label
 
   call random_seed(size=seed_size)
   allocate( seed(seed_Size) )
@@ -2061,8 +2061,8 @@ subroutine compare_two_schemes(test, CS1, CS2, n0, n1, niter, msg)
     endif
   enddo
 
-  write(label(1:8),'(i8)') niter
-  call test%test( error, trim(adjustl(label))//' comparisons of '//msg )
+  write(label,'(I0)') niter
+  call test%test( error, trim(label)//' comparisons of '//msg )
 
 end subroutine compare_two_schemes
 

src/core/MOM.F90

@@ -4300,7 +4300,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,1x),4(a,f8.3,1x),8(a,es11.4,1x))') &
+              write(msg(1:240),'(2(a,I0,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), &
@@ -4309,7 +4309,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,1x),4(a,f8.3,1x),6(a,es11.4))') &
+              write(msg(1:240),'(2(a,I0,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(ig), 'y=',G%gridLatT(jg), &
@@ -4326,8 +4326,8 @@ 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,1x))') 'There were a total of ',numberOfErrors, &
-          'locations detected with extreme surface values!'
+      write(msg(1:240),'(a,i0,a)') 'There were a total of ',numberOfErrors, &
+          ' locations detected with extreme surface values!'
       call MOM_error(FATAL, trim(msg))
     endif
   endif

src/core/MOM_barotropic.F90

@@ -2800,7 +2800,7 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL
 
     ! This might need to be moved outside of the OMP do loop directives.
     if (CS%debug_bt) then
-      write(mesg,'("BT vel update ",I4)') n
+      write(mesg,'("BT vel update ",I0)') n
       debug_halo = 0 ; if  (CS%debug_wide_halos) debug_halo = iev - ie
       call uvchksum(trim(mesg)//" PF[uv]", PFu, PFv, CS%debug_BT_HI, haloshift=debug_halo, &
                     symmetric=.true., unscale=US%L_T_to_m_s*US%s_to_T)
@@ -2888,7 +2888,7 @@ subroutine btstep_timeloop(eta, ubt, vbt, uhbt0, Datu, BTCL_u, vhbt0, Datv, BTCL
     endif
 
     if (CS%debug_bt) then
-      write(mesg,'("BT step ",I4)') n
+      write(mesg,'("BT step ",I0)') n
       call uvchksum(trim(mesg)//" [uv]bt", ubt, vbt, CS%debug_BT_HI, haloshift=debug_halo, &
                     symmetric=.true., unscale=US%L_T_to_m_s)
       call hchksum(eta, trim(mesg)//" eta", CS%debug_BT_HI, haloshift=debug_halo, unscale=GV%H_to_MKS)

src/core/MOM_checksum_packages.F90

@@ -376,7 +376,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe
         write(0,'(a,2f12.5)') 'x,y=', G%geoLonT(i,j), G%geoLatT(i,j)
         write(0,'(a3,3a12)') 'k','h','Temp','Salt'
         do k = 1, nz
-          write(0,'(i3,3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k)
+          write(0,'(I0," ",3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k)
         enddo
         stop 'Extremum detected'
       endif
@@ -389,7 +389,7 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe
         write(0,'(a,2f12.5)') 'x,y=',G%geoLonT(i,j),G%geoLatT(i,j)
         write(0,'(a3,3a12)') 'k','h','Temp','Salt'
         do k = 1, nz
-          write(0,'(i3,3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k)
+          write(0,'(I0," ",3es12.4)') k, h(i,j,k), T_scale*Temp(i,j,k), S_scale*Salt(i,j,k)
         enddo
         stop 'Negative thickness detected'
       endif

src/core/MOM_continuity_PPM.F90

@@ -2346,13 +2346,13 @@ subroutine PPM_reconstruction_x(h_in, h_W, h_E, G, LB, h_min, monotonic, simple_
 
   if ((isl-stencil < G%isd) .or. (iel+stencil > G%ied)) then
     write(mesg,'("In MOM_continuity_PPM, PPM_reconstruction_x called with a ", &
-               & "x-halo that needs to be increased by ",i2,".")') &
+               & "x-halo that needs to be increased by ",I0,".")') &
                stencil + max(G%isd-isl,iel-G%ied)
     call MOM_error(FATAL,mesg)
   endif
   if ((jsl < G%jsd) .or. (jel > G%jed)) then
     write(mesg,'("In MOM_continuity_PPM, PPM_reconstruction_x called with a ", &
-               & "y-halo that needs to be increased by ",i2,".")') &
+               & "y-halo that needs to be increased by ",I0,".")') &
                max(G%jsd-jsl,jel-G%jed)
     call MOM_error(FATAL,mesg)
   endif
@@ -2500,13 +2500,13 @@ subroutine PPM_reconstruction_y(h_in, h_S, h_N, G, LB, h_min, monotonic, simple_
 
   if ((isl < G%isd) .or. (iel > G%ied)) then
     write(mesg,'("In MOM_continuity_PPM, PPM_reconstruction_y called with a ", &
-               & "x-halo that needs to be increased by ",i2,".")') &
+               & "x-halo that needs to be increased by ",I0,".")') &
                max(G%isd-isl,iel-G%ied)
     call MOM_error(FATAL,mesg)
   endif
   if ((jsl-stencil < G%jsd) .or. (jel+stencil > G%jed)) then
     write(mesg,'("In MOM_continuity_PPM, PPM_reconstruction_y called with a ", &
-                 & "y-halo that needs to be increased by ",i2,".")') &
+                 & "y-halo that needs to be increased by ",I0,".")') &
                  stencil + max(G%jsd-jsl,jel-G%jed)
     call MOM_error(FATAL,mesg)
   endif

src/core/MOM_open_boundary.F90

@@ -1042,7 +1042,7 @@ subroutine initialize_segment_data(GV, US, OBC, PF, turns)
           call MOM_error(FATAL," Unable to open OBC file " // trim(filename))
 
         if (OBC%brushcutter_mode .and. (modulo(siz(1),2) == 0 .or. modulo(siz(2),2) == 0)) then
-          write(mesg,'("Brushcutter mode sizes ", I0, I0)') siz(1), siz(2)
+          write(mesg, '("Brushcutter mode sizes ",I0," ",I0)') siz(1), siz(2)
           call MOM_error(WARNING, mesg // " " // trim(filename) // " " // trim(fieldname))
           call MOM_error(FATAL,'segment data are not on the supergrid')
         endif

src/diagnostics/MOM_PointAccel.F90

@@ -157,8 +157,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
     call get_date(CS%Time, yr, mo, day, hr, minute, sec)
     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)') &
+    write (file,'(/,"Time ",I0," ",I0," ",F6.2," U-velocity violation at ",I0,": ",I0,", ",I0, &
+        & " (",F7.2," E ",F7.2," N) Layers ",I0," to ",I0,". 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
 
@@ -497,8 +497,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st
     call get_date(CS%Time, yr, mo, day, hr, minute, sec)
     call get_time((CS%Time - set_date(yr, 1, 1, 0, 0, 0)), sec, yearday)
     write (file,'(/,"--------------------------")')
-    write (file,'(/,"Time ",i5,i4,F6.2," V-velocity violation at ",I4,": ",2(I3), &
-        & " (",F7.2," E ",F7.2," N) Layers ",I3," to ",I3,". dt = ",1PG10.4)') &
+    write (file,'(/,"Time ",I0," ",I0," ",F6.2," V-velocity violation at ",I0,": ",I0,", ",I0, &
+        & " (",F7.2," E ",F7.2," N) Layers ",I0," to ",I0,". dt = ",1PG10.4)') &
         yr, yearday, (REAL(sec)/3600.0), pe_here(), i, J, &
         G%geoLonCv(i,J), G%geoLatCv(i,J), ks, ke, US%T_to_s*dt