From 634991d9c21a7ce84cc563aa9d59b9c53f4224d5 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 19 May 2020 11:05:29 -0400 Subject: [PATCH 01/12] Fixes an integer-kind mismatch in MOM_random, seed_from_time() (#1113) - gcc/8.3.0 issued `Error: Integer too big for its kind` reported in feedback on PR #1111. The intent was to assume kind=4 in these calculations but apparently our compilers were promoting `mod(dy + 32*(mo + 13*yr), 2147483648)` to kind=8. There were two mistakes in the expression: - the use of `2147483648` in the `mod` is not representable with kind=4; - the `mod` produces negative values and should have been a `modulo`. - This commit reduces the range of the results by one number on the positive side and removes all the negatives. --- src/framework/MOM_random.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index c37893012e..14800df9aa 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -143,8 +143,9 @@ integer function seed_from_time(Time) call get_date(Time,yr,mo,dy,hr,mn,sc) s1 = sc + 61*(mn + 61*hr) + 379 ! Range 379 .. 89620 ! Fun fact: 2147483647 is the eighth Mersenne prime. - ! This is not the reason for using 2147483647+1 here. - s2 = mod(dy + 32*(mo + 13*yr), 2147483648) ! Range 0 .. 2147483647 + ! This is not the reason for using 2147483647 here. It is the + ! largest integer of kind=4. + s2 = modulo(dy + 32*(mo + 13*yr), 2147483647_4) ! Range 0 .. 2147483646 seed_from_time = ieor(s1*4111, s2) end function seed_from_time From 7c3750d8477359836bef90f60d9b178af2b9c442 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Fri, 22 May 2020 15:00:47 -0400 Subject: [PATCH 02/12] Codecov: Set base as parent (target) branch Codecov appears to have two schemes for setting a target reference for coverage measurements: `pr` and `parent`. The first seems to measure coverage relative to the point where the PR was branched to branch against the current state of the PR. The second measures coverage relative to the current state of branch to be merged against the merged PR conent PR submissions default to the first, but we want to measure coverage relative to the second. This patch always uses the `parent` method. --- .codecov.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.codecov.yml b/.codecov.yml index 05fe474ab3..84e438145e 100644 --- a/.codecov.yml +++ b/.codecov.yml @@ -3,9 +3,11 @@ coverage: project: default: threshold: 100% + base: parent patch: default: threshold: 100% + base: parent comment: # This must be set to the number of test cases (TCs) after_n_builds: 8 From 33c3bf98f8ee2ba2fa6a158d43b3984cdfa7039c Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 24 May 2020 11:57:05 -0800 Subject: [PATCH 03/12] Added a space to a description. --- src/parameterizations/lateral/MOM_MEKE.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index eedd9e9268..e5a4b3de8a 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1063,7 +1063,7 @@ logical function MEKE_init(Time, G, US, param_file, diag, CS, MEKE, restart_CS) "If true, use an alternative formula for computing the (equilibrium)"//& "initial value of MEKE.", default=.false.) call get_param(param_file, mdl, "MEKE_EQUILIBRIUM_RESTORING", CS%MEKE_equilibrium_restoring, & - "If true, restore MEKE back to its equilibrium value, which is calculated at"//& + "If true, restore MEKE back to its equilibrium value, which is calculated at "//& "each time step.", default=.false.) if (CS%MEKE_equilibrium_restoring) then call get_param(param_file, mdl, "MEKE_RESTORING_TIMESCALE", MEKE_restoring_timescale, & From fc0da5058c590e10e21a4d766e25666ce1620def Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 25 May 2020 15:41:25 -0800 Subject: [PATCH 04/12] Clean up some divide-by-zero issues in OBCs. --- src/core/MOM_open_boundary.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5b6dc168f4..32f9936f4d 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4766,8 +4766,8 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) segment=>OBC%segment(n) if (.not. associated(segment%tr_Reg)) cycle if (segment%is_E_or_W) then + I = segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - I = segment%HI%IsdB ! ishift+I corresponds to the nearest interior tracer cell index ! idir switches the sign of the flow so that positive is into the reservoir if (segment%direction == OBC_DIRECTION_W) then @@ -4775,8 +4775,10 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) else ishift = 0 ; idir = 1 endif + if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + if (h(i+ishift,j,k) == 0.0) cycle u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / (h(i+ishift,j,k)*G%dyCu(I,j))) u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / (h(i+ishift,j,k)*G%dyCu(I,j))) fac1 = 1.0 + (u_L_out-u_L_in) @@ -4787,8 +4789,8 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) enddo ; endif ; enddo enddo else + J = segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - J = segment%HI%JsdB ! jshift+J corresponds to the nearest interior tracer cell index ! jdir switches the sign of the flow so that positive is into the reservoir if (segment%direction == OBC_DIRECTION_S) then @@ -4796,8 +4798,10 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) else jshift = 0 ; jdir = 1 endif + if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + if (h(i,j+jshift,k) == 0.0) cycle v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / (h(i,j+jshift,k)*G%dxCv(i,J))) v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / (h(i,j+jshift,k)*G%dxCv(i,J))) fac1 = 1.0 + (v_L_out-v_L_in) From 8a5ca12f8a6462276eaf14af1368d760a50bb510 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 26 May 2020 14:54:17 -0800 Subject: [PATCH 05/12] Alternate fix for divide-by-zero. --- src/core/MOM_open_boundary.F90 | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 32f9936f4d..69a0adbf25 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4775,12 +4775,14 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) else ishift = 0 ; idir = 1 endif + ! Can keep this or take it out, either way if (G%mask2dT(I+ishift,j) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz - if (h(i+ishift,j,k) == 0.0) cycle - u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / (h(i+ishift,j,k)*G%dyCu(I,j))) - u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / (h(i+ishift,j,k)*G%dyCu(I,j))) + u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & + ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) + u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & + ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) fac1 = 1.0 + (u_L_out-u_L_in) segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & @@ -4798,12 +4800,14 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) else jshift = 0 ; jdir = 1 endif + ! Can keep this or take it out, either way if (G%mask2dT(i,j+jshift) == 0.0) cycle ! Update the reservoir tracer concentration implicitly using a Backward-Euler timestep do m=1,ntr ; if (associated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz - if (h(i,j+jshift,k) == 0.0) cycle - v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / (h(i,j+jshift,k)*G%dxCv(i,J))) - v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / (h(i,j+jshift,k)*G%dxCv(i,J))) + v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & + ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) + v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & + ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) fac1 = 1.0 + (v_L_out-v_L_in) segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & From 41f57c088208aa3832b852f5b664562dff657d28 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 29 May 2020 17:31:28 -0400 Subject: [PATCH 06/12] (*)Improve ePBL when EPBL_ORIGINAL_PE_CALC=False Modified ePBL_column to calculate Te and Se when EPBL_ORIGINAL_PE_CALC is False and there are no temperature change diagnostics being requested, and to return dPEc_dKd from one of the calls to find_PE_chg. This avoids the use of uninitialized values in EPBL_ORIGINAL_PE_CALC is false, and some solutions appear to be similar, but others give large qualitative changes, so there are probably still problems with EPBL_ORIGINAL_PE_CALC = False. When this was originally developed, it was verified to be mathematically equivalent, but in the years that this code was not tested, problems have crept it. All answers in the MOM6-examples test cases are bitwise identical. --- .../vertical/MOM_energetic_PBL.F90 | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 25e1f80ff0..e3c33bd1c8 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -772,7 +772,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs integer :: OBL_it ! Iteration counter real :: Surface_Scale ! Surface decay scale for vstar - + logical :: calc_dT_expect ! If true calculate the expected changes in temperature and salinity. + logical :: calc_Te ! If true calculate the expected final temperature and salinity values. logical :: debug=.false. ! Change this hard-coded value for debugging. ! The following arrays are used only for debugging purposes. @@ -788,7 +789,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - debug = .false. ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) debug = .true. + calc_dT_expect = debug ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) calc_dT_expect = .true. + calc_Te = (calc_dT_expect .or. (.not.CS%orig_PE_calc)) h_neglect = GV%H_subroundoff @@ -1285,7 +1287,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & dT_to_dColHt(k), dS_to_dColHt(k), & - PE_chg=dPE_conv) + PE_chg=dPE_conv, dPEc_dKd=dPEc_dKd) endif MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) @@ -1381,7 +1383,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs htot = htot + h(k) endif - if (debug) then + if (calc_Te) then if (k==2) then Te(1) = b1*(h(1)*T0(1)) Se(1) = b1*(h(1)*S0(1)) @@ -1393,7 +1395,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs enddo Kd(nz+1) = 0.0 - if (debug) then + if (calc_dT_expect) then ! Complete the tridiagonal solve for Te. b1 = 1.0 / hp_a Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) @@ -1404,7 +1406,9 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs Se(k) = Se(k) + c1(K+1)*Se(k+1) eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) enddo + endif + if (debug) then dPE_debug = 0.0 do k=1,nz dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & From 0ee031d342761484f8c81132e60a4a9550cdd035 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 May 2020 10:54:14 -0400 Subject: [PATCH 07/12] Added explicit form of cpu_clock_id Added an explicit MOM6 interface for cpu_clock_id, rather than simply passing the call through to mpp_clock_id, both to explicitly document the interface and arguments and to use the FMS run-time defaults for clock synchronization. This will enable SIS2 to use the MOM_cpu_clock module with the same behavior. All answers and output are bitwise identical. --- src/framework/MOM_cpu_clock.F90 | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/src/framework/MOM_cpu_clock.F90 b/src/framework/MOM_cpu_clock.F90 index 41849aafb7..a041b06b8b 100644 --- a/src/framework/MOM_cpu_clock.F90 +++ b/src/framework/MOM_cpu_clock.F90 @@ -3,8 +3,9 @@ module MOM_cpu_clock ! This file is part of MOM6. See LICENSE.md for the license. +use fms_mod, only : clock_flag_default use mpp_mod, only : cpu_clock_begin => mpp_clock_begin -use mpp_mod, only : cpu_clock_end => mpp_clock_end, cpu_clock_id => mpp_clock_id +use mpp_mod, only : cpu_clock_end => mpp_clock_end, mpp_clock_id use mpp_mod, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT, CLOCK_MODULE_DRIVER use mpp_mod, only : CLOCK_MODULE, CLOCK_ROUTINE, CLOCK_LOOP, CLOCK_INFRA use mpp_mod, only : CLOCK_SYNC => MPP_CLOCK_SYNC @@ -15,4 +16,27 @@ module MOM_cpu_clock public :: CLOCK_COMPONENT, CLOCK_SUBCOMPONENT, CLOCK_MODULE_DRIVER, CLOCK_MODULE public :: CLOCK_ROUTINE, CLOCK_LOOP, CLOCK_INFRA, CLOCK_SYNC +contains + +!> cpu_clock_id returns the integer handle for a named CPU clock. +function cpu_clock_id( name, synchro_flag, grain ) + character(len=*), intent(in) :: name !< The unique name of the CPU clock + integer, intent(in), optional :: synchro_flag !< An integer flag that controls whether the PEs + !! are synchronized before the cpu clocks start counting. + !! Synchronization occurs before the start of a clock if this + !! is odd, while additional (expensive) statistics can set + !! for other values. If absent, the default is taken from the + !! settings for FMS. + integer, intent(in), optional :: grain !< The timing granularity for this clock, usually set to + !! the values of CLOCK_COMPONENT, CLOCK_ROUTINE, CLOCK_LOOP, etc. + integer :: cpu_clock_id !< The integer CPU clock handle. + + if (present(synchro_flag)) then + cpu_clock_id = mpp_clock_id(name, flags=synchro_flag, grain=grain) + else + cpu_clock_id = mpp_clock_id(name, flags=clock_flag_default, grain=grain) + endif + +end function cpu_clock_id + end module MOM_cpu_clock From e0af94c3f26292a783c1c654167cfea21dab6e64 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 May 2020 11:02:24 -0400 Subject: [PATCH 08/12] +Added code to handle tab lengths in documentation Added code to handle discrepancies between compliers in how "\t" is handled in strings, so that the MOM6 documentation files are identical across compilers. All answers are bitwise identical. --- src/framework/MOM_document.F90 | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 6c4c1f1ebb..b7fa6a170c 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -468,6 +468,8 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & integer :: start_ind = 1 ! The starting index in the description for the next line. integer :: nl_ind, tab_ind, end_ind ! The indices of new-lines, tabs, and the end of a line. integer :: len_text, len_tab, len_nl ! The lengths of the text string, tabs and new-lines. + integer :: len_cor ! The permitted length corrected for tab sizes in a line. + integer :: substr_start ! The starting index of a substring to search for tabs. integer :: indnt, msg_pad ! Space counts used to format a message. logical :: msg_done, reset_msg_pad ! Logicals used to format messages. logical :: all, short, layout, debug ! Flags indicating which files to write into. @@ -494,16 +496,25 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & do if (len_trim(desc(start_ind:)) < 1) exit - nl_ind = index(desc(start_ind:), "\n") + len_cor = len_text - msg_pad + substr_start = start_ind + do ! Adjust the available line length for anomalies in the size of tabs + tab_ind = index(desc(substr_start:start_ind+len_cor), "\t") ! Count \t as 2 spaces. + if (tab_ind == 0) exit + substr_start = substr_start + tab_ind + len_cor = len_cor + (len_tab - 2) + enddo + + nl_ind = index(desc(start_ind:), "\n") end_ind = 0 - if ((nl_ind > 0) .and. (len_trim(desc(start_ind:start_ind+nl_ind-2)) > len_text-msg_pad)) then + if ((nl_ind > 0) .and. (len_trim(desc(start_ind:start_ind+nl_ind-2)) > len_cor)) then ! This line is too long despite the new-line character. Look for an earlier space to break. - end_ind = scan(desc(start_ind:start_ind+(len_text-msg_pad)), " ", back=.true.) - 1 + end_ind = scan(desc(start_ind:start_ind+(len_cor)), " ", back=.true.) - 1 if (end_ind > 0) nl_ind = 0 - elseif ((nl_ind == 0) .and. (len_trim(desc(start_ind:)) > len_text-msg_pad)) then + elseif ((nl_ind == 0) .and. (len_trim(desc(start_ind:)) > len_cor)) then ! This line is too long and does not have a new-line character. Look for a space to break. - end_ind = scan(desc(start_ind:start_ind+(len_text-msg_pad)), " ", back=.true.) - 1 + end_ind = scan(desc(start_ind:start_ind+(len_cor)), " ", back=.true.) - 1 endif reset_msg_pad = .false. From 3303fb9d4597c211698d44f441dc3da432f10122 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 May 2020 11:13:56 -0400 Subject: [PATCH 09/12] Included H_subroundoff in a denominator Added an H_subroundoff term to the denominator of an expression in calculate_bkgnd_mixing for the inverse of the mixed layer thickness, so that NaNs will not be created when taking this inverse if CS%HMix is set to 0. All answers are bitwise identical in the MOM6-examples test cases. --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 57199f38d0..779bee6fcf 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -445,7 +445,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) elseif ((.not. CS%Bryan_Lewis_diffusivity) .and. (.not.CS%bulkmixedlayer) .and. & (.not. CS%horiz_varying_background) .and. (CS%Kd /= CS%Kdml)) then - I_Hmix = 1.0 / CS%Hmix + I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff*GV%H_to_Z) do i=is,ie ; depth(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k) From 64827718bc1674d496960807abe2c5a316e39e46 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 30 May 2020 15:53:09 -0400 Subject: [PATCH 10/12] Corrected recent bug in writeMessageAndDesc Minor correction to avoid scanning past the end of a string. With sensitive settings, this bug was causing sensitive models to abort, but if the model ran it was giving bitwise identical answers. --- src/framework/MOM_document.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index b7fa6a170c..610cc5eb63 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -500,6 +500,7 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & substr_start = start_ind do ! Adjust the available line length for anomalies in the size of tabs + if (len_trim(desc) <= start_ind+len_cor) exit ! This line will not span another line. tab_ind = index(desc(substr_start:start_ind+len_cor), "\t") ! Count \t as 2 spaces. if (tab_ind == 0) exit substr_start = substr_start + tab_ind @@ -510,11 +511,11 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & end_ind = 0 if ((nl_ind > 0) .and. (len_trim(desc(start_ind:start_ind+nl_ind-2)) > len_cor)) then ! This line is too long despite the new-line character. Look for an earlier space to break. - end_ind = scan(desc(start_ind:start_ind+(len_cor)), " ", back=.true.) - 1 + end_ind = scan(desc(start_ind:start_ind+len_cor), " ", back=.true.) - 1 if (end_ind > 0) nl_ind = 0 elseif ((nl_ind == 0) .and. (len_trim(desc(start_ind:)) > len_cor)) then ! This line is too long and does not have a new-line character. Look for a space to break. - end_ind = scan(desc(start_ind:start_ind+(len_cor)), " ", back=.true.) - 1 + end_ind = scan(desc(start_ind:start_ind+len_cor), " ", back=.true.) - 1 endif reset_msg_pad = .false. From 6e569173cea5e4bd3fbb4c59b49d64a2e36ccf24 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 31 May 2020 07:39:03 -0400 Subject: [PATCH 11/12] Slight improvement in writeMessageAndDesc Slight revision to writeMessageAndDesc to handle the case when a change in tab spacing will cause a line to exactly the maximum line length. All answers are bitwise identical answers. --- src/framework/MOM_document.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 610cc5eb63..b122a5b6f0 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -469,6 +469,7 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & integer :: nl_ind, tab_ind, end_ind ! The indices of new-lines, tabs, and the end of a line. integer :: len_text, len_tab, len_nl ! The lengths of the text string, tabs and new-lines. integer :: len_cor ! The permitted length corrected for tab sizes in a line. + integer :: len_desc ! The non-whitespace length of the description. integer :: substr_start ! The starting index of a substring to search for tabs. integer :: indnt, msg_pad ! Space counts used to format a message. logical :: msg_done, reset_msg_pad ! Logicals used to format messages. @@ -499,9 +500,10 @@ subroutine writeMessageAndDesc(doc, vmesg, desc, valueWasDefault, indent, & len_cor = len_text - msg_pad substr_start = start_ind - do ! Adjust the available line length for anomalies in the size of tabs - if (len_trim(desc) <= start_ind+len_cor) exit ! This line will not span another line. - tab_ind = index(desc(substr_start:start_ind+len_cor), "\t") ! Count \t as 2 spaces. + len_desc = len_trim(desc) + do ! Adjust the available line length for anomalies in the size of tabs, counting \t as 2 spaces. + if (substr_start >= start_ind+len_cor) exit + tab_ind = index(desc(substr_start:min(len_desc,start_ind+len_cor)), "\t") if (tab_ind == 0) exit substr_start = substr_start + tab_ind len_cor = len_cor + (len_tab - 2) From 1e0a5e4a7d612ac8f4583d27be22c6102057b044 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 2 Jun 2020 12:17:23 -0800 Subject: [PATCH 12/12] Fix to out-of-bounds error - was operating on segments not on core, oh no. --- src/core/MOM_open_boundary.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 69a0adbf25..58e3fb63fc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4790,7 +4790,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) if (associated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif ; enddo enddo - else + elseif (segment%is_N_or_S) then J = segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied ! jshift+J corresponds to the nearest interior tracer cell index