diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index c1042107ec..627fdc9f35 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -367,9 +367,9 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. if (ice_shelf) then - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h) else - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) endif call check_grid( G, GV, h, 0. ) @@ -639,9 +639,9 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. if (use_ice_shelf) then - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) + call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) else - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid ) + call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid ) endif ! Override old grid with new one. The new grid 'h_new' is built in diff --git a/src/ALE/PLM_functions.F90 b/src/ALE/PLM_functions.F90 index da60f9614a..d0f620e4a8 100644 --- a/src/ALE/PLM_functions.F90 +++ b/src/ALE/PLM_functions.F90 @@ -168,8 +168,8 @@ real elemental pure function PLM_extrapolate_slope(h_l, h_c, h_neglect, u_l, u_c real :: hl, hc ! Left and central cell thicknesses [units of grid thickness] ! Avoid division by zero for vanished cells - hl = h_l + h_neglect - hc = h_c + h_neglect + hl = h_l + h_neglect + hc = h_c + h_neglect ! The h2 scheme is used to compute the left edge value left_edge = (u_l*hc + u_c*hl) / (hl + hc) diff --git a/src/ALE/regrid_interp.F90 b/src/ALE/regrid_interp.F90 index 1ab225474c..0c758fadaf 100644 --- a/src/ALE/regrid_interp.F90 +++ b/src/ALE/regrid_interp.F90 @@ -76,7 +76,7 @@ module regrid_interp !! a third-order PPM ih4 scheme). In these cases, we resort to the simplest !! continuous linear scheme (P1M h2). subroutine regridding_set_ppolys(CS, densities, n0, h0, ppoly0_E, ppoly0_S, & - ppoly0_coefs, degree, h_neglect, h_neglect_edge) + ppoly0_coefs, degree, h_neglect, h_neglect_edge) type(interp_CS_type), intent(in) :: CS !< Interpolation control structure integer, intent(in) :: n0 !< Number of cells on source grid real, dimension(n0), intent(in) :: densities !< Actual cell densities [A] diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ddd6fe6dbb..0da0f95214 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2034,14 +2034,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call get_param(param_file, 'MOM', "ICE_SHELF", use_ice_shelf, default=.false., do_not_log=.true.) if (use_ice_shelf) then - inputdir = "." ; call get_param(param_file, 'MOM', "INPUTDIR", inputdir) - inputdir = slasher(inputdir) - call get_param(param_file, 'MOM', "ICE_THICKNESS_FILE", ice_shelf_file, & - "The file from which the ice bathymetry and area are read.", & - fail_if_missing=.true.) - call get_param(param_file, 'MOM', "ICE_AREA_VARNAME", area_varname, & - "The name of the area variable in ICE_THICKNESS_FILE.", & - fail_if_missing=.true.) + inputdir = "." ; call get_param(param_file, 'MOM', "INPUTDIR", inputdir) + inputdir = slasher(inputdir) + call get_param(param_file, 'MOM', "ICE_THICKNESS_FILE", ice_shelf_file, & + "The file from which the ice bathymetry and area are read.", & + fail_if_missing=.true.) + call get_param(param_file, 'MOM', "ICE_AREA_VARNAME", area_varname, & + "The name of the area variable in ICE_THICKNESS_FILE.", & + fail_if_missing=.true.) endif @@ -2854,32 +2854,32 @@ end subroutine register_diags subroutine MOM_timing_init(CS) type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM. - id_clock_ocean = cpu_clock_id('Ocean', grain=CLOCK_COMPONENT) - id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=CLOCK_SUBCOMPONENT) - id_clock_thermo = cpu_clock_id('Ocean thermodynamics and tracers', grain=CLOCK_SUBCOMPONENT) - id_clock_other = cpu_clock_id('Ocean Other', grain=CLOCK_SUBCOMPONENT) - id_clock_tracer = cpu_clock_id('(Ocean tracer advection)', grain=CLOCK_MODULE_DRIVER) - if (.not.CS%adiabatic) then - id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) - else - id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=CLOCK_MODULE_DRIVER) - endif - - id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) - id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) - id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) - id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) - id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) - if (CS%thickness_diffuse) & - id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE) -!if (CS%mixedlayer_restrat) & - id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE) - id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) - id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE) - id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE) - if (CS%offline_tracer_mode) then - id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) - endif + id_clock_ocean = cpu_clock_id('Ocean', grain=CLOCK_COMPONENT) + id_clock_dynamics = cpu_clock_id('Ocean dynamics', grain=CLOCK_SUBCOMPONENT) + id_clock_thermo = cpu_clock_id('Ocean thermodynamics and tracers', grain=CLOCK_SUBCOMPONENT) + id_clock_other = cpu_clock_id('Ocean Other', grain=CLOCK_SUBCOMPONENT) + id_clock_tracer = cpu_clock_id('(Ocean tracer advection)', grain=CLOCK_MODULE_DRIVER) + if (.not.CS%adiabatic) then + id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) + else + id_clock_adiabatic = cpu_clock_id('(Ocean adiabatic driver)', grain=CLOCK_MODULE_DRIVER) + endif + + id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) + id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) + id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) + id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) + id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) + if (CS%thickness_diffuse) & + id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE) + !if (CS%mixedlayer_restrat) & + id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE) + id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) + id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE) + id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE) + if (CS%offline_tracer_mode) then + id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) + endif end subroutine MOM_timing_init diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index f34dcd209e..ac5cb6c84c 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -698,7 +698,7 @@ subroutine Set_pbce_Bouss(e, tv, G, GV, US, Rho0, GFS_scale, pbce, rho_star) do k=2,nz ; do i=Isq,Ieq+1 pbce(i,j,k) = pbce(i,j,k-1) + & (GV%g_prime(K)*GV%H_to_Z) * ((e(i,j,K) - e(i,j,nz+1)) * Ihtot(i)) - enddo ; enddo + enddo ; enddo enddo ! end of j loop endif ! use_EOS diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index bad76d7bce..fa9a518e92 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -1027,7 +1027,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo !$OMP parallel do default(shared) do J=js-1,je - do k=1,nz ; do i=is,ie + do k=1,nz ; do i=is,ie gtot_N(i,j) = gtot_N(i,j) + pbce(i,j,k) * wt_v(i,J,k) gtot_S(i,j+1) = gtot_S(i,j+1) + pbce(i,j+1,k) * wt_v(i,J,k) enddo ; enddo @@ -3079,7 +3079,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif endif ; enddo ; enddo if (OBC%Flather_u_BCs_exist_globally) then - do n = 1, OBC%number_of_segments + do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (segment%is_E_or_W .and. segment%Flather) then do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB @@ -3133,7 +3133,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif endif ; enddo ; enddo if (OBC%Flather_v_BCs_exist_globally) then - do n = 1, OBC%number_of_segments + do n = 1, OBC%number_of_segments segment => OBC%segment(n) if (segment%is_N_or_S .and. segment%Flather) then do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 35ea54a7ed..56fcb725cb 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1302,20 +1302,20 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, ! This diagnostic is rescaled to MKS units when combined. handles%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, Time, & - 'Evaporation/condensation at ocean surface (evaporation is negative)', & - 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & - standard_name='water_evaporation_flux', cmor_field_name='evs', & - cmor_standard_name='water_evaporation_flux', & - cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') + 'Evaporation/condensation at ocean surface (evaporation is negative)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_evaporation_flux', cmor_field_name='evs', & + cmor_standard_name='water_evaporation_flux', & + cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea') ! smg: seaice_melt field requires updates to the sea ice model handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', & - diag%axesT1, Time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', & - 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & - standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & - cmor_field_name='fsitherm', & - cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& - cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') + diag%axesT1, Time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', & + 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s, & + standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', & + cmor_field_name='fsitherm', & + cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',& + cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)') handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, Time, & 'Liquid + frozen precipitation into ocean', 'kg m-2 s-1') diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 43c9c8c406..fda5a97d69 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -459,8 +459,8 @@ subroutine check_redundant_sT2d(mesg, array, G, is, ie, js, je) & 1pe12.4," at i,j = ",2i4," on pe ",i4)') & array(i,j), a_nonsym(i,j),array(i,j)-a_nonsym(i,j),i,j,pe_here() write(0,'(A130)') trim(mesg)//trim(mesg2) - redundant_prints(1) = redundant_prints(1) + 1 - endif + redundant_prints(1) = redundant_prints(1) + 1 + endif enddo ; enddo end subroutine check_redundant_sT2d diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index b79bc77e76..7d11ac0608 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -204,7 +204,7 @@ subroutine MOM_sum_output_init(G, GV, US, param_file, directory, ntrnc, & !query fms_io if there is a filename_appendix (for ensemble runs) call get_filename_appendix(filename_appendix) if (len_trim(filename_appendix) > 0) then - energyfile = trim(energyfile) //'.'//trim(filename_appendix) + energyfile = trim(energyfile) //'.'//trim(filename_appendix) endif CS%energyfile = trim(slasher(directory))//trim(energyfile) @@ -1299,7 +1299,7 @@ subroutine write_depth_list(G, US, CS, filename, list_size) if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) status = NF90_PUT_ATT(ncid, Vid, "long_name", "Open volume below depth") - if (status /= NF90_NOERR) call MOM_error(WARNING, & + if (status /= NF90_NOERR) call MOM_error(WARNING, & filename//" vol_below "//trim(NF90_STRERROR(status))) status = NF90_PUT_ATT(ncid, Vid, "units", "m3") if (status /= NF90_NOERR) call MOM_error(WARNING, & diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 3d2b9dd3e9..6e74c3ffa3 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -1550,12 +1550,12 @@ subroutine convert_temp_salt_for_TEOS10(T, S, HI, kd, mask_z, EOS) do k=1,kd ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec if (mask_z(i,j,k) >= 1.0) then - S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) + S(i,j,k) = gsw_sr_from_sp(S(i,j,k)) ! Get absolute salinity from practical salinity, converting pressures from Pascal to dbar. ! If this option is activated, pressure will need to be added as an argument, and it should be ! moved out into module that is not shared between components, where the ocean_grid can be used. ! S(i,j,k) = gsw_sa_from_sp(S(i,j,k),pres(i,j,k)*1.0e-4,G%geoLonT(i,j),G%geoLatT(i,j)) - T(i,j,k) = gsw_ct_from_pt(S(i,j,k), T(i,j,k)) + T(i,j,k) = gsw_ct_from_pt(S(i,j,k), T(i,j,k)) endif enddo ; enddo ; enddo end subroutine convert_temp_salt_for_TEOS10 diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 709fd80a8e..47dc701798 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -19,8 +19,8 @@ module MOM_diag_manager_wrapper !> An integer handle for a diagnostic array returned by register_diag_field() integer function register_diag_field_array_fms(module_name, field_name, axes, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or !! "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field @@ -55,8 +55,8 @@ end function register_diag_field_array_fms !> An integer handle for a diagnostic scalar array returned by register_diag_field() integer function register_diag_field_scalar_fms(module_name, field_name, init_time, & - long_name, units, missing_value, range, mask_variant, standard_name, & - verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) + long_name, units, missing_value, range, mask_variant, standard_name, & + verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 66f58b5b9d..b323cfcfd2 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -407,15 +407,15 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, allocate(lon_in(id),lat_in(jd),z_in(kd),z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) - start = 1; count = 1; count(1) = id + start = 1 ; count = 1 ; count(1) = id rcode = NF90_GET_VAR(ncid, dim_id(1), lon_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1; count = 1; count(1) = jd + start = 1 ; count = 1 ; count(1) = jd rcode = NF90_GET_VAR(ncid, dim_id(2), lat_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & trim(varnam)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1; count = 1; count(1) = kd + start = 1 ; count = 1 ; count(1) = kd rcode = NF90_GET_VAR(ncid, dim_id(3), z_in, start, count) if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & trim(varnam//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") @@ -425,48 +425,46 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, if (present(m_to_Z)) then ; do k=1,kd ; z_in(k) = m_to_Z * z_in(k) ; enddo ; endif ! extrapolate the input data to the north pole using the northerm-most latitude - add_np=.false. - jdp=jd + add_np = .false. + jdp = jd if (.not. is_ongrid) then - max_lat = maxval(lat_in) - if (max_lat < 90.0) then - add_np=.true. - jdp=jd+1 - allocate(lat_inp(jdp)) - lat_inp(1:jd)=lat_in(:) - lat_inp(jd+1)=90.0 - deallocate(lat_in) - allocate(lat_in(1:jdp)) - lat_in(:)=lat_inp(:) - endif + max_lat = maxval(lat_in) + if (max_lat < 90.0) then + add_np = .true. + jdp = jd+1 + allocate(lat_inp(jdp)) + lat_inp(1:jd) = lat_in(:) + lat_inp(jd+1) = 90.0 + deallocate(lat_in) + allocate(lat_in(1:jdp)) + lat_in(:) = lat_inp(:) + endif endif ! construct level cell boundaries as the mid-point between adjacent centers z_edges_in(1) = 0.0 do K=2,kd - z_edges_in(K)=0.5*(z_in(k-1)+z_in(k)) + z_edges_in(K) = 0.5*(z_in(k-1)+z_in(k)) enddo - z_edges_in(kd+1)=2.0*z_in(kd) - z_in(kd-1) + z_edges_in(kd+1) = 2.0*z_in(kd) - z_in(kd-1) if (is_ongrid) then - allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 - allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 + allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 + allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 else - call horiz_interp_init() - lon_in = lon_in*PI_180 - lat_in = lat_in*PI_180 - allocate(x_in(id,jdp),y_in(id,jdp)) - call meshgrid(lon_in,lat_in, x_in, y_in) - lon_out(:,:) = G%geoLonT(:,:)*PI_180 - lat_out(:,:) = G%geoLatT(:,:)*PI_180 - allocate(tr_in(id,jd)) ; tr_in(:,:)=0.0 - allocate(tr_inp(id,jdp)) ; tr_inp(:,:)=0.0 - allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 - allocate(last_row(id)) ; last_row(:)=0.0 + call horiz_interp_init() + lon_in = lon_in*PI_180 + lat_in = lat_in*PI_180 + allocate(x_in(id,jdp), y_in(id,jdp)) + call meshgrid(lon_in, lat_in, x_in, y_in) + lon_out(:,:) = G%geoLonT(:,:)*PI_180 + lat_out(:,:) = G%geoLatT(:,:)*PI_180 + allocate(tr_in(id,jd)) ; tr_in(:,:) = 0.0 + allocate(tr_inp(id,jdp)) ; tr_inp(:,:) = 0.0 + allocate(mask_in(id,jdp)) ; mask_in(:,:) = 0.0 + allocate(last_row(id)) ; last_row(:) = 0.0 endif - - max_depth = maxval(G%bathyT) call mpp_max(max_depth) @@ -478,7 +476,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, ! to define the layers do k=1,kd write(laynum,'(I8)') k ; laynum = adjustl(laynum) - mask_in=0.0 + mask_in = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1 diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 7181a1f1b9..14518c1259 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -67,8 +67,8 @@ module MOM_restart !> A structure to store information about restart fields that are no longer used type obsolete_restart - character(len=32) :: field_name !< Name of restart field that is no longer in use - character(len=32) :: replacement_name !< Name of replacement restart field, if applicable + character(len=32) :: field_name !< Name of restart field that is no longer in use + character(len=32) :: replacement_name !< Name of replacement restart field, if applicable end type obsolete_restart !> A restart registry and the control structure for restarts diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 66fd873f67..41d397abed 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1271,7 +1271,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "ice shelf (every time step) from a file.", default=.false.) if (CS%find_salt_root) then ! read liquidus coeffs. - call get_param(param_file, mdl, "TFREEZE_S0_P0", CS%TFr_0_0, & + call get_param(param_file, mdl, "TFREEZE_S0_P0", CS%TFr_0_0, & "this is the freezing potential temperature at "//& "S=0, P=0.", units="degC", default=0.0, do_not_log=.true.) call get_param(param_file, mdl, "DTFREEZE_DS", CS%dTFr_dS, & @@ -1592,14 +1592,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_area_shelf_h = register_diag_field('ocean_model', 'area_shelf_h', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) + 'Ice Shelf Area in cell', 'meter-2', conversion=US%L_to_m**2) CS%id_shelf_mass = register_diag_field('ocean_model', 'shelf_mass', CS%diag%axesT1, CS%Time, & - 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) + 'mass of shelf', 'kg/m^2', conversion=US%RZ_to_kg_m2) CS%id_h_shelf = register_diag_field('ocean_model', 'h_shelf', CS%diag%axesT1, CS%Time, & - 'ice shelf thickness', 'm', conversion=US%Z_to_m) - CS%id_mass_flux = register_diag_field('ocean_model', 'mass_flux', CS%diag%axesT1,& - CS%Time, 'Total mass flux of freshwater across the ice-ocean interface.', & - 'kg/s', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2) + 'ice shelf thickness', 'm', conversion=US%Z_to_m) + CS%id_mass_flux = register_diag_field('ocean_model', 'mass_flux', CS%diag%axesT1, CS%Time, & + 'Total mass flux of freshwater across the ice-ocean interface.', & + 'kg/s', conversion=US%RZ_T_to_kg_m2s*US%L_to_m**2) if (CS%const_gamma) then ! use ISOMIP+ eq. with rho_fw = 1000. kg m-3 meltrate_conversion = 86400.0*365.0*US%Z_to_m*US%s_to_T / (1000.0*US%kg_m3_to_R) @@ -1607,27 +1607,27 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl meltrate_conversion = 86400.0*365.0*US%Z_to_m*US%s_to_T / CS%density_ice endif CS%id_melt = register_diag_field('ocean_model', 'melt', CS%diag%axesT1, CS%Time, & - 'Ice Shelf Melt Rate', 'm yr-1', conversion= meltrate_conversion) + 'Ice Shelf Melt Rate', 'm yr-1', conversion= meltrate_conversion) CS%id_thermal_driving = register_diag_field('ocean_model', 'thermal_driving', CS%diag%axesT1, CS%Time, & - 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius') + 'pot. temp. in the boundary layer minus freezing pot. temp. at the ice-ocean interface.', 'Celsius') CS%id_haline_driving = register_diag_field('ocean_model', 'haline_driving', CS%diag%axesT1, CS%Time, & - 'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'psu') + 'salinity in the boundary layer minus salinity at the ice-ocean interface.', 'psu') CS%id_Sbdry = register_diag_field('ocean_model', 'sbdry', CS%diag%axesT1, CS%Time, & - 'salinity at the ice-ocean interface.', 'psu') + 'salinity at the ice-ocean interface.', 'psu') CS%id_u_ml = register_diag_field('ocean_model', 'u_ml', CS%diag%axesCu1, CS%Time, & - 'Eastward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) + 'Eastward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_v_ml = register_diag_field('ocean_model', 'v_ml', CS%diag%axesCv1, CS%Time, & - 'Northward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) + 'Northward vel. in the boundary layer (used to compute ustar)', 'm s-1', conversion=US%L_T_to_m_s) CS%id_exch_vel_s = register_diag_field('ocean_model', 'exch_vel_s', CS%diag%axesT1, CS%Time, & - 'Sub-shelf salinity exchange velocity', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Sub-shelf salinity exchange velocity', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_exch_vel_t = register_diag_field('ocean_model', 'exch_vel_t', CS%diag%axesT1, CS%Time, & - 'Sub-shelf thermal exchange velocity', 'm s-1' , conversion=US%Z_to_m*US%s_to_T) + 'Sub-shelf thermal exchange velocity', 'm s-1' , conversion=US%Z_to_m*US%s_to_T) CS%id_tfreeze = register_diag_field('ocean_model', 'tfreeze', CS%diag%axesT1, CS%Time, & - 'In Situ Freezing point at ice shelf interface', 'degC') + 'In Situ Freezing point at ice shelf interface', 'degC') CS%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & - 'Heat conduction into ice shelf', 'W m-2', conversion=-US%QRZ_T_to_W_m2) + 'Heat conduction into ice shelf', 'W m-2', conversion=-US%QRZ_T_to_W_m2) CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index 0c9fe4e77e..a2c0d482cc 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -2788,9 +2788,9 @@ subroutine update_velocity_masks(CS, G, hmask, umask, vmask, u_face_mask, v_face u_face_mask(:,:) = 0 ; v_face_mask(:,:) = 0 if (G%symmetric) then - is = isd ; js = jsd + is = isd ; js = jsd else - is = isd+1 ; js = jsd+1 + is = isd+1 ; js = jsd+1 endif do j=js,G%jed diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 54b452fc6a..122758f3cc 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -149,51 +149,52 @@ subroutine USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, C do j=G%jsd,G%jed - if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & - ((j+G%jdg_offset) >= G%domain%njhalo+1)) then + if (((j+G%jdg_offset) <= G%domain%njglobal+G%domain%njhalo) .AND. & + ((j+G%jdg_offset) >= G%domain%njhalo+1)) then - do i=G%isc,G%iec + do i=G%isc,G%iec ! if (((i+G%idg_offset) <= G%domain%niglobal+G%domain%nihalo) .AND. & ! ((i+G%idg_offset) >= G%domain%nihalo+1)) then - if ((j >= G%jsc) .and. (j <= G%jec)) then - - if (new_sim) then ; if (G%geoLonCu(i-1,j) >= edge_pos) then - ! Everything past the edge is open ocean. - mass_shelf(i,j) = 0.0 - area_shelf_h(i,j) = 0.0 - hmask (i,j) = 0.0 - h_shelf (i,j) = 0.0 - else - if (G%geoLonCu(i,j) > edge_pos) then - area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & - (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) - hmask (i,j) = 2.0 - else - area_shelf_h(i,j) = G%areaT(i,j) - hmask (i,j) = 1.0 + if ((j >= G%jsc) .and. (j <= G%jec)) then + if (new_sim) then ; if (G%geoLonCu(i-1,j) >= edge_pos) then + ! Everything past the edge is open ocean. + mass_shelf(i,j) = 0.0 + area_shelf_h(i,j) = 0.0 + hmask (i,j) = 0.0 + h_shelf (i,j) = 0.0 + else + if (G%geoLonCu(i,j) > edge_pos) then + area_shelf_h(i,j) = G%areaT(i,j) * (edge_pos - G%geoLonCu(i-1,j)) / & + (G%geoLonCu(i,j) - G%geoLonCu(i-1,j)) + hmask (i,j) = 2.0 + else + area_shelf_h(i,j) = G%areaT(i,j) + hmask (i,j) = 1.0 + endif + + if (G%geoLonT(i,j) > slope_pos) then + h_shelf (i,j) = CS%min_draft + mass_shelf(i,j) = CS%Rho_ocean * CS%min_draft + else + mass_shelf(i,j) = CS%Rho_ocean * (CS%min_draft + & + (CS%max_draft - CS%min_draft) * & + min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + h_shelf(i,j) = (CS%min_draft + & + (CS%max_draft - CS%min_draft) * & + min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + endif + endif ; endif endif - if (G%geoLonT(i,j) > slope_pos) then - h_shelf (i,j) = CS%min_draft - mass_shelf(i,j) = CS%Rho_ocean * CS%min_draft - else - mass_shelf(i,j) = CS%Rho_ocean * (CS%min_draft + & - (CS%max_draft - CS%min_draft) * & - min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) - h_shelf(i,j) = (CS%min_draft + & - (CS%max_draft - CS%min_draft) * & - min(1.0, (c1*(slope_pos - G%geoLonT(i,j)))**2) ) + if ((i+G%idg_offset) == G%domain%nihalo+1) then + hmask(i-1,j) = 3.0 endif - endif ; endif ; endif - - if ((i+G%idg_offset) == G%domain%nihalo+1) then - hmask(i-1,j) = 3.0 + enddo endif - - enddo ; endif ; enddo + enddo end subroutine USER_update_shelf_mass diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 88130857c7..efee50db05 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -240,13 +240,13 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) global_indices(4) = SGdom%njglobal+SGdom%njhalo exni(:) = 2*exni(:) ; exnj(:) = 2*exnj(:) if (associated(G%domain%maskmap)) then - call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & + call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & xextent=exni,yextent=exnj, & symmetry=.true., name="MOM_MOSAIC", maskmap=G%domain%maskmap) else - call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & + call MOM_define_domain(global_indices, SGdom%layout, SGdom%mpp_domain, & xflags=G%domain%X_FLAGS, yflags=G%domain%Y_FLAGS, & xhalo=SGdom%nihalo, yhalo=SGdom%njhalo, & xextent=exni,yextent=exnj, & diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 3733dda6a4..fe3b8efd26 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -400,22 +400,22 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", default="zero", & do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & + case ("file"); call initialize_velocity_from_file(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & + case ("zero"); call initialize_velocity_zero(u, v, G, GV, PF, & just_read_params=just_read) - case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & + case ("uniform"); call initialize_velocity_uniform(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & + case ("circular"); call initialize_velocity_circular(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & + case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) - case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & + case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read_params=just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) - case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & + case ("soliton"); call soliton_initialize_velocity(u, v, h, G, GV, US) + case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, & just_read_params=just_read) - case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& + case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) end select @@ -558,7 +558,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then - call initialize_segment_data(G, OBC, PF) ! call initialize_segment_data(G, OBC, param_file) + call initialize_segment_data(G, OBC, PF) ! call initialize_segment_data(G, OBC, param_file) ! call open_boundary_config(G, US, PF, OBC) ! Call this once to fill boundary arrays from fixed values if (.not. OBC%needs_IO_for_data) & @@ -1790,9 +1790,9 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, param_file, L "performs on-the-fly regridding in lat-lon-time.",& "of sponge restoring data.", default=.false.) if (time_space_interp_sponge) then - call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& - "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& - "INTERPOLATE_SPONGE_TIME_SPACE = True.") + call MOM_error(WARNING, " initialize_sponges: NEW_SPONGES has been deprecated. "//& + "Please use INTERPOLATE_SPONGE_TIME_SPACE instead. Setting "//& + "INTERPOLATE_SPONGE_TIME_SPACE = True.") endif call get_param(param_file, mdl, "INTERPOLATE_SPONGE_TIME_SPACE", time_space_interp_sponge, & "Set True if using the newer sponging code which "//& diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 2572e15a04..26fa16d489 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -139,7 +139,7 @@ subroutine init_oda(Time, G, GV, CS) character(len=200) :: inputdir, basin_file logical :: reentrant_x, reentrant_y, tripolar_N, symmetric - if (associated(CS)) call mpp_error(FATAL,'Calling oda_init with associated control structure') + if (associated(CS)) call mpp_error(FATAL, 'Calling oda_init with associated control structure') allocate(CS) ! Use ens1 parameters , this could be changed at a later time ! if it were desirable to have alternate parameters, e.g. for the grid @@ -175,14 +175,14 @@ subroutine init_oda(Time, G, GV, CS) inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) - case('eakf') + case('eakf') CS%assim_method = EAKF_ASSIM - case('oi') - CS%assim_method = OI_ASSIM - case('no_assim') + case('oi') + CS%assim_method = OI_ASSIM + case('no_assim') CS%assim_method = NO_ASSIM - case default - call mpp_error(FATAL,'Invalid assimilation method provided') + case default + call mpp_error(FATAL, 'Invalid assimilation method provided') end select ens_info = get_ensemble_size() @@ -192,8 +192,8 @@ subroutine init_oda(Time, G, GV, CS) !! Switch to global pelist allocate(CS%ensemble_pelist(CS%ensemble_size,npes_pm)) allocate(CS%filter_pelist(CS%ensemble_size*npes_pm)) - call get_ensemble_pelist(CS%ensemble_pelist,'ocean') - call get_ensemble_filter_pelist(CS%filter_pelist,'ocean') + call get_ensemble_pelist(CS%ensemble_pelist, 'ocean') + call get_ensemble_filter_pelist(CS%filter_pelist, 'ocean') call set_current_pelist(CS%filter_pelist) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 0751177a5d..c431c16ce4 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -780,7 +780,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Variance should be positive but round-off can violate this. Calculating ! variance directly would fix this but requires more operations. Tsgs2(i,j,k) = CS%Stanley_det_coeff * max(0., mn_T2) - enddo ; enddo ; enddo + enddo ; enddo ; enddo endif !$OMP do do j=js-1,je+1 diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index f65a7d150e..89c0bf8377 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -90,7 +90,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) ! Warn user if EPBL is being used, since in this case mixing due to convection will ! be aplied in the boundary layer if (useEPBL) then - call MOM_error(WARNING, 'MOM_CVMix_conv_init: '// & + call MOM_error(WARNING, 'MOM_CVMix_conv_init: '// & 'CVMix convection may not be properly applied when ENERGETICS_SFC_PBL = True'//& 'as convective mixing might occur in the boundary layer.') endif diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index b50f4c1c88..85d9c63a39 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -231,22 +231,22 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) "If true, use the Large-McWilliams-Doney (JGR 1994) "//& "shear mixing parameterization.", default=.false.) if (CS%use_LMD94) then - NumberTrue=NumberTrue + 1 - CS%Mix_Scheme='KPP' + NumberTrue=NumberTrue + 1 + CS%Mix_Scheme='KPP' endif call get_param(param_file, mdl, "USE_PP81", CS%use_PP81, & "If true, use the Pacanowski and Philander (JPO 1981) "//& "shear mixing parameterization.", default=.false.) if (CS%use_PP81) then - NumberTrue = NumberTrue + 1 - CS%Mix_Scheme='PP' + NumberTrue = NumberTrue + 1 + CS%Mix_Scheme='PP' endif use_JHL=kappa_shear_is_used(param_file) if (use_JHL) NumberTrue = NumberTrue + 1 ! After testing for interior schemes, make sure only 0 or 1 are enabled. ! Otherwise, warn user and kill job. if ((NumberTrue) > 1) then - call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & + call MOM_error(FATAL, 'MOM_CVMix_shear_init: '// & 'Multiple shear driven internal mixing schemes selected,'//& ' please disable all but one scheme to proceed.') endif diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1ff12b9099..8b72809837 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1222,7 +1222,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW) - endif + endif ! ea is for passive tracers do i=is,ie ! ea(i,j,1) = netMassInOut(i) @@ -1580,7 +1580,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori return else allocate(CS) - endif + endif CS%diag => diag CS%Time => Time diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7c3697550e..99dee11b9a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -304,8 +304,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if ((CS%use_CVMix_ddiff .or. CS%double_diffusion) .and. & .not.(present(Kd_extra_T) .and. present(Kd_extra_S))) & - call MOM_error(FATAL, "set_diffusivity: both Kd_extra_T and Kd_extra_S must be present "//& - "when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") + call MOM_error(FATAL, "set_diffusivity: both Kd_extra_T and Kd_extra_S must be present "//& + "when USE_CVMIX_DDIFF or DOUBLE_DIFFUSION are true.") TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. & (CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity)) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index e7f7ad9d0d..b870dff1af 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -944,7 +944,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kd_int, Kv deallocate(exp_hab_zetar) case default - call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define CVMIX_TIDAL_SCHEME found in input file.") end select diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index fdf76597ef..62fe491bfc 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1762,49 +1762,49 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & - 'Thickness at Zonal Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Thickness at Zonal Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & - 'Thickness at Meridional Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Thickness at Meridional Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & - 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & - 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units, & - conversion=GV%H_to_m) + 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units, & + conversion=GV%H_to_m) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, & - Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + Time, 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_du_dt_visc > 0) call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) CS%id_dv_dt_visc = register_diag_field('ocean_model', 'dv_dt_visc', diag%axesCvL, & - Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) + Time, 'Meridional Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) if (CS%id_dv_dt_visc > 0) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) CS%id_taux_bot = register_diag_field('ocean_model', 'taux_bot', diag%axesCu1, & - Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) + Time, 'Zonal Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) CS%id_tauy_bot = register_diag_field('ocean_model', 'tauy_bot', diag%axesCv1, & - Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & - conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) + Time, 'Meridional Bottom Stress from Ocean to Earth', 'Pa', & + conversion=US%RZ_to_kg_m2*US%L_T2_to_m_s2) !CS%id_hf_du_dt_visc = register_diag_field('ocean_model', 'hf_du_dt_visc', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Vertical Viscosity', 'm s-2', & diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index ce4f6308b2..650e66c47f 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -67,22 +67,22 @@ module MOM_generic_tracer !> Control structure for generic tracers type, public :: MOM_generic_tracer_CS ; private - character(len = 200) :: IC_file !< The file in which the generic tracer initial values can - !! be found, or an empty string for internal initialization. - logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. - real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers. - real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out. - logical :: tracers_may_reinit !< If true, tracers may go through the - !! initialization code if they are not found in the restart files. - - type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to - !! regulate the timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure - - !> Pointer to the first element of the linked list of generic tracers. - type(g_tracer_type), pointer :: g_tracer_list => NULL() - - integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV + character(len = 200) :: IC_file !< The file in which the generic tracer initial values can + !! be found, or an empty string for internal initialization. + logical :: Z_IC_file !< If true, the generic_tracer IC_file is in Z-space. The default is false. + real :: tracer_IC_val = 0.0 !< The initial value assigned to tracers. + real :: tracer_land_val = -1.0 !< The values of tracers used where land is masked out. + logical :: tracers_may_reinit !< If true, tracers may go through the + !! initialization code if they are not found in the restart files. + + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to + !! regulate the timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Restart control structure + + !> Pointer to the first element of the linked list of generic tracers. + type(g_tracer_type), pointer :: g_tracer_list => NULL() + + integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV end type MOM_generic_tracer_CS diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index a1d7d2fc9d..279f6e901c 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -356,9 +356,9 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Calculate pressure at interfaces and layer averaged alpha/beta if (present(p_surf)) then - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - CS%Pint(i,j,1) = p_surf(i,j) - enddo ; enddo + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + CS%Pint(i,j,1) = p_surf(i,j) + enddo ; enddo else CS%Pint(:,:,1) = 0. endif diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 678199f9cb..87a8c8f9a4 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -342,7 +342,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & !! tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhr !< accumulated volume/mass flux through !! the zonal face [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_neglect !< A tiny zonal mass flux that can + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: uh_neglect !< A tiny zonal mass flux that can !! be neglected [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used logical, dimension(SZJ_(G),SZK_(GV)), intent(inout) :: domore_u !< If true, there is more advection to be @@ -443,41 +443,41 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - if (.not. associated(segment%tr_Reg)) cycle - if (segment%is_E_or_W) then - if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then - I = segment%HI%IsdB - do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then - if (segment%direction == OBC_DIRECTION_W) then - T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) - else - T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) - endif + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + if (segment%is_E_or_W) then + if (j>=segment%HI%jsd .and. j<=segment%HI%jed) then + I = segment%HI%IsdB + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - if (segment%direction == OBC_DIRECTION_W) then - T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - else - T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - endif + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif + else + if (segment%direction == OBC_DIRECTION_W) then + T_tmp(i,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(i+1,m) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do i=segment%HI%IsdB-1,segment%HI%IsdB+1 + Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) enddo - do m = 1,ntr ! Apply update tracer values for slope calculation - do i=segment%HI%IsdB-1,segment%HI%IsdB+1 - Tp = T_tmp(i+1,m) ; Tc = T_tmp(i,m) ; Tm = T_tmp(i-1,m) - dMx = max( Tp, Tc, Tm ) - Tc - dMn= Tc - min( Tp, Tc, Tm ) - slope_x(i,m) = G%mask2dCu(I,j)*G%mask2dCu(I-1,j) * & - sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) - enddo - enddo + enddo - endif - endif - enddo - endif; endif + endif + endif + enddo + endif ; endif ! Calculate the i-direction fluxes of each tracer, using as much @@ -590,7 +590,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. ! Now changing to simply fixed inflows. if ((uhr(I,j,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_W) .or. & - (uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then + (uhr(I,j,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_E)) then uhh(I) = uhr(I,j,k) ! should the reservoir evolve for this case Kate ?? - Nope do m=1,ntr @@ -614,7 +614,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. if ((uhr(I,j,k) > 0.0) .and. (G%mask2dT(i,j) < 0.5) .or. & - (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then + (uhr(I,j,k) < 0.0) .and. (G%mask2dT(i+1,j) < 0.5)) then uhh(I) = uhr(I,j,k) do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%tres)) then @@ -813,42 +813,42 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! loop through open boundaries and recalculate flux terms if (associated(OBC)) then ; if (OBC%OBC_pe) then - do n=1,OBC%number_of_segments - segment=>OBC%segment(n) - if (.not. associated(segment%tr_Reg)) cycle - do i=is,ie - if (segment%is_N_or_S) then - if (i>=segment%HI%isd .and. i<=segment%HI%ied) then - J = segment%HI%JsdB - do m = 1,ntr ! replace tracers with OBC values - if (associated(segment%tr_Reg%Tr(m)%tres)) then - if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) - else - T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k) - endif + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. associated(segment%tr_Reg)) cycle + do i=is,ie + if (segment%is_N_or_S) then + if (i>=segment%HI%isd .and. i<=segment%HI%ied) then + J = segment%HI%JsdB + do m = 1,ntr ! replace tracers with OBC values + if (associated(segment%tr_Reg%Tr(m)%tres)) then + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%tres(i,j,k) else - if (segment%direction == OBC_DIRECTION_S) then - T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - else - T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc - endif + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%tres(i,j,k) endif + else + if (segment%direction == OBC_DIRECTION_S) then + T_tmp(i,m,j) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + else + T_tmp(i,m,j+1) = segment%tr_Reg%Tr(m)%OBC_inflow_conc + endif + endif + enddo + do m = 1,ntr ! Apply update tracer values for slope calculation + do j=segment%HI%JsdB-1,segment%HI%JsdB+1 + Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) + dMx = max( Tp, Tc, Tm ) - Tc + dMn= Tc - min( Tp, Tc, Tm ) + slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & + sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) enddo - do m = 1,ntr ! Apply update tracer values for slope calculation - do j=segment%HI%JsdB-1,segment%HI%JsdB+1 - Tp = T_tmp(i,m,j+1) ; Tc = T_tmp(i,m,j) ; Tm = T_tmp(i,m,j-1) - dMx = max( Tp, Tc, Tm ) - Tc - dMn= Tc - min( Tp, Tc, Tm ) - slope_y(i,m,j) = G%mask2dCv(i,J)*G%mask2dCv(i,J-1) * & - sign( min(0.5*abs(Tp-Tm), 2.0*dMx, 2.0*dMn), Tp-Tm ) - enddo - enddo - endif - endif ! is_N_S - enddo ! i-loop - enddo ! segment loop - endif; endif + enddo + endif + endif ! is_N_S + enddo ! i-loop + enddo ! segment loop + endif ; endif ! Calculate the j-direction fluxes of each tracer, using as much ! the minimum of the remaining mass flux (vhr) and the half the mass @@ -963,7 +963,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows from masked areas. ! Now changing to simply fixed inflows. if ((vhr(i,J,k) > 0.0) .and. (segment%direction == OBC_DIRECTION_S) .or. & - (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then + (vhr(i,J,k) < 0.0) .and. (segment%direction == OBC_DIRECTION_N)) then vhh(i,J) = vhr(i,J,k) do m=1,ntr if (associated(segment%tr_Reg%Tr(m)%t)) then @@ -998,7 +998,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & endif enddo endif - endif; endif + endif ; endif else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 1a081f4aaf..1a240c8995 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -776,7 +776,7 @@ subroutine tracer_epipycnal_ML_diff(h, dt, Tr, ntr, khdt_epi_x, khdt_epi_y, G, & ! Sort each column by increasing density. This should already be close, ! and the size of the arrays are small, so straight insertion is used. !$OMP do - do j=js-1,je+1; do i=is-1,ie+1 + do j=js-1,je+1 ; do i=is-1,ie+1 do k=2,num_srt(i,j) ; if (rho_srt(i,k,j) < rho_srt(i,k-1,j)) then ! The last segment needs to be shuffled earlier in the list. do k2 = k,2,-1 ; if (rho_srt(i,k2,j) >= rho_srt(i,k2-1,j)) exit @@ -1530,19 +1530,19 @@ subroutine tracer_hor_diff_init(Time, G, GV, US, param_file, diag, EOS, diabatic CS%id_CFL = -1 CS%id_KhTr_u = register_diag_field('ocean_model', 'KHTR_u', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + 'Epipycnal tracer diffusivity at zonal faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_v = register_diag_field('ocean_model', 'KHTR_v', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) + 'Epipycnal tracer diffusivity at meridional faces of tracer cell', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_KhTr_h = register_diag_field('ocean_model', 'KHTR_h', diag%axesT1, Time, & - 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & - cmor_field_name='diftrelo', & - cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & - cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') + 'Epipycnal tracer diffusivity at tracer cell center', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T, & + cmor_field_name='diftrelo', & + cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & + cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & - 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'm2', conversion=US%L_to_m**2) CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & - 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'm2', conversion=US%L_to_m**2) if (CS%check_diffusive_CFL) then CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& 'Grid CFL number for lateral/neutral tracer diffusion', 'nondim') diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index d5f2b3963b..8380aa86b6 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -311,10 +311,10 @@ subroutine RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, in_flux(:,:,:) = 0.0 m=1 do j=js,je ; do i=is,ie - !set tracer to 1.0 in the surface of the continental shelf - if (G%geoLonT(i,j) <= (CS%CSL)) then - CS%tr(i,j,1,m) = 1.0 !first layer - endif + ! set tracer to 1.0 in the surface of the continental shelf + if (G%geoLonT(i,j) <= (CS%CSL)) then + CS%tr(i,j,1,m) = 1.0 !first layer + endif enddo ; enddo if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index a2f1fdaa62..293d601757 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -449,7 +449,7 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, param_file, use_ALE, CSp, AC ! Construct a grid (somewhat arbitrarily) to describe the sponge T/S on do k=1,nz - e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) + e0(k) = -G%max_depth * ( real(k-1) / real(nz) ) enddo e0(nz+1) = -G%max_depth do j=js,je ; do i=is,ie diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index f4778f0d9a..c6e8910def 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -233,7 +233,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, US, param_file, tv, just_read h(i,j,k) = GV%Z_to_H * (eta1D(k) - eta1D(k+1)) endif enddo - enddo ; enddo + enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates if (just_read) return ! All run-time parameters have been read, so return. @@ -536,46 +536,46 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, PF, use_ALE, CSp, ACSp) select case ( coordinateMode(verticalCoordinate) ) - case ( REGRIDDING_RHO ) - ! Construct notional interface positions - e0(1) = 0. - do K=2,nz - e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range - e0(k) = min( 0., e0(k) ) ! Bound by surface - e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model - ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',& - ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) - ! call MOM_mesg(mesg,5) - enddo - e0(nz+1) = -G%max_depth - - ! Calculate thicknesses - do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) - do k=nz,1,-1 - eta1D(k) = e0(k) - if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then - eta1D(k) = eta1D(k+1) + GV%Angstrom_Z - h(i,j,k) = GV%Angstrom_H - else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) - endif - enddo - enddo ; enddo - - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates - do j=js,je ; do i=is,ie - eta1D(nz+1) = -G%bathyT(i,j) - do k=nz,1,-1 - eta1D(k) = -G%max_depth * real(k-1) / real(nz) - if (eta1D(k) < (eta1D(k+1) + min_thickness)) then - eta1D(k) = eta1D(k+1) + min_thickness - h(i,j,k) = min_thickness * GV%Z_to_H - else - h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) - endif - enddo - enddo ; enddo + case ( REGRIDDING_RHO ) + ! Construct notional interface positions + e0(1) = 0. + do K=2,nz + e0(k) = -G%max_depth * ( 0.5 * ( GV%Rlay(k-1) + GV%Rlay(k) ) - rho_sur ) / rho_range + e0(k) = min( 0., e0(k) ) ! Bound by surface + e0(k) = max( -G%max_depth, e0(k) ) ! Bound by possible deepest point in model + ! write(mesg,*) 'G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k)',& + ! G%max_depth,GV%Rlay(k-1),GV%Rlay(k),e0(k) + ! call MOM_mesg(mesg,5) + enddo + e0(nz+1) = -G%max_depth + + ! Calculate thicknesses + do j=js,je ; do i=is,ie + eta1D(nz+1) = -G%bathyT(i,j) + do k=nz,1,-1 + eta1D(k) = e0(k) + if (eta1D(k) < (eta1D(k+1) + GV%Angstrom_Z)) then + eta1D(k) = eta1D(k+1) + GV%Angstrom_Z + h(i,j,k) = GV%Angstrom_H + else + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + endif + enddo + enddo ; enddo + + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + do j=js,je ; do i=is,ie + eta1D(nz+1) = -G%bathyT(i,j) + do k=nz,1,-1 + eta1D(k) = -G%max_depth * real(k-1) / real(nz) + if (eta1D(k) < (eta1D(k+1) + min_thickness)) then + eta1D(k) = eta1D(k+1) + min_thickness + h(i,j,k) = min_thickness * GV%Z_to_H + else + h(i,j,k) = GV%Z_to_H*(eta1D(k) - eta1D(k+1)) + endif + enddo + enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates do j=js,je ; do i=is,ie diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 25e60d4895..adaee16d4e 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -238,9 +238,9 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.) if (CS%relative_tau) then - REL_TAU_FAC = 1. + REL_TAU_FAC = 1. else - REL_TAU_FAC = 0. !Multiplied to 0 surface current + REL_TAU_FAC = 0. !Multiplied to 0 surface current endif !> Compute storm center location @@ -432,9 +432,9 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) if ( (radius > 10.*CS%rad_max_wind) .and.& (radius < 15.*CS%rad_max_wind) ) then - ALPH = ALPH*(15.0 - radius/CS%rad_max_wind)/5. + ALPH = ALPH*(15.0 - radius/CS%rad_max_wind)/5. elseif (radius > 15.*CS%rad_max_wind) then - ALPH = 0.0 + ALPH = 0.0 endif ALPH = ALPH * CS%Deg2Rad @@ -545,12 +545,12 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ! be maintained. Causes winds far from storm center to be a ! couple of m/s higher than the correct Holland prof. if (BR_Bench) then - rkm = rad/1000. - rB = (US%L_to_m*rkm)**B + rkm = rad/1000. + rB = (US%L_to_m*rkm)**B else - ! if not comparing to benchmark, then use correct Holland prof. - rkm = rad - rB = (US%L_to_m*rad)**B + ! if not comparing to benchmark, then use correct Holland prof. + rkm = rad + rB = (US%L_to_m*rad)**B endif !/ BR ! Calculate U10 in the interior (inside of 10x radius of maximum wind), @@ -561,11 +561,11 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C elseif (rad > 10.*CS%rad_max_wind .AND. rad < 12.*CS%rad_max_wind) then rad=(CS%rad_max_wind)*10. if (BR_Bench) then - rkm = rad/1000. - rB = (US%L_to_m*rkm)**B + rkm = rad/1000. + rB = (US%L_to_m*rkm)**B else - rkm = rad - rB = (US%L_to_m*rad)**B + rkm = rad + rB = (US%L_to_m*rad)**B endif U10 = ( sqrt( A*B*dP*exp(-A/rB)/(1.2*US%kg_m3_to_R*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local) & * (12. - rad/CS%rad_max_wind)/2. @@ -588,7 +588,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ALPH = 0.0 endif ALPH = ALPH * Deg2Rad - !/BR + !/BR ! Prepare for wind calculation ! X_TS is component of translation speed added to wind vector ! due to background steering wind. diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index f528323fe6..3e078b135b 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -211,9 +211,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Dummy Check if (associated(CS)) then - call MOM_error(FATAL, "wave_interface_init called with an associated"//& - "control structure.") - return + call MOM_error(FATAL, "wave_interface_init called with an associated control structure.") + return endif PI=4.0*atan(1.0) @@ -327,9 +326,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) call get_param(param_file,mdl,"SURFBAND_STOKES_Y",CS%PrescribedSurfStkY, & "Y-direction surface Stokes drift for bands.",units='m/s', & default=0.0) - case default! No method provided - call MOM_error(FATAL,'Check WAVE_METHOD.') - end select + case default! No method provided + call MOM_error(FATAL,'Check WAVE_METHOD.') + end select case (DHH85_STRING)!Donelan et al., 1985 spectrum WaveMethod = DHH85 @@ -349,8 +348,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) default=.false.) case (LF17_STRING)!Li and Fox-Kemper 17 wind-sea Langmuir number WaveMethod = LF17 - case default - call MOM_error(FATAL,'Check WAVE_METHOD.') + case default + call MOM_error(FATAL,'Check WAVE_METHOD.') end select ! Langmuir number Options