From 2ac4fe6faa30d9007c327098eb7a2a485ef1b081 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Jan 2022 09:13:24 -0500 Subject: [PATCH] Clean up non-standard syntax and whitespace Eliminated a number of instances of non-standard syntax from that described in https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide. The changes include enforcing the MOM6-standard 2-point indentation convention, replacing 'if(A)' with 'if (A)', and changing logical comparison syntax like '.gt.' to '>' or '.eq.' to '=='. An old commented out block of code for debugging (detected by its use of non-standard syntax) was also eliminated. All answers and output are bitwise identical. --- src/ALE/MOM_ALE.F90 | 4 +- src/core/MOM.F90 | 12 +-- src/core/MOM_continuity_PPM.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 18 ++-- src/core/MOM_dynamics_unsplit.F90 | 23 +++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 20 ++-- src/core/MOM_open_boundary.F90 | 8 +- src/core/MOM_variables.F90 | 8 +- src/framework/MOM_checksums.F90 | 20 ++-- src/framework/MOM_document.F90 | 18 ++-- src/framework/MOM_io.F90 | 16 +-- src/framework/MOM_random.F90 | 10 +- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 8 +- src/ocean_data_assim/MOM_oda_driver.F90 | 98 +++++++++---------- .../lateral/MOM_internal_tides.F90 | 4 +- .../lateral/MOM_tidal_forcing.F90 | 2 +- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 5 +- .../vertical/MOM_tidal_mixing.F90 | 27 ++--- src/tracer/MOM_lateral_boundary_diffusion.F90 | 14 +-- 20 files changed, 150 insertions(+), 169 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9aa01738b6..41ee555c52 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -869,7 +869,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) endif if (associated(OBC)) then - if (OBC%segnum_u(I,j) .ne. 0) then + if (OBC%segnum_u(I,j) /= 0) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -902,7 +902,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) endif if (associated(OBC)) then - if (OBC%segnum_v(i,J) .ne. 0) then + if (OBC%segnum_v(i,J) /= 0) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 7a15d58bb1..c36c0545e1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1138,11 +1138,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT - if (CS%do_dynamics) then!run particles whether or not stepping is split - if (CS%use_particles) then - call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model - endif - endif + if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split + call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model + endif if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then @@ -3721,8 +3719,8 @@ subroutine MOM_end(CS) endif if (CS%use_particles) then - call particles_end(CS%particles) - deallocate(CS%particles) + call particles_end(CS%particles) + deallocate(CS%particles) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 95de2fd923..e5bd2f9ae9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1282,7 +1282,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac l_seg = OBC%segnum_v(i,J) do_I(I) = .false. - if(l_seg /= OBC_NONE) & + if (l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 68b844562f..f22fb9a862 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1368,12 +1368,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Pressure Force Acceleration', & @@ -1398,12 +1398,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Coriolis and Advective Acceleration', & @@ -1448,12 +1448,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & 'Depth-integral of Barotropic Anomaly Zonal Acceleration', & @@ -1472,7 +1472,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & @@ -1481,7 +1481,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & @@ -1490,7 +1490,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fcc4c3d49b..9a58dddd0f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -239,8 +239,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -431,22 +429,23 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call enable_averages(dt, Time_local, CS%diag) -! Calculate effective areas and post data + ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif - ! h_av = (h + hp)/2 do k=1,nz do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 694d88f2ea..ec4a1aa843 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -250,8 +250,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -452,17 +450,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2c3f016005..41ba70f152 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -859,7 +859,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! siz(3) is constituent for tidal variables call field_size(filename, 'constituent', siz, no_domain=.true.) ! expect third dimension to be number of constituents in MOM_input - if (siz(3) .ne. OBC%n_tide_constituents .and. OBC%add_tide_constituents) then + if (siz(3) /= OBC%n_tide_constituents .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Number of constituents in input data is not '//& 'the same as the number specified') endif @@ -897,7 +897,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! Check if this is a tidal field. If so, the number ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then - if (OBC%n_tide_constituents .gt. 1 .and. OBC%add_tide_constituents) then + if (OBC%n_tide_constituents > 1 .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Only one constituent is supported when specifying '//& 'tidal boundary conditions by value rather than file.') endif @@ -997,7 +997,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) ! If the nodal correction is based on a different time, initialize that. ! Otherwise, it can use N from the time reference. if (OBC%add_nodal_terms) then - if (sum(nodal_ref_date) .ne. 0) then + if (sum(nodal_ref_date) /= 0) then ! A reference date was provided for the nodal correction nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3)) call astro_longitudes_init(nodal_time, nodal_longitudes) @@ -3939,7 +3939,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& - (index(segment%field(m)%name, 'phase') .le. 0 .and. index(segment%field(m)%name, 'amp') .le. 0)) then + (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer_in) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index ba5001e427..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -316,10 +316,10 @@ module MOM_variables !> pointers to grids modifying cell metric at porous barriers type, public :: porous_barrier_ptrs - real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] end type porous_barrier_ptrs diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index fffdb9bed8..d1a8102fc1 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -110,7 +110,7 @@ subroutine chksum0(scalar, mesg, scale, logunit) call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then rs = scaling * scalar @@ -147,7 +147,7 @@ subroutine zchksum(array, mesg, scale, logunit) endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -352,7 +352,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -618,7 +618,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -901,7 +901,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1079,7 +1079,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1246,7 +1246,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -1397,7 +1397,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1576,7 +1576,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1754,7 +1754,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ff0934ac55..24f77a0eb2 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -672,22 +672,22 @@ function real_array_string(vals, sep) integer :: j, n, ns logical :: doWrite character(len=10) :: separator - n=1 ; doWrite=.true. ; real_array_string='' + n = 1 ; doWrite = .true. ; real_array_string = '' if (present(sep)) then - separator=sep ; ns=len(sep) + separator = sep ; ns = len(sep) else - separator=', ' ; ns=2 + separator = ', ' ; ns = 2 endif do j=1,size(vals) - doWrite=.true. - if (j0) then ! Write separator if a number has already been written + if (len(real_array_string) > 0) then ! Write separator if a number has already been written real_array_string = real_array_string // separator(1:ns) endif if (n>1) then diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2b8fb210d5..2ea19df183 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -1617,16 +1617,16 @@ subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. if (present(ax_data)) then - if (allocated(ax_data)) deallocate(ax_data) - allocate(ax_data(axis%ax_size)) - ax_data(:)=axis%ax_data + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:) = axis%ax_data endif - if (present(name)) name=axis%name - if (present(longname)) longname=axis%longname - if (present(units)) units=axis%units - if (present(cartesian)) cartesian=axis%cartesian - if (present(ax_size)) ax_size=axis%ax_size + if (present(name)) name = axis%name + if (present(longname)) longname = axis%longname + if (present(units)) units = axis%units + if (present(cartesian)) cartesian = axis%cartesian + if (present(ax_size)) ax_size = axis%ax_size end subroutine get_axis_info diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 709fd27731..bef78a433a 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -223,9 +223,9 @@ function new_RandomNumberSequence(seed) result(twister) twister%state(0) = iand(seed, -1) do i = 1, blockSize - 1 ! ubound(twister%state) - twister%state(i) = 1812433253 * ieor(twister%state(i-1), & - ishft(twister%state(i-1), -30)) + i - twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines + twister%state(i) = 1812433253 * ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30)) + i + twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines end do twister%currentElement = blockSize end function new_RandomNumberSequence @@ -236,7 +236,7 @@ end function new_RandomNumberSequence integer function getRandomInt(twister) type(randomNumberSequence), intent(inout) :: twister !< The Mersenne Twister container - if(twister%currentElement >= blockSize) call nextState(twister) + if (twister%currentElement >= blockSize) call nextState(twister) getRandomInt = temper(twister%state(twister%currentElement)) twister%currentElement = twister%currentElement + 1 @@ -251,7 +251,7 @@ double precision function getRandomReal(twister) integer :: localInt localInt = getRandomInt(twister) - if(localInt < 0) then + if (localInt < 0) then getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0) else getRandomReal = dble(localInt )/(2.0d0**32 - 1.0d0) diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 2a3066dfbd..ef4ad7b6d9 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -448,7 +448,7 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & type(diag_type), pointer :: diag => NULL() MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -537,7 +537,7 @@ integer function register_MOM_IS_static_field(module_name, field_name, axes, & type(diag_ctrl), pointer :: diag_cs !< A structure that is used to regulate diagnostic output MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -582,8 +582,8 @@ function i2s(a, n_in) character(len=15) :: i2s_temp integer :: i,n - n=size(a) - if(present(n_in)) n = n_in + n = size(a) + if (present(n_in)) n = n_in i2s = '' do i=1,n diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d5259d760a..f183231c88 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -79,9 +79,9 @@ module MOM_oda_driver_mod !> A structure containing integer handles for bias adjustment of tracers type :: INC_CS - integer :: fldno = 0 !< The number of tracers - integer :: T_id !< The integer handle for the temperature file - integer :: S_id !< The integer handle for the salinity file + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file end type INC_CS !> Control structure that contains a transpose of the ocean state across ensemble members. @@ -353,21 +353,21 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) if (CS%do_bias_adjustment) then - call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & - "The name of the file containing temperature and salinity "//& - "tendency adjustments", default='temp_salt_adjustment.nc') + call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') - inc_file = trim(inputdir) // trim(bias_correction_file) - CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) - CS%INC_CS%fldno = 2 - if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') - allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -455,7 +455,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return + if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return !! switch to global pelist @@ -531,43 +531,43 @@ subroutine oda(Time, CS) end subroutine oda subroutine get_bias_correction_tracer(Time, CS) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer :: CS !< ocean DA control structure - - integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias, S_bias - real, allocatable, dimension(:,:,:) :: mask_z - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value - integer,dimension(3) :: fld_sz - - call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - - ! This should be replaced to use mask_z instead of the following lines - ! which are intended to zero land values using an arbitrary limit. - fld_sz=shape(T_bias) - do i=1,fld_sz(1) - do j=1,fld_sz(2) - do k=1,fld_sz(3) - if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 - enddo - enddo + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) > 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) > 1.0E-3) S_bias(i,j,k) = 0.0 + enddo enddo + enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier - call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) - call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) - call cpu_clock_end(id_clock_bias_adjustment) + call cpu_clock_end(id_clock_bias_adjustment) - end subroutine get_bias_correction_tracer +end subroutine get_bias_correction_tracer !> Finalize DA module subroutine oda_end(CS) @@ -655,7 +655,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real :: missing_value if (.not. associated(CS)) return - if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + if (CS%assim_method == NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return call cpu_clock_begin(id_clock_apply_increments) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index eb7d3a6340..dfbb3e0d63 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1696,13 +1696,13 @@ subroutine reflect(En, NAngle, CS, G, LB) if (ridge(i,j)) then ! if ray is not incident but in ridge cell, use complementary angle - if ((Nangle_d2 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle)) then + if ((Nangle_d2 < angle_to_wall) .and. (angle_to_wall < Nangle)) then angle_wall0 = mod(angle_wall0 + Nangle_d2 + Nangle, Nangle) endif endif ! do reflection - if ((0 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle_d2)) then + if ((0 < angle_to_wall) .and. (angle_to_wall < Nangle_d2)) then angle_r0 = mod(2*angle_wall0 - a0 + Nangle, Nangle) angle_r = angle_r0 + 1 !re-index to 1 -> Nangle if (a /= angle_r) then diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index cc4517a473..f1d6e6bb57 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -388,7 +388,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) if (sum(tide_ref_date) == 0) then ! tide_ref_date defaults to 0. CS%time_ref = set_date(1, 1, 1) else - if(.not. CS%use_eq_phase) then + if (.not. CS%use_eq_phase) then ! Using a reference date but not using phase relative to equilibrium. ! This makes sense as long as either phases are overridden, or ! correctly simulating tidal phases is not desired. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 2ff0a21196..d12d850a73 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1213,7 +1213,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d88d5e551d..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -916,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c8166c47b8..be574b4356 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -308,7 +308,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di endif ! CS%use_CVMix_tidal ! Read in vertical profile of tidal energy dissipation - if ( CS%CVMix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_CVMix_tidal) then + if ( CS%CVMix_tidal_scheme == SCHMITTNER .or. .not. CS%use_CVMix_tidal) then call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy "//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -562,8 +562,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di fail_if_missing=.true.) ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent if ( .not. ( & - (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%CVMix_tidal_scheme.eq.SIMMONS).or. & - (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%CVMix_tidal_scheme.eq.SCHMITTNER) ) )then + (uppercase(tidal_energy_type(1:4)) == 'JAYN' .and. CS%CVMix_tidal_scheme == SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)) == 'ER03' .and. CS%CVMix_tidal_scheme == SCHMITTNER) ) )then call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& " mixing scheme: "//trim(CVMix_tidal_scheme_str) ) @@ -1434,7 +1434,7 @@ subroutine setup_tidal_diagnostics(G, GV, CS) ! additional diags for CVMix if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SIMMONS) then + if (CS%CVMix_tidal_scheme /= SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif @@ -1442,14 +1442,14 @@ subroutine setup_tidal_diagnostics(G, GV, CS) endif if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif @@ -1636,21 +1636,6 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) enddo ; enddo enddo - !open(unit=1905,file="out_1905.txt",access="APPEND") - !do j=G%jsd,G%jed - ! do i=isd,ied - ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then - ! write(1905,*) "-------------------------------------------" - ! do k=50,nz_in(1) - ! write(1905,*) i,j,k - ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc - ! end do - ! endif - ! enddo - !enddo - !close(1905) - ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index c11bc9856c..4a98aa1934 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -643,7 +643,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ k_bot_diff = (k_bot_max - k_bot_min) ! tracer flux where the minimum BLD intersets layer - if ((CS%linear) .and. (k_bot_diff .gt. 1)) then + if ((CS%linear) .and. (k_bot_diff > 1)) then ! apply linear decay at the base of hbl do k = k_bot_min,1,-1 F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) @@ -678,11 +678,11 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ ! ! TODO: GMM add option to apply linear decay ! k_top_max = MAX(k_top_L, k_top_R) ! ! make sure left and right k indices span same range -! if (k_top_max .ne. k_top_L) then +! if (k_top_max /= k_top_L) then ! k_top_L = k_top_max ! zeta_top_L = 1.0 ! endif -! if (k_top_max .ne. k_top_R) then +! if (k_top_max /= k_top_R) then ! k_top_R= k_top_max ! zeta_top_R = 1.0 ! endif @@ -1011,10 +1011,10 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - test_boundary_k_range = k_top .ne. k_top_ans - test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) - test_boundary_k_range = test_boundary_k_range .or. (k_bot .ne. k_bot_ans) - test_boundary_k_range = test_boundary_k_range .or. (zeta_bot .ne. zeta_bot_ans) + test_boundary_k_range = k_top /= k_top_ans + test_boundary_k_range = test_boundary_k_range .or. (zeta_top /= zeta_top_ans) + test_boundary_k_range = test_boundary_k_range .or. (k_bot /= k_bot_ans) + test_boundary_k_range = test_boundary_k_range .or. (zeta_bot /= zeta_bot_ans) if (test_boundary_k_range) write(stdout,*) "UNIT TEST FAILED: ", test_name if (test_boundary_k_range .or. verbose) then