From f1460df3839688c5501e4a17b1013a405b0557c2 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 16 Jun 2016 15:13:57 -0400 Subject: [PATCH 01/65] Need to figure out why Kd values change --- src/core/MOM.F90 | 262 ++++++++++++----------- src/tracer/MOM_offline_control.F90 | 321 +++++++++++++++++++++++++++++ 2 files changed, 467 insertions(+), 116 deletions(-) create mode 100644 src/tracer/MOM_offline_control.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3afd5de7de..12bd38d028 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,7 +30,6 @@ module MOM use MOM_coms, only : reproducing_sum use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diag_mediator, only : diag_mediator_init, enable_averaging -use MOM_diag_mediator, only : diag_mediator_infrastructure_init use MOM_diag_mediator, only : diag_set_thickness_ptr, diag_update_target_grids use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr use MOM_diag_mediator, only : register_diag_field, register_static_field @@ -55,7 +54,7 @@ module MOM use MOM_spatial_means, only : global_area_mean, global_area_integral use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) -use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) +use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/), increment_date ! MOM core modules use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity @@ -82,11 +81,9 @@ module MOM use MOM_dynamics_legacy_split, only : step_MOM_dyn_legacy_split, register_restarts_dyn_legacy_split use MOM_dynamics_legacy_split, only : initialize_dyn_legacy_split, end_dyn_legacy_split use MOM_dynamics_legacy_split, only : adjustments_dyn_legacy_split, MOM_dyn_legacy_split_CS -use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_EOS, only : EOS_init use MOM_error_checking, only : check_redundant use MOM_grid, only : MOM_grid_init, ocean_grid_type, MOM_grid_end -use MOM_hor_index, only : hor_index_type use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init @@ -114,13 +111,18 @@ module MOM use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state -use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_vert_friction, only : vertvisc, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units use MOM_wave_speed, only : wave_speed_init, wave_speed_CS +! Offline modules +use MOM_offline_transport, only : offline_transport_CS +use MOM_offline_transport, only : transport_by_data_override, transport_by_files, next_modulo_time +use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport +use time_manager_mod, only : print_date + implicit none ; private #include @@ -189,6 +191,8 @@ module MOM !! MOM_regridding module. logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an !! undocumented run-time flag that is fragile. + logical :: do_online !< If false, does not call step_MOM_dyn_*. This is an + !! undocumented run-time flag that is fragile. real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) @@ -219,7 +223,7 @@ module MOM ! Flags needed to reach between start and finish phases of initialization logical :: write_IC !< If true, then the initial conditions will be written to file - character(len=120) :: IC_file !< A file into which the initial conditions are + character(len=80) :: IC_file !< A file into which the initial conditions are !! written in a new run if SAVE_INITIAL_CONDS is true. integer :: ntrunc !< number u,v truncations since last call to write_energy @@ -362,6 +366,8 @@ module MOM type(sponge_CS), pointer :: sponge_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() type(ALE_CS), pointer :: ALE_CSp => NULL() + type(offline_transport_CS), pointer :: offline_CS => NULL() + ! These are used for group halo updates. type(group_pass_type) :: pass_tau_ustar_psurf @@ -374,6 +380,8 @@ module MOM type(group_pass_type) :: pass_uv_T_S_h type(group_pass_type) :: pass_ssh + + end type MOM_control_struct public initialize_MOM @@ -469,6 +477,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) logical :: showCallTree logical :: do_pass_kd_kv_turb ! This is used for a group halo pass. + G => CS%G ; GV => CS%GV is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -786,7 +795,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_other) - call cpu_clock_begin(id_clock_dynamics) call disable_averaging(CS%diag) @@ -800,10 +808,12 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call enable_averaging(dtth,Time_local+set_time(int(floor(dtth-dt+0.5))), CS%diag) call cpu_clock_begin(id_clock_thick_diff) + if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) + call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dtth, G, GV, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) call do_group_pass(CS%pass_h, G%Domain) @@ -889,14 +899,45 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") - endif ! -------------------------------------------------- end SPLIT + endif ! ------------- + + if (.not. CS%do_online) then + !print *, "TRANSPORT BY DATA OVERRIDE at time", & + ! time_type_to_real(increment_date(Time_start,seconds = int(time_interval/2))) + !call transport_by_data_override(G, increment_date(Time_start,seconds = int(time_interval/2)), & + ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) + + !print *, "TRANSPORT BY DATA OVERRIDE at time", & + ! time_type_to_real(Time_start) + !call transport_by_data_override(G, Time_start, & + ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) + + call transport_by_files(G, CS%offline_CS, GV%Angstrom, & + CS%u, CS%v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, CS%h, eta_av, CS%missing) + !call do_group_pass(CS%pass_h, G%Domain) + if( is_root_pe() ) call print_date(Time_start) + endif + + if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag) + if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag) + if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag) + if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag) + if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, CS%u(:,:,:), CS%diag) + if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, CS%v(:,:,:), CS%diag) + if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, CS%h(:,:,:), CS%diag) + if(CS%offline_CS%id_eta>0) call post_data(CS%offline_CS%id_eta, eta_av(:,:), CS%diag) + + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) + + if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) call do_group_pass(CS%pass_h, G%Domain) @@ -927,9 +968,42 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (CS%useMEKE) call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, & CS%visc, dt, G, GV, CS%MEKE_CSp, CS%uhtr, CS%vhtr) + + if (.not. CS%do_online) then + !print *, "TRANSPORT BY DATA OVERRIDE at time", & + ! time_type_to_real(increment_date(Time_start,seconds = int(time_interval/2))) + !call transport_by_data_override(G, increment_date(Time_start,seconds = int(time_interval/2)), & + ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) + + !print *, "TRANSPORT BY DATA OVERRIDE at time", & + ! time_type_to_real(Time_start) + !call transport_by_data_override(G, Time_start, & + ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) + +! call transport_by_files(G, CS%offline_CS, GV%Angstrom, & +! CS%u, CS%v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, CS%h, eta_av, CS%missing) + !call do_group_pass(CS%pass_h, G%Domain) + + endif + +! if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag) +! if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag) +! if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag) +! if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag) +! if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, CS%u(:,:,:), CS%diag) +! if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, CS%v(:,:,:), CS%diag) +! if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, CS%h(:,:,:), CS%diag) +! if(CS%offline_CS%id_eta>0) call post_data(CS%offline_CS%id_eta, eta_av(:,:), CS%diag) + + call disable_averaging(CS%diag) call cpu_clock_end(id_clock_dynamics) + + + + + CS%dt_trans = CS%dt_trans + dt if (thermo_does_span_coupling) then do_advection = (CS%dt_trans + 0.5*dt > dt_therm) @@ -1367,7 +1441,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) ! local type(ocean_grid_type), pointer :: G ! pointer to a structure with metrics and related type(verticalGrid_type), pointer :: GV => NULL() - type(dyn_horgrid_type), pointer :: dG => NULL() type(diag_ctrl), pointer :: diag character(len=4), parameter :: vers_num = 'v2.0' @@ -1393,7 +1466,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) logical :: symmetric ! If true, use symmetric memory allocation. logical :: save_IC ! If true, save the initial conditions. logical :: do_unit_tests ! If true, call unit tests. - logical :: test_grid_copy = .false. type(time_type) :: Start_time type(ocean_internal_state) :: MOM_internal_state @@ -1404,11 +1476,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) return endif allocate(CS) - - if (test_grid_copy) then ; allocate(G) - else ; G => CS%G ; endif - + G => CS%G CS%Time => Time + diag => CS%diag id_clock_init = cpu_clock_id('Ocean Initialization', grain=CLOCK_SUBCOMPONENT) call cpu_clock_begin(id_clock_init) @@ -1440,11 +1510,19 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call MOM_checksums_init(param_file) - call diag_mediator_infrastructure_init() call MOM_io_init(param_file) call MOM_grid_init(G, param_file) call verticalGridInit( param_file, CS%GV ) GV => CS%GV + ! Copy several common variables from the vertical grid to the horizontal grid. + ! Consider removing these later? + G%ke = GV%ke + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + call diag_mediator_init(G, param_file, diag, doc_file_dir=dirs%output_directory) ! Read relevant parameters and write them to the model log. call log_version(param_file, "MOM", version, "") @@ -1505,6 +1583,10 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) "If False, skips the dynamics calls that update u & v, as well as\n"//& "the gravity wave adjustment to h. This is a fragile feature and\n"//& "thus undocumented.", default=.true., do_not_log=.true. ) + call get_param(param_file, "MOM", "DO_ONLINE", CS%do_online, & + "If False, skips the dynamics calls that update u & v, as well as\n"//& + "the gravity wave adjustment to h. This is a fragile feature and\n"//& + "thus undocumented.", default=.true., do_not_log=.true. ) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & "If true, interface heights are diffused with a \n"//& "coefficient of KHTH.", default=.false.) @@ -1663,14 +1745,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call tracer_registry_init(param_file, CS%tracer_Reg) - ! Copy a common variable from the vertical grid to the horizontal grid. - ! Consider removing this later? - G%ke = GV%ke - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - ! Allocate and initialize space for primary MOM variables. ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 @@ -1687,8 +1761,8 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) CS%vd_S = var_desc(name="S",units="PPT",longname="Salinity",& cmor_field_name="so",cmor_units="ppt", & conversion=0.001) - call register_tracer(CS%tv%T, CS%vd_T, param_file, G%HI, GV, CS%tracer_Reg, CS%vd_T) - call register_tracer(CS%tv%S, CS%vd_S, param_file, G%HI, GV, CS%tracer_Reg, CS%vd_S) + call register_tracer(CS%tv%T, CS%vd_T, param_file, G, CS%tracer_Reg, CS%vd_T) + call register_tracer(CS%tv%S, CS%vd_S, param_file, G, CS%tracer_Reg, CS%vd_S) endif if (CS%use_frazil) then allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0 @@ -1751,34 +1825,44 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) ! Set the fields that are needed for bitwise identical restarting ! the time stepping scheme. - call restart_init(param_file, CS%restart_CSp) - call set_restart_fields(GV, param_file, CS) + call restart_init(G, param_file, CS%restart_CSp) + call set_restart_fields(G, GV, param_file, CS) if (CS%split) then if (CS%legacy_split) then - call register_restarts_dyn_legacy_split(G%HI, GV, param_file, & + call register_restarts_dyn_legacy_split(G, GV, param_file, & CS%dyn_legacy_split_CSp, CS%restart_CSp, CS%uh, CS%vh) else - call register_restarts_dyn_split_RK2(G%HI, GV, param_file, & + call register_restarts_dyn_split_RK2(G, GV, param_file, & CS%dyn_split_RK2_CSp, CS%restart_CSp, CS%uh, CS%vh) endif else if (CS%use_RK2) then - call register_restarts_dyn_unsplit_RK2(G%HI, GV, param_file, & + call register_restarts_dyn_unsplit_RK2(G, GV, param_file, & CS%dyn_unsplit_RK2_CSp, CS%restart_CSp) else - call register_restarts_dyn_unsplit(G%HI, GV, param_file, & + call register_restarts_dyn_unsplit(G, GV, param_file, & CS%dyn_unsplit_CSp, CS%restart_CSp) endif endif ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(G%HI, GV, param_file, CS%tracer_flow_CSp, & - CS%tracer_Reg, CS%restart_CSp) + call call_tracer_register(G, param_file, CS%tracer_flow_CSp, & + diag, CS%tracer_Reg, CS%restart_CSp) - call MEKE_alloc_register_restart(G%HI, param_file, CS%MEKE, CS%restart_CSp) - call set_visc_register_restarts(G%HI, GV, param_file, CS%visc, CS%restart_CSp) - call mixedlayer_restrat_register_restarts(G%HI, param_file, CS%mixedlayer_restrat_CSp, CS%restart_CSp) + call MEKE_alloc_register_restart(G, param_file, CS%MEKE, CS%restart_CSp) + call set_visc_register_restarts(G, param_file, CS%visc, CS%restart_CSp) + call mixedlayer_restrat_register_restarts(G, param_file, CS%mixedlayer_restrat_CSp, CS%restart_CSp) + + call cpu_clock_begin(id_clock_pass_init) + !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM + call create_group_pass(CS%pass_uv_T_S_h, CS%u, CS%v, G%Domain) + if (CS%use_temperature) then + call create_group_pass(CS%pass_uv_T_S_h, CS%tv%T, G%Domain) + call create_group_pass(CS%pass_uv_T_S_h, CS%tv%S, G%Domain) + endif + call create_group_pass(CS%pass_uv_T_S_h, CS%h, G%Domain) + call cpu_clock_end(id_clock_pass_init) ! Initialize fields call callTree_waypoint("restart registration complete (initialize_MOM)") @@ -1786,12 +1870,12 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_fixed(G, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - call MOM_initialize_coord(GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv, G%max_depth) + call MOM_initialize_coord(G, GV, param_file, write_geom_files, & + dirs%output_directory, CS%tv) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, GV, G%max_depth, CS%ALE_CSp) + call ALE_init(param_file, G, GV, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif @@ -1801,62 +1885,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") - ! From this point, there may be pointers being set, so the final grid type - ! that will persist through the run has to be used. - - ! Shift from using the temporary dynamic grid type to using the final (potentially - ! static) ocean grid type. - ! call clone_MOM_domain(dG%Domain, CS%G%Domain) - ! call MOM_grid_init(CS%G, param_file) - ! call copy_dyngrid_to_MOM_grid(dg, CS%G) - ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. - ! if (CS%debug .or. CS%G%symmetric) & - ! call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) - - ! ! Copy a common variable from the vertical grid to the horizontal grid. - ! ! Consider removing this later? - ! CS%G%ke = GV%ke - ! G => CS%G - - if (test_grid_copy) then - ! Copy the data from the temporary grid to the dyn_hor_grid to CS%G. - call create_dyn_horgrid(dG, G%HI) - call clone_MOM_domain(G%Domain, dG%Domain) - - call clone_MOM_domain(G%Domain, CS%G%Domain) - call MOM_grid_init(CS%G, param_file) - - call copy_MOM_grid_to_dyngrid(G, dg) - call copy_dyngrid_to_MOM_grid(dg, CS%G) - ! Copy a common variable from the vertical grid to the horizontal grid. - ! Consider removing this later? - CS%G%ke = GV%ke - - call destroy_dyn_horgrid(dG) - call MOM_grid_end(G) ; deallocate(G) - - G => CS%G - - if (CS%debug .or. CS%G%symmetric) & - call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) - endif - - - ! At this point, all user-modified initialization code has been called. The - ! remainder of this subroutine is controlled by the parameters that have - ! have already been set. - - - call cpu_clock_begin(id_clock_pass_init) - !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM - call create_group_pass(CS%pass_uv_T_S_h, CS%u, CS%v, G%Domain) - if (CS%use_temperature) then - call create_group_pass(CS%pass_uv_T_S_h, CS%tv%T, G%Domain) - call create_group_pass(CS%pass_uv_T_S_h, CS%tv%S, G%Domain) - endif - call create_group_pass(CS%pass_uv_T_S_h, CS%h, G%Domain) - call cpu_clock_end(id_clock_pass_init) - if (ALE_remap_init_conds(CS%ALE_CSp) .and. .not. query_initialized(CS%h,"h",CS%restart_CSp)) then ! This block is controlled by the ALE parameter REMAP_AFTER_INITIALIZATION. ! \todo This block exists for legacy reasons and we should phase it out of @@ -1867,7 +1895,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call hchksum(CS%h*GV%H_to_m,"Pre ALE adjust init cond h", G, haloshift=1) endif call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)") - call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h ) + call adjustGridForIntegrity(CS%ALE_CSp, G, CS%h ) call callTree_waypoint("Calling ALE_main() to remap initial conditions (initialize_MOM)") call ALE_main( G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp ) call cpu_clock_begin(id_clock_pass_init) @@ -1882,10 +1910,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) endif if ( CS%use_ALE_algorithm ) call ALE_updateVerticalGridType( CS%ALE_CSp, GV ) - diag => CS%diag - ! Initialize the diag mediator. - call diag_mediator_init(G, param_file, diag, doc_file_dir=dirs%output_directory) - ! Initialize the diagnostics mask arrays. ! This step has to be done after call to MOM_initialize_state ! and before MOM_diagnostics_init @@ -1905,7 +1929,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_begin(id_clock_MOM_init) if (CS%use_ALE_algorithm) then - call ALE_writeCoordinateFile( CS%ALE_CSp, GV, dirs%output_directory ) + call ALE_writeCoordinateFile( CS%ALE_CSp, G, GV, dirs%output_directory ) endif call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("ALE initialized (initialize_MOM)") @@ -1982,9 +2006,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call tracer_hor_diff_init(Time, G, param_file, diag, CS%tracer_diff_CSp, CS%neutral_diffusion_CSp) if (CS%use_ALE_algorithm) & - call register_diags_TS_vardec(Time, G%HI, GV, param_file, CS) + call register_diags_TS_vardec(Time, G, param_file, CS) - call lock_tracer_registry(CS%tracer_Reg) + call lock_tracer_registry(CS%tracer_Reg, diag, Time, G) call callTree_waypoint("tracer registry now locked (initialize_MOM)") ! now register some diagnostics since tracer registry is locked @@ -2014,12 +2038,15 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) endif + call offline_transport_init(param_file, CS%offline_CS) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CS) + + ! This subroutine initializes any tracer packages. new_sim = ((dirs%input_filename(1:1) == 'n') .and. & (LEN_TRIM(dirs%input_filename) == 1)) - call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & - CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & - CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) + call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, CS%OBC, & + CS%tracer_flow_CSp, CS%sponge_CSp, CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) call cpu_clock_begin(id_clock_pass_init) call do_group_pass(CS%pass_uv_T_S_h, G%Domain) @@ -2439,11 +2466,10 @@ end subroutine register_diags_TS_tendency !> Initialize diagnostics for the variance decay of temp/salt !! across regridding/remapping -subroutine register_diags_TS_vardec(Time, HI, GV, param_file, CS) - type(time_type), intent(in) :: Time !< current model time - type(hor_index_type), intent(in) :: HI !< horizontal index type - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(param_file_type), intent(in) :: param_file !< parameter file +subroutine register_diags_TS_vardec(Time, G, param_file, CS) + type(time_type), intent(in) :: Time !< current model time + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_control_struct), pointer :: CS !< control structure for MOM integer :: isd, ied, jsd, jed, nz @@ -2451,7 +2477,7 @@ subroutine register_diags_TS_vardec(Time, HI, GV, param_file, CS) type(diag_ctrl), pointer :: diag diag => CS%diag - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke ! variancy decay through ALE operation CS%id_T_vardec = register_diag_field('ocean_model', 'T_vardec', diag%axesTL, Time, & @@ -2461,7 +2487,7 @@ subroutine register_diags_TS_vardec(Time, HI, GV, param_file, CS) CS%T_squared(:,:,:) = 0. vd_tmp = var_desc(name="T2", units="degC2", longname="Squared Potential Temperature") - call register_tracer(CS%T_squared, vd_tmp, param_file, HI, GV, CS%tracer_reg) + call register_tracer(CS%T_squared, vd_tmp, param_file, G, CS%tracer_reg) endif CS%id_S_vardec = register_diag_field('ocean_model', 'S_vardec', diag%axesTL, Time, & @@ -2471,11 +2497,14 @@ subroutine register_diags_TS_vardec(Time, HI, GV, param_file, CS) CS%S_squared(:,:,:) = 0. vd_tmp = var_desc(name="S2", units="PPT2", longname="Squared Salinity") - call register_tracer(CS%S_squared, vd_tmp, param_file, HI, GV, CS%tracer_reg) + call register_tracer(CS%S_squared, vd_tmp, param_file, G, CS%tracer_reg) endif end subroutine register_diags_TS_vardec + + + !> This subroutine sets up clock IDs for timing various subroutines. subroutine MOM_timing_init(CS) type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM. @@ -2759,7 +2788,8 @@ end subroutine write_static_fields !! This routine should be altered if there are any changes to the !! time stepping scheme. The CHECK_RESTART facility may be used to !! confirm that all needed restart fields have been included. -subroutine set_restart_fields(GV, param_file, CS) +subroutine set_restart_fields(G, GV, param_file, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< opened file for parsing to get parameters type(MOM_control_struct), intent(in) :: CS !< control structure set up by inialize_MOM diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 new file mode 100644 index 0000000000..00a8c5839b --- /dev/null +++ b/src/tracer/MOM_offline_control.F90 @@ -0,0 +1,321 @@ +!*********************************************************************** +!* GNU General Public License * +!* This file is a part of MOM. * +!* * +!* MOM is free software; you can redistribute it and/or modify it and * +!* are expected to follow the terms of the GNU General Public License * +!* as published by the Free Software Foundation; either version 2 of * +!* the License, or (at your option) any later version. * +!* * +!* MOM is distributed in the hope that it will be useful, but WITHOUT * +!* ANY WARRANTY; without even the impliec warranty of MERCHANTABILITY * +!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * +!* License for more details. * +!* * +!* For the full text of the GNU General Public License, * +!* write to: Free Software Foundation, Inc., * +!* 675 Mass Ave, Cambridge, MA 02139, USA. * +!* or see: http://www.gnu.org/licenses/gpl.html * +!*********************************************************************** + +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Andrew Shao 2016 * +!* * +!* The subroutines here allow MOM6 to be run in a so-called 'offline' * +!* mode ostensibly for the purpose of modeling tracers. Instead of * +!* calculating u, v, and h prognostically, these fields are read in * +!* at regular intervals which have been saved from a previous * +!* integration of MOM6. * +!* * +!* Users are warned that the usual diagnostics (i.e. conservation of * +!* mass) cannot be expected to be replicated to the same accuracy as * +!* the online model because some information is loss due to the * +!* averaging and snapshotting involved with saving offline files. The * +!* responsibility lies on the user that the loss of accuracy is * +!* acceptable for their application. +!* * +!* Macros written all in capital letters are defined in MOM_memory.h * +!* * +!********+*********+*********+*********+*********+*********+*********+** + +module MOM_offline_transport + + use data_override_mod, only : data_override_init, data_override + use MOM_time_manager, only : time_type + use MOM_domains, only : pass_var, pass_vector, To_All + use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe + use MOM_grid, only : ocean_grid_type + use MOM_io, only : read_data + use MOM_file_parser, only : get_param, log_version, param_file_type + use MOM_diag_mediator, only : diag_ctrl, register_diag_field + use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + implicit none + + + type, public :: offline_transport_CS + + integer :: total_counter ! How many total timesteps have been taken since + ! the start of the run + + integer :: start_index ! Timelevel to start + integer :: numtime ! How many timelevels in the input fields + + integer :: & ! Index of each of the variables to be read in + ridx_mean = -1, & ! Separate indices for each variabile if they are + ridx_snap = -1 ! setoff from each other in time + + + character(len=200) :: offlinedir ! Directory where offline fields are stored + character(len=200) :: & ! Names + transport_file, & + h_file + + logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are + ! offset by one time level + + integer :: & + id_h = -1, & + id_u = -1, id_v = -1, & + id_uh = -1, id_vh = -1, & + id_uhtr = -1, id_vhtr = -1, & + id_eta = -1 + + end type offline_transport_CS + +#include "MOM_memory.h" + + public next_modulo_time + public offline_transport_init + public transport_by_files + public transport_by_data_override + +contains + + function next_modulo_time(inidx, total_counter) + ! Returns the next time interval to be read + integer :: total_counter ! How many times advect_tracer has been called + integer :: inidx ! Number of time levels in the input files + + integer :: read_index ! The index in the input files that corresponds + ! to the current timestep + + integer :: next_modulo_time + + read_index = mod(inidx+1,total_counter) + if (read_index < 0) read_index = inidx-read_index + if (read_index == 0) read_index = 1 + + next_modulo_time = read_index + + end function next_modulo_time + + !> Initialize additional diagnostics required for offline tracer transport + subroutine register_diags_offline_transport(Time, diag, CS) + + type(offline_transport_CS), pointer :: CS !< control structure for MOM + type(time_type), intent(in) :: Time !< current model time + type(diag_ctrl) :: diag + + CS%id_uhtr = register_diag_field('ocean_model', 'uhtr_off', diag%axesCuL, Time, & + 'Accumulated zonal thickness fluxes to advect tracers', 'kg') + CS%id_vhtr = register_diag_field('ocean_model', 'vhtr_off', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_uh = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_vh = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_u = register_diag_field('ocean_model', 'u_off', diag%axesCuL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_v = register_diag_field('ocean_model', 'v_off', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_h = register_diag_field('ocean_model', 'h_off', diag%axesTL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_eta = register_diag_field('ocean_model', 'eta_av', diag%axesT1, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_eta = register_diag_field('ocean_model', 'p_surf_begin', diag%axesT1, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + + end subroutine register_diags_offline_transport + + subroutine offline_transport_init(param_file, CS) + + type(param_file_type) :: param_file + type(offline_transport_CS), pointer :: CS + + character(len=40) :: mod = "offline_transport" + + + call callTree_enter("offline_transport_init, MOM_offline_control.F90") + + if (associated(CS)) then + call MOM_error(WARNING, "offline_transport_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + CS%total_counter = 0; + call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & + "Input directory where the offline fields can be found", fail_if_missing=.true.) + call get_param(param_file, mod, "TRANSPORT_FILE", CS%transport_file, & + "Filename where uhtr, vhtr, u, v fields can be found", default="offline_transport.nc") + call get_param(param_file, mod, "H_FILE", CS%h_file, & + "Filename where the h field can be found", default="offline_h.nc") + call get_param(param_file, mod, "START_INDEX", CS%start_index, & + "Which time index to start from", fail_if_missing=.true.) + call get_param(param_file, mod, "NUMTIME", CS%numtime, & + "Number of timelevels in offline input files", fail_if_missing=.true.) + call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & + "True if the time-averaged fields and snapshot fields are offset by one time level", & + default=.false.) + + CS%transport_file = trim(CS%offlinedir)//trim(CS%transport_file) + CS%h_file = trim(CS%offlinedir)//trim(CS%h_file) + + + ! Set the starting read index for time-averaged and snapshotted fields + CS%ridx_mean = CS%start_index + if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) + if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index + + call callTree_leave("offline_transport_init") + + end subroutine offline_transport_init + + subroutine transport_by_files(G, CS, angstrom, u, v, uh, vh, uhtr, vhtr, h , eta_av, missing) + type(ocean_grid_type) , intent(inout) :: G + type(offline_transport_CS) , intent(inout) :: CS + real :: angstrom + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness after advection (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G)) , intent(inout) :: eta_av + real :: missing + + integer :: i, j, k + + call callTree_enter("transport_by_files, MOM_offline_control.F90") + + if ( is_root_pe() ) print *, "Read index: ", CS%ridx_mean + + ! Read time-averaged fields (middle of time interval timestamp) + call read_data(CS%transport_file, 'u', u(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'v', v(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) +! + call read_data(CS%transport_file, 'uh', uh(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'vh', vh(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + + + call read_data(CS%transport_file, 'uhtr', uhtr(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'vhtr', vhtr(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) +! +! call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_mean,position=CENTER) +! +! ! Read snapshot fields (end of time interval timestamp) + call read_data(CS%transport_file, 'h', h(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + + ! Apply masks sinice read_data doesn't account for missing values?! + do k = 1,G%ke +! +! ! Fields on T-cell + do j=G%jsd, G%jed ; do i=G%isd, G%ied + if( h(i,j,k)<0.0 ) h(i,j,k) = angstrom +! if(eta_av(i,j).EQ.missing) eta_av = 0 + enddo ; enddo +! +! + ! Fields on U-Grid + do j=G%jsd, G%jed ; do i=G%isdb, G%iedb + if(uhtr(i,j,k) .EQ. missing) uhtr(i,j,k) = 0 + if(uh(i,j,k) .EQ. missing) uh(i,j,k) = 0 + if(u(i,j,k) .EQ. missing) u(i,j,k) = 0 + enddo ; enddo + + ! Fields on V-Grid + do j=G%jsdb, G%jedb ; do i=G%isd, G%ied + if(vhtr(i,j,k) .EQ. missing) vhtr(i,j,k) = 0 + if(vh(i,j,k) .EQ. missing) vh(i,j,k) = 0 + if(v(i,j,k) .EQ. missing) v(i,j,k) = 0 + enddo ; enddo + +! +! + enddo +! +! ! Make sure all halos have been updated + call pass_vector(uhtr, vhtr, G%Domain) + call pass_vector(uh, vh, G%Domain) + call pass_vector(u, v, G%Domain) + call pass_var(h,G%Domain) + call pass_var(eta_av, G%Domain) + + ! Update the read indices + CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) + CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) + + + + call callTree_leave("transport_by_file") + + end subroutine transport_by_files + + subroutine transport_by_data_override(G, day, u, v, uhtr, vhtr, h) + type(time_type) , intent(in) :: day !< Current model time + type(ocean_grid_type) , intent(inout) :: G + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness after advection (m or kg m-2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + + ! This subroutine sets the surface wind stresses + + ! Arguments: + ! state = structure describing ocean surface state + ! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs + ! (in) day = time of the fluxes + ! (in) G = ocean grid structure + ! (in) CS = pointer to control struct returned by previous surface_forcing_init call + + integer :: i, j, is_in, ie_in, js_in, je_in + + call callTree_enter("ocean_transport_by_data_override, MOM_offline_control.F90") + + is_in = G%isc - G%isd + 1 + ie_in = G%iec - G%isd + 1 + js_in = G%jsc - G%jsd + 1 + je_in = G%jec - G%jsd + 1 + + call data_override('OCN', 'uhtr', uhtr, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'vhtr', vhtr, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'u', u, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'v', v, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + call data_override('OCN', 'h', h, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) + + ! call data_override('OCN', 'uhtr', uhtr, day) + ! call data_override('OCN', 'vhtr', vhtr, day) + ! call data_override('OCN', 'u', u, day) + ! call data_override('OCN', 'v', v, day) + ! call data_override('OCN', 'h', h, day) + + call pass_vector(uhtr, vhtr, G%Domain) + call pass_vector(u, v, G%Domain) + call pass_var(h, G%Domain) + call callTree_leave("transport_by_data_override") + + end subroutine transport_by_data_override + +end module MOM_offline_transport From 31b50e3e242b952c930f481a1f0bda663a6b471c Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 27 Jun 2016 16:27:39 -0400 Subject: [PATCH 02/65] Works storing fields offline with Baltic_ALE_z testcase with THICKNESSDIFFUSE_FIRST=False --- src/core/MOM.F90 | 274 ++++++++++-------- .../vertical/MOM_diabatic_driver.F90 | 25 +- src/tracer/MOM_offline_control.F90 | 172 ++++++++--- 3 files changed, 309 insertions(+), 162 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 12bd38d028..c0d2fdae59 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -30,6 +30,7 @@ module MOM use MOM_coms, only : reproducing_sum use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diag_mediator, only : diag_mediator_init, enable_averaging +use MOM_diag_mediator, only : diag_mediator_infrastructure_init use MOM_diag_mediator, only : diag_set_thickness_ptr, diag_update_target_grids use MOM_diag_mediator, only : disable_averaging, post_data, safe_alloc_ptr use MOM_diag_mediator, only : register_diag_field, register_static_field @@ -54,7 +55,7 @@ module MOM use MOM_spatial_means, only : global_area_mean, global_area_integral use MOM_state_initialization, only : MOM_initialize_state use MOM_time_manager, only : time_type, set_time, time_type_to_real, operator(+) -use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/), increment_date +use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) ! MOM core modules use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity @@ -81,9 +82,11 @@ module MOM use MOM_dynamics_legacy_split, only : step_MOM_dyn_legacy_split, register_restarts_dyn_legacy_split use MOM_dynamics_legacy_split, only : initialize_dyn_legacy_split, end_dyn_legacy_split use MOM_dynamics_legacy_split, only : adjustments_dyn_legacy_split, MOM_dyn_legacy_split_CS +use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid use MOM_EOS, only : EOS_init use MOM_error_checking, only : check_redundant use MOM_grid, only : MOM_grid_init, ocean_grid_type, MOM_grid_end +use MOM_hor_index, only : hor_index_type use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init @@ -111,6 +114,7 @@ module MOM use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state +use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_vert_friction, only : vertvisc, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd @@ -123,6 +127,7 @@ module MOM use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use time_manager_mod, only : print_date + implicit none ; private #include @@ -190,9 +195,8 @@ module MOM !! set by calling the function useRegridding() from the !! MOM_regridding module. logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an - !! undocumented run-time flag that is fragile. logical :: do_online !< If false, does not call step_MOM_dyn_*. This is an - !! undocumented run-time flag that is fragile. + !! undocumented run-time flag that is fragile. !! undocumented run-time flag that is fragile. real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) @@ -223,7 +227,7 @@ module MOM ! Flags needed to reach between start and finish phases of initialization logical :: write_IC !< If true, then the initial conditions will be written to file - character(len=80) :: IC_file !< A file into which the initial conditions are + character(len=120) :: IC_file !< A file into which the initial conditions are !! written in a new run if SAVE_INITIAL_CONDS is true. integer :: ntrunc !< number u,v truncations since last call to write_energy @@ -368,7 +372,6 @@ module MOM type(ALE_CS), pointer :: ALE_CSp => NULL() type(offline_transport_CS), pointer :: offline_CS => NULL() - ! These are used for group halo updates. type(group_pass_type) :: pass_tau_ustar_psurf type(group_pass_type) :: pass_h @@ -380,8 +383,6 @@ module MOM type(group_pass_type) :: pass_uv_T_S_h type(group_pass_type) :: pass_ssh - - end type MOM_control_struct public initialize_MOM @@ -451,6 +452,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) eta_av, & ! average sea surface height or column mass over a timestep (meter or kg/m2) ssh ! sea surface height based on eta_av (meter or kg/m2) + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: write_all_3du + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: write_all_3dv + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: write_all_3dt + real, allocatable, dimension(:,:) :: & tmp, & ! temporary 2d field zos, & ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh (meter) @@ -477,7 +482,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) logical :: showCallTree logical :: do_pass_kd_kv_turb ! This is used for a group halo pass. - G => CS%G ; GV => CS%GV is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -795,6 +799,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_other) + call cpu_clock_begin(id_clock_dynamics) call disable_averaging(CS%diag) @@ -808,12 +813,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call enable_averaging(dtth,Time_local+set_time(int(floor(dtth-dt+0.5))), CS%diag) call cpu_clock_begin(id_clock_thick_diff) - if (associated(CS%VarMix)) & - call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) + call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dtth, G, GV, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) - call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) call do_group_pass(CS%pass_h, G%Domain) @@ -854,7 +857,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) enddo ; enddo ; enddo endif - if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT + if (CS%do_dynamics .and. CS%split .and. CS%do_online) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -880,7 +883,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") - elseif (CS%do_dynamics) then ! --------------------------------------------------- not SPLIT + elseif (CS%do_dynamics .and. CS%do_online) then ! --------------------------------------------------- not SPLIT ! This section uses an unsplit stepping scheme for the dynamic ! equations; basically the stacked shallow water equations with viscosity. ! Because the time step is limited by CFL restrictions on the external @@ -899,7 +902,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_unsplit (step_MOM)") - endif ! ------------- + endif ! -------------------------------------------------- end SPLIT if (.not. CS%do_online) then !print *, "TRANSPORT BY DATA OVERRIDE at time", & @@ -913,31 +916,58 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) call transport_by_files(G, CS%offline_CS, GV%Angstrom, & - CS%u, CS%v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, CS%h, eta_av, CS%missing) + u, v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, h, eta_av, CS%missing, CS%visc,CS%T,CS%S) +! CS%visc%kv_bbl_u, CS%visc%kv_bbl_v, CS%visc%bbl_thick_u, CS%visc%bbl_thick_v, CS%visc%ustar_bbl, & +! ) !call do_group_pass(CS%pass_h, G%Domain) - if( is_root_pe() ) call print_date(Time_start) +! if( is_root_pe() ) call print_date(Time_start) +! CS%visc%calc_bbl = .true. + +! call horizontal_viscosity(u_av, v_av, h_av, CS%dyn_split_RK2_CSp%diffu, CS%dyn_split_RK2_CSp%diffv, & +! CS%dyn_split_RK2_CSp%MEKE, CS%dyn_split_RK2_CSp%Varmix, G, GV, CS%dyn_split_RK2_CSp%hor_visc_CSp, OBC=CS%dyn_split_RK2_CSp%OBC) + + endif - if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag) - if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag) - if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag) - if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag) - if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, CS%u(:,:,:), CS%diag) - if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, CS%v(:,:,:), CS%diag) - if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, CS%h(:,:,:), CS%diag) +! call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & +! CS%diag) + write_all_3dt = 1. + write_all_3du = 1. + write_all_3dv = 1. + + if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag, mask=write_all_3du) + if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag, mask=write_all_3dv) + if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag, mask=write_all_3du) + if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag, mask=write_all_3dv) + if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, u(:,:,:), CS%diag, mask=write_all_3du) + if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, v(:,:,:), CS%diag, mask=write_all_3dv) + if(CS%offline_CS%id_ray_u>0) call post_data(CS%offline_CS%id_ray_u, CS%visc%Ray_u(:,:,:), CS%diag, mask=write_all_3du) + if(CS%offline_CS%id_ray_v>0) call post_data(CS%offline_CS%id_ray_v, CS%visc%Ray_v(:,:,:), CS%diag) + if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, h(:,:,:), CS%diag, mask=write_all_3dt) if(CS%offline_CS%id_eta>0) call post_data(CS%offline_CS%id_eta, eta_av(:,:), CS%diag) + if(CS%offline_CS%id_kv_bbl_u>0) call post_data(CS%offline_CS%id_kv_bbl_u, CS%visc%kv_bbl_u(:,:), CS%diag) + if(CS%offline_CS%id_bbl_thick_u>0) call post_data(CS%offline_CS%id_bbl_thick_u, CS%visc%bbl_thick_u(:,:), CS%diag) + if(CS%offline_CS%id_kv_bbl_v>0) call post_data(CS%offline_CS%id_kv_bbl_v, CS%visc%kv_bbl_v(:,:), CS%diag) + if(CS%offline_CS%id_bbl_thick_v>0) call post_data(CS%offline_CS%id_bbl_thick_v, CS%visc%bbl_thick_v(:,:), CS%diag) + if(CS%offline_CS%id_temp>0) call post_data(CS%offline_CS%id_temp,CS%T(:,:,:), CS%diag, mask=write_all_3dt) + if(CS%offline_CS%id_salt>0) call post_data(CS%offline_CS%id_salt,CS%S(:,:,:), CS%diag, mask=write_all_3dt) +! if(CS%offline_CS%id_ustar>0) call post_data(CS%offline_CS%id_ustar, CS%visc%ustar_bbl(:,:), CS%diag) +! call disable_averaging(CS%diag) + if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) + if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G, haloshift=0) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G, haloshift=1) call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) call do_group_pass(CS%pass_h, G%Domain) @@ -968,42 +998,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (CS%useMEKE) call step_forward_MEKE(CS%MEKE, h, CS%VarMix%SN_u, CS%VarMix%SN_v, & CS%visc, dt, G, GV, CS%MEKE_CSp, CS%uhtr, CS%vhtr) - - if (.not. CS%do_online) then - !print *, "TRANSPORT BY DATA OVERRIDE at time", & - ! time_type_to_real(increment_date(Time_start,seconds = int(time_interval/2))) - !call transport_by_data_override(G, increment_date(Time_start,seconds = int(time_interval/2)), & - ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) - - !print *, "TRANSPORT BY DATA OVERRIDE at time", & - ! time_type_to_real(Time_start) - !call transport_by_data_override(G, Time_start, & - ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) - -! call transport_by_files(G, CS%offline_CS, GV%Angstrom, & -! CS%u, CS%v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, CS%h, eta_av, CS%missing) - !call do_group_pass(CS%pass_h, G%Domain) - - endif - -! if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag) -! if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag) -! if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag) -! if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag) -! if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, CS%u(:,:,:), CS%diag) -! if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, CS%v(:,:,:), CS%diag) -! if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, CS%h(:,:,:), CS%diag) -! if(CS%offline_CS%id_eta>0) call post_data(CS%offline_CS%id_eta, eta_av(:,:), CS%diag) - - call disable_averaging(CS%diag) call cpu_clock_end(id_clock_dynamics) - - - - - CS%dt_trans = CS%dt_trans + dt if (thermo_does_span_coupling) then do_advection = (CS%dt_trans + 0.5*dt > dt_therm) @@ -1441,6 +1438,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) ! local type(ocean_grid_type), pointer :: G ! pointer to a structure with metrics and related type(verticalGrid_type), pointer :: GV => NULL() + type(dyn_horgrid_type), pointer :: dG => NULL() type(diag_ctrl), pointer :: diag character(len=4), parameter :: vers_num = 'v2.0' @@ -1466,6 +1464,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) logical :: symmetric ! If true, use symmetric memory allocation. logical :: save_IC ! If true, save the initial conditions. logical :: do_unit_tests ! If true, call unit tests. + logical :: test_grid_copy = .false. type(time_type) :: Start_time type(ocean_internal_state) :: MOM_internal_state @@ -1476,9 +1475,11 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) return endif allocate(CS) - G => CS%G + + if (test_grid_copy) then ; allocate(G) + else ; G => CS%G ; endif + CS%Time => Time - diag => CS%diag id_clock_init = cpu_clock_id('Ocean Initialization', grain=CLOCK_SUBCOMPONENT) call cpu_clock_begin(id_clock_init) @@ -1510,19 +1511,11 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call MOM_checksums_init(param_file) + call diag_mediator_infrastructure_init() call MOM_io_init(param_file) call MOM_grid_init(G, param_file) call verticalGridInit( param_file, CS%GV ) GV => CS%GV - ! Copy several common variables from the vertical grid to the horizontal grid. - ! Consider removing these later? - G%ke = GV%ke - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - call diag_mediator_init(G, param_file, diag, doc_file_dir=dirs%output_directory) ! Read relevant parameters and write them to the model log. call log_version(param_file, "MOM", version, "") @@ -1590,7 +1583,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & "If true, interface heights are diffused with a \n"//& "coefficient of KHTH.", default=.false.) - call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", & + call get_param(param_file, "MOM", "`_FIRST", & CS%thickness_diffuse_first, & "If true, do thickness diffusion before dynamics.\n"//& "This is only used if THICKNESSDIFFUSE is true.", & @@ -1745,6 +1738,14 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call tracer_registry_init(param_file, CS%tracer_Reg) + ! Copy a common variable from the vertical grid to the horizontal grid. + ! Consider removing this later? + G%ke = GV%ke + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + ! Allocate and initialize space for primary MOM variables. ALLOC_(CS%u(IsdB:IedB,jsd:jed,nz)) ; CS%u(:,:,:) = 0.0 ALLOC_(CS%v(isd:ied,JsdB:JedB,nz)) ; CS%v(:,:,:) = 0.0 @@ -1761,8 +1762,8 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) CS%vd_S = var_desc(name="S",units="PPT",longname="Salinity",& cmor_field_name="so",cmor_units="ppt", & conversion=0.001) - call register_tracer(CS%tv%T, CS%vd_T, param_file, G, CS%tracer_Reg, CS%vd_T) - call register_tracer(CS%tv%S, CS%vd_S, param_file, G, CS%tracer_Reg, CS%vd_S) + call register_tracer(CS%tv%T, CS%vd_T, param_file, G%HI, GV, CS%tracer_Reg, CS%vd_T) + call register_tracer(CS%tv%S, CS%vd_S, param_file, G%HI, GV, CS%tracer_Reg, CS%vd_S) endif if (CS%use_frazil) then allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0 @@ -1825,44 +1826,34 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) ! Set the fields that are needed for bitwise identical restarting ! the time stepping scheme. - call restart_init(G, param_file, CS%restart_CSp) - call set_restart_fields(G, GV, param_file, CS) + call restart_init(param_file, CS%restart_CSp) + call set_restart_fields(GV, param_file, CS) if (CS%split) then if (CS%legacy_split) then - call register_restarts_dyn_legacy_split(G, GV, param_file, & + call register_restarts_dyn_legacy_split(G%HI, GV, param_file, & CS%dyn_legacy_split_CSp, CS%restart_CSp, CS%uh, CS%vh) else - call register_restarts_dyn_split_RK2(G, GV, param_file, & + call register_restarts_dyn_split_RK2(G%HI, GV, param_file, & CS%dyn_split_RK2_CSp, CS%restart_CSp, CS%uh, CS%vh) endif else if (CS%use_RK2) then - call register_restarts_dyn_unsplit_RK2(G, GV, param_file, & + call register_restarts_dyn_unsplit_RK2(G%HI, GV, param_file, & CS%dyn_unsplit_RK2_CSp, CS%restart_CSp) else - call register_restarts_dyn_unsplit(G, GV, param_file, & + call register_restarts_dyn_unsplit(G%HI, GV, param_file, & CS%dyn_unsplit_CSp, CS%restart_CSp) endif endif ! This subroutine calls user-specified tracer registration routines. ! Additional calls can be added to MOM_tracer_flow_control.F90. - call call_tracer_register(G, param_file, CS%tracer_flow_CSp, & - diag, CS%tracer_Reg, CS%restart_CSp) - - call MEKE_alloc_register_restart(G, param_file, CS%MEKE, CS%restart_CSp) - call set_visc_register_restarts(G, param_file, CS%visc, CS%restart_CSp) - call mixedlayer_restrat_register_restarts(G, param_file, CS%mixedlayer_restrat_CSp, CS%restart_CSp) + call call_tracer_register(G%HI, GV, param_file, CS%tracer_flow_CSp, & + CS%tracer_Reg, CS%restart_CSp) - call cpu_clock_begin(id_clock_pass_init) - !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM - call create_group_pass(CS%pass_uv_T_S_h, CS%u, CS%v, G%Domain) - if (CS%use_temperature) then - call create_group_pass(CS%pass_uv_T_S_h, CS%tv%T, G%Domain) - call create_group_pass(CS%pass_uv_T_S_h, CS%tv%S, G%Domain) - endif - call create_group_pass(CS%pass_uv_T_S_h, CS%h, G%Domain) - call cpu_clock_end(id_clock_pass_init) + call MEKE_alloc_register_restart(G%HI, param_file, CS%MEKE, CS%restart_CSp) + call set_visc_register_restarts(G%HI, GV, param_file, CS%visc, CS%restart_CSp) + call mixedlayer_restrat_register_restarts(G%HI, param_file, CS%mixedlayer_restrat_CSp, CS%restart_CSp) ! Initialize fields call callTree_waypoint("restart registration complete (initialize_MOM)") @@ -1870,12 +1861,12 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_begin(id_clock_MOM_init) call MOM_initialize_fixed(G, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") - call MOM_initialize_coord(G, GV, param_file, write_geom_files, & - dirs%output_directory, CS%tv) + call MOM_initialize_coord(GV, param_file, write_geom_files, & + dirs%output_directory, CS%tv, G%max_depth) call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)") if (CS%use_ALE_algorithm) then - call ALE_init(param_file, G, GV, CS%ALE_CSp) + call ALE_init(param_file, GV, G%max_depth, CS%ALE_CSp) call callTree_waypoint("returned from ALE_init() (initialize_MOM)") endif @@ -1885,6 +1876,62 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") + ! From this point, there may be pointers being set, so the final grid type + ! that will persist through the run has to be used. + + ! Shift from using the temporary dynamic grid type to using the final (potentially + ! static) ocean grid type. + ! call clone_MOM_domain(dG%Domain, CS%G%Domain) + ! call MOM_grid_init(CS%G, param_file) + ! call copy_dyngrid_to_MOM_grid(dg, CS%G) + ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. + ! if (CS%debug .or. CS%G%symmetric) & + ! call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) + + ! ! Copy a common variable from the vertical grid to the horizontal grid. + ! ! Consider removing this later? + ! CS%G%ke = GV%ke + ! G => CS%G + + if (test_grid_copy) then + ! Copy the data from the temporary grid to the dyn_hor_grid to CS%G. + call create_dyn_horgrid(dG, G%HI) + call clone_MOM_domain(G%Domain, dG%Domain) + + call clone_MOM_domain(G%Domain, CS%G%Domain) + call MOM_grid_init(CS%G, param_file) + + call copy_MOM_grid_to_dyngrid(G, dg) + call copy_dyngrid_to_MOM_grid(dg, CS%G) + ! Copy a common variable from the vertical grid to the horizontal grid. + ! Consider removing this later? + CS%G%ke = GV%ke + + call destroy_dyn_horgrid(dG) + call MOM_grid_end(G) ; deallocate(G) + + G => CS%G + + if (CS%debug .or. CS%G%symmetric) & + call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) + endif + + + ! At this point, all user-modified initialization code has been called. The + ! remainder of this subroutine is controlled by the parameters that have + ! have already been set. + + + call cpu_clock_begin(id_clock_pass_init) + !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM + call create_group_pass(CS%pass_uv_T_S_h, CS%u, CS%v, G%Domain) + if (CS%use_temperature) then + call create_group_pass(CS%pass_uv_T_S_h, CS%tv%T, G%Domain) + call create_group_pass(CS%pass_uv_T_S_h, CS%tv%S, G%Domain) + endif + call create_group_pass(CS%pass_uv_T_S_h, CS%h, G%Domain) + call cpu_clock_end(id_clock_pass_init) + if (ALE_remap_init_conds(CS%ALE_CSp) .and. .not. query_initialized(CS%h,"h",CS%restart_CSp)) then ! This block is controlled by the ALE parameter REMAP_AFTER_INITIALIZATION. ! \todo This block exists for legacy reasons and we should phase it out of @@ -1895,7 +1942,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call hchksum(CS%h*GV%H_to_m,"Pre ALE adjust init cond h", G, haloshift=1) endif call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)") - call adjustGridForIntegrity(CS%ALE_CSp, G, CS%h ) + call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h ) call callTree_waypoint("Calling ALE_main() to remap initial conditions (initialize_MOM)") call ALE_main( G, GV, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp ) call cpu_clock_begin(id_clock_pass_init) @@ -1910,6 +1957,10 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) endif if ( CS%use_ALE_algorithm ) call ALE_updateVerticalGridType( CS%ALE_CSp, GV ) + diag => CS%diag + ! Initialize the diag mediator. + call diag_mediator_init(G, param_file, diag, doc_file_dir=dirs%output_directory) + ! Initialize the diagnostics mask arrays. ! This step has to be done after call to MOM_initialize_state ! and before MOM_diagnostics_init @@ -1929,7 +1980,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call cpu_clock_begin(id_clock_MOM_init) if (CS%use_ALE_algorithm) then - call ALE_writeCoordinateFile( CS%ALE_CSp, G, GV, dirs%output_directory ) + call ALE_writeCoordinateFile( CS%ALE_CSp, GV, dirs%output_directory ) endif call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("ALE initialized (initialize_MOM)") @@ -2006,9 +2057,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call tracer_hor_diff_init(Time, G, param_file, diag, CS%tracer_diff_CSp, CS%neutral_diffusion_CSp) if (CS%use_ALE_algorithm) & - call register_diags_TS_vardec(Time, G, param_file, CS) + call register_diags_TS_vardec(Time, G%HI, GV, param_file, CS) - call lock_tracer_registry(CS%tracer_Reg, diag, Time, G) + call lock_tracer_registry(CS%tracer_Reg) call callTree_waypoint("tracer registry now locked (initialize_MOM)") ! now register some diagnostics since tracer registry is locked @@ -2037,7 +2088,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) cmor_long_name ="Sea Water Salinity") endif - call offline_transport_init(param_file, CS%offline_CS) call register_diags_offline_transport(Time, CS%diag, CS%offline_CS) @@ -2045,8 +2095,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) ! This subroutine initializes any tracer packages. new_sim = ((dirs%input_filename(1:1) == 'n') .and. & (LEN_TRIM(dirs%input_filename) == 1)) - call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, CS%OBC, & - CS%tracer_flow_CSp, CS%sponge_CSp, CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) + call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & + CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & + CS%ALE_sponge_CSp, CS%diag_to_Z_CSp) call cpu_clock_begin(id_clock_pass_init) call do_group_pass(CS%pass_uv_T_S_h, G%Domain) @@ -2466,10 +2517,11 @@ end subroutine register_diags_TS_tendency !> Initialize diagnostics for the variance decay of temp/salt !! across regridding/remapping -subroutine register_diags_TS_vardec(Time, G, param_file, CS) - type(time_type), intent(in) :: Time !< current model time - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(param_file_type), intent(in) :: param_file !< parameter file +subroutine register_diags_TS_vardec(Time, HI, GV, param_file, CS) + type(time_type), intent(in) :: Time !< current model time + type(hor_index_type), intent(in) :: HI !< horizontal index type + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_control_struct), pointer :: CS !< control structure for MOM integer :: isd, ied, jsd, jed, nz @@ -2477,7 +2529,7 @@ subroutine register_diags_TS_vardec(Time, G, param_file, CS) type(diag_ctrl), pointer :: diag diag => CS%diag - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke ! variancy decay through ALE operation CS%id_T_vardec = register_diag_field('ocean_model', 'T_vardec', diag%axesTL, Time, & @@ -2487,7 +2539,7 @@ subroutine register_diags_TS_vardec(Time, G, param_file, CS) CS%T_squared(:,:,:) = 0. vd_tmp = var_desc(name="T2", units="degC2", longname="Squared Potential Temperature") - call register_tracer(CS%T_squared, vd_tmp, param_file, G, CS%tracer_reg) + call register_tracer(CS%T_squared, vd_tmp, param_file, HI, GV, CS%tracer_reg) endif CS%id_S_vardec = register_diag_field('ocean_model', 'S_vardec', diag%axesTL, Time, & @@ -2497,14 +2549,11 @@ subroutine register_diags_TS_vardec(Time, G, param_file, CS) CS%S_squared(:,:,:) = 0. vd_tmp = var_desc(name="S2", units="PPT2", longname="Squared Salinity") - call register_tracer(CS%S_squared, vd_tmp, param_file, G, CS%tracer_reg) + call register_tracer(CS%S_squared, vd_tmp, param_file, HI, GV, CS%tracer_reg) endif end subroutine register_diags_TS_vardec - - - !> This subroutine sets up clock IDs for timing various subroutines. subroutine MOM_timing_init(CS) type(MOM_control_struct), intent(in) :: CS !< control structure set up by initialize_MOM. @@ -2788,8 +2837,7 @@ end subroutine write_static_fields !! This routine should be altered if there are any changes to the !! time stepping scheme. The CHECK_RESTART facility may be used to !! confirm that all needed restart fields have been included. -subroutine set_restart_fields(G, GV, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure +subroutine set_restart_fields(GV, param_file, CS) type(verticalGrid_type), intent(inout) :: GV !< ocean vertical grid structure type(param_file_type), intent(in) :: param_file !< opened file for parsing to get parameters type(MOM_control_struct), intent(in) :: CS !< control structure set up by inialize_MOM diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 391fc1f316..667efbd6df 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1101,8 +1101,11 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) enddo ; enddo do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) + +! if(do_online) then + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) +! endif elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -1123,15 +1126,25 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) + +! if(do_online) then + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) +! endif + else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) + +! if(do_online) then + call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) +! endif + endif ! (CS%mix_boundary_tracers) + + call cpu_clock_end(id_clock_tracers) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 00a8c5839b..47067c0fe8 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -49,7 +49,9 @@ module MOM_offline_transport use MOM_io, only : read_data use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_diag_mediator, only : diag_ctrl, register_diag_field - use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + use MOM_variables, only : vertvisc_type + implicit none @@ -79,7 +81,14 @@ module MOM_offline_transport id_u = -1, id_v = -1, & id_uh = -1, id_vh = -1, & id_uhtr = -1, id_vhtr = -1, & - id_eta = -1 + id_eta = -1, & + id_ea = -1, id_eb = -1, & + id_ray_u = -1, id_ray_v = -1, & + id_bbl_thick_u = -1, id_bbl_thick_v = -1, & + id_kv_bbl_u = -1, id_kv_bbl_v = -1, & + id_temp = -1, id_salt = -1 + ! id_ustar = -1 + end type offline_transport_CS @@ -117,25 +126,57 @@ subroutine register_diags_offline_transport(Time, diag, CS) type(time_type), intent(in) :: Time !< current model time type(diag_ctrl) :: diag - CS%id_uhtr = register_diag_field('ocean_model', 'uhtr_off', diag%axesCuL, Time, & + CS%id_uhtr = register_diag_field('ocean_model', 'uhtr_off', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg') - CS%id_vhtr = register_diag_field('ocean_model', 'vhtr_off', diag%axesCvL, Time, & + CS%id_uh = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_u = register_diag_field('ocean_model', 'u_off', diag%axesCuL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_ray_u = register_diag_field('ocean_model', 'ray_u_off', diag%axesCuL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u_off', diag%axesCu1, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u_off', diag%axesCu1, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_uh = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & + + CS%id_vhtr = register_diag_field('ocean_model', 'vhtr_off', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_vh = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_v = register_diag_field('ocean_model', 'v_off', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_vh = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & + CS%id_ray_v = register_diag_field('ocean_model', 'ray_v_off', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_u = register_diag_field('ocean_model', 'u_off', diag%axesCuL, Time, & + CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v_off', diag%axesCv1, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_v = register_diag_field('ocean_model', 'v_off', diag%axesCvL, Time, & + CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v_off',diag%axesCv1, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_h = register_diag_field('ocean_model', 'h_off', diag%axesTL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') CS%id_eta = register_diag_field('ocean_model', 'eta_av', diag%axesT1, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_eta = register_diag_field('ocean_model', 'p_surf_begin', diag%axesT1, Time, & + CS%id_temp = register_diag_field('ocean_model', 'temp_off', diag%axesTL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_salt = register_diag_field('ocean_model', 'salt_off', diag%axesTL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + + + ! CS%id_kvbbl_u = register_diag_field('ocean_model', 'kvbbl_u', diag%axesCu1, Time, & + ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! CS%id_kvbbl_v = register_diag_field('ocean_model', 'kvbbl_v', diag%axesCv1, Time, & + ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! + ! CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u_off', diag%axesCu1, Time, & + ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v_off', diag%axesCv1, Time, & + ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! + ! CS%id_ustar = register_diag_field('ocean_model', 'ustar_bbl_off', diag%axesT1, Time, & + ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + + end subroutine register_diags_offline_transport subroutine offline_transport_init(param_file, CS) @@ -183,62 +224,103 @@ subroutine offline_transport_init(param_file, CS) end subroutine offline_transport_init - subroutine transport_by_files(G, CS, angstrom, u, v, uh, vh, uhtr, vhtr, h , eta_av, missing) + subroutine transport_by_files(G, CS, angstrom, u, v, uh, vh, uhtr, vhtr, h, eta_av, missing, visc, temp, salt) !, kv_bbl_u, kv_bbl_v, bbl_thick_u, bbl_thick_v, ustar_bbl, missing) type(ocean_grid_type) , intent(inout) :: G type(offline_transport_CS) , intent(inout) :: CS real :: angstrom - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness after advection (m or kg m-2) - real, dimension(SZI_(G),SZJ_(G)) , intent(inout) :: eta_av + ! Fields at U-points + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u, uh, uhtr + ! Fields at V-points + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v, vh, vhtr + ! Fields at T-point + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h, temp, salt + ! Fields at T-point (2D) + real, dimension(SZI_(G),SZJ_(G)) :: eta_av + ! Scalars real :: missing + ! Derived types + type(vertvisc_type) :: visc + integer :: i, j, k call callTree_enter("transport_by_files, MOM_offline_control.F90") - if ( is_root_pe() ) print *, "Read index: ", CS%ridx_mean + ! if ( is_root_pe() ) print *, "Read index: ", CS%ridx_mean ! Read time-averaged fields (middle of time interval timestamp) call read_data(CS%transport_file, 'u', u(:,:,:),domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'v', v(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) -! call read_data(CS%transport_file, 'uh', uh(:,:,:),domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'vh', vh(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - - call read_data(CS%transport_file, 'uhtr', uhtr(:,:,:),domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'ray_u', visc%Ray_u(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'kv_bbl_u', visc%kv_bbl_u(:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'bbl_thick_u', visc%bbl_thick_u(:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + + call read_data(CS%transport_file, 'v', v(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%transport_file, 'vh', vh(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) call read_data(CS%transport_file, 'vhtr', vhtr(:,:,:),domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) -! -! call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_mean,position=CENTER) -! -! ! Read snapshot fields (end of time interval timestamp) + call read_data(CS%transport_file, 'ray_v', visc%Ray_v(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%transport_file, 'kv_bbl_v', visc%kv_bbl_v(:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%transport_file, 'bbl_thick_v', visc%bbl_thick_v(:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + + ! + call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + ! + ! ! Read snapshot fields (end of time interval timestamp) call read_data(CS%transport_file, 'h', h(:,:,:),domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%transport_file, 'temp', temp(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%transport_file, 'salt', salt(:,:,:),domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + + + call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + ! + ! + ! call read_data(CS%transport_file, 'kvbbl_u', kv_bbl_u(:,:),domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_mean,position=EAST) + ! call read_data(CS%transport_file, 'kvbbl_v', kv_bbl_v(:,:),domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_mean,position=NORTH) + ! + ! call read_data(CS%transport_file, 'bbl_thick_u', bbl_thick_u(:,:),domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_mean,position=EAST) + ! call read_data(CS%transport_file, 'bbl_thick_v', bbl_thick_v(:,:),domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_mean,position=NORTH) + ! call read_data(CS%transport_file, 'ustar_bbl', ustar_bbl(:,:),domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_mean,position=CENTER) ! Apply masks sinice read_data doesn't account for missing values?! do k = 1,G%ke -! -! ! Fields on T-cell + ! + ! ! Fields on T-cell do j=G%jsd, G%jed ; do i=G%isd, G%ied - if( h(i,j,k)<0.0 ) h(i,j,k) = angstrom -! if(eta_av(i,j).EQ.missing) eta_av = 0 + if( h(i,j,k).EQ.missing ) h(i,j,k) = angstrom + if( temp(i,j,k).EQ.missing ) temp(i,j,k) = 0 + if( salt(i,j,k).EQ.missing ) salt(i,j,k) = 0 + if(eta_av(i,j).EQ.missing) eta_av(i,j) = 0 enddo ; enddo -! -! + ! + ! ! Fields on U-Grid do j=G%jsd, G%jed ; do i=G%isdb, G%iedb + if(visc%bbl_thick_u(i,j) .EQ. missing) visc%bbl_thick_u(i,j) = 0 + if(visc%kv_bbl_u(i,j) .EQ. missing) visc%kv_bbl_u(i,j) = 0 + if(visc%ray_u(i,j,k) .EQ. missing) visc%ray_u(i,j,k) = 0 if(uhtr(i,j,k) .EQ. missing) uhtr(i,j,k) = 0 if(uh(i,j,k) .EQ. missing) uh(i,j,k) = 0 if(u(i,j,k) .EQ. missing) u(i,j,k) = 0 @@ -246,28 +328,32 @@ subroutine transport_by_files(G, CS, angstrom, u, v, uh, vh, uhtr, vhtr, h , eta ! Fields on V-Grid do j=G%jsdb, G%jedb ; do i=G%isd, G%ied + if(visc%bbl_thick_v(i,j) .EQ. missing) visc%bbl_thick_v(i,j) = 0 + if(visc%kv_bbl_v(i,j) .EQ. missing) visc%kv_bbl_v(i,j) = 0 + if(visc%ray_v(i,j,k) .EQ. missing) visc%ray_v(i,j,k) = 0 if(vhtr(i,j,k) .EQ. missing) vhtr(i,j,k) = 0 if(vh(i,j,k) .EQ. missing) vh(i,j,k) = 0 if(v(i,j,k) .EQ. missing) v(i,j,k) = 0 enddo ; enddo -! -! + ! + ! enddo -! -! ! Make sure all halos have been updated + ! + ! ! Make sure all halos have been updated call pass_vector(uhtr, vhtr, G%Domain) call pass_vector(uh, vh, G%Domain) call pass_vector(u, v, G%Domain) + call pass_vector(visc%ray_u, visc%ray_v, G%Domain) call pass_var(h,G%Domain) call pass_var(eta_av, G%Domain) + call pass_var(temp, G%Domain) + call pass_var(salt, G%Domain) ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) - - call callTree_leave("transport_by_file") end subroutine transport_by_files From ae78ec37498089c045abdf1247c52836b9067cc2 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 8 Jul 2016 12:02:48 -0400 Subject: [PATCH 03/65] Offline tracer transport reproduces bitwise identical results in the Baltic test case and for the first 1.5 days of the Baltic_ALE_z case --- src/core/MOM.F90 | 324 ++++++++--- .../vertical/MOM_diabatic_driver.F90 | 32 +- src/tracer/MOM_offline_control.F90 | 540 +++++++++--------- src/tracer/MOM_tracer_advect.F90 | 3 +- src/tracer/MOM_tracer_flow_control.F90 | 2 +- src/tracer/MOM_tracer_hor_diff.F90 | 227 +++++--- 6 files changed, 678 insertions(+), 450 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c0d2fdae59..d108d02b13 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -114,6 +114,7 @@ module MOM use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS use MOM_tracer_flow_control, only : tracer_flow_control_init, call_tracer_surface_state +use MOM_tracer_flow_control, only : call_tracer_column_fns use MOM_transcribe_grid, only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid use MOM_vert_friction, only : vertvisc, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init @@ -123,7 +124,7 @@ module MOM ! Offline modules use MOM_offline_transport, only : offline_transport_CS -use MOM_offline_transport, only : transport_by_data_override, transport_by_files, next_modulo_time +use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use time_manager_mod, only : print_date @@ -370,7 +371,7 @@ module MOM type(sponge_CS), pointer :: sponge_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() type(ALE_CS), pointer :: ALE_CSp => NULL() - type(offline_transport_CS), pointer :: offline_CS => NULL() + type(offline_transport_CS), pointer :: offline_CSp => NULL() ! These are used for group halo updates. type(group_pass_type) :: pass_tau_ustar_psurf @@ -388,6 +389,7 @@ module MOM public initialize_MOM public finish_MOM_initialization public step_MOM +public step_tracers public MOM_end public calculate_surface_state @@ -476,6 +478,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_predia, eta_preale + real :: tot_wt_ssh, Itot_wt_ssh, I_time_int real :: zos_area_mean, volo, ssh_ga type(time_type) :: Time_local @@ -489,6 +492,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h + write_all_3du = 1. + write_all_3dv = 1. + write_all_3dt = 1. + call cpu_clock_begin(id_clock_ocean) call cpu_clock_begin(id_clock_other) @@ -693,15 +700,15 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, CS%tv, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, G, GV, CS%diabatic_CSp) + dtdia, G, GV, CS%diabatic_CSp, CS%offline_CSp) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) - if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) - if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) - if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) - if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag) - if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag) + if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag, mask = write_all_3du) + if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag, mask = write_all_3dv) + if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag, mask = write_all_3dt) + if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag, mask = write_all_3dt) + if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag, mask = write_all_3dt) if (CS%id_e_preale > 0) then call find_eta(h, CS%tv, G%g_Earth, G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) @@ -857,7 +864,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) enddo ; enddo ; enddo endif - if (CS%do_dynamics .and. CS%split .and. CS%do_online) then !--------------------------- start SPLIT + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -883,7 +890,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (showCallTree) call callTree_waypoint("finished step_MOM_dyn_split (step_MOM)") - elseif (CS%do_dynamics .and. CS%do_online) then ! --------------------------------------------------- not SPLIT + elseif (CS%do_dynamics) then ! --------------------------------------------------- not SPLIT ! This section uses an unsplit stepping scheme for the dynamic ! equations; basically the stacked shallow water equations with viscosity. ! Because the time step is limited by CFL restrictions on the external @@ -904,58 +911,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif ! -------------------------------------------------- end SPLIT - if (.not. CS%do_online) then - !print *, "TRANSPORT BY DATA OVERRIDE at time", & - ! time_type_to_real(increment_date(Time_start,seconds = int(time_interval/2))) - !call transport_by_data_override(G, increment_date(Time_start,seconds = int(time_interval/2)), & - ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) - - !print *, "TRANSPORT BY DATA OVERRIDE at time", & - ! time_type_to_real(Time_start) - !call transport_by_data_override(G, Time_start, & - ! CS%u, CS%v, CS%uhtr, CS%vhtr, CS%h) - - call transport_by_files(G, CS%offline_CS, GV%Angstrom, & - u, v, CS%uh, CS%vh, CS%uhtr, CS%vhtr, h, eta_av, CS%missing, CS%visc,CS%T,CS%S) -! CS%visc%kv_bbl_u, CS%visc%kv_bbl_v, CS%visc%bbl_thick_u, CS%visc%bbl_thick_v, CS%visc%ustar_bbl, & -! ) - !call do_group_pass(CS%pass_h, G%Domain) -! if( is_root_pe() ) call print_date(Time_start) -! CS%visc%calc_bbl = .true. - -! call horizontal_viscosity(u_av, v_av, h_av, CS%dyn_split_RK2_CSp%diffu, CS%dyn_split_RK2_CSp%diffv, & -! CS%dyn_split_RK2_CSp%MEKE, CS%dyn_split_RK2_CSp%Varmix, G, GV, CS%dyn_split_RK2_CSp%hor_visc_CSp, OBC=CS%dyn_split_RK2_CSp%OBC) - - endif - -! call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & -! CS%diag) - write_all_3dt = 1. - write_all_3du = 1. - write_all_3dv = 1. - - if(CS%offline_CS%id_uhtr>0) call post_data(CS%offline_CS%id_uhtr, CS%uhtr(:,:,:), CS%diag, mask=write_all_3du) - if(CS%offline_CS%id_vhtr>0) call post_data(CS%offline_CS%id_vhtr, CS%vhtr(:,:,:), CS%diag, mask=write_all_3dv) - if(CS%offline_CS%id_uh>0) call post_data(CS%offline_CS%id_uh, CS%uh(:,:,:), CS%diag, mask=write_all_3du) - if(CS%offline_CS%id_vh>0) call post_data(CS%offline_CS%id_vh, CS%vh(:,:,:), CS%diag, mask=write_all_3dv) - if(CS%offline_CS%id_u>0) call post_data(CS%offline_CS%id_u, u(:,:,:), CS%diag, mask=write_all_3du) - if(CS%offline_CS%id_v>0) call post_data(CS%offline_CS%id_v, v(:,:,:), CS%diag, mask=write_all_3dv) - if(CS%offline_CS%id_ray_u>0) call post_data(CS%offline_CS%id_ray_u, CS%visc%Ray_u(:,:,:), CS%diag, mask=write_all_3du) - if(CS%offline_CS%id_ray_v>0) call post_data(CS%offline_CS%id_ray_v, CS%visc%Ray_v(:,:,:), CS%diag) - if(CS%offline_CS%id_h>0) call post_data(CS%offline_CS%id_h, h(:,:,:), CS%diag, mask=write_all_3dt) - if(CS%offline_CS%id_eta>0) call post_data(CS%offline_CS%id_eta, eta_av(:,:), CS%diag) - if(CS%offline_CS%id_kv_bbl_u>0) call post_data(CS%offline_CS%id_kv_bbl_u, CS%visc%kv_bbl_u(:,:), CS%diag) - if(CS%offline_CS%id_bbl_thick_u>0) call post_data(CS%offline_CS%id_bbl_thick_u, CS%visc%bbl_thick_u(:,:), CS%diag) - if(CS%offline_CS%id_kv_bbl_v>0) call post_data(CS%offline_CS%id_kv_bbl_v, CS%visc%kv_bbl_v(:,:), CS%diag) - if(CS%offline_CS%id_bbl_thick_v>0) call post_data(CS%offline_CS%id_bbl_thick_v, CS%visc%bbl_thick_v(:,:), CS%diag) - if(CS%offline_CS%id_temp>0) call post_data(CS%offline_CS%id_temp,CS%T(:,:,:), CS%diag, mask=write_all_3dt) - if(CS%offline_CS%id_salt>0) call post_data(CS%offline_CS%id_salt,CS%S(:,:,:), CS%diag, mask=write_all_3dt) -! if(CS%offline_CS%id_ustar>0) call post_data(CS%offline_CS%id_ustar, CS%visc%ustar_bbl(:,:), CS%diag) - - - -! call disable_averaging(CS%diag) if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) @@ -1017,8 +973,8 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call uchksum(u,"Pre-advection u", G, haloshift=2) call vchksum(v,"Pre-advection v", G, haloshift=2) call hchksum(h*GV%H_to_m,"Pre-advection h", G, haloshift=1) - call uchksum(CS%uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=0) - call vchksum(CS%vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=0) + call uchksum(CS%uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) + call vchksum(CS%vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) ! call MOM_state_chksum("Pre-advection ", u, v, & ! h, CS%uhtr, CS%vhtr, G, GV, haloshift=1) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) @@ -1037,6 +993,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call enable_averaging(CS%dt_trans, Time_local, CS%diag) call cpu_clock_begin(id_clock_tracer) + + ! Post fields used for offline tracer model + call post_advection_fields( G, CS%offline_CSp, CS%diag, CS%dt_trans, h, & + CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_trans, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h, CS%dt_trans, CS%MEKE, CS%VarMix, G, GV, & @@ -1083,17 +1043,26 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, CS%tv, fluxes, CS%visc, CS%ADp, CS%CDp, & - CS%dt_trans, G, GV, CS%diabatic_CSp) + CS%dt_trans, G, GV, CS%diabatic_CSp, CS%offline_CSp) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) ! Regridding/remapping is done here, at the end of the thermodynamics time step ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag, mask = write_all_3du) + if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag, mask = write_all_3dv) + if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag, mask = write_all_3dt) + if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag, mask = write_all_3dt) + if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag, mask = write_all_3dt) + if (CS%id_e_preale > 0) then + call find_eta(h, CS%tv, G%g_Earth, G, GV, eta_preale) + call post_data(CS%id_e_preale, eta_preale, CS%diag) + endif + if ( CS%use_ALE_algorithm ) then ! call pass_vector(u, v, G%Domain) call do_group_pass(CS%pass_T_S_h, G%Domain) - ! update squared quantities if (associated(CS%S_squared)) & CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 @@ -1424,6 +1393,223 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) end subroutine step_MOM +subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(surface), intent(inout) :: state !< surface ocean state + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval + type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM + + ! Local pointers + type(ocean_grid_type), pointer :: G ! Pointer to a structure containing + ! metrics and related information + type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information + ! about the vertical grid + ! U-3D + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr + ! U-2D + real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x + ! V-3D + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr + ! V-2D + real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y + + ! Local variables + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + eatr, & ! Amount of fluid entrained from the layer above within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + ebtr, & ! Amount of fluid entrained from the layer below within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + h_old, & ! Layer thickness before diapycnal entrainment + ! (m for Bouss, kg/m^2 for non-Bouss) + h_new, & ! Layer thickness after diapycnal entrainment + ! (m for Bouss, kg/m^2 for non-Bouss) + h_adv, & ! Layer thickness after diapycnal entrainment + ! (m for Bouss, kg/m^2 for non-Bouss) + h_end, & + temp_old, salt_old ! + + ! Grid-related pointer assignments + G => CS%G + GV => CS%GV + ! T-cell pointer assignments + + ! U-cell pointer assignments + + ! V-cell pointer assignments + uhtr = 0.0 + khdt_x = 0.0 + vhtr = 0.0 + khdt_y = 0.0 + eatr = 0.0 + ebtr = 0.0 + h_old = 0.0 + h_new = 0.0 + h_adv = 0.0 + h_end = 0.0 + temp_old = 0.0 + salt_old = 0.0 + + + + if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then + if (CS%use_temperature) then + call create_group_pass(CS%pass_T_S_h, CS%tv%T, G%Domain) + call create_group_pass(CS%pass_T_S_h, CS%tv%S, G%Domain) + endif + call create_group_pass(CS%pass_T_S_h, CS%offline_CSp%h_preale, G%Domain) + endif + + call cpu_clock_begin(id_clock_tracer) + call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & + CS%diag) + call transport_by_files(G, CS%offline_CSp, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & + khdt_x, khdt_y, CS%tv%T, CS%tv%S, CS%dt_therm, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) + + CS%uhtr = uhtr + CS%vhtr = vhtr + +!------------DIABATIC FIRST + + if (CS%diabatic_first) then + if (CS%debug) then + call hchksum(h_old*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) + endif + + call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & + fluxes, CS%dt_therm, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + if ( CS%use_ALE_algorithm ) then + + temp_old = CS%tv%T + salt_old = CS%tv%S + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale + + call do_group_pass(CS%pass_T_S_h, G%Domain) + + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_therm) + call cpu_clock_end(id_clock_ALE) + + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) + + endif ! endif for the block "if ( CS%use_ALE_algorithm )" + + + + endif +!-----------ADVECTION AND DIFFUSION + call post_advection_fields( G, CS%offline_CSp, CS%diag, CS%dt_therm, h_adv, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) + + if (CS%debug) then + call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) + call uchksum(CS%uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) + call vchksum(CS%vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) + if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) + if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) + endif + + call advect_tracer(h_adv, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_therm, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg) + call tracer_hordiff(h_adv, CS%dt_therm, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) + +!------------DIABATIC AFTER + if (.not. CS%diabatic_first) then + if (CS%debug) then + call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) + endif + + call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & + fluxes, CS%dt_therm, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + if ( CS%use_ALE_algorithm ) then + + temp_old = CS%tv%T + salt_old = CS%tv%S + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale + + call do_group_pass(CS%pass_T_S_h, G%Domain) + + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_therm) + call cpu_clock_end(id_clock_ALE) + endif ! endif for the block "if ( CS%use_ALE_algorithm )" + + + if (CS%debug .and. CS%use_ALE_algorithm) then + call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) + endif + + call disable_averaging(CS%diag) + call cpu_clock_end(id_clock_tracer) + CS%h = h_end + + + +end subroutine step_tracers !> This subroutine initializes MOM. @@ -1576,10 +1762,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) "If False, skips the dynamics calls that update u & v, as well as\n"//& "the gravity wave adjustment to h. This is a fragile feature and\n"//& "thus undocumented.", default=.true., do_not_log=.true. ) - call get_param(param_file, "MOM", "DO_ONLINE", CS%do_online, & - "If False, skips the dynamics calls that update u & v, as well as\n"//& - "the gravity wave adjustment to h. This is a fragile feature and\n"//& - "thus undocumented.", default=.true., do_not_log=.true. ) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & "If true, interface heights are diffused with a \n"//& "coefficient of KHTH.", default=.false.) @@ -2088,8 +2270,8 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) cmor_long_name ="Sea Water Salinity") endif - call offline_transport_init(param_file, CS%offline_CS) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CS) + call offline_transport_init(param_file, CS%offline_CSp, CS%use_ALE_algorithm, G, GV) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) ! This subroutine initializes any tracer packages. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 667efbd6df..d813f36d9d 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -57,6 +57,8 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speeds use time_manager_mod, only : increment_time ! for testing itides (BDM) +use MOM_offline_transport, only : offline_transport_CS, post_diabatic_fields + implicit none ; private @@ -69,7 +71,7 @@ module MOM_diabatic_driver public adiabatic_driver_init !> Control structure for this module -type, public :: diabatic_CS ; private +type, public :: diabatic_CS ; logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -212,7 +214,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) +subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_CSp) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) @@ -226,6 +228,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations real, intent(in) :: dt !< time increment (seconds) type(diabatic_CS), pointer :: CS !< module control structure + type(offline_transport_CS), pointer :: offline_CSp !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within @@ -1102,10 +1105,11 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo enddo -! if(do_online) then - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) -! endif + ! Post the fields used for tracers here + call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, eatr, ebtr ) + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -1127,19 +1131,15 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo -! if(do_online) then - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) -! endif + call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, eatr, ebtr) + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) else - -! if(do_online) then - call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp) -! endif - + call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, ea, eb) + call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp) endif ! (CS%mix_boundary_tracers) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 47067c0fe8..dcb3ec70a6 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -41,25 +41,28 @@ module MOM_offline_transport - use data_override_mod, only : data_override_init, data_override - use MOM_time_manager, only : time_type - use MOM_domains, only : pass_var, pass_vector, To_All - use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe - use MOM_grid, only : ocean_grid_type - use MOM_io, only : read_data - use MOM_file_parser, only : get_param, log_version, param_file_type - use MOM_diag_mediator, only : diag_ctrl, register_diag_field - use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST - use MOM_variables, only : vertvisc_type + + use data_override_mod, only : data_override_init, data_override + use MOM_time_manager, only : time_type + use MOM_domains, only : pass_var, pass_vector, To_All + use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe + use MOM_grid, only : ocean_grid_type + use MOM_verticalGrid, only : verticalGrid_type + use MOM_io, only : read_data + use MOM_file_parser, only : get_param, log_version, param_file_type + use MOM_diag_mediator, only : diag_ctrl, register_diag_field + use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + use MOM_variables, only : vertvisc_type + use MOM_forcing_type, only : forcing + use MOM_shortwave_abs, only : optics_type + use MOM_diag_mediator, only : post_data implicit none +#include type, public :: offline_transport_CS - integer :: total_counter ! How many total timesteps have been taken since - ! the start of the run - integer :: start_index ! Timelevel to start integer :: numtime ! How many timelevels in the input fields @@ -71,53 +74,219 @@ module MOM_offline_transport character(len=200) :: offlinedir ! Directory where offline fields are stored character(len=200) :: & ! Names transport_file, & - h_file + h_file, & + ts_file, & + preale_file logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level - integer :: & - id_h = -1, & - id_u = -1, id_v = -1, & - id_uh = -1, id_vh = -1, & - id_uhtr = -1, id_vhtr = -1, & - id_eta = -1, & - id_ea = -1, id_eb = -1, & - id_ray_u = -1, id_ray_v = -1, & - id_bbl_thick_u = -1, id_bbl_thick_v = -1, & - id_kv_bbl_u = -1, id_kv_bbl_v = -1, & - id_temp = -1, id_salt = -1 - ! id_ustar = -1 + ! These fields for preale are allocatable because they are not necessary for all runs + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & + T_preale, & + S_preale, & + h_preale + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & + u_preale + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & + v_preale + integer :: & + id_h_new = -1, & + id_h_old = -1, & + id_h_adv = -1, & + id_uhtr = -1, & + id_vhtr = -1, & + id_eatr = -1, & + id_ebtr = -1, & + id_temp = -1, & + id_salt = -1 end type offline_transport_CS #include "MOM_memory.h" - - public next_modulo_time public offline_transport_init - public transport_by_files - public transport_by_data_override + public post_diabatic_fields + public post_advection_fields contains - function next_modulo_time(inidx, total_counter) - ! Returns the next time interval to be read - integer :: total_counter ! How many times advect_tracer has been called - integer :: inidx ! Number of time levels in the input files + ! Called from call_tracer_column_fns to make sure that all the terms in the + ! diabatic driver routine are the same online and offline + subroutine post_diabatic_fields( G, CS, diag, dt, h_old, h_new, eatr, ebtr ) + + type(ocean_grid_type), intent(in) :: G + type(offline_transport_CS), intent(in) :: CS + type(diag_ctrl), target, intent(inout) :: diag + real, intent(in) :: dt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, & + eatr, ebtr + + real :: Idt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt + write_all_3dt = 1. + + if (CS%id_h_old>0) call post_data(CS%id_h_old, h_old, diag, mask = write_all_3dt ) + if (CS%id_h_new>0) call post_data(CS%id_h_new, h_new, diag, mask = write_all_3dt ) + if (CS%id_eatr>0) call post_data(CS%id_eatr, eatr, diag, mask = write_all_3dt) + if (CS%id_ebtr>0) call post_data(CS%id_ebtr, ebtr, diag, mask = write_all_3dt) + + end subroutine post_diabatic_fields + + ! Called right before tracer_advect call in MOM.F90 to ensure that all terms + ! in the tracer advection routine are the same online and offline + subroutine post_advection_fields( G, CS, diag, dt, h_adv, uhtr, vhtr, temp, salt ) + + type(ocean_grid_type), intent(in) :: G + type(offline_transport_CS), intent(in) :: CS + type(diag_ctrl), target, intent(inout) :: diag + real, intent(in) :: dt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_adv, temp, salt + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: write_all_3du + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: write_all_3dv + + + write_all_3dt = 1. + write_all_3du = 1. + write_all_3dv = 1. + + if (CS%id_h_adv>0) call post_data(CS%id_h_adv, h_adv, diag, mask = write_all_3dt ) + if (CS%id_uhtr>0) call post_data(CS%id_uhtr, uhtr, diag, mask = write_all_3du ) + if (CS%id_vhtr>0) call post_data(CS%id_vhtr, vhtr, diag, mask = write_all_3dv ) + if (CS%id_temp>0) call post_data(CS%id_temp, temp, diag, mask = write_all_3dt ) + if (CS%id_salt>0) call post_data(CS%id_salt, salt, diag, mask = write_all_3dt ) + + end subroutine post_advection_fields + + subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + temp, salt, dt, fluxes, optics, do_ale_in) + type(ocean_grid_type), intent(inout) :: G + type(offline_transport_CS), intent(inout) :: CS + type(forcing), intent(inout) :: fluxes + type(optics_type), intent(inout) :: optics + real, intent(in) :: dt + logical, optional :: do_ale_in + + !! Mandatory variables + ! Fields at U-points + ! 3D + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uhtr + ! 2D + real, dimension(SZIB_(G),SZJ_(G)) :: khdt_x + ! Fields at V-points + ! 3D + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vhtr + ! 2D + real, dimension(SZI_(G),SZJB_(G)) :: khdt_y + ! Fields at T-point + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + h_new, h_old, h_adv, h_end, & + eatr, ebtr, & + temp, salt + logical :: do_ale - integer :: read_index ! The index in the input files that corresponds - ! to the current timestep + do_ale = .false.; + if (present(do_ale_in) ) do_ale = do_ale_in - integer :: next_modulo_time - read_index = mod(inidx+1,total_counter) - if (read_index < 0) read_index = inidx-read_index - if (read_index == 0) read_index = 1 + call callTree_enter("transport_by_files, MOM_offline_control.F90") - next_modulo_time = read_index - end function next_modulo_time + !! Time-averaged fields + ! U-cell fields + call read_data(CS%transport_file, 'uhtr_sum', uhtr,domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%transport_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + + ! V-cell fields + call read_data(CS%transport_file, 'vhtr_sum', vhtr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%transport_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + + ! T-cell fields + call read_data(CS%transport_file, 'eatr_sum', eatr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%transport_file, 'ebtr_sum', ebtr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%ts_file, 'temp', temp, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%ts_file, 'salt', salt, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + + !! Read snapshot fields (end of time interval timestamp) + ! T-cell fields + call read_data(CS%h_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%h_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%h_file, 'h_adv', h_adv, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%h_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + + if (do_ale) then + call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + + endif + + + + ! Convert all transport from time-averages to total amounts +! uhtr = uhtr * dt +! vhtr = vhtr * dt +! eatr = eatr * dt +! ebtr = ebtr * dt +! khdt_x = khdt_x * dt +! khdt_y = khdt_y * dt + + !! Make sure all halos have been updated + ! Vector fields + call pass_vector(uhtr, vhtr, G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) + + ! Scalar fields + call pass_var(h_adv, G%Domain) + call pass_var(h_old, G%Domain) + call pass_var(h_new, G%Domain) + call pass_var(h_end, G%Domain) + call pass_var(eatr, G%Domain) + call pass_var(ebtr, G%Domain) + call pass_var(temp, G%Domain) + call pass_var(salt, G%Domain) + + if (do_ale) then + + call pass_vector(CS%u_preale,CS%v_preale,G%Domain) + call pass_var(CS%h_preale, G%Domain) + call pass_var(CS%T_preale, G%Domain) + call pass_var(CS%S_preale, G%Domain) + + + endif + + + ! Update the read indices + CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) + CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) + + call callTree_leave("transport_by_file") + + end subroutine transport_by_files !> Initialize additional diagnostics required for offline tracer transport subroutine register_diags_offline_transport(Time, diag, CS) @@ -126,66 +295,51 @@ subroutine register_diags_offline_transport(Time, diag, CS) type(time_type), intent(in) :: Time !< current model time type(diag_ctrl) :: diag - CS%id_uhtr = register_diag_field('ocean_model', 'uhtr_off', diag%axesCuL, Time, & - 'Accumulated zonal thickness fluxes to advect tracers', 'kg') - CS%id_uh = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_u = register_diag_field('ocean_model', 'u_off', diag%axesCuL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_ray_u = register_diag_field('ocean_model', 'ray_u_off', diag%axesCuL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u_off', diag%axesCu1, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u_off', diag%axesCu1, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_vhtr = register_diag_field('ocean_model', 'vhtr_off', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_vh = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_v = register_diag_field('ocean_model', 'v_off', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_ray_v = register_diag_field('ocean_model', 'ray_v_off', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v_off', diag%axesCv1, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v_off',diag%axesCv1, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! U-cell fields + CS%id_uhtr = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & + 'Accumulated zonal thickness fluxes to advect tracers', 'kg') - CS%id_h = register_diag_field('ocean_model', 'h_off', diag%axesTL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_eta = register_diag_field('ocean_model', 'eta_av', diag%axesT1, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_temp = register_diag_field('ocean_model', 'temp_off', diag%axesTL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - CS%id_salt = register_diag_field('ocean_model', 'salt_off', diag%axesTL, Time, & + ! V-cell fields + CS%id_vhtr = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + ! T-cell fields + CS%id_h_adv = register_diag_field('ocean_model', 'h_adv', diag%axesTL, Time, & + 'Layer Thickness prior to advection', 'm') + CS%id_h_old = register_diag_field('ocean_model', 'h_old', diag%axesTL, Time, & + 'Layer Thickness before diabatic', 'm') + CS%id_h_new = register_diag_field('ocean_model', 'h_new', diag%axesTL, Time, & + 'Layer Thickness after diabatic', 'm') + CS%id_eatr = register_diag_field('ocean_model', 'eatr_off', diag%axesTL, Time, & + 'Entrainment from layer above', 'kg') + CS%id_ebtr = register_diag_field('ocean_model', 'ebtr_off', diag%axesTL, Time, & + 'Entrainment from layer below', 'kg') + CS%id_temp = register_diag_field('ocean_model', 'temp_off', diag%axesTL, Time, & + 'Temperature prior to advection', 'C') + CS%id_salt = register_diag_field('ocean_model', 'salt_off', diag%axesTL, Time, & + 'Salinity prior to advection', 'S') - ! CS%id_kvbbl_u = register_diag_field('ocean_model', 'kvbbl_u', diag%axesCu1, Time, & - ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - ! CS%id_kvbbl_v = register_diag_field('ocean_model', 'kvbbl_v', diag%axesCv1, Time, & - ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - ! - ! CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u_off', diag%axesCu1, Time, & - ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - ! CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v_off', diag%axesCv1, Time, & - ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - ! - ! CS%id_ustar = register_diag_field('ocean_model', 'ustar_bbl_off', diag%axesT1, Time, & - ! 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - end subroutine register_diags_offline_transport - subroutine offline_transport_init(param_file, CS) + subroutine offline_transport_init(param_file, CS, do_ale, G, GV) + + type(param_file_type) , intent(in) :: param_file + type(offline_transport_CS), pointer, intent(inout) :: CS + logical , intent(in) :: do_ale + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV - type(param_file_type) :: param_file - type(offline_transport_CS), pointer :: CS + character(len=40) :: mod = "offline_transport" - character(len=40) :: mod = "offline_transport" + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter("offline_transport_init, MOM_offline_control.F90") @@ -196,13 +350,17 @@ subroutine offline_transport_init(param_file, CS) endif allocate(CS) - CS%total_counter = 0; + ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing=.true.) call get_param(param_file, mod, "TRANSPORT_FILE", CS%transport_file, & - "Filename where uhtr, vhtr, u, v fields can be found", default="offline_transport.nc") + "Filename where uhtr, vhtr, ea, eb fields can be found") call get_param(param_file, mod, "H_FILE", CS%h_file, & - "Filename where the h field can be found", default="offline_h.nc") + "Filename where the h fields can be found") + call get_param(param_file, mod, "TS_FILE", CS%ts_file, & + "Filename where the temperature and salinity fields can be found") + call get_param(param_file, mod, "PREALE_FILE", CS%preale_file, & + "Filename where the preale T, S, u, v, and h fields are found") call get_param(param_file, mod, "START_INDEX", CS%start_index, & "Which time index to start from", fail_if_missing=.true.) call get_param(param_file, mod, "NUMTIME", CS%numtime, & @@ -211,197 +369,47 @@ subroutine offline_transport_init(param_file, CS) "True if the time-averaged fields and snapshot fields are offset by one time level", & default=.false.) + ! Concatenate offline directory and file names CS%transport_file = trim(CS%offlinedir)//trim(CS%transport_file) CS%h_file = trim(CS%offlinedir)//trim(CS%h_file) - + CS%ts_file = trim(CS%offlinedir)//trim(CS%ts_file) + CS%preale_file = trim(CS%offlinedir)//trim(CS%preale_file) ! Set the starting read index for time-averaged and snapshotted fields CS%ridx_mean = CS%start_index if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index + if (do_ale) then + ALLOC_(CS%u_preale(IsdB:IedB,jsd:jed,nz)) ; CS%u_preale(:,:,:) = 0.0 + ALLOC_(CS%v_preale(isd:ied,JsdB:JedB,nz)) ; CS%v_preale(:,:,:) = 0.0 + ALLOC_(CS%h_preale(isd:ied,jsd:jed,nz)) ; CS%h_preale(:,:,:) = GV%Angstrom + ALLOC_(CS%T_preale(isd:ied,jsd:jed,nz)) ; CS%T_preale(:,:,:) = 0.0 + ALLOC_(CS%S_preale(isd:ied,jsd:jed,nz)) ; CS%S_preale(:,:,:) = 0.0 + endif + call callTree_leave("offline_transport_init") end subroutine offline_transport_init - subroutine transport_by_files(G, CS, angstrom, u, v, uh, vh, uhtr, vhtr, h, eta_av, missing, visc, temp, salt) !, kv_bbl_u, kv_bbl_v, bbl_thick_u, bbl_thick_v, ustar_bbl, missing) - type(ocean_grid_type) , intent(inout) :: G - type(offline_transport_CS) , intent(inout) :: CS - real :: angstrom - ! Fields at U-points - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u, uh, uhtr - ! Fields at V-points - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v, vh, vhtr - ! Fields at T-point - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h, temp, salt - ! Fields at T-point (2D) - real, dimension(SZI_(G),SZJ_(G)) :: eta_av - ! Scalars - real :: missing - ! Derived types - type(vertvisc_type) :: visc - - - integer :: i, j, k - - call callTree_enter("transport_by_files, MOM_offline_control.F90") - - ! if ( is_root_pe() ) print *, "Read index: ", CS%ridx_mean - - ! Read time-averaged fields (middle of time interval timestamp) - call read_data(CS%transport_file, 'u', u(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'uh', uh(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'uhtr', uhtr(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'ray_u', visc%Ray_u(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'kv_bbl_u', visc%kv_bbl_u(:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'bbl_thick_u', visc%bbl_thick_u(:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - - call read_data(CS%transport_file, 'v', v(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'vh', vh(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'vhtr', vhtr(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'ray_v', visc%Ray_v(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'kv_bbl_v', visc%kv_bbl_v(:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'bbl_thick_v', visc%bbl_thick_v(:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - - ! - call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - ! - ! ! Read snapshot fields (end of time interval timestamp) - call read_data(CS%transport_file, 'h', h(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%transport_file, 'temp', temp(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%transport_file, 'salt', salt(:,:,:),domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - + function next_modulo_time(inidx, numtime) + ! Returns the next time interval to be read + integer :: numtime ! Number of time levels in input fields + integer :: inidx ! The current time index - call read_data(CS%transport_file, 'eta_av', eta_av(:,:), domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - ! - ! - ! call read_data(CS%transport_file, 'kvbbl_u', kv_bbl_u(:,:),domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_mean,position=EAST) - ! call read_data(CS%transport_file, 'kvbbl_v', kv_bbl_v(:,:),domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_mean,position=NORTH) - ! - ! call read_data(CS%transport_file, 'bbl_thick_u', bbl_thick_u(:,:),domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_mean,position=EAST) - ! call read_data(CS%transport_file, 'bbl_thick_v', bbl_thick_v(:,:),domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_mean,position=NORTH) - ! call read_data(CS%transport_file, 'ustar_bbl', ustar_bbl(:,:),domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_mean,position=CENTER) - - ! Apply masks sinice read_data doesn't account for missing values?! - do k = 1,G%ke - ! - ! ! Fields on T-cell - do j=G%jsd, G%jed ; do i=G%isd, G%ied - if( h(i,j,k).EQ.missing ) h(i,j,k) = angstrom - if( temp(i,j,k).EQ.missing ) temp(i,j,k) = 0 - if( salt(i,j,k).EQ.missing ) salt(i,j,k) = 0 - if(eta_av(i,j).EQ.missing) eta_av(i,j) = 0 - enddo ; enddo - ! - ! - ! Fields on U-Grid - do j=G%jsd, G%jed ; do i=G%isdb, G%iedb - if(visc%bbl_thick_u(i,j) .EQ. missing) visc%bbl_thick_u(i,j) = 0 - if(visc%kv_bbl_u(i,j) .EQ. missing) visc%kv_bbl_u(i,j) = 0 - if(visc%ray_u(i,j,k) .EQ. missing) visc%ray_u(i,j,k) = 0 - if(uhtr(i,j,k) .EQ. missing) uhtr(i,j,k) = 0 - if(uh(i,j,k) .EQ. missing) uh(i,j,k) = 0 - if(u(i,j,k) .EQ. missing) u(i,j,k) = 0 - enddo ; enddo - - ! Fields on V-Grid - do j=G%jsdb, G%jedb ; do i=G%isd, G%ied - if(visc%bbl_thick_v(i,j) .EQ. missing) visc%bbl_thick_v(i,j) = 0 - if(visc%kv_bbl_v(i,j) .EQ. missing) visc%kv_bbl_v(i,j) = 0 - if(visc%ray_v(i,j,k) .EQ. missing) visc%ray_v(i,j,k) = 0 - if(vhtr(i,j,k) .EQ. missing) vhtr(i,j,k) = 0 - if(vh(i,j,k) .EQ. missing) vh(i,j,k) = 0 - if(v(i,j,k) .EQ. missing) v(i,j,k) = 0 - enddo ; enddo - - ! - ! - enddo - ! - ! ! Make sure all halos have been updated - call pass_vector(uhtr, vhtr, G%Domain) - call pass_vector(uh, vh, G%Domain) - call pass_vector(u, v, G%Domain) - call pass_vector(visc%ray_u, visc%ray_v, G%Domain) - call pass_var(h,G%Domain) - call pass_var(eta_av, G%Domain) - call pass_var(temp, G%Domain) - call pass_var(salt, G%Domain) + integer :: read_index ! The index in the input files that corresponds + ! to the current timestep - ! Update the read indices - CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) - CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) + integer :: next_modulo_time - call callTree_leave("transport_by_file") + read_index = mod(inidx+1,numtime) + if (read_index < 0) read_index = inidx-read_index + if (read_index == 0) read_index = numtime - end subroutine transport_by_files - subroutine transport_by_data_override(G, day, u, v, uhtr, vhtr, h) - type(time_type) , intent(in) :: day !< Current model time - type(ocean_grid_type) , intent(inout) :: G - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness after advection (m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - - ! This subroutine sets the surface wind stresses - - ! Arguments: - ! state = structure describing ocean surface state - ! (out) fluxes = structure with pointers to forcing fields; unused have NULL ptrs - ! (in) day = time of the fluxes - ! (in) G = ocean grid structure - ! (in) CS = pointer to control struct returned by previous surface_forcing_init call - - integer :: i, j, is_in, ie_in, js_in, je_in - - call callTree_enter("ocean_transport_by_data_override, MOM_offline_control.F90") - - is_in = G%isc - G%isd + 1 - ie_in = G%iec - G%isd + 1 - js_in = G%jsc - G%jsd + 1 - je_in = G%jec - G%jsd + 1 - - call data_override('OCN', 'uhtr', uhtr, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - call data_override('OCN', 'vhtr', vhtr, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - call data_override('OCN', 'u', u, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - call data_override('OCN', 'v', v, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - call data_override('OCN', 'h', h, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - - ! call data_override('OCN', 'uhtr', uhtr, day) - ! call data_override('OCN', 'vhtr', vhtr, day) - ! call data_override('OCN', 'u', u, day) - ! call data_override('OCN', 'v', v, day) - ! call data_override('OCN', 'h', h, day) + next_modulo_time = read_index - call pass_vector(uhtr, vhtr, G%Domain) - call pass_vector(u, v, G%Domain) - call pass_var(h, G%Domain) - call callTree_leave("transport_by_data_override") + end function next_modulo_time - end subroutine transport_by_data_override end module MOM_offline_transport diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 26ed11fe75..9a8aaa86dd 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -18,7 +18,6 @@ module MOM_tracer_advect use MOM_variables, only : ocean_OBC_type, OBC_FLATHER_E use MOM_variables, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type - implicit none ; private #include @@ -54,7 +53,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg) type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment (seconds) type(tracer_advect_CS), pointer :: CS !< control structure for module - type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 3a71eff968..f446e3136b 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -42,7 +42,6 @@ module MOM_tracer_flow_control use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : surface, ocean_OBC_type, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type - #include ! Add references to other user-provide tracer modules here. @@ -356,6 +355,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, dt, G, GV, tv, o if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// & "Module must be initialized via call_tracer_register before it is used.") + ! Add calls to tracer column functions here. if (CS%use_USER_tracer_example) & call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 4a7c6e6799..49b0d0c86e 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -9,7 +9,7 @@ module MOM_tracer_hor_diff use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_domains, only : sum_across_PEs, max_across_PEs use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_checksums, only : hchksum +use MOM_checksums, only : hchksum, uchksum, vchksum use MOM_EOS, only : calculate_density use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery @@ -62,6 +62,8 @@ module MOM_tracer_hor_diff integer :: id_KhTr_v = -1 integer :: id_KhTr_h = -1 integer :: id_CFL = -1 + integer :: id_khdt_x = -1 + integer :: id_khdt_y = -1 type(group_pass_type) :: pass_t !For group halo pass, used in both !tracer_hordiff and tracer_epipycnal_ML_diff @@ -82,7 +84,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (m or kg m-2) real, intent(in) :: dt !< time step (seconds) @@ -97,6 +99,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) !! NULL ptrs, and these may (probably will) point to !! some of the same arrays as Tr does. tv is required !! for epipycnal mixing between mixed layer and the interior. + ! Optional inputs for offline tracer transport + logical, optional :: do_online_flag + real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: read_khdt_x + real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: read_khdt_y + + logical :: do_online = .true. + real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a ! grid cell, in m-3 or kg-1. @@ -104,18 +113,21 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) CFL, & ! A diffusive CFL number for each cell, nondim. dTr ! The change in a tracer's concentration, in units of ! concentration. + real, dimension(SZIB_(G),SZJ_(G)) :: & khdt_x, & ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points, in m2. Coef_x, & ! The coefficients relating zonal tracer differences ! to time-integrated fluxes, in m3 or kg. - Kh_u ! Tracer mixing coefficient at u-points, in m2 s-1. + Kh_u, & ! Tracer mixing coefficient at u-points, in m2 s-1. + write_all_2du ! Make sure that all the data gets written real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points, in m2. Coef_y, & ! The coefficients relating meridional tracer differences ! to time-integrated fluxes, in m3 or kg. - Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. + Kh_v, & ! Tracer mixing coefficient at u-points, in m2 s-1. + write_all_2dv ! Make sure that all the data gets written real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled @@ -132,6 +144,9 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) real :: normalize ! normalization used for diagnostic Kh_h; diffusivity averaged to h-points. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + if (present(do_online_flag)) do_online = do_online_flag + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & @@ -171,95 +186,103 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) call cpu_clock_end(id_clock_pass) if (CS%show_call_tree) call callTree_waypoint("Calculating diffusivity (tracer_hordiff)") - if (use_VarMix) then -!$OMP parallel default(none) shared(is,ie,js,je,CS,VarMix,MEKE,Resoln_scaled, & -!$OMP Kh_u,Kh_v,khdt_x,dt,G,khdt_y) & -!$OMP private(Kh_loc,Rd_dx) -!$OMP do - do j=js,je ; do I=is-1,ie - Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) - if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) - if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) - if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) - Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) - if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points - Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) - if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max - Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min - endif - enddo ; enddo -!$OMP do - do J=js-1,je ; do i=is,ie - Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) - if (associated(MEKE%Kh)) & - Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) - if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) - if (Resoln_scaled) & - Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) - Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) - if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity - Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points - Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) - if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max - Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min - endif - enddo ; enddo -!$OMP do - do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) - enddo ; enddo -!$OMP do - do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) - enddo ; enddo -!$OMP end parallel - elseif (Resoln_scaled) then -!$OMP parallel default(none) shared(is,ie,js,je,VarMix,Kh_u,Kh_v,khdt_x,khdt_y,CS,dt,G) & -!$OMP private(Res_fn) -!$OMP do - do j=js,je ; do I=is-1,ie - Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) - Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn - enddo ; enddo -!$OMP do - do J=js-1,je ; do i=is,ie - Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) - Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn - enddo ; enddo -!$OMP end parallel - else -!$OMP parallel default(none) shared(is,ie,js,je,Kh_u,Kh_v,khdt_x,khdt_y,CS,G,dt) - if (CS%id_KhTr_u > 0) then -!$OMP do - do j=js,je ; do I=is-1,ie - Kh_u(I,j) = CS%KhTr - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) - enddo ; enddo - else -!$OMP do - do j=js,je ; do I=is-1,ie - khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) - enddo ; enddo - endif - if (CS%id_KhTr_v > 0) then -!$OMP do - do J=js-1,je ; do i=is,ie - Kh_v(i,J) = CS%KhTr - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) - enddo ; enddo - else -!$OMP do - do J=js-1,je ; do i=is,ie - khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) - enddo ; enddo - endif -!$OMP end parallel - endif + + if (do_online) then + if (use_VarMix) then + !$OMP parallel default(none) shared(is,ie,js,je,CS,VarMix,MEKE,Resoln_scaled, & + !$OMP Kh_u,Kh_v,khdt_x,dt,G,khdt_y) & + !$OMP private(Kh_loc,Rd_dx) + !$OMP do + do j=js,je ; do I=is-1,ie + Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + if (associated(MEKE%Kh)) & + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) + if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) + if (Resoln_scaled) & + Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) + if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity + Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i+1,j) ) ! Rd/dx at u-points + Kh_loc=Kh_u(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max + Kh_u(I,j) = max(Kh_loc, CS%KhTr_min) ! Re-apply min + endif + enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie + Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + if (associated(MEKE%Kh)) & + Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) + if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) + if (Resoln_scaled) & + Kh_Loc = Kh_Loc * 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) + if (CS%KhTr_passivity_coeff>0.) then ! Apply passivity + Rd_dx=0.5*( VarMix%Rd_dx_h(i,j)+VarMix%Rd_dx_h(i,j+1) ) ! Rd/dx at v-points + Kh_loc=Kh_v(I,j)*max( CS%KhTr_passivity_min, CS%KhTr_passivity_coeff*Rd_dx ) + if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) ! Re-apply max + Kh_v(i,J) = max(Kh_loc, CS%KhTr_min) ! Re-apply min + endif + enddo ; enddo + + !$OMP do + do j=js,je ; do I=is-1,ie + khdt_x(I,j) = dt*(Kh_u(I,j)*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie + khdt_y(i,J) = dt*(Kh_v(i,J)*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + enddo ; enddo + !$OMP end parallel + elseif (Resoln_scaled) then + !$OMP parallel default(none) shared(is,ie,js,je,VarMix,Kh_u,Kh_v,khdt_x,khdt_y,CS,dt,G) & + !$OMP private(Res_fn) + !$OMP do + do j=js,je ; do I=is-1,ie + Res_fn = 0.5 * (VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i+1,j)) + Kh_u(I,j) = max(CS%KhTr * Res_fn, CS%KhTr_min) + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) * Res_fn + enddo ; enddo + !$OMP do + do J=js-1,je ; do i=is,ie + Res_fn = 0.5*(VarMix%Res_fn_h(i,j) + VarMix%Res_fn_h(i,j+1)) + Kh_v(i,J) = max(CS%KhTr * Res_fn, CS%KhTr_min) + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) * Res_fn + enddo ; enddo + !$OMP end parallel + else + !$OMP parallel default(none) shared(is,ie,js,je,Kh_u,Kh_v,khdt_x,khdt_y,CS,G,dt) + if (CS%id_KhTr_u > 0) then + !$OMP do + do j=js,je ; do I=is-1,ie + Kh_u(I,j) = CS%KhTr + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + enddo ; enddo + else + !$OMP do + do j=js,je ; do I=is-1,ie + khdt_x(I,j) = dt*(CS%KhTr*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + enddo ; enddo + endif + if (CS%id_KhTr_v > 0) then + !$OMP do + do J=js-1,je ; do i=is,ie + Kh_v(i,J) = CS%KhTr + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + enddo ; enddo + else + !$OMP do + do J=js-1,je ; do i=is,ie + khdt_y(i,J) = dt*(CS%KhTr*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + enddo ; enddo + endif + !$OMP end parallel + endif ! VarMix + else ! .not. do_online + khdt_x = read_khdt_x + khdt_y = read_khdt_y + endif ! do_online + if (CS%check_diffusive_CFL) then if (CS%show_call_tree) call callTree_waypoint("Checking diffusive CFL (tracer_hordiff)") @@ -449,6 +472,17 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv) endif + if( CS%debug ) then + call uchksum(khdt_x,"After tracer diffusion khdt_x", G, haloshift=2) + call vchksum(khdt_y,"After tracer diffusion khdt_y", G, haloshift=2) + call uchksum(Coef_x,"After tracer diffusion Coef_x", G, haloshift=2) + call vchksum(Coef_y,"After tracer diffusion Coef_y", G, haloshift=2) + endif + + write_all_2du = 1. ; write_all_2dv = 1. + if (CS%id_khdt_x > 0) call post_data(CS%id_khdt_x, khdt_x, CS%diag, mask=write_all_2du) + if (CS%id_khdt_y > 0) call post_data(CS%id_khdt_y, khdt_y, CS%diag, mask=write_all_2dv) + if (CS%show_call_tree) call callTree_leave("tracer_hordiff()") end subroutine tracer_hordiff @@ -1397,7 +1431,12 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, CS, CSnd) cmor_standard_name= 'ocean_tracer_epineutral_laplacian_diffusivity', & cmor_long_name = 'Ocean Tracer Epineutral Laplacian Diffusivity') CS%id_CFL = register_diag_field('ocean_model', 'CFL_lateral_diff', diag%axesT1, Time,& - 'Grid CFL number for lateral/neutral tracer diffusion', 'dimensionless') + 'Grid CFL number for lateral/neutral tracer diffusion', 'dimensionless') + + CS%id_khdt_x = register_diag_field('ocean_model', 'KHDT_x', diag%axesCu1, Time, & + 'Epipycnal tracer diffusivity operator at zonal faces of tracer cell', 'meter2') + CS%id_khdt_y = register_diag_field('ocean_model', 'KHDT_y', diag%axesCv1, Time, & + 'Epipycnal tracer diffusivity operator at meridional faces of tracer cell', 'meter2') end subroutine tracer_hor_diff_init From d335eacb09820bb47a084ff2b88a66e43773793b Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 8 Jul 2016 12:26:25 -0400 Subject: [PATCH 04/65] Renamed offline file name variables read from MOM_input to avoid conflicts with existing parameters --- src/tracer/MOM_offline_control.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index dcb3ec70a6..bccc071df2 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -355,11 +355,11 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) "Input directory where the offline fields can be found", fail_if_missing=.true.) call get_param(param_file, mod, "TRANSPORT_FILE", CS%transport_file, & "Filename where uhtr, vhtr, ea, eb fields can be found") - call get_param(param_file, mod, "H_FILE", CS%h_file, & + call get_param(param_file, mod, "OFF_H_FILE", CS%h_file, & "Filename where the h fields can be found") - call get_param(param_file, mod, "TS_FILE", CS%ts_file, & + call get_param(param_file, mod, "OFF_TS_FILE", CS%ts_file, & "Filename where the temperature and salinity fields can be found") - call get_param(param_file, mod, "PREALE_FILE", CS%preale_file, & + call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & "Filename where the preale T, S, u, v, and h fields are found") call get_param(param_file, mod, "START_INDEX", CS%start_index, & "Which time index to start from", fail_if_missing=.true.) From 3776e9c0dcf18960d334615d32064ee12fc4b398 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 8 Jul 2016 13:39:15 -0400 Subject: [PATCH 05/65] Commiting modified solo driver which allows step_MOM to be bypassed --- config_src/solo_driver/MOM_driver.F90 | 34 +++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 4db2d95330..53f015d5a2 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -47,6 +47,7 @@ program MOM_main use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : calculate_surface_state, finish_MOM_initialization + use MOM, only : step_tracers use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -169,6 +170,14 @@ program MOM_main logical :: unit_in_use integer :: initClock, mainClock, termClock + logical :: do_online ! If true, use the model in prognostic mode where + ! the barotropic and baroclinic dynamics, thermodynamics, + ! etc. are stepped forward integrated in time. + ! If false, the all of the above are bypassed with all + ! fields necessary to integrate only the tracer advection + ! and diffusion equation are read in from files stored from + ! a previous integration of the prognostic model + type(MOM_control_struct), pointer :: MOM_CSp => NULL() type(surface_forcing_CS), pointer :: surface_forcing_CSp => NULL() type(sum_output_CS), pointer :: sum_output_CSp => NULL() @@ -350,6 +359,15 @@ program MOM_main "The interval in units of TIMEUNIT between saves of the \n"//& "energies of the run and other globally summed diagnostics.", & default=set_time(int(time_step+0.5)), timeunit=Time_unit) + call get_param(param_file, mod, "DO_ONLINE", do_online, & + "If true, use the model in prognostic mode where\n"//& + "the barotropic and baroclinic dynamics, thermodynamics,\n"//& + "etc. are stepped forward integrated in time.\n"//& + "If false, the all of the above are bypassed with all\n"//& + "fields necessary to integrate only the tracer advection\n"//& + "and diffusion equation are read in from files stored from\n"//& + "a previous integration of the prognostic model", default=.true.) + call log_param(param_file, mod, "ELAPSED TIME AS MASTER", elapsed_time_master) ! Close the param_file. No further parsing of input is possible after this. @@ -399,8 +417,10 @@ program MOM_main call callTree_enter("Main loop, MOM_driver.F90",n) ! Set the forcing for the next steps. - call set_forcing(state, fluxes, Time, Time_step_ocean, grid, & + if (do_online) then + call set_forcing(state, fluxes, Time, Time_step_ocean, grid, & surface_forcing_CSp) + endif if (MOM_CSp%debug) then call MOM_forcing_chksum("After set forcing", fluxes, grid, haloshift=0) endif @@ -423,7 +443,8 @@ program MOM_main ! This call steps the model over a time time_step. Time1 = Master_Time ; Time = Master_Time - call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) + if (do_online) call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) + ! Time = Time + Time_step_ocean ! This is here to enable fractional-second time steps. @@ -450,6 +471,7 @@ program MOM_main surface_forcing_CSp%handles) call disable_averaging(MOM_CSp%diag) + if (do_online) then if (fluxes%fluxes_used) then call enable_averaging(fluxes%dt_buoy_accum, Time, MOM_CSp%diag) call forcing_diagnostics(fluxes, state, fluxes%dt_buoy_accum, grid, & @@ -458,8 +480,10 @@ program MOM_main call disable_averaging(MOM_CSp%diag) else call MOM_error(FATAL, "The solo MOM_driver is not yet set up to handle "//& - "thermodynamic time steps that are longer than the couping timestep.") - endif + "thermodynamic time steps that are longer than the coupling timestep.") + endif ; endif + + if (.not. do_online) call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) ! See if it is time to write out the energy. if ((Time + (Time_step_ocean/2) > write_energy_time) .and. & @@ -502,7 +526,7 @@ program MOM_main if (Restart_control>=0) then if (MOM_CSp%dt_trans > 0.0) call MOM_error(WARNING, "End of MOM_main reached "//& "with a non-zero dt_trans. Additional restart fields are required.") - if (.not.fluxes%fluxes_used) call MOM_error(FATAL, "End of MOM_main reached "//& + if (.not.fluxes%fluxes_used .and. do_online) call MOM_error(FATAL, "End of MOM_main reached "//& "with unused buoyancy fluxes. For conservation, the ocean restart "//& "files can only be created after the buoyancy forcing is applied.") From eedef37fd9977e2e213ad3961e28ce1f60cf6e29 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 8 Jul 2016 15:02:43 -0400 Subject: [PATCH 06/65] Misplaced endif was accidentally setting T and S to 0 when .not. diabatic_first --- src/core/MOM.F90 | 33 +++++++++++++++--------------- src/tracer/MOM_offline_control.F90 | 2 +- 2 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index d108d02b13..a454795a84 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1582,26 +1582,27 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_therm) call cpu_clock_end(id_clock_ALE) - endif ! endif for the block "if ( CS%use_ALE_algorithm )" + - if (CS%debug .and. CS%use_ALE_algorithm) then - call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) - endif + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif - CS%tv%T = temp_old - CS%tv%S = salt_old + CS%tv%T = temp_old + CS%tv%S = salt_old - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) - endif + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) + endif ! endif for the block "if ( CS%use_ALE_algorithm )" + endif ! diabatic second call disable_averaging(CS%diag) call cpu_clock_end(id_clock_tracer) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index bccc071df2..739a2b0ebc 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -353,7 +353,7 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing=.true.) - call get_param(param_file, mod, "TRANSPORT_FILE", CS%transport_file, & + call get_param(param_file, mod, "OFF_TRANSPORT_FILE", CS%transport_file, & "Filename where uhtr, vhtr, ea, eb fields can be found") call get_param(param_file, mod, "OFF_H_FILE", CS%h_file, & "Filename where the h fields can be found") From 168141ebba16622fdc6b8f2ef812086c29f2e5a9 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 12 Jul 2016 14:12:06 -0400 Subject: [PATCH 07/65] Commiting local changes --- src/core/MOM.F90 | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index d108d02b13..4901c92985 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1443,15 +1443,14 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) khdt_y = 0.0 eatr = 0.0 ebtr = 0.0 - h_old = 0.0 - h_new = 0.0 - h_adv = 0.0 - h_end = 0.0 + h_old = GV%Angstrom + h_new = GV%Angstrom + h_adv = GV%Angstrom + h_end = GV%Angstrom temp_old = 0.0 salt_old = 0.0 - if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then if (CS%use_temperature) then call create_group_pass(CS%pass_T_S_h, CS%tv%T, G%Domain) @@ -1464,10 +1463,12 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & CS%diag) call transport_by_files(G, CS%offline_CSp, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & - khdt_x, khdt_y, CS%tv%T, CS%tv%S, CS%dt_therm, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) + khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) CS%uhtr = uhtr CS%vhtr = vhtr + CS%T = temp_old + CS%S = salt_old !------------DIABATIC FIRST @@ -1484,8 +1485,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. if ( CS%use_ALE_algorithm ) then - temp_old = CS%tv%T - salt_old = CS%tv%S CS%tv%T = CS%offline_CSp%T_preale CS%tv%S = CS%offline_CSp%S_preale @@ -2574,7 +2573,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) 'Layer Thickness before diabatic forcing', thickness_units, v_cell_method='sum') CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & 'Interface Heights before diabatic forcing', 'meter') - if (CS%diabatic_first .and. (.not. CS%adiabatic)) then +! if (CS%diabatic_first .and. (.not. CS%adiabatic)) then CS%id_u_preale = register_diag_field('ocean_model', 'u_preale', diag%axesCuL, Time, & 'Zonal velocity before remapping', 'meter second-1') CS%id_v_preale = register_diag_field('ocean_model', 'v_preale', diag%axesCvL, Time, & @@ -2587,7 +2586,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) 'Salinity before remapping', 'ppt') CS%id_e_preale = register_diag_field('ocean_model', 'e_preale', diag%axesTi, Time, & 'Interface Heights before remapping', 'meter') - endif +! endif if (CS%use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & From 8adb7009383551f7ee3cb509666bda46fb029f3a Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 12 Jul 2016 14:12:45 -0400 Subject: [PATCH 08/65] More local changes --- src/tracer/MOM_offline_control.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index bccc071df2..ebd6db2dd0 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -163,12 +163,11 @@ subroutine post_advection_fields( G, CS, diag, dt, h_adv, uhtr, vhtr, temp, salt end subroutine post_advection_fields subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, dt, fluxes, optics, do_ale_in) + temp, salt, fluxes, optics, do_ale_in) type(ocean_grid_type), intent(inout) :: G type(offline_transport_CS), intent(inout) :: CS type(forcing), intent(inout) :: fluxes type(optics_type), intent(inout) :: optics - real, intent(in) :: dt logical, optional :: do_ale_in !! Mandatory variables @@ -231,6 +230,11 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht timelevel=CS%ridx_snap,position=CENTER) if (do_ale) then + CS%h_preale = 1.0e-10 + CS%T_preale = 0.0 + CS%S_preale = 0.0 + CS%u_preale = 0.0 + CS%v_preale = 0.0 call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & @@ -271,7 +275,7 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht if (do_ale) then - call pass_vector(CS%u_preale,CS%v_preale,G%Domain) +! call pass_vector(CS%u_preale,CS%v_preale,G%Domain) call pass_var(CS%h_preale, G%Domain) call pass_var(CS%T_preale, G%Domain) call pass_var(CS%S_preale, G%Domain) @@ -353,7 +357,7 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing=.true.) - call get_param(param_file, mod, "TRANSPORT_FILE", CS%transport_file, & + call get_param(param_file, mod, "OFF_TRANSPORT_FILE", CS%transport_file, & "Filename where uhtr, vhtr, ea, eb fields can be found") call get_param(param_file, mod, "OFF_H_FILE", CS%h_file, & "Filename where the h fields can be found") From 0e7fefbc48e5250934868880ebb8efe9a11d9e56 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 13 Jul 2016 14:30:59 -0400 Subject: [PATCH 09/65] Initialize some fields to make sure that checksums reproduce --- .DoxygenLayout.xml | 378 +++++++++--------- src/core/MOM.F90 | 34 +- .../vertical/MOM_diabatic_driver.F90 | 6 +- src/tracer/MOM_offline_control.F90 | 116 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 3 + 5 files changed, 269 insertions(+), 268 deletions(-) diff --git a/.DoxygenLayout.xml b/.DoxygenLayout.xml index cddccea7db..ebe1bea767 100644 --- a/.DoxygenLayout.xml +++ b/.DoxygenLayout.xml @@ -1,194 +1,198 @@ - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 901c4dd2ea..1b2734c10a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -995,7 +995,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_tracer) ! Post fields used for offline tracer model - call post_advection_fields( G, CS%offline_CSp, CS%diag, CS%dt_trans, h, & + call post_advection_fields( G, CS%offline_CSp, CS%diag, h, & CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_trans, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) @@ -1401,7 +1401,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM ! Local pointers - type(ocean_grid_type), pointer :: G ! Pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid @@ -1437,18 +1437,18 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! U-cell pointer assignments ! V-cell pointer assignments - uhtr = 0.0 - khdt_x = 0.0 - vhtr = 0.0 - khdt_y = 0.0 - eatr = 0.0 - ebtr = 0.0 - h_old = GV%Angstrom - h_new = GV%Angstrom - h_adv = GV%Angstrom - h_end = GV%Angstrom - temp_old = 0.0 - salt_old = 0.0 + uhtr(:,:,:) = 0.0 + vhtr(:,:,:) = 0.0 + khdt_x(:,:) = 0.0 + khdt_y(:,:) = 0.0 + eatr(:,:,:) = 0.0 + ebtr(:,:,:) = 0.0 + h_old(:,:,:) = GV%Angstrom + h_new(:,:,:) = GV%Angstrom + h_adv(:,:,:) = GV%Angstrom + h_end(:,:,:) = GV%Angstrom + temp_old(:,:,:) = 0.0 + salt_old(:,:,:) = 0.0 if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then @@ -1488,7 +1488,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tv%T = CS%offline_CSp%T_preale CS%tv%S = CS%offline_CSp%S_preale - call do_group_pass(CS%pass_T_S_h, G%Domain) +! call do_group_pass(CS%pass_T_S_h, G%Domain) ! update squared quantities if (associated(CS%S_squared)) & @@ -1524,11 +1524,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif ! endif for the block "if ( CS%use_ALE_algorithm )" - - endif !-----------ADVECTION AND DIFFUSION - call post_advection_fields( G, CS%offline_CSp, CS%diag, CS%dt_therm, h_adv, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) + call post_advection_fields( G, CS%offline_CSp, CS%diag, h_adv, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) if (CS%debug) then call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d813f36d9d..77765b4ebc 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1106,7 +1106,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ enddo ! Post the fields used for tracers here - call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, eatr, ebtr ) + call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, eatr, ebtr ) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) @@ -1131,13 +1131,13 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, eatr, ebtr) + call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, eatr, ebtr) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) else - call post_diabatic_fields( G, offline_CSp, CS%diag, dt, hold, h, ea, eb) + call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb) call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index ebd6db2dd0..1e4669ae87 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -73,9 +73,9 @@ module MOM_offline_transport character(len=200) :: offlinedir ! Directory where offline fields are stored character(len=200) :: & ! Names - transport_file, & - h_file, & - ts_file, & + mean_file, & + snap_file, & + sum_file, & preale_file logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are @@ -94,13 +94,13 @@ module MOM_offline_transport integer :: & id_h_new = -1, & id_h_old = -1, & - id_h_adv = -1, & - id_uhtr = -1, & - id_vhtr = -1, & - id_eatr = -1, & - id_ebtr = -1, & - id_temp = -1, & - id_salt = -1 + id_h_preadv = -1, & + id_uhtr_preadv = -1, & + id_vhtr_preadv = -1, & + id_eatr_dia = -1, & + id_ebtr_dia = -1, & + id_temp_preadv = -1, & + id_salt_preadv = -1 end type offline_transport_CS @@ -113,34 +113,31 @@ module MOM_offline_transport ! Called from call_tracer_column_fns to make sure that all the terms in the ! diabatic driver routine are the same online and offline - subroutine post_diabatic_fields( G, CS, diag, dt, h_old, h_new, eatr, ebtr ) + subroutine post_diabatic_fields( G, CS, diag, h_old, h_new, eatr, ebtr ) type(ocean_grid_type), intent(in) :: G type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), target, intent(inout) :: diag - real, intent(in) :: dt + type(diag_ctrl), intent(inout) :: diag real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, & eatr, ebtr - real :: Idt real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt write_all_3dt = 1. if (CS%id_h_old>0) call post_data(CS%id_h_old, h_old, diag, mask = write_all_3dt ) if (CS%id_h_new>0) call post_data(CS%id_h_new, h_new, diag, mask = write_all_3dt ) - if (CS%id_eatr>0) call post_data(CS%id_eatr, eatr, diag, mask = write_all_3dt) - if (CS%id_ebtr>0) call post_data(CS%id_ebtr, ebtr, diag, mask = write_all_3dt) + if (CS%id_eatr_dia>0) call post_data(CS%id_eatr_dia, eatr, diag, mask = write_all_3dt) + if (CS%id_ebtr_dia>0) call post_data(CS%id_ebtr_dia, ebtr, diag, mask = write_all_3dt) end subroutine post_diabatic_fields ! Called right before tracer_advect call in MOM.F90 to ensure that all terms ! in the tracer advection routine are the same online and offline - subroutine post_advection_fields( G, CS, diag, dt, h_adv, uhtr, vhtr, temp, salt ) + subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) type(ocean_grid_type), intent(in) :: G type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), target, intent(inout) :: diag - real, intent(in) :: dt + type(diag_ctrl), intent(inout) :: diag real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_adv, temp, salt real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) @@ -154,11 +151,11 @@ subroutine post_advection_fields( G, CS, diag, dt, h_adv, uhtr, vhtr, temp, salt write_all_3du = 1. write_all_3dv = 1. - if (CS%id_h_adv>0) call post_data(CS%id_h_adv, h_adv, diag, mask = write_all_3dt ) - if (CS%id_uhtr>0) call post_data(CS%id_uhtr, uhtr, diag, mask = write_all_3du ) - if (CS%id_vhtr>0) call post_data(CS%id_vhtr, vhtr, diag, mask = write_all_3dv ) - if (CS%id_temp>0) call post_data(CS%id_temp, temp, diag, mask = write_all_3dt ) - if (CS%id_salt>0) call post_data(CS%id_salt, salt, diag, mask = write_all_3dt ) + if (CS%id_h_preadv>0) call post_data(CS%id_h_preadv, h_adv, diag, mask = write_all_3dt ) + if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) + if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) + if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) + if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) end subroutine post_advection_fields @@ -195,38 +192,37 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht call callTree_enter("transport_by_files, MOM_offline_control.F90") - !! Time-averaged fields - ! U-cell fields - call read_data(CS%transport_file, 'uhtr_sum', uhtr,domain=G%Domain%mpp_domain, & + !! Time-summed fields + ! U-grid + call read_data(CS%sum_file, 'uhtr_preadv_sum', uhtr,domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%transport_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=EAST) - - ! V-cell fields - call read_data(CS%transport_file, 'vhtr_sum', vhtr, domain=G%Domain%mpp_domain, & + ! V-grid + call read_data(CS%sum_file, 'vhtr_preadv_sum', vhtr, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%transport_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) - - ! T-cell fields - call read_data(CS%transport_file, 'eatr_sum', eatr, domain=G%Domain%mpp_domain, & + ! T-grid + call read_data(CS%sum_file, 'eatr_dia_sum', eatr, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%transport_file, 'ebtr_sum', ebtr, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file, 'ebtr_dia_sum', ebtr, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%ts_file, 'temp', temp, domain=G%Domain%mpp_domain, & + + !! Time-averaged fields + call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%ts_file, 'salt', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) - ! T-cell fields - call read_data(CS%h_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%h_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%h_file, 'h_adv', h_adv, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%h_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) if (do_ale) then @@ -275,7 +271,7 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht if (do_ale) then -! call pass_vector(CS%u_preale,CS%v_preale,G%Domain) + call pass_vector(CS%u_preale,CS%v_preale,G%Domain) call pass_var(CS%h_preale, G%Domain) call pass_var(CS%T_preale, G%Domain) call pass_var(CS%S_preale, G%Domain) @@ -301,27 +297,27 @@ subroutine register_diags_offline_transport(Time, diag, CS) ! U-cell fields - CS%id_uhtr = register_diag_field('ocean_model', 'uh_off', diag%axesCuL, Time, & + CS%id_uhtr_preadv = register_diag_field('ocean_model', 'uhtr_preadv', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg') ! V-cell fields - CS%id_vhtr = register_diag_field('ocean_model', 'vh_off', diag%axesCvL, Time, & + CS%id_vhtr_preadv = register_diag_field('ocean_model', 'vhtr_preadv', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') ! T-cell fields - CS%id_h_adv = register_diag_field('ocean_model', 'h_adv', diag%axesTL, Time, & + CS%id_h_preadv = register_diag_field('ocean_model', 'h_preadv', diag%axesTL, Time, & 'Layer Thickness prior to advection', 'm') CS%id_h_old = register_diag_field('ocean_model', 'h_old', diag%axesTL, Time, & 'Layer Thickness before diabatic', 'm') CS%id_h_new = register_diag_field('ocean_model', 'h_new', diag%axesTL, Time, & 'Layer Thickness after diabatic', 'm') - CS%id_eatr = register_diag_field('ocean_model', 'eatr_off', diag%axesTL, Time, & + CS%id_eatr_dia = register_diag_field('ocean_model', 'eatr_dia', diag%axesTL, Time, & 'Entrainment from layer above', 'kg') - CS%id_ebtr = register_diag_field('ocean_model', 'ebtr_off', diag%axesTL, Time, & + CS%id_ebtr_dia = register_diag_field('ocean_model', 'ebtr_dia', diag%axesTL, Time, & 'Entrainment from layer below', 'kg') - CS%id_temp = register_diag_field('ocean_model', 'temp_off', diag%axesTL, Time, & + CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & 'Temperature prior to advection', 'C') - CS%id_salt = register_diag_field('ocean_model', 'salt_off', diag%axesTL, Time, & + CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & 'Salinity prior to advection', 'S') @@ -357,12 +353,12 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", fail_if_missing=.true.) - call get_param(param_file, mod, "OFF_TRANSPORT_FILE", CS%transport_file, & - "Filename where uhtr, vhtr, ea, eb fields can be found") - call get_param(param_file, mod, "OFF_H_FILE", CS%h_file, & - "Filename where the h fields can be found") - call get_param(param_file, mod, "OFF_TS_FILE", CS%ts_file, & - "Filename where the temperature and salinity fields can be found") + call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & + "Filename where time-averaged fields are fund can be found") + call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & + "Filename where the accumulated fields can be found") + call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & + "Filename where snapshot fields can be found") call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & "Filename where the preale T, S, u, v, and h fields are found") call get_param(param_file, mod, "START_INDEX", CS%start_index, & @@ -374,9 +370,9 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) default=.false.) ! Concatenate offline directory and file names - CS%transport_file = trim(CS%offlinedir)//trim(CS%transport_file) - CS%h_file = trim(CS%offlinedir)//trim(CS%h_file) - CS%ts_file = trim(CS%offlinedir)//trim(CS%ts_file) + CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) + CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) + CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) CS%preale_file = trim(CS%offlinedir)//trim(CS%preale_file) ! Set the starting read index for time-averaged and snapshotted fields diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 49b0d0c86e..682766d2a5 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -147,6 +147,9 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (present(do_online_flag)) do_online = do_online_flag + khdt_x = 0.0 ; khdt_y = 0.0 + Coef_x = 0.0 ; Coef_y = 0.0 + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & From 107756bbf49731edaf55f772415a5fcfb654f2d0 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 14 Jul 2016 11:38:26 -0400 Subject: [PATCH 10/65] SIS2 global test case now reproduces exactly offline --- src/core/MOM.F90 | 6 +++--- src/tracer/MOM_tracer_hor_diff.F90 | 2 ++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1b2734c10a..01c581f55f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1530,13 +1530,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (CS%debug) then call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) - call uchksum(CS%uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) - call vchksum(CS%vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) + call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) + call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) endif - call advect_tracer(h_adv, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_therm, G, GV, & + call advect_tracer(h_adv, uhtr, vhtr, CS%OBC, CS%dt_therm, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h_adv, CS%dt_therm, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 682766d2a5..9b740d5635 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -9,6 +9,7 @@ module MOM_tracer_hor_diff use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_domains, only : sum_across_PEs, max_across_PEs use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : pass_vector use MOM_checksums, only : hchksum, uchksum, vchksum use MOM_EOS, only : calculate_density use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe @@ -286,6 +287,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla khdt_y = read_khdt_y endif ! do_online + call pass_vector(khdt_x,khdt_y,G%Domain) if (CS%check_diffusive_CFL) then if (CS%show_call_tree) call callTree_waypoint("Checking diffusive CFL (tracer_hordiff)") From fee50bca6257eecb3d65410cb0c095968b1632df Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 15 Jul 2016 13:30:53 -0400 Subject: [PATCH 11/65] MOM6 offline now does staggered offline advection and diffusion by splitting up the vertical and horizontal transports. Also added more options for offline control. --- config_src/solo_driver/MOM_driver.F90 | 24 ++++++---- src/core/MOM.F90 | 68 ++++++++++++++++++--------- src/tracer/MOM_offline_control.F90 | 27 +++++++---- src/tracer/MOM_tracer_hor_diff.F90 | 6 +-- 4 files changed, 83 insertions(+), 42 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 53f015d5a2..35d68b45ba 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -135,6 +135,7 @@ program MOM_main ! representation of time_step. real :: time_step ! The time step of a call to step_MOM in seconds. real :: dt ! The baroclinic dynamics time step, in seconds. + real :: dt_off ! Offline time step in seconds integer :: ntstep ! The number of baroclinic dynamics time steps ! within time_step. @@ -307,8 +308,21 @@ program MOM_main call get_param(param_file, mod, "DT_FORCING", time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& - "The default value is given by DT.", units="s", default=dt) + "The default value is given by DT.", units="s", default=dt) + call get_param(param_file, mod, "DO_ONLINE", do_online, & + "If true, use the model in prognostic mode where\n"//& + "the barotropic and baroclinic dynamics, thermodynamics,\n"//& + "etc. are stepped forward integrated in time.\n"//& + "If false, the all of the above are bypassed with all\n"//& + "fields necessary to integrate only the tracer advection\n"//& + "and diffusion equation are read in from files stored from\n"//& + "a previous integration of the prognostic model", default=.true.) + if (.not. do_online) then + call get_param(param_file, mod, "DT_OFFLINE", time_step, & + "Time step for the offline time step") + dt = time_step + endif ntstep = MAX(1,ceiling(time_step/dt - 0.001)) Time_step_ocean = set_time(int(floor(time_step+0.5))) @@ -359,14 +373,6 @@ program MOM_main "The interval in units of TIMEUNIT between saves of the \n"//& "energies of the run and other globally summed diagnostics.", & default=set_time(int(time_step+0.5)), timeunit=Time_unit) - call get_param(param_file, mod, "DO_ONLINE", do_online, & - "If true, use the model in prognostic mode where\n"//& - "the barotropic and baroclinic dynamics, thermodynamics,\n"//& - "etc. are stepped forward integrated in time.\n"//& - "If false, the all of the above are bypassed with all\n"//& - "fields necessary to integrate only the tracer advection\n"//& - "and diffusion equation are read in from files stored from\n"//& - "a previous integration of the prognostic model", default=.true.) call log_param(param_file, mod, "ELAPSED TIME AS MASTER", elapsed_time_master) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 01c581f55f..94c54ab38a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1428,6 +1428,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! (m for Bouss, kg/m^2 for non-Bouss) h_end, & temp_old, salt_old ! + integer :: niter, iter + real :: Inum_iter, dt_iter + + niter = CS%offline_CSp%num_off_iter ! Grid-related pointer assignments G => CS%G @@ -1451,13 +1455,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) salt_old(:,:,:) = 0.0 - if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then - if (CS%use_temperature) then - call create_group_pass(CS%pass_T_S_h, CS%tv%T, G%Domain) - call create_group_pass(CS%pass_T_S_h, CS%tv%S, G%Domain) - endif - call create_group_pass(CS%pass_T_S_h, CS%offline_CSp%h_preale, G%Domain) - endif +! if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then +! if (CS%use_temperature) then +! call create_group_pass(CS%pass_T_S_h, CS%tv%T, G%Domain) +! call create_group_pass(CS%pass_T_S_h, CS%tv%S, G%Domain) +! endif +! call create_group_pass(CS%pass_T_S_h, CS%offline_CSp%h_preale, G%Domain) +! endif call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & @@ -1465,11 +1469,29 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call transport_by_files(G, CS%offline_CSp, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) - CS%uhtr = uhtr - CS%vhtr = vhtr + ! Scale accumated transport by number of sub iterations + + dt_iter = CS%offline_CSp%dt_offline + + if (niter>1) then + Inum_iter = 1./real(niter) + dt_iter = CS%offline_CSp%dt_offline*Inum_iter + eatr = eatr * Inum_iter + ebtr = ebtr * Inum_iter + uhtr = uhtr * Inum_iter + vhtr = vhtr * Inum_iter + khdt_x = khdt_x * Inum_iter + khdt_y = khdt_y * Inum_iter + endif + + CS%T = temp_old CS%S = salt_old + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) + + do iter=1,niter !------------DIABATIC FIRST if (CS%diabatic_first) then @@ -1478,7 +1500,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & - fluxes, CS%dt_therm, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) @@ -1505,7 +1527,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_therm) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -1515,6 +1537,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tv%T = temp_old CS%tv%S = salt_old + + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. This needs to @@ -1526,7 +1551,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif !-----------ADVECTION AND DIFFUSION - call post_advection_fields( G, CS%offline_CSp, CS%diag, h_adv, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) + call post_advection_fields( G, CS%offline_CSp, CS%diag, h_adv, uhtr, vhtr, CS%tv%T, CS%tv%S ) if (CS%debug) then call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) @@ -1536,9 +1561,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) endif - call advect_tracer(h_adv, uhtr, vhtr, CS%OBC, CS%dt_therm, G, GV, & + call advect_tracer(h_adv, uhtr, vhtr, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h_adv, CS%dt_therm, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_adv, dt_iter, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) !------------DIABATIC AFTER @@ -1548,7 +1573,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & - fluxes, CS%dt_therm, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) @@ -1560,7 +1585,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tv%T = CS%offline_CSp%T_preale CS%tv%S = CS%offline_CSp%S_preale - call do_group_pass(CS%pass_T_S_h, G%Domain) + call pass_var(CS%tv%T,G%Domain) + call pass_var(CS%tv%S,G%Domain) ! update squared quantities if (associated(CS%S_squared)) & @@ -1577,7 +1603,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_therm) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) call cpu_clock_end(id_clock_ALE) @@ -1592,21 +1618,21 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tv%T = temp_old CS%tv%S = salt_old + call pass_var(CS%tv%T,G%Domain) + call pass_var(CS%tv%S,G%Domain) ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. This needs to ! happen after the H update and before the next post_data. call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) + call post_diags_TS_vardec(G, CS, dt_iter) endif ! endif for the block "if ( CS%use_ALE_algorithm )" endif ! diabatic second - + end do call disable_averaging(CS%diag) call cpu_clock_end(id_clock_tracer) CS%h = h_end - - end subroutine step_tracers diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 1e4669ae87..ada99fc1fb 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -91,6 +91,10 @@ module MOM_offline_transport real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & v_preale + real :: dt_offline ! Timestep used for offline tracers + + integer :: num_off_iter + integer :: & id_h_new = -1, & id_h_old = -1, & @@ -105,6 +109,7 @@ module MOM_offline_transport end type offline_transport_CS #include "MOM_memory.h" +#include "version_variable.h" public offline_transport_init public post_diabatic_fields public post_advection_fields @@ -349,25 +354,31 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) return endif allocate(CS) - + call log_version(param_file,mod,version, & + "This module allows for tracers to be run offline") + ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", fail_if_missing=.true.) + "Input directory where the offline fields can be found", default=" ") call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where time-averaged fields are fund can be found") + "Filename where time-averaged fields are fund can be found", default=" ") call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found") + "Filename where the accumulated fields can be found", default = " ") call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found") + "Filename where snapshot fields can be found",default=" ") call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & - "Filename where the preale T, S, u, v, and h fields are found") + "Filename where the preale T, S, u, v, and h fields are found",default=" ") call get_param(param_file, mod, "START_INDEX", CS%start_index, & - "Which time index to start from", fail_if_missing=.true.) + "Which time index to start from", default=1) call get_param(param_file, mod, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", fail_if_missing=.true.) + "Number of timelevels in offline input files", default=0) call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & "True if the time-averaged fields and snapshot fields are offset by one time level", & default=.false.) + call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & + "Number of iterations to subdivide the offline tracer advection and diffusion" ) + call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & + "Length of the offline timestep") ! Concatenate offline directory and file names CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 9b740d5635..6414b7f708 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -148,9 +148,6 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (present(do_online_flag)) do_online = do_online_flag - khdt_x = 0.0 ; khdt_y = 0.0 - Coef_x = 0.0 ; Coef_y = 0.0 - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "register_tracer must be called before tracer_hordiff.") if (LOC(Reg)==0) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & @@ -285,9 +282,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla else ! .not. do_online khdt_x = read_khdt_x khdt_y = read_khdt_y + call pass_vector(khdt_x,khdt_y,G%Domain) endif ! do_online - call pass_vector(khdt_x,khdt_y,G%Domain) + if (CS%check_diffusive_CFL) then if (CS%show_call_tree) call callTree_waypoint("Checking diffusive CFL (tracer_hordiff)") From 5bc35faed42d9d454b8dd5122784ebe6b373956e Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 27 Jul 2016 17:43:55 -0400 Subject: [PATCH 12/65] Recalculation of h_end after all mass fluxes matches h_end to within last two digits --- src/core/MOM.F90 | 332 ++++++----- src/tracer/MOM_offline_control.F90 | 765 ++++++++++++++----------- src/tracer/MOM_tracer_advect.F90 | 37 +- src/tracer/MOM_tracer_flow_control.F90 | 9 +- src/tracer/advection_test_tracer.F90 | 64 ++- 5 files changed, 699 insertions(+), 508 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 94c54ab38a..16844e3a62 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -126,7 +126,9 @@ module MOM use MOM_offline_transport, only : offline_transport_CS use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport +use MOM_offline_transport, only : update_h_horizontal_flux, update_h_vertical_flux use time_manager_mod, only : print_date +use MOM_sum_output, only : write_energy implicit none ; private @@ -1218,7 +1220,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call enable_averaging(dt,Time_local, CS%diag) if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) - if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) + if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag, mask=write_all_3dt) ! compute ssh, which is either eta_av for Bouss, or ! diagnosed ssh for non-Bouss; call "find_eta" for this @@ -1401,18 +1403,18 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM ! Local pointers - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing + type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid ! U-3D - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub ! U-2D - real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x + real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x, khdt_x_sub ! V-3D - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub ! V-2D - real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y + real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub ! Local variables real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & @@ -1420,22 +1422,36 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! one time step (m for Bouss, kg/m^2 for non-Bouss) ebtr, & ! Amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - h_old, & ! Layer thickness before diapycnal entrainment + eatr_sub, & + ebtr_sub, & + h_beg, & ! Layer thickness before diapycnal entrainment ! (m for Bouss, kg/m^2 for non-Bouss) h_new, & ! Layer thickness after diapycnal entrainment ! (m for Bouss, kg/m^2 for non-Bouss) h_adv, & ! Layer thickness after diapycnal entrainment ! (m for Bouss, kg/m^2 for non-Bouss) h_end, & + h_pre, & + h_vol, & + h_temp, & temp_old, salt_old ! integer :: niter, iter real :: Inum_iter, dt_iter - - niter = CS%offline_CSp%num_off_iter + integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: isv, iev, jsv, jev ! The valid range of the indices. + integer :: IsdB, IedB, JsdB, JedB ! Grid-related pointer assignments G => CS%G GV => CS%GV + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + + niter = CS%offline_CSp%num_off_iter + ! T-cell pointer assignments ! U-cell pointer assignments @@ -1443,12 +1459,16 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! V-cell pointer assignments uhtr(:,:,:) = 0.0 vhtr(:,:,:) = 0.0 + uhtr_sub(:,:,:) = 0.0 + vhtr_sub(:,:,:) = 0.0 + eatr_sub(:,:,:) = 0.0 + ebtr_sub(:,:,:) = 0.0 khdt_x(:,:) = 0.0 khdt_y(:,:) = 0.0 eatr(:,:,:) = 0.0 ebtr(:,:,:) = 0.0 - h_old(:,:,:) = GV%Angstrom - h_new(:,:,:) = GV%Angstrom + h_beg(:,:,:) = GV%Angstrom + h_new(:,:,:) = 0.0 h_adv(:,:,:) = GV%Angstrom h_end(:,:,:) = GV%Angstrom temp_old(:,:,:) = 0.0 @@ -1466,24 +1486,30 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & CS%diag) - call transport_by_files(G, CS%offline_CSp, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & + call transport_by_files(G, CS%offline_CSp, h_beg, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) - ! Scale accumated transport by number of sub iterations + h_pre(:,:,:) = 0.0 + h_temp(:,:,:) = 0.0 + ! Reconstruct h_sub at the beginning of the timestep as the total mass from the end of the timestep + ! minus horizontal and vertical mass fluxes. Both h_sub and h_new are updated later in the main transport loop + ! in this subroutine. Note that the order of h_end and h_pre are switched and negative, signs + ! added to 3d mass fluxes to account for the fact that we're constructing h at a previous time + call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_end, h_pre) + h_temp = h_pre + call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_temp, h_pre) dt_iter = CS%offline_CSp%dt_offline - - if (niter>1) then - Inum_iter = 1./real(niter) - dt_iter = CS%offline_CSp%dt_offline*Inum_iter - eatr = eatr * Inum_iter - ebtr = ebtr * Inum_iter - uhtr = uhtr * Inum_iter - vhtr = vhtr * Inum_iter - khdt_x = khdt_x * Inum_iter - khdt_y = khdt_y * Inum_iter - endif + ! Scale accumated transport by number of sub iterations + Inum_iter = 1./real(niter) + dt_iter = CS%offline_CSp%dt_offline*Inum_iter + eatr_sub = eatr * Inum_iter + ebtr_sub = ebtr * Inum_iter + uhtr_sub = uhtr * Inum_iter + vhtr_sub = vhtr * Inum_iter + khdt_x_sub = khdt_x * Inum_iter + khdt_y_sub = khdt_y * Inum_iter CS%T = temp_old CS%S = salt_old @@ -1494,144 +1520,166 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do iter=1,niter !------------DIABATIC FIRST - if (CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_old*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif - - call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - if ( CS%use_ALE_algorithm ) then - - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale - -! call do_group_pass(CS%pass_T_S_h, G%Domain) - - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - + if (CS%diabatic_first) then if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + call hchksum(h_beg*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) - endif + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - CS%tv%T = temp_old - CS%tv%S = salt_old - - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo - endif ! endif for the block "if ( CS%use_ALE_algorithm )" + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + if ( CS%use_ALE_algorithm ) then - endif -!-----------ADVECTION AND DIFFUSION - call post_advection_fields( G, CS%offline_CSp, CS%diag, h_adv, uhtr, vhtr, CS%tv%T, CS%tv%S ) + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale - if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) - call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) - call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) - if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) - if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) - endif - - call advect_tracer(h_adv, uhtr, vhtr, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h_adv, dt_iter, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) - -!------------DIABATIC AFTER - if (.not. CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif - - call call_tracer_column_fns(h_old, h_new, eatr, ebtr, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! call do_group_pass(CS%pass_T_S_h, G%Domain) - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - if ( CS%use_ALE_algorithm ) then + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) - temp_old = CS%tv%T - salt_old = CS%tv%S - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) + endif ! endif for the block "if ( CS%use_ALE_algorithm )" - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) - endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - + endif + !-----------ADVECTION AND DIFFUSION + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + call post_advection_fields( G, CS%offline_CSp, CS%diag, h_pre, uhtr_sub, vhtr_sub, CS%tv%T, CS%tv%S) + if (CS%debug) then + call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) + call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) + call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) + if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) + if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) + endif + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg) + call tracer_hordiff(h_new, dt_iter, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x_sub, khdt_y_sub) + + ! Done with advection so now h_pre should be h_new + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + !------------DIABATIC AFTER + if (.not. CS%diabatic_first) then if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) endif - CS%tv%T = temp_old - CS%tv%S = salt_old - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, dt_iter) - endif ! endif for the block "if ( CS%use_ALE_algorithm )" - endif ! diabatic second + ! Update h_new with convergence of vertical mass transports + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + if ( CS%use_ALE_algorithm ) then + + temp_old = CS%tv%T + salt_old = CS%tv%S + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale + + call pass_var(CS%tv%T,G%Domain) + call pass_var(CS%tv%S,G%Domain) + + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + + + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + call pass_var(CS%tv%T,G%Domain) + call pass_var(CS%tv%S,G%Domain) + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, dt_iter) + endif ! endif for the block "if ( CS%use_ALE_algorithm )" + endif ! diabatic second end do call disable_averaging(CS%diag) call cpu_clock_end(id_clock_tracer) - CS%h = h_end + + CS%h = h_new + call pass_var(CS%h,G%Domain) end subroutine step_tracers diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index ada99fc1fb..0fe3ca0520 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -42,385 +42,458 @@ module MOM_offline_transport - use data_override_mod, only : data_override_init, data_override - use MOM_time_manager, only : time_type - use MOM_domains, only : pass_var, pass_vector, To_All - use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe - use MOM_grid, only : ocean_grid_type - use MOM_verticalGrid, only : verticalGrid_type - use MOM_io, only : read_data - use MOM_file_parser, only : get_param, log_version, param_file_type - use MOM_diag_mediator, only : diag_ctrl, register_diag_field - use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST - use MOM_variables, only : vertvisc_type - use MOM_forcing_type, only : forcing - use MOM_shortwave_abs, only : optics_type - use MOM_diag_mediator, only : post_data - - implicit none + use data_override_mod, only : data_override_init, data_override + use MOM_time_manager, only : time_type + use MOM_domains, only : pass_var, pass_vector, To_All + use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe + use MOM_grid, only : ocean_grid_type + use MOM_verticalGrid, only : verticalGrid_type + use MOM_io, only : read_data + use MOM_file_parser, only : get_param, log_version, param_file_type + use MOM_diag_mediator, only : diag_ctrl, register_diag_field + use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + use MOM_variables, only : vertvisc_type + use MOM_forcing_type, only : forcing + use MOM_shortwave_abs, only : optics_type + use MOM_diag_mediator, only : post_data + + implicit none #include - type, public :: offline_transport_CS + type, public :: offline_transport_CS - integer :: start_index ! Timelevel to start - integer :: numtime ! How many timelevels in the input fields + integer :: start_index ! Timelevel to start + integer :: numtime ! How many timelevels in the input fields - integer :: & ! Index of each of the variables to be read in - ridx_mean = -1, & ! Separate indices for each variabile if they are - ridx_snap = -1 ! setoff from each other in time + integer :: & ! Index of each of the variables to be read in + ridx_mean = -1, & ! Separate indices for each variabile if they are + ridx_snap = -1 ! setoff from each other in time - character(len=200) :: offlinedir ! Directory where offline fields are stored - character(len=200) :: & ! Names - mean_file, & - snap_file, & - sum_file, & - preale_file + character(len=200) :: offlinedir ! Directory where offline fields are stored + character(len=200) :: & ! Names + mean_file, & + snap_file, & + sum_file, & + preale_file - logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are - ! offset by one time level + logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are + ! offset by one time level - ! These fields for preale are allocatable because they are not necessary for all runs - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - T_preale, & - S_preale, & - h_preale - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u_preale - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v_preale + ! These fields for preale are allocatable because they are not necessary for all runs + real, allocatable, dimension(NIMEM_,NJMEM_,NKMEM_) :: & + T_preale, & + S_preale, & + h_preale + real, allocatable, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & + u_preale + real, allocatable, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & + v_preale - real :: dt_offline ! Timestep used for offline tracers + real :: dt_offline ! Timestep used for offline tracers - integer :: num_off_iter + integer :: num_off_iter - integer :: & - id_h_new = -1, & - id_h_old = -1, & - id_h_preadv = -1, & - id_uhtr_preadv = -1, & - id_vhtr_preadv = -1, & - id_eatr_dia = -1, & - id_ebtr_dia = -1, & - id_temp_preadv = -1, & - id_salt_preadv = -1 + integer :: & + id_h_new = -1, & + id_h_old = -1, & + id_h_preadv = -1, & + id_uhtr_preadv = -1, & + id_vhtr_preadv = -1, & + id_eatr_dia = -1, & + id_ebtr_dia = -1, & + id_temp_preadv = -1, & + id_salt_preadv = -1 - end type offline_transport_CS + end type offline_transport_CS #include "MOM_memory.h" #include "version_variable.h" - public offline_transport_init - public post_diabatic_fields - public post_advection_fields + public offline_transport_init + public post_diabatic_fields + public post_advection_fields contains ! Called from call_tracer_column_fns to make sure that all the terms in the ! diabatic driver routine are the same online and offline - subroutine post_diabatic_fields( G, CS, diag, h_old, h_new, eatr, ebtr ) + subroutine post_diabatic_fields( G, CS, diag, h_old, h_new, eatr, ebtr ) - type(ocean_grid_type), intent(in) :: G - type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), intent(inout) :: diag - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, & - eatr, ebtr + type(ocean_grid_type), intent(in) :: G + type(offline_transport_CS), intent(in) :: CS + type(diag_ctrl), intent(inout) :: diag + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, & + eatr, ebtr - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt - write_all_3dt = 1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt + write_all_3dt = 1. - if (CS%id_h_old>0) call post_data(CS%id_h_old, h_old, diag, mask = write_all_3dt ) - if (CS%id_h_new>0) call post_data(CS%id_h_new, h_new, diag, mask = write_all_3dt ) - if (CS%id_eatr_dia>0) call post_data(CS%id_eatr_dia, eatr, diag, mask = write_all_3dt) - if (CS%id_ebtr_dia>0) call post_data(CS%id_ebtr_dia, ebtr, diag, mask = write_all_3dt) + if (CS%id_h_old>0) call post_data(CS%id_h_old, h_old, diag, mask = write_all_3dt ) + if (CS%id_h_new>0) call post_data(CS%id_h_new, h_new, diag, mask = write_all_3dt ) + if (CS%id_eatr_dia>0) call post_data(CS%id_eatr_dia, eatr, diag, mask = write_all_3dt) + if (CS%id_ebtr_dia>0) call post_data(CS%id_ebtr_dia, ebtr, diag, mask = write_all_3dt) - end subroutine post_diabatic_fields + end subroutine post_diabatic_fields ! Called right before tracer_advect call in MOM.F90 to ensure that all terms ! in the tracer advection routine are the same online and offline - subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) - - type(ocean_grid_type), intent(in) :: G - type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), intent(inout) :: diag - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_adv, temp, salt - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: write_all_3du - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: write_all_3dv - - - write_all_3dt = 1. - write_all_3du = 1. - write_all_3dv = 1. - - if (CS%id_h_preadv>0) call post_data(CS%id_h_preadv, h_adv, diag, mask = write_all_3dt ) - if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) - if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) - if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) - if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) - - end subroutine post_advection_fields - - subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, fluxes, optics, do_ale_in) - type(ocean_grid_type), intent(inout) :: G - type(offline_transport_CS), intent(inout) :: CS - type(forcing), intent(inout) :: fluxes - type(optics_type), intent(inout) :: optics - logical, optional :: do_ale_in - - !! Mandatory variables - ! Fields at U-points - ! 3D - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uhtr - ! 2D - real, dimension(SZIB_(G),SZJ_(G)) :: khdt_x - ! Fields at V-points - ! 3D - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vhtr - ! 2D - real, dimension(SZI_(G),SZJB_(G)) :: khdt_y - ! Fields at T-point - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - h_new, h_old, h_adv, h_end, & - eatr, ebtr, & - temp, salt - logical :: do_ale - - do_ale = .false.; - if (present(do_ale_in) ) do_ale = do_ale_in - - - call callTree_enter("transport_by_files, MOM_offline_control.F90") - - - !! Time-summed fields - ! U-grid - call read_data(CS%sum_file, 'uhtr_preadv_sum', uhtr,domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%sum_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - ! V-grid - call read_data(CS%sum_file, 'vhtr_preadv_sum', vhtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - call read_data(CS%sum_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - ! T-grid - call read_data(CS%sum_file, 'eatr_dia_sum', eatr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%sum_file, 'ebtr_dia_sum', ebtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - - !! Time-averaged fields - call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - - !! Read snapshot fields (end of time interval timestamp) - call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - - if (do_ale) then - CS%h_preale = 1.0e-10 - CS%T_preale = 0.0 - CS%S_preale = 0.0 - CS%u_preale = 0.0 - CS%v_preale = 0.0 - call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - - endif - - - - ! Convert all transport from time-averages to total amounts -! uhtr = uhtr * dt -! vhtr = vhtr * dt -! eatr = eatr * dt -! ebtr = ebtr * dt -! khdt_x = khdt_x * dt -! khdt_y = khdt_y * dt - - !! Make sure all halos have been updated - ! Vector fields - call pass_vector(uhtr, vhtr, G%Domain) - call pass_vector(khdt_x, khdt_y, G%Domain) - - ! Scalar fields - call pass_var(h_adv, G%Domain) - call pass_var(h_old, G%Domain) - call pass_var(h_new, G%Domain) - call pass_var(h_end, G%Domain) - call pass_var(eatr, G%Domain) - call pass_var(ebtr, G%Domain) - call pass_var(temp, G%Domain) - call pass_var(salt, G%Domain) - - if (do_ale) then - - call pass_vector(CS%u_preale,CS%v_preale,G%Domain) - call pass_var(CS%h_preale, G%Domain) - call pass_var(CS%T_preale, G%Domain) - call pass_var(CS%S_preale, G%Domain) - - - endif - - - ! Update the read indices - CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) - CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) - - call callTree_leave("transport_by_file") - - end subroutine transport_by_files - - !> Initialize additional diagnostics required for offline tracer transport - subroutine register_diags_offline_transport(Time, diag, CS) - - type(offline_transport_CS), pointer :: CS !< control structure for MOM - type(time_type), intent(in) :: Time !< current model time - type(diag_ctrl) :: diag - - - ! U-cell fields - CS%id_uhtr_preadv = register_diag_field('ocean_model', 'uhtr_preadv', diag%axesCuL, Time, & - 'Accumulated zonal thickness fluxes to advect tracers', 'kg') - - ! V-cell fields - CS%id_vhtr_preadv = register_diag_field('ocean_model', 'vhtr_preadv', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') - - ! T-cell fields - CS%id_h_preadv = register_diag_field('ocean_model', 'h_preadv', diag%axesTL, Time, & - 'Layer Thickness prior to advection', 'm') - CS%id_h_old = register_diag_field('ocean_model', 'h_old', diag%axesTL, Time, & - 'Layer Thickness before diabatic', 'm') - CS%id_h_new = register_diag_field('ocean_model', 'h_new', diag%axesTL, Time, & - 'Layer Thickness after diabatic', 'm') - CS%id_eatr_dia = register_diag_field('ocean_model', 'eatr_dia', diag%axesTL, Time, & - 'Entrainment from layer above', 'kg') - CS%id_ebtr_dia = register_diag_field('ocean_model', 'ebtr_dia', diag%axesTL, Time, & - 'Entrainment from layer below', 'kg') - CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & - 'Temperature prior to advection', 'C') - CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & - 'Salinity prior to advection', 'S') - - - - end subroutine register_diags_offline_transport - - subroutine offline_transport_init(param_file, CS, do_ale, G, GV) - - type(param_file_type) , intent(in) :: param_file - type(offline_transport_CS), pointer, intent(inout) :: CS - logical , intent(in) :: do_ale - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV + subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) + + type(ocean_grid_type), intent(in) :: G + type(offline_transport_CS), intent(in) :: CS + type(diag_ctrl), intent(inout) :: diag + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_adv, temp, salt + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: write_all_3du + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: write_all_3dv + + + write_all_3dt = 1. + write_all_3du = 1. + write_all_3dv = 1. + + if (CS%id_h_preadv>0) call post_data(CS%id_h_preadv, h_adv, diag, mask = write_all_3dt ) + if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) + if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) + if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) + if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) + + end subroutine post_advection_fields + + subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + temp, salt, fluxes, optics, do_ale_in) + type(ocean_grid_type), intent(inout) :: G + type(offline_transport_CS), intent(inout) :: CS + type(forcing), intent(inout) :: fluxes + type(optics_type), intent(inout) :: optics + logical, optional :: do_ale_in + + !! Mandatory variables + ! Fields at U-points + ! 3D + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uhtr + ! 2D + real, dimension(SZIB_(G),SZJ_(G)) :: khdt_x + ! Fields at V-points + ! 3D + real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vhtr + ! 2D + real, dimension(SZI_(G),SZJB_(G)) :: khdt_y + ! Fields at T-point + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + h_new, h_old, h_adv, h_end, & + eatr, ebtr, & + temp, salt + logical :: do_ale + + do_ale = .false.; + if (present(do_ale_in) ) do_ale = do_ale_in + + + call callTree_enter("transport_by_files, MOM_offline_control.F90") + + + !! Time-summed fields + ! U-grid + call read_data(CS%sum_file, 'uhtr_preadv_sum', uhtr,domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%sum_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + ! V-grid + call read_data(CS%sum_file, 'vhtr_preadv_sum', vhtr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%sum_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + ! T-grid + call read_data(CS%sum_file, 'eatr_dia_sum', eatr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%sum_file, 'ebtr_dia_sum', ebtr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + + !! Time-averaged fields + call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + + !! Read snapshot fields (end of time interval timestamp) + call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + + if (do_ale) then + CS%h_preale = 1.0e-10 + CS%T_preale = 0.0 + CS%S_preale = 0.0 + CS%u_preale = 0.0 + CS%v_preale = 0.0 + call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=CENTER) + call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=CENTER) + call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_mean,position=NORTH) + + endif + + + + ! Convert all transport from time-averages to total amounts + ! uhtr = uhtr * dt + ! vhtr = vhtr * dt + ! eatr = eatr * dt + ! ebtr = ebtr * dt + ! khdt_x = khdt_x * dt + ! khdt_y = khdt_y * dt + + !! Make sure all halos have been updated + ! Vector fields + call pass_vector(uhtr, vhtr, G%Domain) + call pass_vector(khdt_x, khdt_y, G%Domain) + + ! Scalar fields + call pass_var(h_adv, G%Domain) + call pass_var(h_old, G%Domain) + call pass_var(h_new, G%Domain) + call pass_var(h_end, G%Domain) + call pass_var(eatr, G%Domain) + call pass_var(ebtr, G%Domain) + call pass_var(temp, G%Domain) + call pass_var(salt, G%Domain) + + if (do_ale) then + + call pass_vector(CS%u_preale,CS%v_preale,G%Domain) + call pass_var(CS%h_preale, G%Domain) + call pass_var(CS%T_preale, G%Domain) + call pass_var(CS%S_preale, G%Domain) + + + endif + + ! Update the read indices + CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) + CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) + + call callTree_leave("transport_by_file") + + end subroutine transport_by_files + + !> Initialize additional diagnostics required for offline tracer transport + subroutine register_diags_offline_transport(Time, diag, CS) + + type(offline_transport_CS), pointer :: CS !< control structure for MOM + type(time_type), intent(in) :: Time !< current model time + type(diag_ctrl) :: diag + + + ! U-cell fields + CS%id_uhtr_preadv = register_diag_field('ocean_model', 'uhtr_preadv', diag%axesCuL, Time, & + 'Accumulated zonal thickness fluxes to advect tracers', 'kg') + + ! V-cell fields + CS%id_vhtr_preadv = register_diag_field('ocean_model', 'vhtr_preadv', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + + ! T-cell fields + CS%id_h_preadv = register_diag_field('ocean_model', 'h_preadv', diag%axesTL, Time, & + 'Layer Thickness prior to advection', 'm', v_cell_method = 'sum') + CS%id_h_old = register_diag_field('ocean_model', 'h_old', diag%axesTL, Time, & + 'Layer Thickness before diabatic', 'm', v_cell_method = 'sum') + CS%id_h_new = register_diag_field('ocean_model', 'h_new', diag%axesTL, Time, & + 'Layer Thickness after diabatic', 'm', v_cell_method = 'sum') + CS%id_eatr_dia = register_diag_field('ocean_model', 'eatr_dia', diag%axesTL, Time, & + 'Entrainment from layer above', 'kg') + CS%id_ebtr_dia = register_diag_field('ocean_model', 'ebtr_dia', diag%axesTL, Time, & + 'Entrainment from layer below', 'kg') + CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & + 'Temperature prior to advection', 'C') + CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & + 'Salinity prior to advection', 'S') + + + + end subroutine register_diags_offline_transport + + subroutine offline_transport_init(param_file, CS, do_ale, G, GV) + + type(param_file_type) , intent(in) :: param_file + type(offline_transport_CS), pointer, intent(inout) :: CS + logical , intent(in) :: do_ale + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV + + character(len=40) :: mod = "offline_transport" - character(len=40) :: mod = "offline_transport" + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: IsdB, IedB, JsdB, JedB - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: IsdB, IedB, JsdB, JedB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + call callTree_enter("offline_transport_init, MOM_offline_control.F90") - call callTree_enter("offline_transport_init, MOM_offline_control.F90") - - if (associated(CS)) then - call MOM_error(WARNING, "offline_transport_init called with an associated "// & - "control structure.") - return - endif - allocate(CS) - call log_version(param_file,mod,version, & - "This module allows for tracers to be run offline") + if (associated(CS)) then + call MOM_error(WARNING, "offline_transport_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + call log_version(param_file,mod,version, & + "This module allows for tracers to be run offline") - ! Parse MOM_input for offline control - call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", default=" ") - call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where time-averaged fields are fund can be found", default=" ") - call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found", default = " ") - call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found",default=" ") - call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & - "Filename where the preale T, S, u, v, and h fields are found",default=" ") - call get_param(param_file, mod, "START_INDEX", CS%start_index, & - "Which time index to start from", default=1) - call get_param(param_file, mod, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", default=0) - call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & - "True if the time-averaged fields and snapshot fields are offset by one time level", & - default=.false.) - call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & - "Number of iterations to subdivide the offline tracer advection and diffusion" ) - call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & - "Length of the offline timestep") - - ! Concatenate offline directory and file names - CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) - CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) - CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) - CS%preale_file = trim(CS%offlinedir)//trim(CS%preale_file) - - ! Set the starting read index for time-averaged and snapshotted fields - CS%ridx_mean = CS%start_index - if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) - if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index - - if (do_ale) then - ALLOC_(CS%u_preale(IsdB:IedB,jsd:jed,nz)) ; CS%u_preale(:,:,:) = 0.0 - ALLOC_(CS%v_preale(isd:ied,JsdB:JedB,nz)) ; CS%v_preale(:,:,:) = 0.0 - ALLOC_(CS%h_preale(isd:ied,jsd:jed,nz)) ; CS%h_preale(:,:,:) = GV%Angstrom - ALLOC_(CS%T_preale(isd:ied,jsd:jed,nz)) ; CS%T_preale(:,:,:) = 0.0 - ALLOC_(CS%S_preale(isd:ied,jsd:jed,nz)) ; CS%S_preale(:,:,:) = 0.0 - endif - - call callTree_leave("offline_transport_init") - - end subroutine offline_transport_init - - function next_modulo_time(inidx, numtime) - ! Returns the next time interval to be read - integer :: numtime ! Number of time levels in input fields - integer :: inidx ! The current time index - - integer :: read_index ! The index in the input files that corresponds - ! to the current timestep - - integer :: next_modulo_time - - read_index = mod(inidx+1,numtime) - if (read_index < 0) read_index = inidx-read_index - if (read_index == 0) read_index = numtime - - - next_modulo_time = read_index - - end function next_modulo_time + ! Parse MOM_input for offline control + call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & + "Input directory where the offline fields can be found", default=" ") + call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & + "Filename where time-averaged fields are fund can be found", default=" ") + call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & + "Filename where the accumulated fields can be found", default = " ") + call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & + "Filename where snapshot fields can be found",default=" ") + call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & + "Filename where the preale T, S, u, v, and h fields are found",default=" ") + call get_param(param_file, mod, "START_INDEX", CS%start_index, & + "Which time index to start from", default=1) + call get_param(param_file, mod, "NUMTIME", CS%numtime, & + "Number of timelevels in offline input files", default=0) + call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & + "True if the time-averaged fields and snapshot fields are offset by one time level", & + default=.false.) + call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & + "Number of iterations to subdivide the offline tracer advection and diffusion" ) + call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & + "Length of the offline timestep") + + ! Concatenate offline directory and file names + CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) + CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) + CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) + CS%preale_file = trim(CS%offlinedir)//trim(CS%preale_file) + + ! Set the starting read index for time-averaged and snapshotted fields + CS%ridx_mean = CS%start_index + if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) + if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index + + if (do_ale) then + ALLOC_(CS%u_preale(IsdB:IedB,jsd:jed,nz)) ; CS%u_preale(:,:,:) = 0.0 + ALLOC_(CS%v_preale(isd:ied,JsdB:JedB,nz)) ; CS%v_preale(:,:,:) = 0.0 + ALLOC_(CS%h_preale(isd:ied,jsd:jed,nz)) ; CS%h_preale(:,:,:) = GV%Angstrom + ALLOC_(CS%T_preale(isd:ied,jsd:jed,nz)) ; CS%T_preale(:,:,:) = 0.0 + ALLOC_(CS%S_preale(isd:ied,jsd:jed,nz)) ; CS%S_preale(:,:,:) = 0.0 + endif + + call callTree_leave("offline_transport_init") + + end subroutine offline_transport_init + + function next_modulo_time(inidx, numtime) + ! Returns the next time interval to be read + integer :: numtime ! Number of time levels in input fields + integer :: inidx ! The current time index + + integer :: read_index ! The index in the input files that corresponds + ! to the current timestep + + integer :: next_modulo_time + + read_index = mod(inidx+1,numtime) + if (read_index < 0) read_index = inidx-read_index + if (read_index == 0) read_index = numtime + + + next_modulo_time = read_index + + end function next_modulo_time + + subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new + + ! Local variables + integer :: i, j, k, m, is, ie, js, je, nz + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + do k = 1, nz + do i=is,ie ; do j=js,je + + h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) + ! In the case that the layer is now dramatically thinner than it was previously, + ! add a bit of mass to avoid truncation errors. This will lead to + ! non-conservation of tracers + h_new(i,j,k) = h_new(i,j,k) + & + max(GV%Angstrom, 1.0e-14*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + + enddo ; enddo + enddo + + end subroutine update_h_horizontal_flux + + + subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: ea + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: eb + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new + + ! Local variables + integer :: i, j, k, m, is, ie, js, je, nz + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + ! Update h_new with convergence of vertical mass transports + do j=js,je + do i=is,ie + + ! Top layer + h_new(i,j,1) = h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + h_new(i,j,1) = max(GV%Angstrom, h_new(i,j,1)) + + ! Bottom layer + h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + h_new(i,j,nz) = max(GV%Angstrom, h_new(i,j,nz)) + + enddo + + ! Interior layers + do k=2,nz-1 ; do i=is,ie + + h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) + + h_new(i,j,k) = max(GV%Angstrom, h_new(i,j,k)) + + + enddo ; enddo + + + enddo + + end subroutine update_h_vertical_flux end module MOM_offline_transport diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 9a8aaa86dd..b0e43cd40b 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -9,7 +9,7 @@ module MOM_tracer_advect use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_domains, only : sum_across_PEs, max_across_PEs -use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type, pass_var use MOM_checksums, only : hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -54,6 +54,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg) real, intent(in) :: dt !< time increment (seconds) type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers @@ -118,6 +119,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg) ! This initializes the halos of uhr and vhr because pass_vector might do ! calculations on them, even though they are never used. !$OMP do + do k = 1, nz do j = jsd, jed; do i = IsdB, IedB; uhr(i,j,k) = 0.0; enddo ; enddo do j = jsdB, jedB; do i = Isd, Ied; vhr(i,j,k) = 0.0; enddo ; enddo @@ -126,20 +128,27 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg) ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo -! This loop reconstructs the thickness field the last time that the -! tracers were updated, probably just after the diabatic forcing. A useful -! diagnostic could be to compare this reconstruction with that older value. - do i=is,ie ; do j=js,je - hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & - ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) -! In the case that the layer is now dramatically thinner than it was previously, -! add a bit of mass to avoid truncation errors. This will lead to -! non-conservation of tracers - hprev(i,j,k) = hprev(i,j,k) + & - max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) - enddo ; enddo + if (.not. present(h_prev_opt)) then + ! This loop reconstructs the thickness field the last time that the + ! tracers were updated, probably just after the diabatic forcing. A useful + ! diagnostic could be to compare this reconstruction with that older value. + do i=is,ie ; do j=js,je + hprev(i,j,k) = max(0.0, G%areaT(i,j)*h_end(i,j,k) + & + ((uhr(I,j,k) - uhr(I-1,j,k)) + (vhr(i,J,k) - vhr(i,J-1,k)))) + ! In the case that the layer is now dramatically thinner than it was previously, + ! add a bit of mass to avoid truncation errors. This will lead to + ! non-conservation of tracers + hprev(i,j,k) = hprev(i,j,k) + & + max(0.0, 1.0e-13*hprev(i,j,k) - G%areaT(i,j)*h_end(i,j,k)) + enddo ; enddo + else + do i=is,ie ; do j=js,je + hprev(i,j,k) = h_prev_opt(i,j,k); + enddo ; enddo + endif enddo + !$OMP do do j=jsd,jed ; do I=isd,ied-1 uh_neglect(I,j) = GV%H_subroundoff*MIN(G%areaT(i,j),G%areaT(i+1,j)) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index f446e3136b..622118efc1 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -65,7 +65,7 @@ module MOM_tracer_flow_control use oil_tracer, only : oil_stock, oil_tracer_end, oil_tracer_CS use advection_test_tracer, only : register_advection_test_tracer, initialize_advection_test_tracer use advection_test_tracer, only : advection_test_tracer_column_physics, advection_test_tracer_surface_state -use advection_test_tracer, only : advection_test_tracer_end, advection_test_tracer_CS +use advection_test_tracer, only : advection_test_tracer_end, advection_test_tracer_CS, advection_test_stock #ifdef _USE_GENERIC_TRACER use MOM_generic_tracer, only : register_MOM_generic_tracer, initialize_MOM_generic_tracer use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state @@ -481,6 +481,13 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni endif #endif + if (CS%use_advection_test_tracer) then + ns = advection_test_stock( h, values, G, GV, CS%advection_test_tracer_CSp, & + names, units, stock_index ) + call store_stocks("advection_test_tracer", ns, names, units, values, index, & + stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + endif + if (ns_tot == 0) stock_values(1) = 0.0 if (present(num_stocks)) num_stocks = ns_tot diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index a490299e76..a99ddf4446 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -80,7 +80,7 @@ module advection_test_tracer public register_advection_test_tracer, initialize_advection_test_tracer public advection_test_tracer_surface_state, advection_test_tracer_end -public advection_test_tracer_column_physics +public advection_test_tracer_column_physics, advection_test_stock ! ntr is the number of tracers in this module. integer, parameter :: ntr = 11 @@ -90,6 +90,7 @@ module advection_test_tracer end type p3d type, public :: advection_test_tracer_CS ; private + integer ntr ! Number of tracers in this module logical :: coupled_tracers = .false. ! These tracers are not offered to the ! coupler. character(len=200) :: tracer_IC_file ! The full path to the IC file, or " " @@ -282,7 +283,7 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS h_neglect = GV%H_subroundoff CS%diag => diag - + CS%ntr = NTR if (.not.restart) then do m=1,NTR do k=1,nz ; do j=js,je ; do i=is,ie @@ -398,9 +399,9 @@ subroutine advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, if (.not.associated(CS)) return -! do m=1,NTR -! call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) -! enddo + do m=1,NTR + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo if (CS%mask_tracers) then do m = 1,NTR ; if (CS%id_tracer(m) > 0) then @@ -461,6 +462,59 @@ subroutine advection_test_tracer_surface_state(state, h, G, CS) endif end subroutine advection_test_tracer_surface_state +function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) + type(ocean_grid_type), intent(in) :: G + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h + real, dimension(:), intent(out) :: stocks + type(verticalGrid_type), intent(in) :: GV + type(advection_test_tracer_CS), pointer :: CS + character(len=*), dimension(:), intent(out) :: names + character(len=*), dimension(:), intent(out) :: units + integer, optional, intent(in) :: stock_index + integer :: advection_test_stock +! This function calculates the mass-weighted integral of all tracer stocks, +! returning the number of stocks it has calculated. If the stock_index +! is present, only the stock corresponding to that coded index is returned. + +! Arguments: h - Layer thickness, in m or kg m-2. +! (out) stocks - the mass-weighted integrated amount of each tracer, +! in kg times concentration units. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! register_ideal_age_tracer. +! (out) names - the names of the stocks calculated. +! (out) units - the units of the stocks calculated. +! (in,opt) stock_index - the coded index of a specific stock being sought. +! Return value: the number of stocks calculated here. + + integer :: i, j, k, is, ie, js, je, nz, m + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + advection_test_stock = 0 + if (.not.associated(CS)) return + if (CS%ntr < 1) return + + if (present(stock_index)) then ; if (stock_index > 0) then + ! Check whether this stock is available from this routine. + + ! No stocks from this routine are being checked yet. Return 0. + return + endif ; endif + + do m=1,CS%ntr + call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="advection_test_stock") + stocks(m) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & + (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + enddo ; enddo ; enddo + stocks(m) = GV%H_to_kg_m2 * stocks(m) + enddo + advection_test_stock = CS%ntr + +end function advection_test_stock + subroutine advection_test_tracer_end(CS) type(advection_test_tracer_CS), pointer :: CS integer :: m From ca083198120c0193d8f5a7a00bae8295837f363f Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 2 Aug 2016 16:22:10 -0400 Subject: [PATCH 13/65] Convergence improved to 6 digits of accuracy --- src/core/MOM.F90 | 343 +++++++++--------- .../vertical/MOM_diabatic_driver.F90 | 4 +- src/tracer/MOM_offline_control.F90 | 30 +- src/tracer/MOM_tracer_advect.F90 | 5 +- 4 files changed, 204 insertions(+), 178 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 16844e3a62..a2be41dc16 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -37,7 +37,7 @@ module MOM use MOM_diag_mediator, only : register_scalar_field use MOM_diag_mediator, only : set_axes_info, diag_ctrl, diag_masks_set use MOM_domains, only : MOM_domains_init, clone_MOM_domain -use MOM_domains, only : sum_across_PEs, pass_var +use MOM_domains, only : sum_across_PEs, pass_var, pass_vector use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_domains, only : start_group_pass, complete_group_pass @@ -1461,46 +1461,27 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr(:,:,:) = 0.0 uhtr_sub(:,:,:) = 0.0 vhtr_sub(:,:,:) = 0.0 - eatr_sub(:,:,:) = 0.0 - ebtr_sub(:,:,:) = 0.0 khdt_x(:,:) = 0.0 khdt_y(:,:) = 0.0 eatr(:,:,:) = 0.0 ebtr(:,:,:) = 0.0 + eatr_sub(:,:,:) = 0.0 + ebtr_sub(:,:,:) = 0.0 h_beg(:,:,:) = GV%Angstrom - h_new(:,:,:) = 0.0 + h_new(:,:,:) = GV%Angstrom h_adv(:,:,:) = GV%Angstrom h_end(:,:,:) = GV%Angstrom temp_old(:,:,:) = 0.0 salt_old(:,:,:) = 0.0 - -! if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then -! if (CS%use_temperature) then -! call create_group_pass(CS%pass_T_S_h, CS%tv%T, G%Domain) -! call create_group_pass(CS%pass_T_S_h, CS%tv%S, G%Domain) -! endif -! call create_group_pass(CS%pass_T_S_h, CS%offline_CSp%h_preale, G%Domain) -! endif - call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & CS%diag) - call transport_by_files(G, CS%offline_CSp, h_beg, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & +! call transport_by_files(G, CS%offline_CSp, h_beg, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & +! khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) + call transport_by_files(G, CS%offline_CSp, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) - h_pre(:,:,:) = 0.0 - h_temp(:,:,:) = 0.0 - ! Reconstruct h_sub at the beginning of the timestep as the total mass from the end of the timestep - ! minus horizontal and vertical mass fluxes. Both h_sub and h_new are updated later in the main transport loop - ! in this subroutine. Note that the order of h_end and h_pre are switched and negative, signs - ! added to 3d mass fluxes to account for the fact that we're constructing h at a previous time - call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_end, h_pre) - h_temp = h_pre - call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_temp, h_pre) - - dt_iter = CS%offline_CSp%dt_offline - ! Scale accumated transport by number of sub iterations Inum_iter = 1./real(niter) dt_iter = CS%offline_CSp%dt_offline*Inum_iter @@ -1517,168 +1498,206 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(CS%S,G%Domain) - do iter=1,niter -!------------DIABATIC FIRST + h_pre(:,:,:) = GV%Angstrom + h_temp(:,:,:) = GV%Angstrom + ! Reconstruct h_sub at the beginning of the timestep as the total mass from the end of the timestep + ! minus horizontal and vertical mass fluxes. Both h_sub and h_new are updated later in the main transport loop + ! in this subroutine. Note that the order of h_end and h_pre are switched and negative, signs + ! added to 3d mass fluxes to account for the fact that we're constructing h at a previous time + + h_pre = CS%h + +! if (CS%diabatic_first) then +! call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_pre, h_temp) +! call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_temp, h_pre) +! else +! call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_pre, h_temp) +! call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_temp, h_pre) +! endif - if (CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_beg*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + dt_iter = CS%offline_CSp%dt_offline - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + if (CS%diabatic_first .and. CS%use_ALE_algorithm) then + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - if ( CS%use_ALE_algorithm ) then +! call do_group_pass(CS%pass_T_S_h, G%Domain) - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - ! call do_group_pass(CS%pass_T_S_h, G%Domain) + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) - endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) + CS%tv%T = temp_old + CS%tv%S = salt_old - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) - endif + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) - CS%tv%T = temp_old - CS%tv%S = salt_old + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) + endif !Diabatic first and ALE - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) - endif ! endif for the block "if ( CS%use_ALE_algorithm )" + do iter=1,niter - endif - !-----------ADVECTION AND DIFFUSION - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - call post_advection_fields( G, CS%offline_CSp, CS%diag, h_pre, uhtr_sub, vhtr_sub, CS%tv%T, CS%tv%S) +!------------DIABATIC FIRST + if (CS%diabatic_first) then if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) - call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) - call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) - if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) - if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) + call hchksum(h_beg*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) endif - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg) - call tracer_hordiff(h_new, dt_iter, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x_sub, khdt_y_sub) + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! Done with advection so now h_pre should be h_new + ! We are now done with the vertical mass transports, so now h_new is h_sub do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - !------------DIABATIC AFTER - if (.not. CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif - ! Update h_new with convergence of vertical mass transports - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - if ( CS%use_ALE_algorithm ) then - - temp_old = CS%tv%T - salt_old = CS%tv%S - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale - - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) - endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - - - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Post-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Post-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Post-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) - endif - - CS%tv%T = temp_old - CS%tv%S = salt_old - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, dt_iter) - endif ! endif for the block "if ( CS%use_ALE_algorithm )" - endif ! diabatic second + endif + !-----------ADVECTION AND DIFFUSION + + + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + call post_advection_fields( G, CS%offline_CSp, CS%diag, h_pre, uhtr_sub, vhtr_sub, CS%tv%T, CS%tv%S) + + if (CS%debug) then + call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) + call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) + call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) + if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) + if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) + endif + + do k = 1, nz ; do i = is, ie ; do j=js, je + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + +! if (iter.eq.niter) then +! call advect_tracer(h_end, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & +! CS%tracer_adv_CSp, CS%tracer_Reg) +! else + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol) +! endif +! call tracer_hordiff(h_new, dt_iter, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x_sub, khdt_y_sub) + + ! Done with advection so now h_pre should be h_new + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + !------------DIABATIC AFTER + if (.not. CS%diabatic_first) then + if (CS%debug) then + call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) + endif + + ! Update h_new with convergence of vertical mass transports + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + + ! We are now done with the vertical mass transports, so now h_pre is set as h_new + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + endif ! diabatic second end do - call disable_averaging(CS%diag) + + ! Tracer diffusion happens after the 3d advection + call tracer_hordiff(h_end, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) + + if (.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale + +! call do_group_pass(CS%pass_T_S_h, G%Domain) + + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, CS%dt_trans) + + endif !Diabatic second and ALE + + h_temp = h_end-h_new + if (CS%offline_CSp%id_h_new) call post_data(CS%offline_CSp%id_h_new, h_new, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, h_temp, CS%diag) + call cpu_clock_end(id_clock_tracer) - CS%h = h_new + call disable_averaging(CS%diag) + + CS%h = h_end call pass_var(CS%h,G%Domain) end subroutine step_tracers diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 77765b4ebc..33692d177e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1106,7 +1106,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ enddo ! Post the fields used for tracers here - call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, eatr, ebtr ) + call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb ) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) @@ -1131,7 +1131,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, eatr, ebtr) + call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 0fe3ca0520..8305d7fbfd 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -164,7 +164,8 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) end subroutine post_advection_fields - subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & +! subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & temp, salt, fluxes, optics, do_ale_in) type(ocean_grid_type), intent(inout) :: G type(offline_transport_CS), intent(inout) :: CS @@ -185,7 +186,7 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht real, dimension(SZI_(G),SZJB_(G)) :: khdt_y ! Fields at T-point real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - h_new, h_old, h_adv, h_end, & + h_new, h_adv, h_end, & eatr, ebtr, & temp, salt logical :: do_ale @@ -223,8 +224,8 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht !! Read snapshot fields (end of time interval timestamp) call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) +! call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & @@ -266,7 +267,7 @@ subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uht ! Scalar fields call pass_var(h_adv, G%Domain) - call pass_var(h_old, G%Domain) +! call pass_var(h_old, G%Domain) call pass_var(h_new, G%Domain) call pass_var(h_end, G%Domain) call pass_var(eatr, G%Domain) @@ -443,7 +444,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom, 1.0e-14*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo @@ -470,22 +471,25 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do i=is,ie ! Top layer - h_new(i,j,1) = h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)) - h_new(i,j,1) = max(GV%Angstrom, h_new(i,j,1)) + h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)+ea(i,j,1) )) + h_new(i,j,1) = h_new(i,j,1) + & + max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer - h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) - h_new(i,j,nz) = max(GV%Angstrom, h_new(i,j,nz)) + h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1))) + h_new(i,j,nz) = h_new(i,j,nz) + & + max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is,ie - h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1))) + h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = max(GV%Angstrom, h_new(i,j,k)) + h_new(i,j,k) = h_new(i,j,k) + & + max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index b0e43cd40b..7694ec586b 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -55,6 +55,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt) type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) + integer, optional :: max_iter_in type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers @@ -104,6 +105,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt) max_iter = 2*INT(CEILING(dt/CS%dt)) + 1 + if(present(max_iter_in)) max_iter = max_iter_in + call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) call create_group_pass(CS%pass_uhr_vhr_t_hprev, hprev, G%Domain) From 79dfab099d870e73d8856203513bd088b376deca Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 8 Aug 2016 16:33:14 -0400 Subject: [PATCH 14/65] Rewrote advection step using a flux limited and added Strang time split --- config_src/solo_driver/MOM_driver.F90 | 6 +- src/core/MOM.F90 | 147 ++++++++-------- src/tracer/MOM_offline_control.F90 | 230 +++++++++++++++++++++++--- src/tracer/MOM_tracer_advect.F90 | 4 +- 4 files changed, 279 insertions(+), 108 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 35d68b45ba..ed6f4826bd 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -449,8 +449,8 @@ program MOM_main ! This call steps the model over a time time_step. Time1 = Master_Time ; Time = Master_Time - if (do_online) call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) - + if (do_online) call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) + if (.not. do_online) call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) ! Time = Time + Time_step_ocean ! This is here to enable fractional-second time steps. @@ -489,7 +489,7 @@ program MOM_main "thermodynamic time steps that are longer than the coupling timestep.") endif ; endif - if (.not. do_online) call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) + ! See if it is time to write out the energy. if ((Time + (Time_step_ocean/2) > write_energy_time) .and. & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a2be41dc16..7dc1294383 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -126,7 +126,7 @@ module MOM use MOM_offline_transport, only : offline_transport_CS use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport -use MOM_offline_transport, only : update_h_horizontal_flux, update_h_vertical_flux +use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux use time_manager_mod, only : print_date use MOM_sum_output, only : write_energy @@ -1431,15 +1431,17 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_adv, & ! Layer thickness after diapycnal entrainment ! (m for Bouss, kg/m^2 for non-Bouss) h_end, & - h_pre, & h_vol, & + h_pre, & h_temp, & temp_old, salt_old ! integer :: niter, iter real :: Inum_iter, dt_iter + real :: global_flux_sum integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB + logical :: z_first, x_before_y ! Grid-related pointer assignments G => CS%G @@ -1459,14 +1461,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! V-cell pointer assignments uhtr(:,:,:) = 0.0 vhtr(:,:,:) = 0.0 - uhtr_sub(:,:,:) = 0.0 - vhtr_sub(:,:,:) = 0.0 khdt_x(:,:) = 0.0 khdt_y(:,:) = 0.0 eatr(:,:,:) = 0.0 ebtr(:,:,:) = 0.0 - eatr_sub(:,:,:) = 0.0 - ebtr_sub(:,:,:) = 0.0 h_beg(:,:,:) = GV%Angstrom h_new(:,:,:) = GV%Angstrom h_adv(:,:,:) = GV%Angstrom @@ -1482,40 +1480,16 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call transport_by_files(G, CS%offline_CSp, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) - ! Scale accumated transport by number of sub iterations Inum_iter = 1./real(niter) dt_iter = CS%offline_CSp%dt_offline*Inum_iter - eatr_sub = eatr * Inum_iter - ebtr_sub = ebtr * Inum_iter - uhtr_sub = uhtr * Inum_iter - vhtr_sub = vhtr * Inum_iter - khdt_x_sub = khdt_x * Inum_iter - khdt_y_sub = khdt_y * Inum_iter CS%T = temp_old CS%S = salt_old call pass_var(CS%T,G%Domain) call pass_var(CS%S,G%Domain) - h_pre(:,:,:) = GV%Angstrom - h_temp(:,:,:) = GV%Angstrom - ! Reconstruct h_sub at the beginning of the timestep as the total mass from the end of the timestep - ! minus horizontal and vertical mass fluxes. Both h_sub and h_new are updated later in the main transport loop - ! in this subroutine. Note that the order of h_end and h_pre are switched and negative, signs - ! added to 3d mass fluxes to account for the fact that we're constructing h at a previous time - h_pre = CS%h - -! if (CS%diabatic_first) then -! call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_pre, h_temp) -! call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_temp, h_pre) -! else -! call update_h_vertical_flux(G, GV, -eatr, -ebtr, h_pre, h_temp) -! call update_h_horizontal_flux(G, GV, -uhtr, -vhtr, h_temp, h_pre) -! endif - - dt_iter = CS%offline_CSp%dt_offline if (CS%diabatic_first .and. CS%use_ALE_algorithm) then @@ -1565,79 +1539,83 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif !Diabatic first and ALE + h_new(:,:,:) = GV%Angstrom + ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method + ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) + ! to make sure that offline advection is monotonic and postive-definite - do iter=1,niter -!------------DIABATIC FIRST + x_before_y = (MOD(G%first_direction,2) == 0) + z_first = CS%diabatic_first - if (CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_beg*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif + do iter=1,CS%offline_CSp%num_off_iter - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + do k = 1, nz ; do j=js,je ; do i=is,ie + + eatr_sub(i,j,k) = eatr(i,j,k) + ebtr_sub(i,j,k) = ebtr(i,j,k) + uhtr_sub(i,j,k) = uhtr(i,j,k) + vhtr_sub(i,j,k) = vhtr(i,j,k) + + enddo; enddo ; enddo + ! Calculate 3d mass transports to be used in this iteration + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) + + if (z_first) then + ! Do vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) + do k = 1, nz ; do j=js,je ; do i=is,ie + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - endif - !-----------ADVECTION AND DIFFUSION - + ! Zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - call post_advection_fields( G, CS%offline_CSp, CS%diag, h_pre, uhtr_sub, vhtr_sub, CS%tv%T, CS%tv%S) - - if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-advection h", G, haloshift=1) - call uchksum(uhtr*GV%H_to_m,"Pre-advection uhtr", G, haloshift=1) - call vchksum(vhtr*GV%H_to_m,"Pre-advection vhtr", G, haloshift=1) - if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G, haloshift=1) - if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G, haloshift=1) - endif - do k = 1, nz ; do i = is, ie ; do j=js, je h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo - -! if (iter.eq.niter) then -! call advect_tracer(h_end, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & -! CS%tracer_adv_CSp, CS%tracer_Reg) -! else - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol) -! endif -! call tracer_hordiff(h_new, dt_iter, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x_sub, khdt_y_sub) - - ! Done with advection so now h_pre should be h_new + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is,ie ; do j=js,je h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - !------------DIABATIC AFTER - if (.not. CS%diabatic_first) then - if (CS%debug) then - call hchksum(h_adv*GV%H_to_m,"Pre-diabatic h", G, haloshift=1) - endif - ! Update h_new with convergence of vertical mass transports - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + if (.not. z_first) then + ! Do vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do j=js,je ; do i=is,ie + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + endif + + ! Update remaining transports + do k = 1, nz ; do j=js,je ; do i=is,ie + eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) + ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo + + ! Stop if we've depleted all the mastransports + if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) ==0.0) exit - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! Switch order of Strang split + z_first = .not. z_first + x_before_y = .not. x_before_y - ! We are now done with the vertical mass transports, so now h_pre is set as h_new - do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - endif ! diabatic second end do + if (is_root_pe()) print *, 'Number of iterations: ', iter + ! Tracer diffusion happens after the 3d advection call tracer_hordiff(h_end, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) @@ -1690,14 +1668,19 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif !Diabatic second and ALE h_temp = h_end-h_new - if (CS%offline_CSp%id_h_new) call post_data(CS%offline_CSp%id_h_new, h_new, CS%diag) + if (CS%offline_CSp%id_h_new>0) call post_data(CS%offline_CSp%id_h_new, h_new, CS%diag) if (CS%id_h>0) call post_data(CS%id_h, h_temp, CS%diag) - + if (CS%id_u>0) call post_data(CS%id_u, uhtr, CS%diag) + if (CS%id_v>0) call post_data(CS%id_v, vhtr, CS%diag) + if (CS%offline_CSp%id_eatr_dia>0) call post_data(CS%offline_CSp%id_eatr_dia, eatr, CS%diag) + if (CS%offline_CSp%id_ebtr_dia>0) call post_data(CS%offline_CSp%id_ebtr_dia, ebtr, CS%diag) call cpu_clock_end(id_clock_tracer) call disable_averaging(CS%diag) - CS%h = h_end + do i = is, ie ; do j = js, je ; do k=1,nz + CS%h(i,j,k) = h_end(i,j,k) + enddo ; enddo; enddo call pass_var(CS%h,G%Domain) end subroutine step_tracers diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 8305d7fbfd..b3f678df9c 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -164,7 +164,7 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) end subroutine post_advection_fields -! subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + ! subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & temp, salt, fluxes, optics, do_ale_in) type(ocean_grid_type), intent(inout) :: G @@ -216,16 +216,16 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields - call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'temp', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'salt', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) -! call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_snap,position=CENTER) + ! call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & + ! timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & @@ -251,7 +251,6 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr endif - ! Convert all transport from time-averages to total amounts ! uhtr = uhtr * dt ! vhtr = vhtr * dt @@ -267,7 +266,7 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr ! Scalar fields call pass_var(h_adv, G%Domain) -! call pass_var(h_old, G%Domain) + ! call pass_var(h_old, G%Domain) call pass_var(h_new, G%Domain) call pass_var(h_end, G%Domain) call pass_var(eatr, G%Domain) @@ -438,13 +437,17 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) do k = 1, nz do i=is,ie ; do j=js,je - h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & - ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) +! h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & +! ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) + h_new(i,j,k) = G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers - h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) +! h_new(i,j,k) = h_new(i,j,k) + & +! max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + + ! Convert back to thickness h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo @@ -471,25 +474,28 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do i=is,ie ! Top layer - h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)+ea(i,j,1) )) - h_new(i,j,1) = h_new(i,j,1) + & - max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,1) - h_pre(i,j,1)) + h_new(i,j,1) = h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1)) + ! h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)+ea(i,j,1) )) + ! h_new(i,j,1) = h_new(i,j,1) + & + ! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer - h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1))) - h_new(i,j,nz) = h_new(i,j,nz) + & - max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,nz) - h_pre(i,j,nz)) + h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) + ! h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) + ! h_new(i,j,nz) = h_new(i,j,nz) + & + ! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is,ie - h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1)))) - - h_new(i,j,k) = h_new(i,j,k) + & - max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,k) - h_pre(i,j,k)) + h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) +! h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & +! (eb(i,j,k) - ea(i,j,k+1)))) +! h_new(i,j,k) = h_new(i,j,k) + & +! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo @@ -499,5 +505,185 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) end subroutine update_h_vertical_flux + ! + ! subroutine offline_tracer_advection(G, GV, CS, uhr, vhr, ear, ebr, h_pre, dt_iter) + ! type(ocean_grid_type), pointer :: G + ! type(verticalGrid_type), pointer :: GV + ! type(offline_transport_CS), pointer :: CS !< control structure for MOM + ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr + ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ear + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ebr + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_pre + ! + ! ! Local variables + ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uhtr_sub + ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vhtr_sub + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: eatr_sub + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: ebtr_sub + ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_new, h_vol + ! integer :: i, j, k, m, is, ie, js, je, nz, iter, niter + ! ! Set index-related variables for fields on T-grid + ! is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + ! + ! h_new(:,:,:) = GV%Angstrom + ! ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method + ! ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) + ! ! to make sure that offline advection is monotonic and postive-definite + ! + ! + ! do iter=1,CS%offline_CSp%num_off_iter + ! do k = 1, nz ; do j=js,je ; do i=is,ie + ! + ! eatr_sub(i,j,k) = ear(i,j,k) + ! ebtr_sub(i,j,k) = ebr(i,j,k) + ! uhtr_sub(i,j,k) = uhr(i,j,k) + ! vhtr_sub(i,j,k) = vhr(i,j,k) + ! + ! enddo; enddo ; enddo + ! + ! ! Calculate 3d mass transports to be used in this iteration + ! call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) + ! + ! + ! !! Now start doing the split advection + ! ! Zonal and meridional advection + ! call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + ! do k = 1, nz ; do i = is, ie ; do j=js, je + ! h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + ! enddo; enddo; enddo + ! call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + ! CS%tracer_adv_CSp, CS%tracer_Reg, h_vol) + ! ! Done with horizontal so now h_pre should be h_new + ! do k = 1, nz ; do i=is,ie ; do j=js,je + ! h_pre(i,j,k) = h_new(i,j,k) + ! enddo ; enddo ; enddo + ! + ! !! Now do vertical advection + ! call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + ! call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + ! fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! ! We are now done with the vertical mass transports, so now h_new is h_sub + ! do k = 1, nz ; do j=js,je ; do i=is,ie + ! h_pre(i,j,k) = h_new(i,j,k) + ! enddo ; enddo ; enddo + ! + ! ! Update remaining transports + ! do k = 1, nz ; do j=js,je ; do i=is,ie + ! ear(i,j,k) = ear(i,j,k) - eatr_sub(i,j,k) + ! ebr(i,j,k) = ebr(i,j,k) - ebtr_sub(i,j,k) + ! uhr(I,j,k) = uhr(I,j,k) - uhtr_sub(I,j,k) + ! vhr(i,J,k) = vhr(i,J,k) - vhtr_sub(i,J,k) + ! enddo; enddo ; enddo + ! + ! end do + ! + ! end subroutine offline_tracer_advection + + subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + + ! Local variables + integer :: i, j, k, m, is, ie, js, je, nz + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux, scale_factor + real :: pos_flux, hvol, h_neglect + + ! In this subroutine, fluxes out of the box are scaled away if they deplete + ! the layer, note that we define the positive direction as flux out of the box. + ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs + ! to enforce the positive out convention + k = 1 + do j=js,je ; do i=is,ie + top_flux(i,j,k) = -ea(i,j,k) + bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) + enddo ; enddo + + do k = 2, nz-1 ; do j=js,je ; do i=is,ie + top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) + bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) + enddo ; enddo ; enddo + + k=nz + do j=js,je ; do i=is,ie + top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) + bottom_flux(i,j,k) = -eb(i,j,k) + enddo ; enddo + + + ! Calculate sum of positive fluxes (negatives applied to enforce convention) + ! in a given cell and scale it back if it would deplete a layer + do k = 1, nz ; do j=js,je ; do i=is,ie + + hvol = h_pre(i,j,k)*G%areaT(i,j) + pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & + max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & + max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + if (pos_flux>hvol .and. pos_flux>0.0) then + + h_neglect = GV%Angstrom * G%areaT(I,j) + scale_factor(i,j,k) = ( hvol )/pos_flux*0.8 + else + scale_factor(i,j,k) = 1.0 + endif + + enddo ; enddo ; enddo + + ! Scale vertical fluxes + k = 1 + do j=js,je ; do i=is,ie + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) + endif + if (bottom_flux(i,j,k)>0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor(i,j,k) + endif + enddo ; enddo + + do k = 2, nz-1 ; do j=js,je ; do i=is,ie + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor(i,j,k) + endif + if (bottom_flux(i,j,k) > 0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor(i,j,k) + endif + enddo ; enddo ; enddo + + k=nz + do j=js,je ; do i=is,ie + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor(i,j,k) + endif + if (bottom_flux(i,j,k) > 0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) + endif + enddo ; enddo + + ! Scale horizontal fluxes + do k = 2, nz-1 ; do j=js,je ; do i=is,ie + + if (uh(I,j,k)>0.0) uh(I,j,k) = uh(I,j,k)*scale_factor(i,j,k) + if (-uh(I-1,j,k)>0.0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor(i,j,k) + + if (vh(i,J,k)>0.0) vh(i,J,k) = vh(i,J,k)*scale_factor(i,j,k) + if (-vh(i,J-1,k)>0.0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor(i,j,k) + + enddo ; enddo ; enddo + + end subroutine limit_mass_flux_3d end module MOM_offline_transport diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 7694ec586b..60baf152cc 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -56,6 +56,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) integer, optional :: max_iter_in + logical, optional :: x_first_in type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers @@ -106,6 +107,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter = 2*INT(CEILING(dt/CS%dt)) + 1 if(present(max_iter_in)) max_iter = max_iter_in + if(present(x_first_in)) x_first = x_first_in call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) From c28bf428cb1ea3e5eb6532c502aa3d3e7e4aca75 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 9 Aug 2016 10:22:39 -0400 Subject: [PATCH 15/65] Found one small indexing error. Tracer now conserving to within algorithm accuracy using 1 and 5 day timesteps in the Baltic case --- src/core/MOM.F90 | 58 +++++++---- src/tracer/MOM_offline_control.F90 | 162 +++++++++++------------------ src/tracer/MOM_tracer_advect.F90 | 2 +- 3 files changed, 98 insertions(+), 124 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 7dc1294383..f7c890be58 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1437,7 +1437,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) temp_old, salt_old ! integer :: niter, iter real :: Inum_iter, dt_iter - real :: global_flux_sum + real :: hmix_min integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB @@ -1492,6 +1492,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre = CS%h dt_iter = CS%offline_CSp%dt_offline + hmix_min = CS%offline_CSp%hmix_min + if (CS%diabatic_first .and. CS%use_ALE_algorithm) then ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) @@ -1560,34 +1562,50 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo; enddo ; enddo ! Calculate 3d mass transports to be used in this iteration - call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, hmix_min, & + CS%offline_CSp%max_off_cfl) if (z_first) then - ! Do vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + ! First do vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub do k = 1, nz ; do j=js,je ; do i=is,ie h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - endif - ! Zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is, ie ; do j=js, je - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is,ie ; do j=js,je - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo + + ! Second zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) + do k = 1, nz ; do i = is, ie ; do j=js, je + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + endif if (.not. z_first) then - ! Do vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + + ! First zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) + do k = 1, nz ; do i = is, ie ; do j=js, je + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is,ie ; do j=js,je + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + ! Second vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub @@ -1604,8 +1622,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo - ! Stop if we've depleted all the mastransports - if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) ==0.0) exit + ! Stop if we've depleted all the mass transports + if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) == 0.0) exit ! Switch order of Strang split z_first = .not. z_first diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index b3f678df9c..829bb7110e 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -81,6 +81,8 @@ module MOM_offline_transport logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level + real :: hmix_min + real :: max_off_cfl ! These fields for preale are allocatable because they are not necessary for all runs real, allocatable, dimension(NIMEM_,NJMEM_,NKMEM_) :: & T_preale, & @@ -378,6 +380,12 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) "Number of iterations to subdivide the offline tracer advection and diffusion" ) call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & "Length of the offline timestep") + call get_param(param_file, "MOM_mixed_layer", "HMIX_MIN", CS%hmix_min, & + "The minimum mixed layer depth if the mixed layer depth \n"//& + "is determined dynamically.", units="m", default=0.0) + call get_param(param_file, "MOM_mixed_layer", "MAX_OFF_CFL", CS%max_off_cfl, & + "Maximum CFL when advection is done offline. This should be less than 1 \n", & + units="nondim", default=0.9) ! Concatenate offline directory and file names CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) @@ -421,13 +429,14 @@ function next_modulo_time(inidx, numtime) end function next_modulo_time - subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) + subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new, hmix_min) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new + real, intent(in) :: hmix_min ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -437,32 +446,42 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) do k = 1, nz do i=is,ie ; do j=js,je -! h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & -! ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - h_new(i,j,k) = G%areaT(i,j)*h_pre(i,j,k) + & - ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k))) + h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) +! h_new(i,j,k) = G%areaT(i,j)*h_pre(i,j,k) + & +! ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers -! h_new(i,j,k) = h_new(i,j,k) + & -! max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + h_new(i,j,k) = h_new(i,j,k) + & + max(GV%Angstrom, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo enddo +! +! do k=1, GV%nkml +! do i=is,ie ; do j=js,je +! +! h_new(i,j,k) = max(hmix_min/2, h_new(i,j,k)) +! +! enddo ; enddo +! enddo + end subroutine update_h_horizontal_flux - subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) + subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new, hmix_min) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new + real , intent(in) :: hmix_min ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -474,113 +493,45 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do i=is,ie ! Top layer - h_new(i,j,1) = h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1)) - ! h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2)+ea(i,j,1) )) - ! h_new(i,j,1) = h_new(i,j,1) + & - ! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,1) - h_pre(i,j,1)) + h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) + h_new(i,j,1) = h_new(i,j,1) + & + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer - h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) - ! h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) - ! h_new(i,j,nz) = h_new(i,j,nz) + & - ! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,nz) - h_pre(i,j,nz)) +! h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) + h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) + h_new(i,j,nz) = h_new(i,j,nz) + & + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is,ie - h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1))) -! h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & -! (eb(i,j,k) - ea(i,j,k+1)))) -! h_new(i,j,k) = h_new(i,j,k) + & -! max(0.0, 1.0e-13/G%areaT(i,j)*h_new(i,j,k) - h_pre(i,j,k)) +! h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & +! (eb(i,j,k) - ea(i,j,k+1))) + h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1)))) + h_new(i,j,k) = h_new(i,j,k) + & + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo - enddo +! do k=1, GV%nkml +! do i=is,ie ; do j=js,je +! +! h_new(i,j,k) = max(hmix_min/2, h_new(i,j,k)) +! +! enddo ; enddo +! enddo + end subroutine update_h_vertical_flux - ! - ! subroutine offline_tracer_advection(G, GV, CS, uhr, vhr, ear, ebr, h_pre, dt_iter) - ! type(ocean_grid_type), pointer :: G - ! type(verticalGrid_type), pointer :: GV - ! type(offline_transport_CS), pointer :: CS !< control structure for MOM - ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhr - ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhr - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ear - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ebr - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_pre - ! - ! ! Local variables - ! real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: uhtr_sub - ! real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: vhtr_sub - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: eatr_sub - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: ebtr_sub - ! real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_new, h_vol - ! integer :: i, j, k, m, is, ie, js, je, nz, iter, niter - ! ! Set index-related variables for fields on T-grid - ! is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! - ! h_new(:,:,:) = GV%Angstrom - ! ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method - ! ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) - ! ! to make sure that offline advection is monotonic and postive-definite - ! - ! - ! do iter=1,CS%offline_CSp%num_off_iter - ! do k = 1, nz ; do j=js,je ; do i=is,ie - ! - ! eatr_sub(i,j,k) = ear(i,j,k) - ! ebtr_sub(i,j,k) = ebr(i,j,k) - ! uhtr_sub(i,j,k) = uhr(i,j,k) - ! vhtr_sub(i,j,k) = vhr(i,j,k) - ! - ! enddo; enddo ; enddo - ! - ! ! Calculate 3d mass transports to be used in this iteration - ! call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) - ! - ! - ! !! Now start doing the split advection - ! ! Zonal and meridional advection - ! call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - ! do k = 1, nz ; do i = is, ie ; do j=js, je - ! h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - ! enddo; enddo; enddo - ! call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - ! CS%tracer_adv_CSp, CS%tracer_Reg, h_vol) - ! ! Done with horizontal so now h_pre should be h_new - ! do k = 1, nz ; do i=is,ie ; do j=js,je - ! h_pre(i,j,k) = h_new(i,j,k) - ! enddo ; enddo ; enddo - ! - ! !! Now do vertical advection - ! call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - ! call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - ! fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! ! We are now done with the vertical mass transports, so now h_new is h_sub - ! do k = 1, nz ; do j=js,je ; do i=is,ie - ! h_pre(i,j,k) = h_new(i,j,k) - ! enddo ; enddo ; enddo - ! - ! ! Update remaining transports - ! do k = 1, nz ; do j=js,je ; do i=is,ie - ! ear(i,j,k) = ear(i,j,k) - eatr_sub(i,j,k) - ! ebr(i,j,k) = ebr(i,j,k) - ebtr_sub(i,j,k) - ! uhr(I,j,k) = uhr(I,j,k) - uhtr_sub(I,j,k) - ! vhr(i,J,k) = vhr(i,J,k) - vhtr_sub(i,J,k) - ! enddo; enddo ; enddo - ! - ! end do - ! - ! end subroutine offline_tracer_advection - - subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) + + subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cfl) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh @@ -588,6 +539,8 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + real, intent(in) :: hmix_min + real, intent(in) :: max_off_cfl ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -606,6 +559,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) k = 1 do j=js,je ; do i=is,ie top_flux(i,j,k) = -ea(i,j,k) + bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo @@ -629,10 +583,12 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) - if (pos_flux>hvol .and. pos_flux>0.0) then - h_neglect = GV%Angstrom * G%areaT(I,j) - scale_factor(i,j,k) = ( hvol )/pos_flux*0.8 + + if (pos_flux>hvol .and. pos_flux>0.0) then + h_neglect = GV%Angstrom*G%areaT(i,j) + h_neglect = 0.0 + scale_factor(i,j,k) = ( hvol - h_neglect )/pos_flux*max_off_cfl else scale_factor(i,j,k) = 1.0 endif @@ -674,7 +630,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) enddo ; enddo ! Scale horizontal fluxes - do k = 2, nz-1 ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js,je ; do i=is,ie if (uh(I,j,k)>0.0) uh(I,j,k) = uh(I,j,k)*scale_factor(i,j,k) if (-uh(I-1,j,k)>0.0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor(i,j,k) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 60baf152cc..11ac61fc08 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -107,7 +107,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter = 2*INT(CEILING(dt/CS%dt)) + 1 if(present(max_iter_in)) max_iter = max_iter_in - if(present(x_first_in)) x_first = x_first_in + if(present(x_first_in)) x_first = x_first_in call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) From 74777252488f51bf275e844fa5f2b5d3c3683a72 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 9 Aug 2016 14:45:28 -0400 Subject: [PATCH 16/65] Working out which halo updates aneed to be done. --- src/core/MOM.F90 | 46 +++++++++++++++++++++++------- src/tracer/MOM_offline_control.F90 | 16 ++--------- 2 files changed, 39 insertions(+), 23 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f7c890be58..c2ea7ec7ef 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1471,6 +1471,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_end(:,:,:) = GV%Angstrom temp_old(:,:,:) = 0.0 salt_old(:,:,:) = 0.0 + uhtr_sub(:,:,:) = 0.0 + vhtr_sub(:,:,:) = 0.0 + eatr_sub(:,:,:) = 0.0 + ebtr_sub(:,:,:) = 0.0 call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & @@ -1552,18 +1556,29 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do iter=1,CS%offline_CSp%num_off_iter - do k = 1, nz ; do j=js,je ; do i=is,ie + call pass_var(eatr,G%Domain) + call pass_var(ebtr,G%Domain) + call pass_var(h_pre,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) + call pass_var(ebtr,G%Domain) + do k = 1, nz ; do j=js,je ; do i=is,ie eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) - uhtr_sub(i,j,k) = uhtr(i,j,k) - vhtr_sub(i,j,k) = vhtr(i,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js,je ; do i=is-1,ie + uhtr_sub(I,j,k) = uhtr(I,j,k) + enddo; enddo ; enddo + do k = 1, nz ; do j=js-1,je ; do i=is,ie + vhtr_sub(i,J,k) = vhtr(i,J,k) enddo; enddo ; enddo ! Calculate 3d mass transports to be used in this iteration call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, hmix_min, & CS%offline_CSp%max_off_cfl) + call pass_vector(uhtr_sub, vhtr_sub, G%Domain) if (z_first) then ! First do vertical advection @@ -1575,7 +1590,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) do k = 1, nz ; do i = is, ie ; do j=js, je @@ -1583,11 +1597,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo; enddo; enddo call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is,ie ; do j=js,je h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + endif if (.not. z_first) then @@ -1604,6 +1620,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & @@ -1612,30 +1629,39 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do k = 1, nz ; do j=js,je ; do i=is,ie h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + + endif ! Update remaining transports do k = 1, nz ; do j=js,je ; do i=is,ie eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js,je ; do i=is-1,ie uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo - ! Stop if we've depleted all the mass transports - if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) == 0.0) exit + do k = 1, nz ; do j=js-1,je ; do i=is,ie + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo +! +! ! Stop if we've depleted all the mass transports +! if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) == 0.0) exit ! Switch order of Strang split z_first = .not. z_first x_before_y = .not. x_before_y - end do + call pass_var(h_pre, G%Domain) if (is_root_pe()) print *, 'Number of iterations: ', iter ! Tracer diffusion happens after the 3d advection - call tracer_hordiff(h_end, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & + + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) if (.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then @@ -1699,7 +1725,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do i = is, ie ; do j = js, je ; do k=1,nz CS%h(i,j,k) = h_end(i,j,k) enddo ; enddo; enddo - call pass_var(CS%h,G%Domain) + end subroutine step_tracers diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 829bb7110e..a976874945 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -218,9 +218,9 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields - call read_data(CS%snap_file, 'temp', temp, domain=G%Domain%mpp_domain, & + call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%snap_file, 'salt', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) @@ -252,15 +252,6 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr endif - - ! Convert all transport from time-averages to total amounts - ! uhtr = uhtr * dt - ! vhtr = vhtr * dt - ! eatr = eatr * dt - ! ebtr = ebtr * dt - ! khdt_x = khdt_x * dt - ! khdt_y = khdt_y * dt - !! Make sure all halos have been updated ! Vector fields call pass_vector(uhtr, vhtr, G%Domain) @@ -448,8 +439,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new, hmix_min) h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) -! h_new(i,j,k) = G%areaT(i,j)*h_pre(i,j,k) + & -! ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k))) + ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers From 33836c6f1a7d37bff09d7998ab992018f4af92f0 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 9 Aug 2016 16:07:33 -0400 Subject: [PATCH 17/65] Extended calculation slightly into the halo region --- src/core/MOM.F90 | 16 +++++++++------- src/tracer/MOM_offline_control.F90 | 6 ++++-- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c2ea7ec7ef..a27bf2430e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1550,6 +1550,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) ! to make sure that offline advection is monotonic and postive-definite + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first @@ -1567,11 +1569,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ebtr_sub(i,j,k) = ebtr(i,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js,je ; do i=is-1,ie + do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js-1,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie vhtr_sub(i,J,k) = vhtr(i,J,k) enddo; enddo ; enddo @@ -1639,11 +1641,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js,je ; do i=is-1,ie + do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js-1,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo ! @@ -1659,10 +1661,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre, G%Domain) if (is_root_pe()) print *, 'Number of iterations: ', iter - ! Tracer diffusion happens after the 3d advection + ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x, khdt_y) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) if (.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then ! Regridding/remapping is done here, at end of thermodynamics time step diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index a976874945..68e86e6c6a 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -619,15 +619,17 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf endif enddo ; enddo + call pass_var(scale_factor,G%Domain) ! Scale horizontal fluxes - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 if (uh(I,j,k)>0.0) uh(I,j,k) = uh(I,j,k)*scale_factor(i,j,k) if (-uh(I-1,j,k)>0.0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor(i,j,k) + enddo ; enddo ; enddo + do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie if (vh(i,J,k)>0.0) vh(i,J,k) = vh(i,J,k)*scale_factor(i,j,k) if (-vh(i,J-1,k)>0.0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor(i,j,k) - enddo ; enddo ; enddo end subroutine limit_mass_flux_3d From 378c62323425a04379f23a2adb33c5ae6d8d96f2 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 9 Aug 2016 17:07:21 -0400 Subject: [PATCH 18/65] Confirmed working convergence with online/offline global --- src/core/MOM.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a27bf2430e..2f8c2b077a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1494,7 +1494,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(:,:,:) = GV%Angstrom h_pre = CS%h - dt_iter = CS%offline_CSp%dt_offline hmix_min = CS%offline_CSp%hmix_min From d9533d58ec89db3347de7f3a44b8e8af8e65e403 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 9 Aug 2016 18:37:47 -0400 Subject: [PATCH 19/65] Started cleaning up the code, but now it no longer converges. Need to check with previous commit to see where mistake was made --- src/core/MOM.F90 | 45 ++----- .../vertical/MOM_diabatic_driver.F90 | 16 +-- src/tracer/MOM_offline_control.F90 | 124 ++++-------------- 3 files changed, 41 insertions(+), 144 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a27bf2430e..3623e730ec 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -702,7 +702,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, CS%tv, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, G, GV, CS%diabatic_CSp, CS%offline_CSp) + dtdia, G, GV, CS%diabatic_CSp) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1045,7 +1045,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, CS%tv, fluxes, CS%visc, CS%ADp, CS%CDp, & - CS%dt_trans, G, GV, CS%diabatic_CSp, CS%offline_CSp) + CS%dt_trans, G, GV, CS%diabatic_CSp) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1424,12 +1424,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! one time step (m for Bouss, kg/m^2 for non-Bouss) eatr_sub, & ebtr_sub, & - h_beg, & ! Layer thickness before diapycnal entrainment - ! (m for Bouss, kg/m^2 for non-Bouss) h_new, & ! Layer thickness after diapycnal entrainment ! (m for Bouss, kg/m^2 for non-Bouss) - h_adv, & ! Layer thickness after diapycnal entrainment - ! (m for Bouss, kg/m^2 for non-Bouss) h_end, & h_vol, & h_pre, & @@ -1437,7 +1433,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) temp_old, salt_old ! integer :: niter, iter real :: Inum_iter, dt_iter - real :: hmix_min integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB @@ -1465,9 +1460,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) khdt_y(:,:) = 0.0 eatr(:,:,:) = 0.0 ebtr(:,:,:) = 0.0 - h_beg(:,:,:) = GV%Angstrom + h_pre(:,:,:) = GV%Angstrom h_new(:,:,:) = GV%Angstrom - h_adv(:,:,:) = GV%Angstrom h_end(:,:,:) = GV%Angstrom temp_old(:,:,:) = 0.0 salt_old(:,:,:) = 0.0 @@ -1479,10 +1473,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & CS%diag) -! call transport_by_files(G, CS%offline_CSp, h_beg, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & -! khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) - call transport_by_files(G, CS%offline_CSp, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, & - khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%diabatic_CSp%optics, CS%use_ALE_algorithm) + + call transport_by_files(G, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & + khdt_x, khdt_y, temp_old, salt_old, CS%use_ALE_algorithm) Inum_iter = 1./real(niter) dt_iter = CS%offline_CSp%dt_offline*Inum_iter @@ -1492,11 +1485,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(CS%T,G%Domain) call pass_var(CS%S,G%Domain) - h_pre(:,:,:) = GV%Angstrom h_pre = CS%h - dt_iter = CS%offline_CSp%dt_offline - - hmix_min = CS%offline_CSp%hmix_min if (CS%diabatic_first .and. CS%use_ALE_algorithm) then ! Regridding/remapping is done here, at end of thermodynamics time step @@ -1578,13 +1567,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo; enddo ; enddo ! Calculate 3d mass transports to be used in this iteration - call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, hmix_min, & + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & CS%offline_CSp%max_off_cfl) call pass_vector(uhtr_sub, vhtr_sub, G%Domain) if (z_first) then ! First do vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub @@ -1593,7 +1582,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo ; enddo ; enddo ! Second zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is, ie ; do j=js, je h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo @@ -1605,13 +1594,12 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - endif if (.not. z_first) then ! First zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) do k = 1, nz ; do i = is, ie ; do j=js, je h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo @@ -1624,7 +1612,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Second vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub @@ -1648,19 +1636,14 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo -! -! ! Stop if we've depleted all the mass transports -! if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) == 0.0) exit - ! Switch order of Strang split + ! Switch order of Strang split every iteration z_first = .not. z_first x_before_y = .not. x_before_y end do call pass_var(h_pre, G%Domain) - if (is_root_pe()) print *, 'Number of iterations: ', iter - ! Tracer diffusion Strang split between advection and diffusion call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & @@ -1714,12 +1697,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif !Diabatic second and ALE h_temp = h_end-h_new - if (CS%offline_CSp%id_h_new>0) call post_data(CS%offline_CSp%id_h_new, h_new, CS%diag) if (CS%id_h>0) call post_data(CS%id_h, h_temp, CS%diag) if (CS%id_u>0) call post_data(CS%id_u, uhtr, CS%diag) if (CS%id_v>0) call post_data(CS%id_v, vhtr, CS%diag) - if (CS%offline_CSp%id_eatr_dia>0) call post_data(CS%offline_CSp%id_eatr_dia, eatr, CS%diag) - if (CS%offline_CSp%id_ebtr_dia>0) call post_data(CS%offline_CSp%id_ebtr_dia, ebtr, CS%diag) + call cpu_clock_end(id_clock_tracer) call disable_averaging(CS%diag) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 33692d177e..da0c875de1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -57,7 +57,6 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speeds use time_manager_mod, only : increment_time ! for testing itides (BDM) -use MOM_offline_transport, only : offline_transport_CS, post_diabatic_fields implicit none ; private @@ -214,7 +213,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_CSp) +subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) @@ -228,7 +227,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations real, intent(in) :: dt !< time increment (seconds) type(diabatic_CS), pointer :: CS !< module control structure - type(offline_transport_CS), pointer :: offline_CSp !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & ea, & ! amount of fluid entrained from the layer above within @@ -318,6 +316,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ ! (H units = m for Bouss, kg/m^2 for non-Bouss). real :: dt_mix ! amount of time over which to apply mixing (seconds) real :: Idt ! inverse time step (1/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth integer :: num_z_diags ! number of diagnostics to be interpolated to depth @@ -1105,12 +1104,9 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo enddo - ! Post the fields used for tracers here - call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb ) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) - elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers do j=js,je ; do i=is,ie @@ -1131,13 +1127,10 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb) call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) - else - call post_diabatic_fields( G, offline_CSp, CS%diag, hold, h, ea, eb) call call_tracer_column_fns(hold, h, ea, eb, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp) @@ -1354,8 +1347,9 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS, offline_ if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + write_all_3dt = 1. + if (CS%id_ea > 0) call post_data(CS%id_ea, eatr, CS%diag, mask = write_all_3dt) + if (CS%id_eb > 0) call post_data(CS%id_eb, ebtr, CS%diag, mask = write_all_3dt) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 68e86e6c6a..f6401e8879 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -81,7 +81,6 @@ module MOM_offline_transport logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level - real :: hmix_min real :: max_off_cfl ! These fields for preale are allocatable because they are not necessary for all runs real, allocatable, dimension(NIMEM_,NJMEM_,NKMEM_) :: & @@ -98,13 +97,8 @@ module MOM_offline_transport integer :: num_off_iter integer :: & - id_h_new = -1, & - id_h_old = -1, & - id_h_preadv = -1, & id_uhtr_preadv = -1, & id_vhtr_preadv = -1, & - id_eatr_dia = -1, & - id_ebtr_dia = -1, & id_temp_preadv = -1, & id_salt_preadv = -1 @@ -113,31 +107,15 @@ module MOM_offline_transport #include "MOM_memory.h" #include "version_variable.h" public offline_transport_init - public post_diabatic_fields public post_advection_fields + public transport_by_files + public register_diags_offline_transport + public update_h_horizontal_flux + public update_h_vertical_flux + public limit_mass_flux_3d contains - ! Called from call_tracer_column_fns to make sure that all the terms in the - ! diabatic driver routine are the same online and offline - subroutine post_diabatic_fields( G, CS, diag, h_old, h_new, eatr, ebtr ) - - type(ocean_grid_type), intent(in) :: G - type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), intent(inout) :: diag - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, & - eatr, ebtr - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt - write_all_3dt = 1. - - if (CS%id_h_old>0) call post_data(CS%id_h_old, h_old, diag, mask = write_all_3dt ) - if (CS%id_h_new>0) call post_data(CS%id_h_new, h_new, diag, mask = write_all_3dt ) - if (CS%id_eatr_dia>0) call post_data(CS%id_eatr_dia, eatr, diag, mask = write_all_3dt) - if (CS%id_ebtr_dia>0) call post_data(CS%id_ebtr_dia, ebtr, diag, mask = write_all_3dt) - - end subroutine post_diabatic_fields - ! Called right before tracer_advect call in MOM.F90 to ensure that all terms ! in the tracer advection routine are the same online and offline subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) @@ -158,21 +136,19 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) write_all_3du = 1. write_all_3dv = 1. - if (CS%id_h_preadv>0) call post_data(CS%id_h_preadv, h_adv, diag, mask = write_all_3dt ) - if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) - if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) - if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) - if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) + + if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) + if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) + if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) + if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) end subroutine post_advection_fields ! subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, fluxes, optics, do_ale_in) + subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + temp, salt, do_ale_in) type(ocean_grid_type), intent(inout) :: G type(offline_transport_CS), intent(inout) :: CS - type(forcing), intent(inout) :: fluxes - type(optics_type), intent(inout) :: optics logical, optional :: do_ale_in !! Mandatory variables @@ -188,7 +164,7 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr real, dimension(SZI_(G),SZJB_(G)) :: khdt_y ! Fields at T-point real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & - h_new, h_adv, h_end, & + h_end, & eatr, ebtr, & temp, salt logical :: do_ale @@ -212,9 +188,9 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr call read_data(CS%sum_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) ! T-grid - call read_data(CS%sum_file, 'eatr_dia_sum', eatr, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file, 'ea_sum', eatr, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%sum_file, 'ebtr_dia_sum', ebtr, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file, 'eb_sum', ebtr, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields @@ -224,12 +200,6 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) - call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - ! call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & - ! timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) @@ -258,9 +228,6 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr call pass_vector(khdt_x, khdt_y, G%Domain) ! Scalar fields - call pass_var(h_adv, G%Domain) - ! call pass_var(h_old, G%Domain) - call pass_var(h_new, G%Domain) call pass_var(h_end, G%Domain) call pass_var(eatr, G%Domain) call pass_var(ebtr, G%Domain) @@ -302,23 +269,11 @@ subroutine register_diags_offline_transport(Time, diag, CS) 'Accumulated meridional thickness fluxes to advect tracers', 'kg') ! T-cell fields - CS%id_h_preadv = register_diag_field('ocean_model', 'h_preadv', diag%axesTL, Time, & - 'Layer Thickness prior to advection', 'm', v_cell_method = 'sum') - CS%id_h_old = register_diag_field('ocean_model', 'h_old', diag%axesTL, Time, & - 'Layer Thickness before diabatic', 'm', v_cell_method = 'sum') - CS%id_h_new = register_diag_field('ocean_model', 'h_new', diag%axesTL, Time, & - 'Layer Thickness after diabatic', 'm', v_cell_method = 'sum') - CS%id_eatr_dia = register_diag_field('ocean_model', 'eatr_dia', diag%axesTL, Time, & - 'Entrainment from layer above', 'kg') - CS%id_ebtr_dia = register_diag_field('ocean_model', 'ebtr_dia', diag%axesTL, Time, & - 'Entrainment from layer below', 'kg') CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & 'Temperature prior to advection', 'C') CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & 'Salinity prior to advection', 'S') - - end subroutine register_diags_offline_transport subroutine offline_transport_init(param_file, CS, do_ale, G, GV) @@ -371,9 +326,6 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) "Number of iterations to subdivide the offline tracer advection and diffusion" ) call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & "Length of the offline timestep") - call get_param(param_file, "MOM_mixed_layer", "HMIX_MIN", CS%hmix_min, & - "The minimum mixed layer depth if the mixed layer depth \n"//& - "is determined dynamically.", units="m", default=0.0) call get_param(param_file, "MOM_mixed_layer", "MAX_OFF_CFL", CS%max_off_cfl, & "Maximum CFL when advection is done offline. This should be less than 1 \n", & units="nondim", default=0.9) @@ -415,19 +367,17 @@ function next_modulo_time(inidx, numtime) if (read_index < 0) read_index = inidx-read_index if (read_index == 0) read_index = numtime - next_modulo_time = read_index end function next_modulo_time - subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new, hmix_min) + subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new - real, intent(in) :: hmix_min ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -451,27 +401,15 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new, hmix_min) enddo ; enddo enddo -! -! do k=1, GV%nkml -! do i=is,ie ; do j=js,je -! -! h_new(i,j,k) = max(hmix_min/2, h_new(i,j,k)) -! -! enddo ; enddo -! enddo - - end subroutine update_h_horizontal_flux - - subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new, hmix_min) + subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_new - real , intent(in) :: hmix_min ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -498,30 +436,18 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new, hmix_min) ! Interior layers do k=2,nz-1 ; do i=is,ie -! h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & -! (eb(i,j,k) - ea(i,j,k+1))) h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1)))) h_new(i,j,k) = h_new(i,j,k) + & max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) - enddo ; enddo enddo -! do k=1, GV%nkml -! do i=is,ie ; do j=js,je -! -! h_new(i,j,k) = max(hmix_min/2, h_new(i,j,k)) -! -! enddo ; enddo -! enddo - - end subroutine update_h_vertical_flux - subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cfl) + subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh @@ -529,7 +455,6 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre - real, intent(in) :: hmix_min real, intent(in) :: max_off_cfl ! Local variables @@ -549,7 +474,6 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf k = 1 do j=js,je ; do i=is,ie top_flux(i,j,k) = -ea(i,j,k) - bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo @@ -574,18 +498,17 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) - if (pos_flux>hvol .and. pos_flux>0.0) then - h_neglect = GV%Angstrom*G%areaT(i,j) - h_neglect = 0.0 - scale_factor(i,j,k) = ( hvol - h_neglect )/pos_flux*max_off_cfl - else + scale_factor(i,j,k) = ( hvol )/pos_flux*max_off_cfl + else ! Don't scale scale_factor(i,j,k) = 1.0 endif enddo ; enddo ; enddo - ! Scale vertical fluxes + call pass_var(scale_factor,G%Domain) + + ! Scale vertical fluxes based on the sign of top and bottom flux k = 1 do j=js,je ; do i=is,ie if (top_flux(i,j,k) > 0.0) then @@ -619,7 +542,6 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf endif enddo ; enddo - call pass_var(scale_factor,G%Domain) ! Scale horizontal fluxes do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 From 331e26d56b95cbe1071ead45ea85fec034d98186 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 15 Aug 2016 11:33:12 -0400 Subject: [PATCH 20/65] Updated indexing to extend one point into the halo and added necessary halo updates --- src/core/MOM.F90 | 56 +++++---- src/tracer/MOM_offline_control.F90 | 116 ++++++++----------- src/tracer/MOM_tracer_advect.F90 | 178 ++++++++++++++++++----------- 3 files changed, 193 insertions(+), 157 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 2f8c2b077a..b3dab63745 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1416,6 +1416,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! V-2D real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub + real :: sum_abs_fluxes + ! Local variables real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & eatr, & ! Amount of fluid entrained from the layer above within @@ -1494,6 +1496,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(:,:,:) = GV%Angstrom h_pre = CS%h + call pass_var(h_pre,G%Domain) hmix_min = CS%offline_CSp%hmix_min @@ -1557,29 +1560,24 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) do iter=1,CS%offline_CSp%num_off_iter - call pass_var(eatr,G%Domain) - call pass_var(ebtr,G%Domain) - call pass_var(h_pre,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - - call pass_var(ebtr,G%Domain) - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr_sub(i,J,k) = vhtr(i,J,k) enddo; enddo ; enddo + ! Calculate 3d mass transports to be used in this iteration call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, hmix_min, & CS%offline_CSp%max_off_cfl) - call pass_vector(uhtr_sub, vhtr_sub, G%Domain) + if (z_first) then ! First do vertical advection @@ -1587,47 +1585,51 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + call pass_var(h_pre,G%Domain) ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) - do k = 1, nz ; do i = is, ie ; do j=js, je + + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is,ie ; do j=js,je + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + endif if (.not. z_first) then ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new, hmix_min) - do k = 1, nz ; do i = is, ie ; do j=js, je + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is,ie ; do j=js,je + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new, hmix_min) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -1635,21 +1637,29 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif ! Update remaining transports - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo + + call pass_var(eatr,G%Domain) + call pass_var(ebtr,G%Domain) + call pass_var(h_pre,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) ! -! ! Stop if we've depleted all the mass transports -! if ( (sum(eatr)+sum(ebtr)+sum(uhtr)+sum(vhtr)) == 0.0) exit + ! Stop if we've depleted all the mass transports + sum_abs_fluxes = sum(abs(eatr))+sum(abs(eatr))+sum(abs(ebtr))+sum(abs(uhtr))+sum(abs(vhtr)) + call sum_across_PEs(sum_abs_fluxes) + + if ( sum_abs_fluxes == 0.0) exit ! Switch order of Strang split z_first = .not. z_first diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 68e86e6c6a..45c15e2c10 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -224,12 +224,12 @@ subroutine transport_by_files(G, CS, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) - call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) +! call read_data(CS%snap_file, 'h_new', h_new, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_snap,position=CENTER) ! call read_data(CS%snap_file, 'h_old', h_old, domain=G%Domain%mpp_domain, & ! timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) +! call read_data(CS%snap_file, 'h_preadv', h_adv, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_snap,position=CENTER) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) @@ -435,7 +435,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new, hmix_min) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do k = 1, nz - do i=is,ie ; do j=js,je + do i=is-1,ie+1 ; do j=js-1,je+1 h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) @@ -479,8 +479,8 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new, hmix_min) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Update h_new with convergence of vertical mass transports - do j=js,je - do i=is,ie + do j=js-1,je+1 + do i=is-1,ie+1 ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) @@ -496,7 +496,7 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new, hmix_min) enddo ! Interior layers - do k=2,nz-1 ; do i=is,ie + do k=2,nz-1 ; do i=is-1,ie+1 ! h_new(i,j,k) = h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & ! (eb(i,j,k) - ea(i,j,k+1))) @@ -534,8 +534,8 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux, scale_factor - real :: pos_flux, hvol, h_neglect + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux + real :: pos_flux, hvol, h_neglect, scale_factor ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. @@ -547,19 +547,18 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention k = 1 - do j=js,je ; do i=is,ie + do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -ea(i,j,k) - bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo - do k = 2, nz-1 ; do j=js,je ; do i=is,ie + do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo ; enddo k=nz - do j=js,je ; do i=is,ie + do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) bottom_flux(i,j,k) = -eb(i,j,k) enddo ; enddo @@ -567,70 +566,51 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, hmix_min, max_off_cf ! Calculate sum of positive fluxes (negatives applied to enforce convention) ! in a given cell and scale it back if it would deplete a layer - do k = 1, nz ; do j=js,je ; do i=is,ie + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 hvol = h_pre(i,j,k)*G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) - if (pos_flux>hvol .and. pos_flux>0.0) then - h_neglect = GV%Angstrom*G%areaT(i,j) - h_neglect = 0.0 - scale_factor(i,j,k) = ( hvol - h_neglect )/pos_flux*max_off_cfl - else - scale_factor(i,j,k) = 1.0 - endif - - enddo ; enddo ; enddo - - ! Scale vertical fluxes - k = 1 - do j=js,je ; do i=is,ie - if (top_flux(i,j,k) > 0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) + scale_factor = ( hvol )/pos_flux*max_off_cfl + else ! Don't scale + scale_factor = 1.0 endif - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor(i,j,k) - endif - enddo ; enddo - do k = 2, nz-1 ; do j=js,je ; do i=is,ie - if (top_flux(i,j,k) > 0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor(i,j,k) - endif - if (bottom_flux(i,j,k) > 0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor(i,j,k) + ! Scale horizontal fluxes + if (-uh(I-1,j,k)>0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor + if (uh(I,j,k)>0) uh(I,j,k) = uh(I,j,k)*scale_factor + if (-vh(i,J-1,k)>0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor + if (vh(i,J,k)>0) vh(i,J,k) = vh(i,J,k)*scale_factor + + if (k>1 .and. k0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor + endif + if(bottom_flux(i,j,k)>0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor + endif + ! Scale top layer + elseif (k==1) then + if(top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor + if(bottom_flux(i,j,k)>0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor + endif + ! Scale bottom layer + elseif (k==nz) then + if(top_flux(i,j,k)>0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor + endif + if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor endif - enddo ; enddo ; enddo - - k=nz - do j=js,je ; do i=is,ie - if (top_flux(i,j,k) > 0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor(i,j,k) - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor(i,j,k) - endif - if (bottom_flux(i,j,k) > 0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor(i,j,k) - endif - enddo ; enddo - - call pass_var(scale_factor,G%Domain) - ! Scale horizontal fluxes - do k = 1, nz ; do j=js,je ; do i=is-1,ie+1 - - if (uh(I,j,k)>0.0) uh(I,j,k) = uh(I,j,k)*scale_factor(i,j,k) - if (-uh(I-1,j,k)>0.0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor(i,j,k) - enddo ; enddo ; enddo - - do k = 1, nz ; do j=js-1,je+1 ; do i=is,ie - if (vh(i,J,k)>0.0) vh(i,J,k) = vh(i,J,k)*scale_factor(i,j,k) - if (-vh(i,J-1,k)>0.0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor(i,j,k) - enddo ; enddo ; enddo + enddo ; enddo; enddo end subroutine limit_mass_flux_3d diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 11ac61fc08..d0570bc8ea 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, skip_limiter_in) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -57,6 +57,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) integer, optional :: max_iter_in logical, optional :: x_first_in + logical, optional :: skip_limiter_in type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers @@ -83,6 +84,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, itt, ntr, do_any integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB + logical :: skip_limiter domore_u(:,:) = .false. domore_v(:,:) = .false. @@ -108,7 +110,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, if(present(max_iter_in)) max_iter = max_iter_in if(present(x_first_in)) x_first = x_first_in - + skip_limiter = .false. + if(present(skip_limiter_in)) skip_limiter = skip_limiter_in call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) call create_group_pass(CS%pass_uhr_vhr_t_hprev, hprev, G%Domain) @@ -248,11 +251,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, skip_limiter) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM) + isv, iev, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -262,11 +265,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM) + isv, iev, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -300,7 +303,7 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM) + is, ie, js, je, k, G, GV, usePPM, skip_limiter_in) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV type(tracer_type), dimension(ntr), intent(inout) :: Tr @@ -312,6 +315,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, intent(in) :: Idt integer, intent(in) :: ntr, is, ie, js, je,k logical, intent(in) :: usePPM + logical, optional :: skip_limiter_in real, dimension(SZIB_(G),ntr) :: & slope_x, & ! The concentration slope per grid point in units of @@ -336,7 +340,10 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & logical :: do_any_i integer :: i, j, m real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 - logical :: usePLMslope + logical :: usePLMslope, skip_limiter + + skip_limiter = .false. + if(present(skip_limiter_in)) skip_limiter = skip_limiter_in usePLMslope = .not. usePPM @@ -375,40 +382,60 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePLMslope - ! Calculate the i-direction fluxes of each tracer, using as much - ! the minimum of the remaining mass flux (uhr) and the half the mass - ! in the cell plus whatever part of its half of the mass flux that - ! the flux through the other side does not require. - do I=is-1,ie - if (uhr(I,j,k) == 0.0) then - uhh(I) = 0.0 - CFL(I) = 0.0 - elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h - hlos = MAX(0.0,uhr(I+1,j,k)) - if (((hup + uhr(I,j,k) - hlos) < 0.0) .and. & - ((0.5*hup + uhr(I,j,k)) < 0.0)) then !### Add parentheses. - uhh(I) = MIN(-0.5*hup,-hup+hlos,0.0) - domore_u(j,k) = .true. + if (.not. skip_limiter) then + ! Calculate the i-direction fluxes of each tracer, using as much + ! the minimum of the remaining mass flux (uhr) and the half the mass + ! in the cell plus whatever part of its half of the mass flux that + ! the flux through the other side does not require. + do I=is-1,ie + if (uhr(I,j,k) == 0.0) then + uhh(I) = 0.0 + CFL(I) = 0.0 + elseif (uhr(I,j,k) < 0.0) then + hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h + hlos = MAX(0.0,uhr(I+1,j,k)) + if (((hup + uhr(I,j,k) - hlos) < 0.0) .and. & + ((0.5*hup + uhr(I,j,k)) < 0.0)) then !### Add parentheses. + uhh(I) = MIN(-0.5*hup,-hup+hlos,0.0) + domore_u(j,k) = .true. + else + uhh(I) = uhr(I,j,k) + endif + !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) + CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive else - uhh(I) = uhr(I,j,k) + hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-uhr(I-1,j,k)) + if (((hup - uhr(I,j,k) - hlos) < 0.0) .and. & + ((0.5*hup - uhr(I,j,k)) < 0.0)) then !### Add parentheses. + uhh(I) = MAX(0.5*hup,hup-hlos,0.0) + domore_u(j,k) = .true. + else + uhh(I) = uhr(I,j,k) + endif + !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) + CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive endif - !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) - CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive - else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-uhr(I-1,j,k)) - if (((hup - uhr(I,j,k) - hlos) < 0.0) .and. & - ((0.5*hup - uhr(I,j,k)) < 0.0)) then !### Add parentheses. - uhh(I) = MAX(0.5*hup,hup-hlos,0.0) - domore_u(j,k) = .true. - else - uhh(I) = uhr(I,j,k) + enddo + else ! Skip the limiter but retain the necessary quantities + do I=is-1,ie + if (uhr(I,j,k) == 0.0) then + uhh(I) = 0.0 + CFL(I) = 0.0 + elseif (uhr(I,j,k) < 0.0) then + uhh(I) = uhr(I,j,k) + !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) + CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive + domore_u(j,k) = .true. + else + uhh(I) = uhr(I,j,k) + !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) + CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive + domore_u(j,k) = .true. endif - !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) - CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive - endif - enddo + enddo + endif + if (usePPM) then do m=1,ntr ; do I=is-1,ie if (uhh(I) >= 0.0) then @@ -561,7 +588,7 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM) + is, ie, js, je, k, G, GV, usePPM, skip_limiter_in) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV type(tracer_type), dimension(ntr), intent(inout) :: Tr @@ -573,6 +600,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, intent(in) :: Idt integer, intent(in) :: ntr, is, ie, js, je,k logical, intent(in) :: usePPM + logical, optional :: skip_limiter_in real, dimension(SZI_(G),ntr,SZJB_(G)) :: & slope_y, & ! The concentration slope per grid point in units of @@ -598,7 +626,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & logical :: do_any_i integer :: i, j, m real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 - logical :: usePLMslope + logical :: usePLMslope, skip_limiter + + skip_limiter = .false. + if(present(skip_limiter_in)) skip_limiter = skip_limiter_in usePLMslope = .not. usePPM @@ -641,36 +672,51 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! the flux through the other side does not require. do J=js-1,je ; if (domore_v(J,k)) then domore_v(J,k) = .false. - do i=is,ie - if (vhr(i,J,k) == 0.0) then - vhh(i,J) = 0.0 - CFL(i) = 0.0 - elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h - hlos = MAX(0.0,vhr(i,J+1,k)) - if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & - ((0.5*hup + vhr(i,J,k)) < 0.0)) then - vhh(i,J) = MIN(-0.5*hup,-hup+hlos,0.0) - domore_v(J,k) = .true. + if(.not. skip_limiter) then + do i=is,ie + if (vhr(i,J,k) == 0.0) then + vhh(i,J) = 0.0 + CFL(i) = 0.0 + elseif (vhr(i,J,k) < 0.0) then + hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h + hlos = MAX(0.0,vhr(i,J+1,k)) + if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & + ((0.5*hup + vhr(i,J,k)) < 0.0)) then + vhh(i,J) = MIN(-0.5*hup,-hup+hlos,0.0) + domore_v(J,k) = .true. + else + vhh(i,J) = vhr(i,J,k) + endif + !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) + CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else - vhh(i,J) = vhr(i,J,k) + hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-vhr(i,J-1,k)) + if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & + ((0.5*hup - vhr(i,J,k)) < 0.0)) then + vhh(i,J) = MAX(0.5*hup,hup-hlos,0.0) + domore_v(J,k) = .true. + else + vhh(i,J) = vhr(i,J,k) + endif + !ts2(i) = 0.5*(1.0 - vhh(i,J) / (hprev(i,j,k)+h_neglect)) + CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive endif - !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) - CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive - else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-vhr(i,J-1,k)) - if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & - ((0.5*hup - vhr(i,J,k)) < 0.0)) then - vhh(i,J) = MAX(0.5*hup,hup-hlos,0.0) - domore_v(J,k) = .true. + enddo + else + do i=is,ie + if (vhr(i,J,k) == 0.0) then + vhh(i,J) = 0.0 + CFL(i) = 0.0 + elseif (vhr(i,J,k) < 0.0) then + vhh(i,J) = vhr(i,J,k) + CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive else vhh(i,J) = vhr(i,J,k) + CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive endif - !ts2(i) = 0.5*(1.0 - vhh(i,J) / (hprev(i,j,k)+h_neglect)) - CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive - endif - enddo + enddo + endif if (usePPM) then do m=1,ntr ; do i=is,ie if (vhh(i,J) >= 0.0) then From c30adb731d2ad597e9f86cc7fcdab1f4ea64e09a Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 18 Aug 2016 17:11:04 -0400 Subject: [PATCH 21/65] Added an update to eb so that when water is fluxed out of the ocean from a layer, passive tracers are also removed --- src/core/MOM.F90 | 110 +++++++++++------- .../vertical/MOM_diabatic_aux.F90 | 7 +- .../vertical/MOM_diabatic_driver.F90 | 12 +- src/tracer/MOM_offline_control.F90 | 57 ++++++++- src/tracer/MOM_tracer_hor_diff.F90 | 8 +- 5 files changed, 136 insertions(+), 58 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 54b1414fb0..9d8d959390 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -920,14 +920,14 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then call cpu_clock_begin(id_clock_thick_diff) - if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G, haloshift=0) + if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0) if (associated(CS%VarMix)) & call calc_slope_functions(h, CS%tv, dt, G, GV, CS%VarMix) call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, & CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) - if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G, haloshift=1) + if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1) call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) call do_group_pass(CS%pass_h, G%Domain) @@ -1452,6 +1452,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) niter = CS%offline_CSp%num_off_iter + Inum_iter = 1./real(niter) + dt_iter = CS%offline_CSp%dt_offline*Inum_iter ! T-cell pointer assignments @@ -1478,20 +1480,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & CS%diag) - call transport_by_files(G, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & + ! Read in all fields that might be used this timestep + call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, CS%use_ALE_algorithm) - Inum_iter = 1./real(niter) - dt_iter = CS%offline_CSp%dt_offline*Inum_iter - - CS%T = temp_old - CS%S = salt_old - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - - h_pre = CS%h - call pass_var(h_pre,G%Domain) - if (CS%diabatic_first .and. CS%use_ALE_algorithm) then ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) @@ -1509,20 +1501,21 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) endif CS%tv%T = temp_old @@ -1537,13 +1530,23 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, CS%dt_trans) + h_pre = CS%offline_CSp%h_preale; + call pass_var(h_pre,G%Domain) + + else !Not diabatic first or not ale + CS%T = temp_old + CS%S = salt_old + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) + h_pre = CS%h + call pass_var(h_pre,G%Domain) endif !Diabatic first and ALE h_new(:,:,:) = GV%Angstrom ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) - ! to make sure that offline advection is monotonic and postive-definite - + ! to make sure that offline advection is monotonic and positive-definite +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) @@ -1588,7 +1591,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 @@ -1605,7 +1608,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, 1, x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) @@ -1644,11 +1648,19 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) ! - ! Stop if we've depleted all the mass transports - sum_abs_fluxes = sum(abs(eatr))+sum(abs(eatr))+sum(abs(ebtr))+sum(abs(uhtr))+sum(abs(vhtr)) - call sum_across_PEs(sum_abs_fluxes) - - if ( sum_abs_fluxes == 0.0) exit + ! Stop if we've depleted all the mass transport by summing the remaining fluxes at each point + sum_abs_fluxes = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + +! call sum_across_PEs(sum_abs_fluxes) +! if (is_root_pe()) print *, "Remaining fluxes", sum_abs_fluxes +! if ( sum_abs_fluxes == 0.0) then +! print *, "Advection converged early at ", iter, "iterations" +! exit +! endif ! Switch order of Strang split every iteration z_first = .not. z_first @@ -1663,6 +1675,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) if (.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then + + h_temp = CS%offline_CSp%h_preale-h_pre ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. @@ -1679,20 +1693,21 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G, haloshift=1) + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G, haloshift=1) + call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) endif CS%tv%T = temp_old @@ -1707,12 +1722,18 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, CS%dt_trans) + h_new = CS%offline_CSp%h_preale + call pass_var(h_new,G%Domain) + endif !Diabatic second and ALE - h_temp = h_end-h_new - if (CS%id_h>0) call post_data(CS%id_h, h_temp, CS%diag) - if (CS%id_u>0) call post_data(CS%id_u, uhtr, CS%diag) - if (CS%id_v>0) call post_data(CS%id_v, vhtr, CS%diag) + + + if (CS%offline_CSp%id_hr>0) call post_data(CS%offline_CSp%id_hr, h_temp, CS%diag) + if (CS%offline_CSp%id_uhr>0) call post_data(CS%offline_CSp%id_uhr, uhtr, CS%diag) + if (CS%offline_CSp%id_vhr>0) call post_data(CS%offline_CSp%id_vhr, vhtr, CS%diag) + if (CS%offline_CSp%id_ear>0) call post_data(CS%offline_CSp%id_ear, eatr, CS%diag) + if (CS%offline_CSp%id_ebr>0) call post_data(CS%offline_CSp%id_ebr, ebtr, CS%diag) call cpu_clock_end(id_clock_tracer) @@ -1722,6 +1743,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%h(i,j,k) = h_end(i,j,k) enddo ; enddo; enddo + call pass_var(CS%h,G%Domain) + + end subroutine step_tracers diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 587e55f6ce..1a2f4f2534 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -803,7 +803,7 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & +subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv, & aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(ocean_grid_type), intent(in) :: G !< Grid structure @@ -812,6 +812,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The entrainment distance at interfaces (H units) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< The entrainment distance at interfaces (H units) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics container !> If False, treat in/out fluxes separately. @@ -1072,6 +1073,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand h2d(i,k) = h2d(i,k) + dThickness ! New thickness + if (k>1) then + eb(i,j,k-1) = eb(i,j,k-1) + dThickness + endif + if (h2d(i,k) > 0.) then if (calculate_energetics) then ! Calculate the energy required to mix the newly added water over diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index ff5abbc8a3..e2ca78b1a3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -672,6 +672,8 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) do j=js,je ; do i=is,ie ea(i,j,1) = 0. + eb(i,j,1) = 0. + enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & !$OMP private(hval) @@ -724,7 +726,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%use_energetic_PBL) then call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - ea, h, tv, CS%aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) + ea, eb, h, tv, CS%aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) if (CS%debug) then call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0) @@ -775,7 +777,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - ea, h, tv, CS%aggregate_FW_forcing) + ea, eb, h, tv, CS%aggregate_FW_forcing) endif ! endif for CS%use_energetic_PBL @@ -1357,9 +1359,9 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - write_all_3dt = 1. - if (CS%id_ea > 0) call post_data(CS%id_ea, eatr, CS%diag, mask = write_all_3dt) - if (CS%id_eb > 0) call post_data(CS%id_eb, ebtr, CS%diag, mask = write_all_3dt) + write_all_3dt(:,:,:) = 1. + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag, mask = write_all_3dt) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag, mask = write_all_3dt) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 1e2035ec0e..0b845be4bc 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -100,7 +100,12 @@ module MOM_offline_transport id_uhtr_preadv = -1, & id_vhtr_preadv = -1, & id_temp_preadv = -1, & - id_salt_preadv = -1 + id_salt_preadv = -1, & + id_uhr = -1, & + id_vhr = -1, & + id_ear = -1, & + id_ebr = -1, & + id_hr = -1 end type offline_transport_CS @@ -144,10 +149,10 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) end subroutine post_advection_fields - ! subroutine transport_by_files(G, CS, h_old, h_new, h_adv, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & temp, salt, do_ale_in) type(ocean_grid_type), intent(inout) :: G + type(verticalGrid_type), intent(inout) :: GV type(offline_transport_CS), intent(inout) :: CS logical, optional :: do_ale_in @@ -168,10 +173,13 @@ subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt eatr, ebtr, & temp, salt logical :: do_ale + integer :: i, j, k, is, ie, js, je, nz do_ale = .false.; if (present(do_ale_in) ) do_ale = do_ale_in + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + call callTree_enter("transport_by_files, MOM_offline_control.F90") @@ -194,15 +202,32 @@ subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields - call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) +! ! Apply masks at T, U, and V points + do k=1,nz ; do j=js-1,je ; do i=is-1,ie + if (G%mask2dCu(i,j)<1.0) then + uhtr(I,j,k) = 0.0 + khdt_x(I,j) = 0.0; + endif + if (G%mask2dCv(i,j)<1.0) then + vhtr(i,J,k) = 0.0 + khdt_y(i,J) = 0.0; + endif + if (G%mask2dT(i,j)<1.0) then + h_end(i,j,k) = GV%Angstrom + eatr(i,j,k) = 0.0 + ebtr(i,j,k) = 0.0 + endif + enddo; enddo; enddo + if (do_ale) then CS%h_preale = 1.0e-10 CS%T_preale = 0.0 @@ -220,6 +245,18 @@ subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) + do k=1,nz ; do j=js-1,je ; do i=is-1,ie + if (G%mask2dCu(i,j)<1.0) then + CS%u_preale(I,j,k) = 0.0 + endif + if (G%mask2dCv(i,j)<1.0) then + CS%v_preale(I,j,k) = 0.0 + endif + if (G%mask2dT(i,j)<1.0) then + CS%h_preale(i,j,k) = GV%Angstrom + endif + enddo; enddo; enddo + endif !! Make sure all halos have been updated @@ -263,16 +300,26 @@ subroutine register_diags_offline_transport(Time, diag, CS) ! U-cell fields CS%id_uhtr_preadv = register_diag_field('ocean_model', 'uhtr_preadv', diag%axesCuL, Time, & 'Accumulated zonal thickness fluxes to advect tracers', 'kg') + CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & + 'Zonal thickness fluxes remaining at end of timestep', 'kg') ! V-cell fields CS%id_vhtr_preadv = register_diag_field('ocean_model', 'vhtr_preadv', diag%axesCvL, Time, & 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & + 'Meridional thickness fluxes remaining at end of timestep', 'kg') ! T-cell fields CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & 'Temperature prior to advection', 'C') CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & 'Salinity prior to advection', 'S') + CS%id_hr = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & + 'Difference between the stored and calculated layer thickness', 'm') + CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & + 'Remaining thickness entrained from above', 'm') + CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & + 'Remaining thickness entrained from below', 'm') end subroutine register_diags_offline_transport diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 5c5bfecd80..ae34c1ee0c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -475,10 +475,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if( CS%debug ) then - call uchksum(khdt_x,"After tracer diffusion khdt_x", G, haloshift=2) - call vchksum(khdt_y,"After tracer diffusion khdt_y", G, haloshift=2) - call uchksum(Coef_x,"After tracer diffusion Coef_x", G, haloshift=2) - call vchksum(Coef_y,"After tracer diffusion Coef_y", G, haloshift=2) + call uchksum(khdt_x,"After tracer diffusion khdt_x", G%HI, haloshift=2) + call vchksum(khdt_y,"After tracer diffusion khdt_y", G%HI, haloshift=2) + call uchksum(Coef_x,"After tracer diffusion Coef_x", G%HI, haloshift=2) + call vchksum(Coef_y,"After tracer diffusion Coef_y", G%HI, haloshift=2) endif write_all_2du = 1. ; write_all_2dv = 1. From a2bbd6809fc6cf7d11c44bf96d26dba56c80b9bb Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 24 Aug 2016 12:37:32 -0400 Subject: [PATCH 22/65] Syncing to git repository --- src/core/MOM.F90 | 4 +++- .../vertical/MOM_diabatic_aux.F90 | 15 +++++++++------ .../vertical/MOM_diabatic_driver.F90 | 17 +++++++++++------ 3 files changed, 23 insertions(+), 13 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b528b9f3df..4e056dca71 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1678,7 +1678,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) - if (.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then + if(.not. CS%use_ALE_algorithm) h_temp = h_end-h_pre + + if(.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then h_temp = CS%offline_CSp%h_preale-h_pre ! Regridding/remapping is done here, at end of thermodynamics time step diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1a2f4f2534..3d9e137b2f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -803,7 +803,7 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv, & +subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, hloss_boundary, tv, & aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(ocean_grid_type), intent(in) :: G !< Grid structure @@ -812,8 +812,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: ea !< The entrainment distance at interfaces (H units) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: eb !< The entrainment distance at interfaces (H units) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hloss_boundary !< Layer thickness lost in this + !< routine (H units) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics container !> If False, treat in/out fluxes separately. logical, intent(in) :: aggregate_FW_forcing @@ -842,7 +843,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv ! Pen_SW_bnd and netMassOut netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) nonpenSW ! non-downwelling SW, which is absorbed at ocean surface - real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d + real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d, hloss real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand @@ -897,6 +898,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv do k=1,nz ; do i=is,ie h2d(i,k) = h(i,j,k) T2d(i,k) = tv%T(i,j,k) + hloss(i,k) = 0.0 do n=1,nsw opacityBand(n,i,k) = (1.0 / GV%m_to_H)*optics%opacity_band(n,i,j,k) enddo @@ -1011,6 +1013,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv ! Update state hOld = h2d(i,k) ! Keep original thickness in hand h2d(i,k) = h2d(i,k) + dThickness ! New thickness + hloss(i,k) = dThickness if (h2d(i,k) > 0.0) then if (calculate_energetics .and. (dThickness > 0.)) then ! Calculate the energy required to mix the newly added water over @@ -1045,6 +1048,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv endif ! Change in state due to forcing + dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) dTemp = fractionOfForcing*netHeat(i) ! ### The 0.9999 here should become a run-time parameter? @@ -1073,9 +1077,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand h2d(i,k) = h2d(i,k) + dThickness ! New thickness - if (k>1) then - eb(i,j,k-1) = eb(i,j,k-1) + dThickness - endif + hloss(i,k) = hloss(i,k) + dThickness if (h2d(i,k) > 0.) then if (calculate_energetics) then @@ -1162,6 +1164,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, eb, h, tv do k=1,nz ; do i=is,ie h(i,j,k) = h2d(i,k) tv%T(i,j,k) = T2d(i,k) + hloss_boundary(i,j,k) = hloss(i,k) enddo ; enddo ! Diagnose heating (W/m2) applied to a grid cell from SW penetration diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index e2ca78b1a3..c7cd185c0a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -149,7 +149,7 @@ module MOM_diabatic_driver integer :: id_Tdif_z = -1, id_Tadv_z = -1, id_Sdif_z = -1, id_Sadv_z = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_brine_lay = -1 + integer :: id_subMLN2 = -1, id_brine_lay = -1, id_hloss_boundary integer :: id_diabatic_diff_temp_tend = -1 integer :: id_diabatic_diff_saln_tend = -1 @@ -245,7 +245,8 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after - v_h ! entrainment (m/s) + v_h, & ! entrainment (m/s) + hloss_boundary ! Change in layer thickness because of freshwater fluxes at the surfac real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) @@ -672,8 +673,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) do j=js,je ; do i=is,ie ea(i,j,1) = 0. - eb(i,j,1) = 0. - enddo ; enddo !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & !$OMP private(hval) @@ -726,7 +725,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%use_energetic_PBL) then call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - ea, eb, h, tv, CS%aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) + ea, h, hloss_boundary, tv, CS%aggregate_FW_forcing, cTKE, dSV_dT, dSV_dS) if (CS%debug) then call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0) @@ -760,6 +759,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int +! eb(i,j,k-1) = ea(i,j,k) Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics @@ -777,7 +777,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, dt, fluxes, CS%optics, & - ea, eb, h, tv, CS%aggregate_FW_forcing) + ea, h, hloss_boundary, tv, CS%aggregate_FW_forcing) endif ! endif for CS%use_energetic_PBL @@ -1362,6 +1362,9 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) write_all_3dt(:,:,:) = 1. if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag, mask = write_all_3dt) if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag, mask = write_all_3dt) + + if (CS%id_hloss_boundary > 0) call post_data(CS%id_hloss_boundary, hloss_boundary, CS%diag, mask = write_all_3dt) + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) @@ -1873,6 +1876,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Layer entrainment from above per timestep','meter') CS%id_eb = register_diag_field('ocean_model','eb',diag%axesTL,Time, & 'Layer entrainment from below per timestep', 'meter') + CS%id_hloss_boundary = register_diag_field('ocean_model','hloss_boundary',diag%axesTL,Time, & + 'Layer thickness lost/gained due to fluxes at the boundary', 'meter') CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & 'Zonal Acceleration from Diapycnal Mixing', 'meter second-2') CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & From cb898b034bed2b866ef7d7b84e15edcc274d102e Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 24 Aug 2016 12:38:20 -0400 Subject: [PATCH 23/65] Fixed a bug that led to nonconservation of passive tracers in ALE mode --- src/core/MOM.F90 | 6 +++--- .../vertical/MOM_diabatic_aux.F90 | 4 +++- .../vertical/MOM_diabatic_driver.F90 | 16 +++++++++++++++- src/tracer/MOM_offline_control.F90 | 4 ++-- src/tracer/MOM_tracer_registry.F90 | 2 +- 5 files changed, 24 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3623e730ec..58ef36917f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1512,7 +1512,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -1674,7 +1674,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, dt_iter) + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -1692,7 +1692,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! for vertical remapping may need to be regenerated. This needs to ! happen after the H update and before the next post_data. call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) + call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) endif !Diabatic second and ALE diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b11cd75421..bcb1aa0fa1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -945,7 +945,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & ! ea is for passive tracers do i=is,ie - ea(i,j,1) = netMassInOut(i) +! ea(i,j,1) = netMassInOut(i) if (aggregate_FW_forcing) then netMassOut(i) = netMassInOut(i) netMassIn(i) = 0. @@ -978,6 +978,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & Temp_in = T2d(i,k) Salin_in = 0.0 dTemp = dTemp + dThickness*Temp_in + ea(i,j,1) = dThickness ! Diagnostics of heat content associated with mass fluxes if (ASSOCIATED(fluxes%heat_content_massin)) & @@ -1045,6 +1046,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, tv, & ! Change in state due to forcing dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) + if (k.eq.1) ea(i,j,k) = ea(i,j,k) + dThickness dTemp = fractionOfForcing*netHeat(i) ! ### The 0.9999 here should become a run-time parameter? dSalt = max( fractionOfForcing*netSalt(i), -0.9999*h2d(i,k)*tv%S(i,j,k)) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index da0c875de1..a38e0d4ed8 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1052,6 +1052,15 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) enddo ; enddo ; enddo endif + ! Undo the effects of applyBoundaryFluxesInOut for passive tracers + if (CS%useALEalgorithm) then + k = 1 + do j=js,je ; do i=is,ie + hold(i,j,k) = hold(i,j,k) - ea(i,j,k) + enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) @@ -1101,7 +1110,12 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif enddo ; enddo - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + + if (CS%useALEalgorithm) then + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + else + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + endif enddo call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, dt, G, GV, tv, & diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index f6401e8879..ef8c3bb91d 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -194,9 +194,9 @@ subroutine transport_by_files(G, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields - call read_data(CS%mean_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%mean_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index fa6c1a1c67..a986def6cd 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -410,7 +410,7 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & tr(i,j,nz) = b1(i) * ((h_tr * tr(i,j,nz) + btm_src(i,j)) + & ea(i,j,nz) * tr(i,j,nz-1)) endif ; enddo - do k=nz-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + do k=G%ke-1,1,-1 ; do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then tr(i,j,k) = tr(i,j,k) + c1(i,k+1)*tr(i,j,k+1) endif ; enddo ; enddo enddo From 65b4f21a26cab577be251f1c7e89b7c477909b53 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 24 Aug 2016 19:31:41 -0400 Subject: [PATCH 24/65] Changed so that update to ea is based on dThickness --- src/core/MOM.F90 | 36 +++++++++---------- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 4 +-- src/tracer/MOM_offline_control.F90 | 17 +++++---- 4 files changed, 30 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4a9bb2a489..76dc4474fc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -708,11 +708,11 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) - if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag, mask = write_all_3du) - if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag, mask = write_all_3dv) - if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag, mask = write_all_3dt) - if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag, mask = write_all_3dt) - if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag, mask = write_all_3dt) + if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) + if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) + if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) + if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag) + if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag) if (CS%id_e_preale > 0) then call find_eta(h, CS%tv, GV%g_Earth, G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) @@ -1058,11 +1058,11 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! Regridding/remapping is done here, at the end of the thermodynamics time step ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag, mask = write_all_3du) - if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag, mask = write_all_3dv) - if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag, mask = write_all_3dt) - if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag, mask = write_all_3dt) - if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag, mask = write_all_3dt) + if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) + if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) + if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) + if (CS%id_T_preale > 0) call post_data(CS%id_T_preale, CS%tv%T, CS%diag) + if (CS%id_S_preale > 0) call post_data(CS%id_S_preale, CS%tv%S, CS%diag) if (CS%id_e_preale > 0) then call find_eta(h, CS%tv, G%g_Earth, G, GV, eta_preale) call post_data(CS%id_e_preale, eta_preale, CS%diag) @@ -1226,7 +1226,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call enable_averaging(dt,Time_local, CS%diag) if (CS%id_u > 0) call post_data(CS%id_u, u, CS%diag) if (CS%id_v > 0) call post_data(CS%id_v, v, CS%diag) - if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag, mask=write_all_3dt) + if (CS%id_h > 0) call post_data(CS%id_h, h, CS%diag) ! compute ssh, which is either eta_av for Bouss, or ! diagnosed ssh for non-Bouss; call "find_eta" for this @@ -1513,12 +1513,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & -<<<<<<< HEAD - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) -======= CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & CS%ALE_CSp, CS%offline_CSp%dt_offline) ->>>>>>> a2bbd6809fc6cf7d11c44bf96d26dba56c80b9bb call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -1536,7 +1532,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! for vertical remapping may need to be regenerated. This needs to ! happen after the H update and before the next post_data. call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%dt_trans) + call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) h_pre = CS%offline_CSp%h_preale; call pass_var(h_pre,G%Domain) @@ -1663,8 +1659,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) enddo; enddo; enddo -! call sum_across_PEs(sum_abs_fluxes) -! if (is_root_pe()) print *, "Remaining fluxes", sum_abs_fluxes + call sum_across_PEs(sum_abs_fluxes) + if (is_root_pe()) print *, "Remaining fluxes", sum_abs_fluxes ! if ( sum_abs_fluxes == 0.0) then ! print *, "Advection converged early at ", iter, "iterations" ! exit @@ -1732,8 +1728,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) - h_new = CS%offline_CSp%h_preale - call pass_var(h_new,G%Domain) + h_end = CS%offline_CSp%h_preale + call pass_var(h_end,G%Domain) endif !Diabatic second and ALE diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ad70aecaa7..d9d28f0d0f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1051,7 +1051,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, ea, h, hloss_ ! Change in state due to forcing dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) - if (k.eq.1) ea(i,j,k) = ea(i,j,k) + dThickness + ea(i,j,k) = ea(i,j,k) + dThickness dTemp = fractionOfForcing*netHeat(i) ! ### The 0.9999 here should become a run-time parameter? dSalt = max( fractionOfForcing*netSalt(i), -0.9999*h2d(i,k)*tv%S(i,j,k)) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d6844602d3..6796337967 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1374,8 +1374,8 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) write_all_3dt(:,:,:) = 1. - if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag, mask = write_all_3dt) - if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag, mask = write_all_3dt) + if (CS%id_ea > 0) call post_data(CS%id_ea, eatr, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, ebtr, CS%diag) if (CS%id_hloss_boundary > 0) call post_data(CS%id_hloss_boundary, hloss_boundary, CS%diag, mask = write_all_3dt) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 0b845be4bc..994a2728cc 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -142,17 +142,22 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) write_all_3dv = 1. - if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) - if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) - if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) - if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) + if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag ) + if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag ) + if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag ) + if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag ) + +! if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) +! if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) +! if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) +! if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) end subroutine post_advection_fields subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & temp, salt, do_ale_in) type(ocean_grid_type), intent(inout) :: G - type(verticalGrid_type), intent(inout) :: GV + type(verticalGrid_type), intent(inout) :: GV type(offline_transport_CS), intent(inout) :: CS logical, optional :: do_ale_in @@ -229,7 +234,7 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, enddo; enddo; enddo if (do_ale) then - CS%h_preale = 1.0e-10 + CS%h_preale = GV%Angstrom CS%T_preale = 0.0 CS%S_preale = 0.0 CS%u_preale = 0.0 From 87cf480b179bdb79eb837db7f7290b112e94a6ea Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 30 Aug 2016 11:00:17 -0400 Subject: [PATCH 25/65] Sync development between laptop and Github --- src/ALE/MOM_ALE.F90 | 11 +++- src/core/MOM.F90 | 21 ++++--- .../vertical/MOM_diabatic_driver.F90 | 6 +- src/tracer/MOM_offline_control.F90 | 59 +++++++++++-------- src/tracer/MOM_tracer_hor_diff.F90 | 4 +- 5 files changed, 59 insertions(+), 42 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index a97fdd7dce..6ca4d4cf0e 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -365,7 +365,7 @@ end subroutine ALE_end !! the old grid and the new grid. The creation of the new grid can be based !! on z coordinates, target interface densities, sigma coordinates or any !! arbitrary coordinate system. -subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) +subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, h_override) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) @@ -375,7 +375,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options real, optional, intent(in) :: dt !< Time step between calls to ALE_main() - + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: h_override !< Current 3D grid obtained after last time step (m or Pa) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step (m or Pa) @@ -399,8 +399,13 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_main)") ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, -dzRegrid, Reg, & + if (.not. present(h_override)) then + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, -dzRegrid, Reg, & + u, v, CS%show_call_tree, dt ) + else + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_override, -dzRegrid, Reg, & u, v, CS%show_call_tree, dt ) + endif if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 76dc4474fc..6a01118937 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -496,9 +496,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h - write_all_3du = 1. - write_all_3dv = 1. - write_all_3dt = 1. + write_all_3du(:,:,:) = 1. + write_all_3dv(:,:,:) = 1. + write_all_3dt(:,:,:) = 1. call cpu_clock_begin(id_clock_ocean) call cpu_clock_begin(id_clock_other) @@ -708,6 +708,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) + write_all_3dt(:,:,:) = 1. if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) @@ -1058,6 +1059,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! Regridding/remapping is done here, at the end of the thermodynamics time step ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + write_all_3dt(:,:,:) = 1. if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) @@ -1487,6 +1489,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Read in all fields that might be used this timestep call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, CS%use_ALE_algorithm) + if (CS%offline_CSp%id_uhtr_preadv>0) call post_data(CS%offline_CSp%id_uhtr_preadv, uhtr, CS%diag) + if (CS%offline_CSp%id_vhtr_preadv>0) call post_data(CS%offline_CSp%id_vhtr_preadv, vhtr, CS%diag) + if (CS%id_h>0) call post_data(CS%id_h, h_end, CS%diag) + + h_pre = CS%h + call pass_var(h_pre,G%Domain) + call hchksum(h_pre, "Before steps h", G%HI, haloshift=1) if (CS%diabatic_first .and. CS%use_ALE_algorithm) then ! Regridding/remapping is done here, at end of thermodynamics time step @@ -1542,8 +1551,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%S = salt_old call pass_var(CS%T,G%Domain) call pass_var(CS%S,G%Domain) - h_pre = CS%h - call pass_var(h_pre,G%Domain) endif !Diabatic first and ALE h_new(:,:,:) = GV%Angstrom @@ -1708,7 +1715,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, CS%offline_CSp%dt_offline) + CS%ALE_CSp, h_override = h_end) call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -2759,7 +2766,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) CS%id_v_preale = register_diag_field('ocean_model', 'v_preale', diag%axesCvL, Time, & 'Meridional velocity before remapping', 'meter second-1') CS%id_h_preale = register_diag_field('ocean_model', 'h_preale', diag%axesTL, Time, & - 'Layer Thickness before remapping', thickness_units, v_cell_method='sum') + 'Layer Thickness before remapping', thickness_units) CS%id_T_preale = register_diag_field('ocean_model', 'T_preale', diag%axesTL, Time, & 'Temperature before remapping', 'degC') CS%id_S_preale = register_diag_field('ocean_model', 'S_preale', diag%axesTL, Time, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 6796337967..921891e3a1 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1374,10 +1374,8 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) write_all_3dt(:,:,:) = 1. - if (CS%id_ea > 0) call post_data(CS%id_ea, eatr, CS%diag) - if (CS%id_eb > 0) call post_data(CS%id_eb, ebtr, CS%diag) - - if (CS%id_hloss_boundary > 0) call post_data(CS%id_hloss_boundary, hloss_boundary, CS%diag, mask = write_all_3dt) + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 994a2728cc..776ca851c6 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -137,9 +137,9 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: write_all_3dv - write_all_3dt = 1. - write_all_3du = 1. - write_all_3dv = 1. + write_all_3dt(:,:,:) = 1. + write_all_3du(:,:,:) = 1. + write_all_3dv(:,:,:) = 1. if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag ) @@ -216,22 +216,29 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) -! ! Apply masks at T, U, and V points - do k=1,nz ; do j=js-1,je ; do i=is-1,ie - if (G%mask2dCu(i,j)<1.0) then - uhtr(I,j,k) = 0.0 - khdt_x(I,j) = 0.0; - endif - if (G%mask2dCv(i,j)<1.0) then - vhtr(i,J,k) = 0.0 - khdt_y(i,J) = 0.0; - endif - if (G%mask2dT(i,j)<1.0) then + ! Apply masks at T, U, and V points + do k=1,nz ; do j=js,je ; do i=is,ie + if(G%mask2dT(i,j)<1.0) then h_end(i,j,k) = GV%Angstrom eatr(i,j,k) = 0.0 ebtr(i,j,k) = 0.0 endif - enddo; enddo; enddo + enddo; enddo ; enddo + + do k=1,nz ; do j=js-1,je ; do i=is,ie + if(G%mask2dCv(i,j)<1.0) then + khdt_y(i,j) = 0.0 + vhtr(i,j,k) = 0.0 + endif + enddo; enddo ; enddo + + do k=1,nz ; do j=js,je ; do i=is-1,ie + if(G%mask2dCu(i,j)<1.0) then + khdt_x(i,j) = 0.0 + uhtr(i,j,k) = 0.0 + endif + enddo; enddo ; enddo + if (do_ale) then CS%h_preale = GV%Angstrom @@ -250,17 +257,17 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) - do k=1,nz ; do j=js-1,je ; do i=is-1,ie - if (G%mask2dCu(i,j)<1.0) then - CS%u_preale(I,j,k) = 0.0 - endif - if (G%mask2dCv(i,j)<1.0) then - CS%v_preale(I,j,k) = 0.0 - endif - if (G%mask2dT(i,j)<1.0) then - CS%h_preale(i,j,k) = GV%Angstrom - endif - enddo; enddo; enddo +! do k=1,nz ; do j=js-1,je ; do i=is-1,ie +! if (G%mask2dCu(i,j)<1.0) then +! CS%u_preale(I,j,k) = 0.0 +! endif +! if (G%mask2dCv(i,j)<1.0) then +! CS%v_preale(I,j,k) = 0.0 +! endif +! if (G%mask2dT(i,j)<1.0) then +! CS%h_preale(i,j,k) = GV%Angstrom +! endif +! enddo; enddo; enddo endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index ae34c1ee0c..b16497fa5c 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -482,8 +482,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla endif write_all_2du = 1. ; write_all_2dv = 1. - if (CS%id_khdt_x > 0) call post_data(CS%id_khdt_x, khdt_x, CS%diag, mask=write_all_2du) - if (CS%id_khdt_y > 0) call post_data(CS%id_khdt_y, khdt_y, CS%diag, mask=write_all_2dv) + if (CS%id_khdt_x > 0) call post_data(CS%id_khdt_x, khdt_x, CS%diag) + if (CS%id_khdt_y > 0) call post_data(CS%id_khdt_y, khdt_y, CS%diag) if (CS%show_call_tree) call callTree_leave("tracer_hordiff()") From b40b43e66b40af7be87fa9ff8c64ce2bf25f6e1e Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 1 Sep 2016 13:45:27 -0400 Subject: [PATCH 26/65] Tracer conservation with Baltic_ALE_z test case, however convergence is slow. Beginning work on a more efficient flux limiter --- src/ALE/MOM_ALE.F90 | 21 ++-- src/core/MOM.F90 | 232 ++++++++++++++++++++++---------------------- 2 files changed, 129 insertions(+), 124 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 6ca4d4cf0e..2e7c7f9368 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -97,7 +97,8 @@ module MOM_ALE integer, dimension(:), allocatable :: id_tracer_remap_tendency !< diagnostic id integer, dimension(:), allocatable :: id_Htracer_remap_tendency !< diagnostic id integer, dimension(:), allocatable :: id_Htracer_remap_tendency_2d !< diagnostic id - logical, dimension(:), allocatable :: do_tendency_diag !< flag for doing diagnostics + logical, dimension(:), allocatable :: do_tendency_diag !< flag for doing diagnostics + integer :: id_dzRegrid end type @@ -282,6 +283,9 @@ subroutine ALE_register_diags(Time, G, diag, C_p, Reg, CS) CS%id_Htracer_remap_tendency(:) = -1 CS%id_Htracer_remap_tendency_2d(:) = -1 + CS%id_dzRegrid = register_diag_field('ocean_model','dzRegrid',diag%axesTi,Time, & + 'Change in interface height due to ALE regridding', 'meter') + if(ntr > 0) then do m=1,ntr @@ -365,7 +369,7 @@ end subroutine ALE_end !! the old grid and the new grid. The creation of the new grid can be based !! on z coordinates, target interface densities, sigma coordinates or any !! arbitrary coordinate system. -subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, h_override) +subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) @@ -375,7 +379,6 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, h_override) type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options real, optional, intent(in) :: dt !< Time step between calls to ALE_main() - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: h_override !< Current 3D grid obtained after last time step (m or Pa) ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step (m or Pa) @@ -399,13 +402,9 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, h_override) if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_main)") ! Remap all variables from old grid h onto new grid h_new - if (.not. present(h_override)) then - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, -dzRegrid, Reg, & - u, v, CS%show_call_tree, dt ) - else - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_override, -dzRegrid, Reg, & + + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, -dzRegrid, Reg, & u, v, CS%show_call_tree, dt ) - endif if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") @@ -419,6 +418,10 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, h_override) enddo if (CS%show_call_tree) call callTree_leave("ALE_main()") + + if (present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + + end subroutine ALE_main !> Check grid for negative thicknesses diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 6a01118937..c8de75e4ac 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1497,69 +1497,19 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre,G%Domain) call hchksum(h_pre, "Before steps h", G%HI, haloshift=1) - if (CS%diabatic_first .and. CS%use_ALE_algorithm) then - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + CS%T = temp_old + CS%S = salt_old + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale - -! call do_group_pass(CS%pass_T_S_h, G%Domain) - - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) - endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, CS%offline_CSp%dt_offline) - call cpu_clock_end(id_clock_ALE) - - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) - endif - - CS%tv%T = temp_old - CS%tv%S = salt_old - - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) - - h_pre = CS%offline_CSp%h_preale; - call pass_var(h_pre,G%Domain) - - else !Not diabatic first or not ale - CS%T = temp_old - CS%S = salt_old - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - endif !Diabatic first and ALE h_new(:,:,:) = GV%Angstrom ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) ! to make sure that offline advection is monotonic and positive-definite ! - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first @@ -1584,7 +1534,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & CS%offline_CSp%max_off_cfl) - if (z_first) then ! First do vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) @@ -1640,12 +1589,63 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif + + if (CS%use_ALE_algorithm) then + + ! Regridding/remapping is done here, at end of thermodynamics time step + ! (that may comprise several dynamical time steps) + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + + CS%tv%T = CS%offline_CSp%T_preale + CS%tv%S = CS%offline_CSp%S_preale + call pass_var(h_pre,G%Domain) +! call do_group_pass(CS%pass_T_S_h, G%Domain) + + ! update squared quantities + if (associated(CS%S_squared)) & + CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + if (associated(CS%T_squared)) & + CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 + + if (CS%debug) then + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) + endif + + CS%tv%T = temp_old + CS%tv%S = salt_old + + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, dt_iter) + + endif + ! Update remaining transports do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo; enddo ; enddo + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo; enddo ; enddo @@ -1659,15 +1659,17 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) ! - ! Stop if we've depleted all the mass transport by summing the remaining fluxes at each point + ! Calculate how close we are to converging by summing the remaining fluxes at each point sum_abs_fluxes = 0.0 do k=1,nz; do j=js,je; do i=is,ie sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - if (is_root_pe()) print *, "Remaining fluxes", sum_abs_fluxes +! +! + if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes !, & +! "UH: ", sum(abs(uhtr)), "VH: ", sum(abs(vhtr)), "EA: ", sum(abs(eatr)), "EB: ", sum(abs(ebtr)) ! if ( sum_abs_fluxes == 0.0) then ! print *, "Advection converged early at ", iter, "iterations" ! exit @@ -1682,63 +1684,63 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) - - if(.not. CS%use_ALE_algorithm) h_temp = h_end-h_pre - - if(.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then - - h_temp = CS%offline_CSp%h_preale-h_pre - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale - -! call do_group_pass(CS%pass_T_S_h, G%Domain) - - ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) - endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, h_override = h_end) - call cpu_clock_end(id_clock_ALE) - - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) - endif +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) - CS%tv%T = temp_old - CS%tv%S = salt_old - - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) - - h_end = CS%offline_CSp%h_preale - call pass_var(h_end,G%Domain) + h_temp = h_end-h_pre +! +! if(.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then +! +! h_temp = CS%offline_CSp%h_preale-h_pre +! ! Regridding/remapping is done here, at end of thermodynamics time step +! ! (that may comprise several dynamical time steps) +! ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. +! +! CS%tv%T = CS%offline_CSp%T_preale +! CS%tv%S = CS%offline_CSp%S_preale +! +!! call do_group_pass(CS%pass_T_S_h, G%Domain) +! +! ! update squared quantities +! if (associated(CS%S_squared)) & +! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 +! if (associated(CS%T_squared)) & +! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 +! +! if (CS%debug) then +! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) +! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) +! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) +! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) +! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) +! endif +! call cpu_clock_begin(id_clock_ALE) +! call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & +! CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & +! CS%ALE_CSp, h_override = h_end) +! call cpu_clock_end(id_clock_ALE) +! +! if (CS%debug) then +! call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) +! call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) +! endif +! +! CS%tv%T = temp_old +! CS%tv%S = salt_old +! +! call pass_var(CS%T,G%Domain) +! call pass_var(CS%S,G%Domain) +! +! ! Whenever thickness changes let the diag manager know, target grids +! ! for vertical remapping may need to be regenerated. This needs to +! ! happen after the H update and before the next post_data. +! call diag_update_target_grids(CS%diag) +! call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) +! +! h_end = CS%offline_CSp%h_preale +! call pass_var(h_end,G%Domain) - endif !Diabatic second and ALE +! endif !Diabatic second and ALE From dd323242476cb6ced997f67db805ee1de04da527 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 2 Sep 2016 11:33:03 -0400 Subject: [PATCH 27/65] Continued work on figuring out how to get convergence quicker when in ALE --- src/core/MOM.F90 | 278 +++++++++++++++++++------------ src/tracer/MOM_tracer_advect.F90 | 198 ++++++++++------------ 2 files changed, 251 insertions(+), 225 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c8de75e4ac..e843ebc32b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1508,98 +1508,192 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) ! to make sure that offline advection is monotonic and positive-definite ! -! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first - do iter=1,CS%offline_CSp%num_off_iter + if (.not. CS%use_ALE_algorithm) then + do iter=1,CS%offline_CSp%num_off_iter - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - eatr_sub(i,j,k) = eatr(i,j,k) - ebtr_sub(i,j,k) = ebtr(i,j,k) - enddo; enddo ; enddo + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + eatr_sub(i,j,k) = eatr(i,j,k) + ebtr_sub(i,j,k) = ebtr(i,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + uhtr_sub(I,j,k) = uhtr(I,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + vhtr_sub(i,J,k) = vhtr(i,J,k) + enddo; enddo ; enddo + + + ! Calculate 3d mass transports to be used in this iteration + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & + CS%offline_CSp%max_off_cfl) + + if (z_first) then + ! First do vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + call pass_var(h_pre,G%Domain) + + ! Second zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 - uhtr_sub(I,j,k) = uhtr(I,j,k) - enddo; enddo ; enddo + endif - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 - vhtr_sub(i,J,k) = vhtr(i,J,k) - enddo; enddo ; enddo + if (.not. z_first) then + ! First zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) - ! Calculate 3d mass transports to be used in this iteration - call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & - CS%offline_CSp%max_off_cfl) + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo - if (z_first) then - ! First do vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - call pass_var(h_pre,G%Domain) - ! Second zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + ! Second vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo + enddo ; enddo ; enddo - endif - if (.not. z_first) then + endif - ! First zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + ! Update remaining transports + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) + ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) + enddo; enddo ; enddo + + + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo + + call pass_var(eatr,G%Domain) + call pass_var(ebtr,G%Domain) + call pass_var(h_pre,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) + ! + ! Calculate how close we are to converging by summing the remaining fluxes at each point + sum_abs_fluxes = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + ! + ! + if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes !, & + ! "UH: ", sum(abs(uhtr)), "VH: ", sum(abs(vhtr)), "EA: ", sum(abs(eatr)), "EB: ", sum(abs(ebtr)) + ! if ( sum_abs_fluxes == 0.0) then + ! print *, "Advection converged early at ", iter, "iterations" + ! exit + ! endif + + ! Switch order of Strang split every iteration + z_first = .not. z_first + x_before_y = .not. x_before_y + + end do + + elseif (CS%use_ALE_algorithm) then + + ! When using ALE (or in z-mode), all mixing at interfaces results in no net change + ! in layer thickness. Therefore, half of the diagnosed mixing is applied before the + ! any horizontal advection occurs and half occurs after the horizontal advection has + ! converged. + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & + CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + + do iter=1,CS%offline_CSp%num_off_iter + ! Perform zonal and meridional advection do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) - - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=100, x_first_in=x_before_y, & + uhr_out=uhtr_sub, vhr_out=vhtr_sub) + x_before_y = .not. x_before_y + ! Advect tracer returns how much horizontal flux remains, thus the total amount of horizontal + ! actually done in this time step is uhtr-uhtr_sub and vhtr-vhtr_sub. This is needed to + ! calculate the cell thickness to be remapped in ALE + do k=1,nz ; do I=is-2,ie+1 ; do j=js-1,js+1 + uhtr_sub(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do I=is-1,ie+1 ; do J=js-2,js+1 + vhtr_sub(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo ; enddo ; enddo - - - ! Second vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - ! We are now done with the vertical mass transports, so now h_new is h_sub + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + ! Calculate the remaining transport + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo + + ! As a way of checking how close we are to converging, sum the absolute value of + ! the remaining horizontal fluxes + sum_abs_fluxes = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes - - endif - - - if (CS%use_ALE_algorithm) then - - ! Regridding/remapping is done here, at end of thermodynamics time step - ! (that may comprise several dynamical time steps) + ! Regridding/remapping is done here after each advection iteration so that + ! layers which no longer exist can get 'reinflated' by ALE + ! While this may call ALE many more times than is done in the online run, it should + ! never result in more changes in thickness due to remapping ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. CS%tv%T = CS%offline_CSp%T_preale CS%tv%S = CS%offline_CSp%S_preale call pass_var(h_pre,G%Domain) -! call do_group_pass(CS%pass_T_S_h, G%Domain) + ! call do_group_pass(CS%pass_T_S_h, G%Domain) ! update squared quantities if (associated(CS%S_squared)) & @@ -1608,11 +1702,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) + call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) + call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) + call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) + call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) endif call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & @@ -1636,56 +1730,18 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! happen after the H update and before the next post_data. call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, dt_iter) + enddo - endif - - ! Update remaining transports - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) - ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) - enddo; enddo ; enddo - - - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 - uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo - - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo - - call pass_var(eatr,G%Domain) - call pass_var(ebtr,G%Domain) - call pass_var(h_pre,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) -! - ! Calculate how close we are to converging by summing the remaining fluxes at each point - sum_abs_fluxes = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) -! -! - if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes !, & -! "UH: ", sum(abs(uhtr)), "VH: ", sum(abs(vhtr)), "EA: ", sum(abs(eatr)), "EB: ", sum(abs(ebtr)) -! if ( sum_abs_fluxes == 0.0) then -! print *, "Advection converged early at ", iter, "iterations" -! exit -! endif - - ! Switch order of Strang split every iteration - z_first = .not. z_first - x_before_y = .not. x_before_y + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & + CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - end do + endif call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion -! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) h_temp = h_end-h_pre ! diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index d5dae86eb9..0f39e44e84 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, skip_limiter_in) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -57,8 +57,8 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_prev_opt !< layer thickness before advection (m or kg m-2) integer, optional :: max_iter_in logical, optional :: x_first_in - logical, optional :: skip_limiter_in - + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -84,7 +84,6 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, itt, ntr, do_any integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB - logical :: skip_limiter domore_u(:,:) = .false. domore_v(:,:) = .false. @@ -110,8 +109,6 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, if(present(max_iter_in)) max_iter = max_iter_in if(present(x_first_in)) x_first = x_first_in - skip_limiter = .false. - if(present(skip_limiter_in)) skip_limiter = skip_limiter_in call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) call create_group_pass(CS%pass_uhr_vhr_t_hprev, hprev, G%Domain) @@ -251,11 +248,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, ! First, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM, skip_limiter) + isv, iev, jsv-stencil, jev+stencil, k, G, GV, CS%usePPM) ! Next, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) + isv, iev, jsv, jev, k, G, GV, CS%usePPM) domore_k(k) = 0 do j=jsv-stencil,jev+stencil ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -265,11 +262,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, ! First, advect meridionally. call advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) + isv-stencil, iev+stencil, jsv, jev, k, G, GV, CS%usePPM) ! Next, advect zonally. call advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, CS%usePPM, skip_limiter) + isv, iev, jsv, jev, k, G, GV, CS%usePPM) domore_k(k) = 0 do j=jsv,jev ; if (domore_u(j,k)) domore_k(k) = 1 ; enddo @@ -281,7 +278,11 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, endif ; enddo ! End of k-loop ! If the advection just isn't finishing after max_iter, move on. - if (itt >= max_iter) exit + if (itt >= max_iter) then + if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) + if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + exit + endif ! Exit if there are no layers that need more iterations. if (isv > is-stencil) then @@ -290,11 +291,19 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, call sum_across_PEs(domore_k(:), nz) call cpu_clock_end(id_clock_sync) do k=1,nz ; do_any = do_any + domore_k(k) ; enddo - if (do_any == 0) exit + if (do_any == 0) then + if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) + if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + exit + endif + endif enddo ! Iterations loop + if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) + if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + call cpu_clock_end(id_clock_advect) end subroutine advect_tracer @@ -303,7 +312,7 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, skip_limiter_in) + is, ie, js, je, k, G, GV, usePPM) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV type(tracer_type), dimension(ntr), intent(inout) :: Tr @@ -315,7 +324,6 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & real, intent(in) :: Idt integer, intent(in) :: ntr, is, ie, js, je,k logical, intent(in) :: usePPM - logical, optional :: skip_limiter_in real, dimension(SZIB_(G),ntr) :: & slope_x, & ! The concentration slope per grid point in units of @@ -340,10 +348,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & logical :: do_any_i integer :: i, j, m real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 - logical :: usePLMslope, skip_limiter - - skip_limiter = .false. - if(present(skip_limiter_in)) skip_limiter = skip_limiter_in + logical :: usePLMslope usePLMslope = .not. usePPM @@ -382,59 +387,41 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePLMslope - if (.not. skip_limiter) then - ! Calculate the i-direction fluxes of each tracer, using as much - ! the minimum of the remaining mass flux (uhr) and the half the mass - ! in the cell plus whatever part of its half of the mass flux that - ! the flux through the other side does not require. - do I=is-1,ie - if (uhr(I,j,k) == 0.0) then - uhh(I) = 0.0 - CFL(I) = 0.0 - elseif (uhr(I,j,k) < 0.0) then - hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h - hlos = MAX(0.0,uhr(I+1,j,k)) - if (((hup + uhr(I,j,k) - hlos) < 0.0) .and. & - ((0.5*hup + uhr(I,j,k)) < 0.0)) then !### Add parentheses. - uhh(I) = MIN(-0.5*hup,-hup+hlos,0.0) - domore_u(j,k) = .true. - else - uhh(I) = uhr(I,j,k) - endif - !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) - CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive + ! Calculate the i-direction fluxes of each tracer, using as much + ! the minimum of the remaining mass flux (uhr) and the half the mass + ! in the cell plus whatever part of its half of the mass flux that + ! the flux through the other side does not require. + do I=is-1,ie + if (uhr(I,j,k) == 0.0) then + uhh(I) = 0.0 + CFL(I) = 0.0 + elseif (uhr(I,j,k) < 0.0) then + hup = hprev(i+1,j,k) - G%areaT(i+1,j)*min_h + hlos = MAX(0.0,uhr(I+1,j,k)) + if (((hup + uhr(I,j,k) - hlos) < 0.0) .and. & + ((0.5*hup + uhr(I,j,k)) < 0.0)) then !### Add parentheses. + uhh(I) = MIN(-0.5*hup,-hup+hlos,0.0) + domore_u(j,k) = .true. else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-uhr(I-1,j,k)) - if (((hup - uhr(I,j,k) - hlos) < 0.0) .and. & - ((0.5*hup - uhr(I,j,k)) < 0.0)) then !### Add parentheses. - uhh(I) = MAX(0.5*hup,hup-hlos,0.0) - domore_u(j,k) = .true. - else - uhh(I) = uhr(I,j,k) - endif - !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) - CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive + uhh(I) = uhr(I,j,k) endif - enddo - else ! Skip the limiter but retain the necessary quantities - do I=is-1,ie - if (uhr(I,j,k) == 0.0) then - uhh(I) = 0.0 - CFL(I) = 0.0 - elseif (uhr(I,j,k) < 0.0) then - uhh(I) = uhr(I,j,k) - !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) - CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive - domore_u(j,k) = .true. - else - uhh(I) = uhr(I,j,k) - !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) - CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive - domore_u(j,k) = .true. + !ts2(I) = 0.5*(1.0 + uhh(I)/(hprev(i+1,j,k)+h_neglect)) + CFL(I) = - uhh(I)/(hprev(i+1,j,k)+h_neglect) ! CFL is positive + else + hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-uhr(I-1,j,k)) + if (((hup - uhr(I,j,k) - hlos) < 0.0) .and. & + ((0.5*hup - uhr(I,j,k)) < 0.0)) then !### Add parentheses. + uhh(I) = MAX(0.5*hup,hup-hlos,0.0) + domore_u(j,k) = .true. + else + uhh(I) = uhr(I,j,k) endif - enddo - endif + !ts2(I) = 0.5*(1.0 - uhh(I)/(hprev(i,j,k)+h_neglect)) + CFL(I) = uhh(I)/(hprev(i,j,k)+h_neglect) ! CFL is positive + endif + enddo + if (usePPM) then do m=1,ntr ; do I=is-1,ie @@ -588,7 +575,7 @@ end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, usePPM, skip_limiter_in) + is, ie, js, je, k, G, GV, usePPM) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV type(tracer_type), dimension(ntr), intent(inout) :: Tr @@ -600,7 +587,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & real, intent(in) :: Idt integer, intent(in) :: ntr, is, ie, js, je,k logical, intent(in) :: usePPM - logical, optional :: skip_limiter_in real, dimension(SZI_(G),ntr,SZJB_(G)) :: & slope_y, & ! The concentration slope per grid point in units of @@ -626,10 +612,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & logical :: do_any_i integer :: i, j, m real :: aR, aL, dMx, dMn, Tp, Tc, Tm, dA, mA, a6 - logical :: usePLMslope, skip_limiter - - skip_limiter = .false. - if(present(skip_limiter_in)) skip_limiter = skip_limiter_in + logical :: usePLMslope usePLMslope = .not. usePPM @@ -672,51 +655,38 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! the flux through the other side does not require. do J=js-1,je ; if (domore_v(J,k)) then domore_v(J,k) = .false. - if(.not. skip_limiter) then - do i=is,ie - if (vhr(i,J,k) == 0.0) then - vhh(i,J) = 0.0 - CFL(i) = 0.0 - elseif (vhr(i,J,k) < 0.0) then - hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h - hlos = MAX(0.0,vhr(i,J+1,k)) - if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & - ((0.5*hup + vhr(i,J,k)) < 0.0)) then - vhh(i,J) = MIN(-0.5*hup,-hup+hlos,0.0) - domore_v(J,k) = .true. - else - vhh(i,J) = vhr(i,J,k) - endif - !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) - CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive + + do i=is,ie + if (vhr(i,J,k) == 0.0) then + vhh(i,J) = 0.0 + CFL(i) = 0.0 + elseif (vhr(i,J,k) < 0.0) then + hup = hprev(i,j+1,k) - G%areaT(i,j+1)*min_h + hlos = MAX(0.0,vhr(i,J+1,k)) + if ((((hup - hlos) + vhr(i,J,k)) < 0.0) .and. & + ((0.5*hup + vhr(i,J,k)) < 0.0)) then + vhh(i,J) = MIN(-0.5*hup,-hup+hlos,0.0) + domore_v(J,k) = .true. else - hup = hprev(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-vhr(i,J-1,k)) - if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & - ((0.5*hup - vhr(i,J,k)) < 0.0)) then - vhh(i,J) = MAX(0.5*hup,hup-hlos,0.0) - domore_v(J,k) = .true. - else - vhh(i,J) = vhr(i,J,k) - endif - !ts2(i) = 0.5*(1.0 - vhh(i,J) / (hprev(i,j,k)+h_neglect)) - CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive - endif - enddo - else - do i=is,ie - if (vhr(i,J,k) == 0.0) then - vhh(i,J) = 0.0 - CFL(i) = 0.0 - elseif (vhr(i,J,k) < 0.0) then vhh(i,J) = vhr(i,J,k) - CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive + endif + !ts2(i) = 0.5*(1.0 + vhh(i,J) / (hprev(i,j+1,k)+h_neglect)) + CFL(i) = - vhh(i,J) / (hprev(i,j+1,k)+h_neglect) ! CFL is positive + else + hup = hprev(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-vhr(i,J-1,k)) + if ((((hup - hlos) - vhr(i,J,k)) < 0.0) .and. & + ((0.5*hup - vhr(i,J,k)) < 0.0)) then + vhh(i,J) = MAX(0.5*hup,hup-hlos,0.0) + domore_v(J,k) = .true. else vhh(i,J) = vhr(i,J,k) - CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive endif - enddo - endif + !ts2(i) = 0.5*(1.0 - vhh(i,J) / (hprev(i,j,k)+h_neglect)) + CFL(i) = vhh(i,J) / (hprev(i,j,k)+h_neglect) ! CFL is positive + endif + enddo + if (usePPM) then do m=1,ntr ; do i=is,ie if (vhh(i,J) >= 0.0) then From d70327b7e96ea4ef92e355af928ece00ab9cda56 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 6 Sep 2016 10:43:56 -0400 Subject: [PATCH 28/65] Started work on a more aggressive limiter --- src/tracer/MOM_offline_control.F90 | 120 +++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 776ca851c6..92d4467c7b 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -521,6 +521,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux real :: pos_flux, hvol, h_neglect, scale_factor + ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not @@ -598,4 +599,123 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d + subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl, z_first, x_before_y) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + real, intent(in) :: max_off_cfl + logical, intent(in) :: z_first, x_before_y + + ! Local variables + integer :: i, j, k, m, is, ie, js, je, nz + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), :: u_out + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), :: v_out + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux + real :: pos_flux, hvol, h_neglect, scale_factor + integer :: flux_order + ! In this subroutine, fluxes out of the box are scaled down if they deplete + ! the layer. Here the positive direction is defined as flux out of the box as opposed to the + ! typical, strictly upwind convention. Hence, uh(I-1) is multipled by negative one, + ! but uh(I) is not. This routine differs from limit_mass_flux_3d because in this case, + ! the ordering of direction matters. While this is more aggressive than the other routine which, + ! Scales fluxes if they would deplete the layer (independent of any convergence within an + ! iteration), this routine should still maintain a CFL less than 1 + ! Because horizontal transport must always be together (i.e. cannot do x->z->y), + ! four cases are considered) + ! 1: z -> x -> y + ! 2: z -> y -> x + ! 3: x -> y -> z + ! 4: y -> x -> z + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + ! Initialize working arrays + u_out(:,:,:) = 0.0 + v_out(:,:,:) = 0.0 + top_flux(:,:,:) = 0.0 + bottom_flux(:,:,:) = 0.0 + + ! Set the flux order (corresponding to one of the four cases described previously) + if (z_first .and. x_before_y) flux_order = 1 + if (z_first .and. (.not. x_before_y)) flux_order = 2 + if ((.not. z_first) .and. x_before_y) flux_order = 3 + if ((.not. z_first) .and. (.not. x_before_y)) flux_order = 4 + + + do k=1,nz ; do i=is-1,ie+1; do j=js-1,je+1 + + u_out(I,j,k) = uh(I,j,k) - uh(I-1,j,k) + v_out(i,J,k) = vh(i,J,k) - vh(i,J-1,k) + + enddo ; enddo ; enddo + + k = 1 + do j=js-1,je+1 ; do i=is-1,ie+1 + top_flux(i,j,k) = -ea(i,j,k) + bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) + enddo ; enddo + + do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 + top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) + bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) + enddo ; enddo ; enddo + + k=nz + do j=js-1,je+1 ; do i=is-1,ie+1 + top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) + bottom_flux(i,j,k) = -eb(i,j,k) + enddo ; enddo + + select case (flux_order) + case (1) ! z -> x -> y + ! Check first to see if either the top or bottom flux would deplete the layer + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + + pos_flux = top_flux + bottom_flux + ! If the total vertical transport depletes a layer + if ( h_pre(i,j,k) < pos_flux ) then + scale_factor = ( h_pre(i,j,k) )/pos_flux*max_off_cfl + if (k>1 .and. k0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor + endif + if(bottom_flux(i,j,k)>0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor + endif + ! Scale top layer + elseif (k==1) then + if(top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor + if(bottom_flux(i,j,k)>0.0) then + eb(i,j,k) = eb(i,j,k)*scale_factor + ea(i,j,k+1) = ea(i,j,k+1)*scale_factor + endif + ! Scale bottom layer + elseif (k==nz) then + if(top_flux(i,j,k)>0.0) then + ea(i,j,k) = ea(i,j,k)*scale_factor + eb(i,j,k-1) = eb(i,j,k-1)*scale_factor + endif + if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor + endif + + + endif + + enddo ; enddo ; enddo + + + + + + + end subroutine limit_mass_flux_3d + + end module MOM_offline_transport From ac2d32d72b33b5309d2b9724e0a20f70db752b92 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 9 Sep 2016 10:06:54 -0400 Subject: [PATCH 29/65] Testing new direction aware flux limiter for offline transport --- src/core/MOM.F90 | 14 +- src/tracer/MOM_offline_control.F90 | 276 ++++++++++++++++++++++------- 2 files changed, 221 insertions(+), 69 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e843ebc32b..143cc4d5b0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -129,6 +129,7 @@ module MOM use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux +use MOM_offline_transport, only : limit_mass_flux_ordered_3d use time_manager_mod, only : print_date use MOM_sum_output, only : write_energy @@ -1440,7 +1441,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_vol, & h_pre, & h_temp, & - temp_old, salt_old ! + temp_old, salt_old, & + ea_zero, eb_zero ! integer :: niter, iter real :: Inum_iter, dt_iter integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz @@ -1641,14 +1643,20 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + ea_zero(:,:,:) = 0.0 ; eb_zero(:,:,:) = 0.0 do iter=1,CS%offline_CSp%num_off_iter + + uhtr_sub(:,:,:) = uhtr(:,:,:) + vhtr_sub(:,:,:) = vhtr(:,:,:) + call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, eatr, ebtr, h_pre, CS%offline_CSp%max_off_cfl, & + z_first, x_before_y) + ! Perform zonal and meridional advection do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=100, x_first_in=x_before_y, & - uhr_out=uhtr_sub, vhr_out=vhtr_sub) + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=100, x_first_in=x_before_y) x_before_y = .not. x_before_y ! Advect tracer returns how much horizontal flux remains, thus the total amount of horizontal ! actually done in this time step is uhtr-uhtr_sub and vhtr-vhtr_sub. This is needed to diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 92d4467c7b..b8bfad09db 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -599,23 +599,21 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d - subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl, z_first, x_before_y) + subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, z_first, x_before_y) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_in real, intent(in) :: max_off_cfl logical, intent(in) :: z_first, x_before_y ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), :: u_out - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), :: v_out - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux - real :: pos_flux, hvol, h_neglect, scale_factor + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_budget ! Tracks how much thickness + ! remains for other fluxes integer :: flux_order ! In this subroutine, fluxes out of the box are scaled down if they deplete ! the layer. Here the positive direction is defined as flux out of the box as opposed to the @@ -633,11 +631,8 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl, ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Initialize working arrays - u_out(:,:,:) = 0.0 - v_out(:,:,:) = 0.0 - top_flux(:,:,:) = 0.0 - bottom_flux(:,:,:) = 0.0 + ! Copy layer thicknesses into a working array for this subroutine + h_budget(:,:,:) = h_in(:,:,:) ! Set the flux order (corresponding to one of the four cases described previously) if (z_first .and. x_before_y) flux_order = 1 @@ -645,77 +640,226 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl, if ((.not. z_first) .and. x_before_y) flux_order = 3 if ((.not. z_first) .and. (.not. x_before_y)) flux_order = 4 + select case (flux_order) + case (1) ! z -> x -> y + ! Check first to see if either the top or bottom flux would deplete the layer + call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + case (2) ! z -> y -> x + call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + case (3) ! x -> y -> z + call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + case (4) ! y -> x -> z + call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + end select + + end subroutine limit_mass_flux_ordered_3d + + subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h + real :: max_off_cfl + ! Limits how much the a layer can be depleted in the vertical direction + real, dimension(SZI_(G),SZK_(G)) :: ea2d, eb2d + real, dimension(SZI_(G),SZK_(G)) :: h2d, scale + real, dimension(SZI_(G),SZK_(G)) :: top_flux, bottom_flux + real :: total_out_flux, h_budget + integer :: i, j, k, m, is, ie, js, je, nz - do k=1,nz ; do i=is-1,ie+1; do j=js-1,je+1 - - u_out(I,j,k) = uh(I,j,k) - uh(I-1,j,k) - v_out(i,J,k) = vh(i,J,k) - vh(i,J-1,k) + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - enddo ; enddo ; enddo + do j=js,je + do k=1,nz ; do i=is,ie + ea2d(i,k) = ea(i,j,k) + eb2d(i,k) = eb(i,j,k) + h2d(i,k) = h(i,j,k) + scale(i,k) = 1.0 + enddo ; enddo; + + k=1 ! Top layer + do i=is,ie + top_flux(i,k) = -ea2d(i,k) + bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) + enddo + ! Interior layers + do k=2, nz-1 ; do i=is,ie + top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) + bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) + enddo ; enddo + k=nz ! Bottom layer + do i=is,ie + top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) + bottom_flux(i,k) = -eb2d(i,k) + enddo - k = 1 - do j=js-1,je+1 ; do i=is-1,ie+1 - top_flux(i,j,k) = -ea(i,j,k) - bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) - enddo ; enddo + do k=1,nz ; do i=is,ie + if (G%mask2dT(i,j)>0.0) then + h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step + ! based on the specified max CFL + total_out_flux = max(0.0,top_flux(i,k)) + max(0.0, bottom_flux(i,k)) + if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux + endif + enddo ; enddo - do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 - top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) - bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) - enddo ; enddo ; enddo + k=1 + do i=is,ie + if(top_flux(i,k)>0.0) then + ea2d(i,k) = ea2d(i,k)*scale(i,k) + endif + if(bottom_flux(i,k)>0.0) then + ea2d(i,k+1) = ea2d(i,k+1)*scale(i,k) + eb2d(i,k) = eb2d(i,k)*scale(i,k) + endif + enddo + ! Interior layers + do k=2, nz-1 ; do i=is,ie + if(top_flux(i,k)>0.0) then + ea2d(i,k) = ea2d(i,k)*scale(i,k) + eb2d(i,k-1) = eb2d(i,k-1)*scale(i,k) + endif + if(bottom_flux(i,k)>0.0) then + ea2d(i,k+1) = ea2d(i,k+1)*scale(i,k) + eb2d(i,k) = eb2d(i,k)*scale(i,k) + endif + enddo; enddo; + k=nz + do i=is,ie + if(top_flux(i,k)>0.0) then + ea2d(i,k) = ea2d(i,k)*scale(i,k) + eb2d(i,k-1) = eb2d(i,k-1)*scale(i,k) + endif + if(bottom_flux(i,k)>0.0) then + eb2d(i,k) = eb2d(i,k)*scale(i,k) + endif + enddo - k=nz - do j=js-1,je+1 ; do i=is-1,ie+1 - top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) - bottom_flux(i,j,k) = -eb(i,j,k) - enddo ; enddo + ! Update h with new scaled fluxes + k=1 ! Top layer + do i=is,ie + top_flux(i,k) = -ea2d(i,k) + bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) + h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) + enddo + ! Interior layers + do k=2, nz-1 ; do i=is,ie + top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) + bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) + h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) + enddo ; enddo + k=nz ! Bottom layer + do i=is,ie + top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) + bottom_flux(i,k) = -eb2d(i,k) + h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) + enddo - select case (flux_order) - case (1) ! z -> x -> y - ! Check first to see if either the top or bottom flux would deplete the layer - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do i=is,ie + h(i,j,k) = h2d(i,k) + ea(i,j,k) = ea2d(i,k) + eb(i,j,k) = eb2d(i,k) + enddo; enddo - pos_flux = top_flux + bottom_flux - ! If the total vertical transport depletes a layer - if ( h_pre(i,j,k) < pos_flux ) then - scale_factor = ( h_pre(i,j,k) )/pos_flux*max_off_cfl - if (k>1 .and. k0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if(bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale top layer - elseif (k==1) then - if(top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor - if(bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale bottom layer - elseif (k==nz) then - if(top_flux(i,j,k)>0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor - endif + enddo + end subroutine flux_limiter_vertical + subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h + real :: max_off_cfl + ! Limits how much the a layer can be depleted in the vertical direction + real, dimension(SZIB_(G),SZK_(G)) :: uh2d + real, dimension(SZI_(G),SZK_(G)) :: h2d, scale + real :: total_out_flux, h_budget + integer :: i, j, k, m, is, ie, js, je, nz - endif + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - enddo ; enddo ; enddo + do j=js,je + do k=1,nz ; do i=is-1,ie + uh2d(i,k) = uh(i,j,k) + h2d(i,k) = h(i,j,k) + scale(i,k) = 1.0 + enddo ; enddo; + + do k=1,nz ; do i=is,ie + if (G%mask2dT(i,j)>0.0) then + h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step + ! based on the specified max CFL + total_out_flux = max(0.0,-uh2d(I-1,k)) + max(0.0, uh2d(I,k)) + ! -1 on uh(I-1) because flow is positive into the cell + if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux + + ! Scale back the outgoing flux(es) + if(-uh2d(I-1,k)>0.0) uh2d(I-1,k) = uh2d(I-1,k)*scale(i,k) + if( uh2d(I,k)>0.0) uh2d(I,k) = uh2d(I,k)*scale(i,k) + h2d(i,k) = h2d(i,k) + ( uh2d(I-1,k)-uh2d(I,k) ) + endif + enddo ; enddo + do k=1,nz ; do i=is-1,ie + uh(I,j,k) = uh2d(I,k) + h(i,j,k) = h2d(i,k) + enddo ; enddo + enddo + end subroutine flux_limiter_u + subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h + real, intent(in) :: max_off_cfl + ! Limits how much the a layer can be depleted in the vertical direction + real, dimension(SZJB_(G),SZK_(G)) :: vh2d + real, dimension(SZJ_(G),SZK_(G)) :: h2d, scale + real :: total_out_flux, h_budget + integer :: i, j, k, m, is, ie, js, je, nz + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + do i=is,ie + do k=1,nz ; do j=js-1,je + vh2d(j,k) = vh(i,j,k) + h2d(j,k) = h(i,j,k) + scale(j,k) = 1.0 + enddo ; enddo; + + do k=1,nz ; do j=js,je + if (G%mask2dT(i,j)>0.0) then + h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step + ! based on the specified max CFL + total_out_flux = max(0.0,-vh2d(J-1,k)) + max(0.0, vh2d(J,k)) + ! -1 on uh(I-1) because flow is positive into the cell + if (total_out_flux>h_budget) scale(j,k) = h_budget/total_out_flux + endif + ! Scale back the outgoing flux(es) + if(-vh2d(J-1,k)>0.0) vh2d(J-1,k) = vh2d(J-1,k)*scale(j,k) + if( vh2d(J,k)>0.0) vh2d(J,k) = vh2d(J,k)*scale(j,k) + h2d(j,k) = h2d(j,k) + ( vh2d(J-1,k)-vh2d(J,k) ) + enddo ; enddo - end subroutine limit_mass_flux_3d + do k=1,nz ; do j=js-1,je + vh(I,j,k) = vh2d(J,k) + h(i,j,k) = h2d(j,k) + enddo ; enddo + enddo + end subroutine flux_limiter_v end module MOM_offline_transport From 529d1b839a1c99d1aca9bb4769846ee5250c4372 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Sat, 10 Sep 2016 18:35:30 -0400 Subject: [PATCH 30/65] Further testing of flux limiter needed --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 95 ++++++-------------------- src/tracer/MOM_offline_control.F90 | 105 +++++++++++++++-------------- 3 files changed, 77 insertions(+), 125 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 2e7c7f9368..4887c302f3 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -419,7 +419,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) if (CS%show_call_tree) call callTree_leave("ALE_main()") - if (present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + !if (CS%id_dzRegrid>0) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) end subroutine ALE_main diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 5c9f01e3db..48b293afde 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1501,7 +1501,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre = CS%h call pass_var(h_pre,G%Domain) - call hchksum(h_pre, "Before steps h", G%HI, haloshift=1) CS%T = temp_old CS%S = salt_old @@ -1623,6 +1622,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) enddo; enddo; enddo call sum_across_PEs(sum_abs_fluxes) + + if (sum_abs_fluxes==0) then + print *, 'Converged after iteration', iter + exit + endif ! ! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes !, & @@ -1644,35 +1648,26 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! in layer thickness. Therefore, half of the diagnosed mixing is applied before the ! any horizontal advection occurs and half occurs after the horizontal advection has ! converged. - call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & - CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) +! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & +! CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) ea_zero(:,:,:) = 0.0 ; eb_zero(:,:,:) = 0.0 do iter=1,CS%offline_CSp%num_off_iter uhtr_sub(:,:,:) = uhtr(:,:,:) vhtr_sub(:,:,:) = vhtr(:,:,:) - call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, eatr, ebtr, h_pre, CS%offline_CSp%max_off_cfl, & + call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, h_pre, CS%offline_CSp%max_off_cfl, & z_first, x_before_y) ! Perform zonal and meridional advection do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo; enddo; enddo - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=100, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=100, x_first_in=x_before_y) x_before_y = .not. x_before_y - ! Advect tracer returns how much horizontal flux remains, thus the total amount of horizontal - ! actually done in this time step is uhtr-uhtr_sub and vhtr-vhtr_sub. This is needed to - ! calculate the cell thickness to be remapped in ALE - do k=1,nz ; do I=is-2,ie+1 ; do j=js-1,js+1 - uhtr_sub(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do I=is-1,ie+1 ; do J=js-2,js+1 - vhtr_sub(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo ; enddo ; enddo - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) @@ -1690,10 +1685,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! the remaining horizontal fluxes sum_abs_fluxes = 0.0 do k=1,nz; do j=js,je; do i=is,ie - sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & + sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) enddo; enddo; enddo call sum_across_PEs(sum_abs_fluxes) + ! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes ! Regridding/remapping is done here after each advection iteration so that @@ -1742,10 +1738,16 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! happen after the H update and before the next post_data. call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, dt_iter) + + + if (sum_abs_fluxes==0) then + print *, 'Converged after iteration', iter + exit + endif enddo - call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & - CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) +! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & +! CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) endif @@ -1756,61 +1758,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) h_temp = h_end-h_pre -! -! if(.not.CS%diabatic_first .and. CS%use_ALE_algorithm) then -! -! h_temp = CS%offline_CSp%h_preale-h_pre -! ! Regridding/remapping is done here, at end of thermodynamics time step -! ! (that may comprise several dynamical time steps) -! ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. -! -! CS%tv%T = CS%offline_CSp%T_preale -! CS%tv%S = CS%offline_CSp%S_preale -! -!! call do_group_pass(CS%pass_T_S_h, G%Domain) -! -! ! update squared quantities -! if (associated(CS%S_squared)) & -! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 -! if (associated(CS%T_squared)) & -! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 -! -! if (CS%debug) then -! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) -! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) -! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) -! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) -! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) -! endif -! call cpu_clock_begin(id_clock_ALE) -! call ALE_main(G, GV, CS%offline_CSp%h_preale, CS%offline_CSp%u_preale, & -! CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & -! CS%ALE_CSp, h_override = h_end) -! call cpu_clock_end(id_clock_ALE) -! -! if (CS%debug) then -! call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) -! call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) -! endif -! -! CS%tv%T = temp_old -! CS%tv%S = salt_old -! -! call pass_var(CS%T,G%Domain) -! call pass_var(CS%S,G%Domain) -! -! ! Whenever thickness changes let the diag manager know, target grids -! ! for vertical remapping may need to be regenerated. This needs to -! ! happen after the H update and before the next post_data. -! call diag_update_target_grids(CS%diag) -! call post_diags_TS_vardec(G, CS, CS%offline_CSp%dt_offline) -! -! h_end = CS%offline_CSp%h_preale -! call pass_var(h_end,G%Domain) - -! endif !Diabatic second and ALE - - if (CS%offline_CSp%id_hr>0) call post_data(CS%offline_CSp%id_hr, h_temp, CS%diag) if (CS%offline_CSp%id_uhr>0) call post_data(CS%offline_CSp%id_uhr, uhtr, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index b8bfad09db..8cde804089 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -45,7 +45,7 @@ module MOM_offline_transport use data_override_mod, only : data_override_init, data_override use MOM_time_manager, only : time_type use MOM_domains, only : pass_var, pass_vector, To_All - use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, WARNING, is_root_pe + use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe use MOM_grid, only : ocean_grid_type use MOM_verticalGrid, only : verticalGrid_type use MOM_io, only : read_data @@ -614,7 +614,7 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, integer :: i, j, k, m, is, ie, js, je, nz real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_budget ! Tracks how much thickness ! remains for other fluxes - integer :: flux_order + integer :: flux_order = -1 ! In this subroutine, fluxes out of the box are scaled down if they deplete ! the layer. Here the positive direction is defined as flux out of the box as opposed to the ! typical, strictly upwind convention. Hence, uh(I-1) is multipled by negative one, @@ -630,9 +630,11 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, ! 4: y -> x -> z ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed ; nz = GV%ke ! Copy layer thicknesses into a working array for this subroutine - h_budget(:,:,:) = h_in(:,:,:) + do k=1,nz ; do j=js,je ; do i=is,ie + h_budget(i,j,k) = h_in(i,j,k)*G%areaT(i,j) + enddo ; enddo ; enddo ! Set the flux order (corresponding to one of the four cases described previously) if (z_first .and. x_before_y) flux_order = 1 @@ -658,6 +660,8 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + case default + call MOM_error(FATAL, "Invalid choice of flux_order") end select end subroutine limit_mass_flux_ordered_3d @@ -677,7 +681,7 @@ subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed ; nz = GV%ke do j=js,je do k=1,nz ; do i=is,ie @@ -704,12 +708,11 @@ subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) enddo do k=1,nz ; do i=is,ie - if (G%mask2dT(i,j)>0.0) then - h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step - ! based on the specified max CFL - total_out_flux = max(0.0,top_flux(i,k)) + max(0.0, bottom_flux(i,k)) - if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux - endif + h_budget = h2d(i,k)*max_off_cfl ! How much the layer can be depleted in any given step + ! based on the specified max CFL + total_out_flux = (max(0.0,top_flux(i,k)) + max(0.0, bottom_flux(i,k)))*G%areaT(i,j) + if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux + if (scale(j,k)>1.0) call MOM_error(FATAL, "scale(j,k) is larger than 1") enddo ; enddo k=1 @@ -749,23 +752,20 @@ subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) do i=is,ie top_flux(i,k) = -ea2d(i,k) bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) - h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) enddo ! Interior layers do k=2, nz-1 ; do i=is,ie top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) - h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) enddo ; enddo k=nz ! Bottom layer do i=is,ie top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) bottom_flux(i,k) = -eb2d(i,k) - h2d(i,k) = -top_flux(i,k) - bottom_flux(i,k) enddo do k=1,nz ; do i=is,ie - h(i,j,k) = h2d(i,k) + h(i,j,k) = h2d(i,k) - (top_flux(i,k)+bottom_flux(i,k))*G%areaT(i,j) ea(i,j,k) = ea2d(i,k) eb(i,j,k) = eb2d(i,k) enddo; enddo @@ -781,38 +781,46 @@ subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) real :: max_off_cfl ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real, dimension(SZI_(G),SZK_(G)) :: h2d, scale - real :: total_out_flux, h_budget + real, dimension(SZI_(G),SZK_(G)) :: h_budget2d, uh_div + real :: scale_factor integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%IsdB ; ie = G%IedB ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do i=is,ie uh2d(i,k) = uh(i,j,k) - h2d(i,k) = h(i,j,k) - scale(i,k) = 1.0 + h_budget2d(i,k) = h(i,j,k)*max_off_cfl enddo ; enddo; - do k=1,nz ; do i=is,ie - if (G%mask2dT(i,j)>0.0) then - h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step - ! based on the specified max CFL - total_out_flux = max(0.0,-uh2d(I-1,k)) + max(0.0, uh2d(I,k)) - ! -1 on uh(I-1) because flow is positive into the cell - if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux - - ! Scale back the outgoing flux(es) - if(-uh2d(I-1,k)>0.0) uh2d(I-1,k) = uh2d(I-1,k)*scale(i,k) - if( uh2d(I,k)>0.0) uh2d(I,k) = uh2d(I,k)*scale(i,k) - h2d(i,k) = h2d(i,k) + ( uh2d(I-1,k)-uh2d(I,k) ) + do k=1,nz ; do i=is+1,ie + uh_div(i,k) = uh2d(I-1,k) - uh2d(I,k) + enddo ; enddo + + do k=1,nz ; do i=is+1,ie + ! Check to see if the uh-divergence will deplete the layer + if(uh_div(i,k)>h_budget2d(i,k)) then + scale = h_budget2d(i,k)/uh_div(i,k) + + ! Three divergent cases + ! <-- , --> + if( uh2d(I-1,k)<0.0 .and. uh2d(I,k)>0.0 ) then + uh2d(I-1,k) = uh2d(I-1,k)*scale + uh2d(I,k) = uh2d(I,k)*scale + ! <-- , <-- + elseif( uh2d(I-1,k)<0.0 .and. uh2d(I,k)<0.0 ) + uh2d(I-1,k) = uh2d(I-1,k)*scale + ! --> , --> + elseif( uh2d(I-1,k)>0.0 .and. uh2d(I,k)>0.0) + uh2d(I,k) = uh2d(I,k)*scale + endif endif enddo ; enddo - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do i=is,ie uh(I,j,k) = uh2d(I,k) - h(i,j,k) = h2d(i,k) + h(i,j,k) = h2d(i,k) + ( uh2d(I-1,k)-uh2d(I,k) ) enddo ; enddo enddo @@ -831,32 +839,29 @@ subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isd ; ie = G%ied ; js = G%jsdB ; je = G%jedB ; nz = GV%ke do i=is,ie - do k=1,nz ; do j=js-1,je - vh2d(j,k) = vh(i,j,k) - h2d(j,k) = h(i,j,k) + do k=1,nz ; do j=js,je + vh2d(J,k) = vh(i,J,k) + h2d(j,k) = h(i,j,k)*G%areaT(i,j) scale(j,k) = 1.0 enddo ; enddo; - do k=1,nz ; do j=js,je - if (G%mask2dT(i,j)>0.0) then - h_budget = h(i,j,k)*max_off_cfl ! How much the layer can be depleted in any given step - ! based on the specified max CFL - total_out_flux = max(0.0,-vh2d(J-1,k)) + max(0.0, vh2d(J,k)) - ! -1 on uh(I-1) because flow is positive into the cell - if (total_out_flux>h_budget) scale(j,k) = h_budget/total_out_flux - endif + do k=1,nz ; do j=js+1,je + h_budget = h2d(j,k)*max_off_cfl ! How much the layer can be depleted in any given step + ! based on the specified max CFL + total_out_flux = vh2d(J-1,k) - vh2d(J,k) + if (total_out_flux>h_budget) scale(j,k) = h_budget/total_out_flux ! Scale back the outgoing flux(es) if(-vh2d(J-1,k)>0.0) vh2d(J-1,k) = vh2d(J-1,k)*scale(j,k) if( vh2d(J,k)>0.0) vh2d(J,k) = vh2d(J,k)*scale(j,k) h2d(j,k) = h2d(j,k) + ( vh2d(J-1,k)-vh2d(J,k) ) enddo ; enddo - do k=1,nz ; do j=js-1,je - vh(I,j,k) = vh2d(J,k) - h(i,j,k) = h2d(j,k) + do k=1,nz ; do j=js,je + vh(i,J,k) = vh2d(J,k) + h(i,j,k) = h2d(j,k)*G%IareaT(i,j) enddo ; enddo enddo end subroutine flux_limiter_v From f83f3f5e816bbf0c12c7c03ed3813871dcb91e6b Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 14 Sep 2016 15:02:59 -0400 Subject: [PATCH 31/65] Syncing before switching brnach --- src/core/MOM.F90 | 4 +- src/tracer/#salt_like_tracer.F90# | 506 +++++++++++++++++++++++++++++ src/tracer/MOM_offline_control.F90 | 124 +++---- 3 files changed, 574 insertions(+), 60 deletions(-) create mode 100644 src/tracer/#salt_like_tracer.F90# diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 48b293afde..9d799103c1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1513,8 +1513,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) ! to make sure that offline advection is monotonic and positive-definite ! - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first diff --git a/src/tracer/#salt_like_tracer.F90# b/src/tracer/#salt_like_tracer.F90# new file mode 100644 index 0000000000..00e150b42d --- /dev/null +++ b/src/tracer/#salt_like_tracer.F90# @@ -0,0 +1,506 @@ +module pseudo_salt_tracer +!*********************************************************************** +/sa::!* GNU General Public License * +!* This file is a part of MOM. * +!* * +!* MOM is free software; you can redistribute it and/or modify it and * +!* are expected to follow the terms of the GNU General Public License * +!* as published by the Free Software Foundation; either version 2 of * +!* the License, or (at your option) any later version. * +!* * +!* MOM is distributed in the hope that it will be useful, but WITHOUT * +!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * +!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * +!* License for more details. * +!* * +!* For the full text of the GNU General Public License, * +!* write to: Free Software Foundation, Inc., * +!* 675 Mass Ave, Cambridge, MA 02139, USA. * +!* or see: http://www.gnu.org/licenses/gpl.html * +!*********************************************************************** + +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Andrew Shao, 2016 * +!* * +!* This file contains the routines necessary to model a passive * +!* tracer that uses the same boundary fluxes as salinity. At the * +!* beginning of the run, salt is set to the same as tv%S. Any * +!* deviations between this salt-like tracer and tv%S signifies a * +!* difference between how active and passive tracers are treated. * +!* A single subroutine is called from within each file to register * +!* each of the tracers for reinitialization and advection and to * +!* register the subroutine that initializes the tracers and set up * +!* their output and the subroutine that does any tracer physics or * +!* chemistry along with diapycnal mixing (included here because some * +!* tracers may float or swim vertically or dye diapycnal processes). * +!* * +!* * +!* Macros written all in capital letters are defined in MOM_memory.h. * +!* * +!* A small fragment of the grid is shown below: * +!* * +!* j+1 x ^ x ^ x At x: q * +!* j+1 > o > o > At ^: v * +!* j x ^ x ^ x At >: u * +!* j > o > o > At o: h, tr * +!* j-1 x ^ x ^ x * +!* i-1 i i+1 At x & ^: * +!* i i+1 At > & o: * +!* * +!* The boundaries always run through q grid points (x). * +!* * +!********+*********+*********+*********+*********+*********+*********+** + +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type, get_time +use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values +use MOM_tracer_vertical, only : tracer_vertdiff +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_variables, only : surface +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use coupler_util, only : set_coupler_values, ind_csurf +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux + +implicit none ; private + +#include + +public register_pseudo_salt_tracer, initialize_pseudo_salt_tracer +public pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state +public pseudo_salt_stock, pseudo_salt_tracer_end + +! NTR_MAX is the maximum number of tracers in this module. +integer, parameter :: NTR_MAX = 1 + +type p3d + real, dimension(:,:,:), pointer :: p => NULL() +end type p3d + +type, public :: pseudo_salt_tracer_CS ; private + integer :: ntr ! The number of tracers that are actually used. + logical :: coupled_tracers = .false. ! These tracers are not offered to the + ! coupler. + type(time_type), pointer :: Time ! A pointer to the ocean model's clock. + type(tracer_registry_type), pointer :: tr_Reg => NULL() + real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this + ! subroutine, in g m-3? + type(p3d), dimension(NTR_MAX) :: & + tr_adx, &! Tracer zonal advective fluxes in g m-3 m3 s-1.An Error Has Occurred + + + tr_ady, &! Tracer meridional advective fluxes in g m-3 m3 s-1. + tr_dfx, &! Tracer zonal diffusive fluxes in g m-3 m3 s-1. + tr_dfy ! Tracer meridional diffusive fluxes in g m-3 m3 s-1. + logical :: mask_tracers ! If true, pseudo_salt is masked out in massless layers. + logical :: pseudo_salt_may_reinit = .true. ! Hard coding since this should not matter + integer, dimension(NTR_MAX) :: & + ind_tr, & ! Indices returned by aof_set_coupler_flux if it is used and the + ! surface tracer concentrations are to be provided to the coupler. + id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1, & + id_tr_dfx = -1, id_tr_dfy = -1 + real, dimension(NTR_MAX) :: land_val = -1.0 + + type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the + ! timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() + + type(vardesc) :: tr_desc(NTR_MAX) +end type pseudo_salt_tracer_CS + +contains + +function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) + type(hor_index_type), intent(in) :: HI + type(verticalGrid_type), intent(in) :: GV + type(param_file_type), intent(in) :: param_file + type(pseudo_salt_tracer_CS), pointer :: CS + type(tracer_registry_type), pointer :: tr_Reg + type(MOM_restart_CS), pointer :: restart_CS +! This subroutine is used to register tracer fields and subroutines +! to be used with MOM. +! Arguments: HI - A horizontal index type structure. +! (in) GV - The ocean's vertical grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CS - A pointer that is set to point to the control structure +! for this module +! (in/out) tr_Reg - A pointer that is set to point to the control structure +! for the tracer advection and diffusion module. +! (in) restart_CS - A pointer to the restart control structure. + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mod = "pseudo_salt_tracer" ! This module's name. + character(len=200) :: inputdir ! The directory where the input files are. + character(len=48) :: var_name ! The variable's name. + character(len=3) :: name_tag ! String for creating identifying pseudo_salt + real, pointer :: tr_ptr(:,:,:) => NULL() + logical :: register_pseudo_salt_tracer + integer :: isd, ied, jsd, jed, nz, m, i, j + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke + + if (associated(CS)) then + call MOM_error(WARNING, "register_pseudo_salt_tracer called with an "// & + "associated control structure.") + return + endif + allocate(CS) + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + + CS%ntr = NTR_MAX + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + + do m=1,CS%ntr + ! This is needed to force the compiler not to do a copy in the registration + ! calls. Curses on the designers and implementers of Fortran90. + CS%tr_desc(m) = var_desc("pseudo_salt", "kg", "Pseudo salt passive tracer", caller=mod) + tr_ptr => CS%tr(:,:,:,m) + call query_vardesc(CS%tr_desc(m), name=var_name, caller="register_pseudo_salt_tracer") + ! Register the tracer for the restart file. + call register_restart_field(tr_ptr, CS%tr_desc(m), & + .not. CS%pseudo_salt_may_reinit, restart_CS) + ! Register the tracer for horizontal advection & diffusion. + call register_tracer(tr_ptr, CS%tr_desc(m), param_file, HI, GV, tr_Reg, & + tr_desc_ptr=CS%tr_desc(m)) + + ! Set coupled_tracers to be true (hard-coded above) to provide the surface + ! values to the coupler (if any). This is meta-code and its arguments will + ! currently (deliberately) give fatal errors if it is used. + if (CS%coupled_tracers) & + CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & + flux_type=' ', implementation=' ', caller="register_pseudo_salt_tracer") + enddo + + CS%tr_Reg => tr_Reg + CS%restart_CSp => restart_CS + register_pseudo_salt_tracer = .true. + +end function register_pseudo_salt_tracer + +subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & + sponge_CSp, diag_to_Z_CSp, tv) + logical, intent(in) :: restart + type(time_type), target, intent(in) :: day + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h + type(diag_ctrl), target, intent(in) :: diag + type(ocean_OBC_type), pointer :: OBC + type(pseudo_salt_tracer_CS), pointer :: CS + type(sponge_CS), pointer :: sponge_CSp + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + type(thermo_var_ptrs), intent(in) :: tv +! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) +! and it sets up the tracer output. + +! Arguments: restart - .true. if the fields have already been read from +! a restart file. +! (in) day - Time of the start of the run. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) h - Layer thickness, in m or kg m-2. +! (in) diag - A structure that is used to regulate diagnostic output. +! (in) OBC - This open boundary condition type specifies whether, where, +! and what open boundary conditions are used. +! (in/out) CS - The control structure returned by a previous call to +! register_pseudo_salt_tracer. +! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if +! they are in use. Otherwise this may be unassociated. +! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics +! in depth space. + character(len=16) :: name ! A variable's name in a NetCDF file. + character(len=72) :: longname ! The long name of that variable. + character(len=48) :: units ! The dimensions of the variable. + character(len=48) :: flux_units ! The units for age tracer fluxes, either + ! years m3 s-1 or years kg s-1. + logical :: OK + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m + integer :: IsdB, IedB, JsdB, JedB + + if (.not.associated(CS)) return + if (CS%ntr < 1) return + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + CS%Time => day + CS%diag => diag + name = "pseudo_salt" + + do m=1,CS%ntr + call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_pseudo_salt_tracer") + if ((.not.restart) .or. (.not. & + query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%tr(i,j,k,m) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + enddo ! Tracer loop + + if (associated(OBC)) then + ! All tracers but the first have 0 concentration in their inflows. As this + ! is the default value, the following calls are unnecessary. + ! do m=1,CS%ntr + ! call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0) + ! enddo + endif + + ! This needs to be changed if the units of tracer are changed above. + if (GV%Boussinesq) then ; flux_units = "kg salt/(m^2 s)" + else ; flux_units = "kg salt/(m^2 s)" ; endif + + do m=1,CS%ntr + ! Register the tracer for the restart file. + call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & + caller="initialize_pseudo_salt_tracer") + CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & + day, trim(longname) , trim(units)) + CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & + CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & + trim(flux_units)) + CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & + CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & + trim(flux_units)) + CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & + CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & + trim(flux_units)) + CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & + CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & + trim(flux_units)) + if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) + if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) + if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) + if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) + +! Register the tracer for horizontal advection & diffusion. + if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & + (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & + call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & + CS%tr_ady(m)%p,CS%tr_dfx(m)%p,CS%tr_dfy(m)%p) + + call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & + day, G, diag_to_Z_CSp) + enddo + +end subroutine initialize_pseudo_salt_tracer + +subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, & + aggregate_FW_forcing, evap_CFL_limit, minimum_forcing_depth) + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb + type(forcing), intent(in) :: fluxes + real, intent(in) :: dt + type(pseudo_salt_tracer_CS), pointer :: CS + type(thermo_var_ptrs), intent(in) :: tv + logical, optional,intent(in) :: aggregate_FW_forcing + real, optional,intent(in) :: evap_CFL_limit + real, optional,intent(in) :: minimum_forcing_depth +! This subroutine applies diapycnal diffusion and any other column +! tracer physics or chemistry to the tracers from this file. +! This is a simple example of a set of advected passive tracers. + +! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. +! (in) h_new - Layer thickness after entrainment, in m or kg m-2. +! (in) ea - an array to which the amount of fluid entrained +! from the layer above during this call will be +! added, in m or kg m-2. +! (in) eb - an array to which the amount of fluid entrained +! from the layer below during this call will be +! added, in m or kg m-2. +! (in) fluxes - A structure containing pointers to any possible +! forcing fields. Unused fields have NULL ptrs. +! (in) dt - The amount of time covered by this call, in s. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! register_pseudo_salt_tracer. +! +! The arguments to this subroutine are redundant in that +! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] + + real :: Isecs_per_year = 1.0 / (365.0*86400.0) + real :: year, h_total, scale, htot, Ih_limit + integer :: secs, days + integer :: i, j, k, is, ie, js, je, nz, m, k_max + real, allocatable :: local_tr(:,:,:) + real, dimension(SZI_(G),SZJ_(G)) :: salt_sfc_src + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + if (.not.associated(CS)) return + if (CS%ntr < 1) return + + ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode + if (present(aggregate_FW_forcing) .and. present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + do j=js,je ; do i=is,ie + + ! The net flux of salt at the surface is determined in a similar way as + ! in extractFluxes1d found in MOM_forcing_type + htot= h_old(i,j,1) + do k=2,nz ; htot = htot + h_old(i,j,k) ; enddo + scale = 1.0 + Ih_limit = 1./max(GV%Angstrom, 1.E-30*GV%m_to_H) + if (htot*Ih_limit < 1.0) scale = htot*Ih_limit + salt_sfc_src(i,j) = (scale*1000.0 * fluxes%salt_flux(i,j)) + salt_sfc_src(i,j) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * +GV%kg_m2_H + enddo ; enddo; + do m=1,CS%ntr + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV, & + aggregate_FW_forcing=aggregate_FW_forcing, evap_CFL_limit=evap_CFL_limit,& + minimum_forcing_depth=minimum_forcing_depth, fluxes=fluxes) + enddo + else + do m=1,CS%ntr + call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) + enddo + endif + + allocate(local_tr(G%isd:G%ied,G%jsd:G%jed,nz)) + do m=1,CS%ntr + if (CS%id_tracer(m)>0) then + if (CS%mask_tracers) then + do k=1,nz ; do j=js,je ; do i=is,ie + if (h_new(i,j,k) < 1.1*GV%Angstrom) then + local_tr(i,j,k) = CS%land_val(m) + else + local_tr(i,j,k) = CS%tr(i,j,k,m) + endif + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + local_tr(i,j,k) = CS%tr(i,j,k,m) + enddo ; enddo ; enddo + endif ! CS%mask_tracers + call post_data(CS%id_tracer(m),local_tr,CS%diag) + endif ! CS%id_tracer(m)>0 + if (CS%id_tr_adx(m)>0) & + call post_data(CS%id_tr_adx(m),CS%tr_adx(m)%p(:,:,:),CS%diag) + if (CS%id_tr_ady(m)>0) & + call post_data(CS%id_tr_ady(m),CS%tr_ady(m)%p(:,:,:),CS%diag) + if (CS%id_tr_dfx(m)>0) & + call post_data(CS%id_tr_dfx(m),CS%tr_dfx(m)%p(:,:,:),CS%diag) + if (CS%id_tr_dfy(m)>0) & + call post_data(CS%id_tr_dfy(m),CS%tr_dfy(m)%p(:,:,:),CS%diag) + enddo + deallocate(local_tr) + +end subroutine pseudo_salt_tracer_column_physics + +function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h + real, dimension(:), intent(out) :: stocks + type(pseudo_salt_tracer_CS), pointer :: CS + character(len=*), dimension(:), intent(out) :: names + character(len=*), dimension(:), intent(out) :: units + integer, optional, intent(in) :: stock_index + integer :: pseudo_salt_stock +! This function calculates the mass-weighted integral of all tracer stocks, +! returning the number of stocks it has calculated. If the stock_index +! is present, only the stock corresponding to that coded index is returned. + +! Arguments: h - Layer thickness, in m or kg m-2. +! (out) stocks - the mass-weighted integrated amount of each tracer, +! in kg times concentration units. +! (in) G - The ocean's grid structure. +! (in) GV - The ocean's vertical grid structure. +! (in) CS - The control structure returned by a previous call to +! register_pseudo_salt_tracer. +! (out) names - the names of the stocks calculated. +! (out) units - the units of the stocks calculated. +! (in,opt) stock_index - the coded index of a specific stock being sought. +! Return value: the number of stocks calculated here. + + integer :: i, j, k, is, ie, js, je, nz, m + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + pseudo_salt_stock = 0 + if (.not.associated(CS)) return + if (CS%ntr < 1) return + + if (present(stock_index)) then ; if (stock_index > 0) then + ! Check whether this stock is available from this routine. + + ! No stocks from this routine are being checked yet. Return 0. + return + endif ; endif + + do m=1,CS%ntr + call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="pseudo_salt_stock") + units(m) = trim(units(m))//" kg" + stocks(m) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & + (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) + enddo ; enddo ; enddo + stocks(m) = GV%H_to_kg_m2 * stocks(m) + enddo + pseudo_salt_stock = CS%ntr + +end function pseudo_salt_stock + +subroutine pseudo_salt_tracer_surface_state(state, h, G, CS) + type(ocean_grid_type), intent(in) :: G + type(surface), intent(inout) :: state + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h + type(pseudo_salt_tracer_CS), pointer :: CS +! This particular tracer package does not report anything back to the coupler. +! The code that is here is just a rough guide for packages that would. +! Arguments: state - A structure containing fields that describe the +! surface state of the ocean. +! (in) h - Layer thickness, in m or kg m-2. +! (in) G - The ocean's grid structure. +! (in) CS - The control structure returned by a previous call to +! register_pseudo_salt_tracer. + integer :: m, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(CS)) return + + if (CS%coupled_tracers) then + do m=1,CS%ntr + ! This call loads the surface vlues into the appropriate array in the + ! coupler-type structure. + call set_coupler_values(CS%tr(:,:,1,m), state%tr_fields, CS%ind_tr(m), & + ind_csurf, is, ie, js, je) + enddo + endif + +end subroutine pseudo_salt_tracer_surface_state + +subroutine pseudo_salt_tracer_end(CS) + type(pseudo_salt_tracer_CS), pointer :: CS + integer :: m + + if (associated(CS)) then + if (associated(CS%tr)) deallocate(CS%tr) + do m=1,CS%ntr + if (associated(CS%tr_adx(m)%p)) deallocate(CS%tr_adx(m)%p) + if (associated(CS%tr_ady(m)%p)) deallocate(CS%tr_ady(m)%p) + if (associated(CS%tr_dfx(m)%p)) deallocate(CS%tr_dfx(m)%p) + if (associated(CS%tr_dfy(m)%p)) deallocate(CS%tr_dfy(m)%p) + enddo + + deallocate(CS) + endif +end subroutine pseudo_salt_tracer_end + +end module pseudo_salt_tracer diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 8cde804089..00a2e78aa9 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -645,19 +645,19 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, select case (flux_order) case (1) ! z -> x -> y ! Check first to see if either the top or bottom flux would deplete the layer - call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + !call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) case (2) ! z -> y -> x - call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) + !call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) case (3) ! x -> y -> z - call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + !call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) case (4) ! y -> x -> z - call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + !call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) case default @@ -781,48 +781,45 @@ subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) real :: max_off_cfl ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real, dimension(SZI_(G),SZK_(G)) :: h_budget2d, uh_div - real :: scale_factor + real :: hup, hlos, min_h integer :: i, j, k, m, is, ie, js, je, nz + min_h= 0.1*GV%Angstrom ! Set index-related variables for fields on T-grid - is = G%IsdB ; ie = G%IedB ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je - do k=1,nz ; do i=is,ie - uh2d(i,k) = uh(i,j,k) - h_budget2d(i,k) = h(i,j,k)*max_off_cfl + do k=1,nz ; do i=is-1,ie + uh2d(I,k) = uh(I,j,k) enddo ; enddo; - do k=1,nz ; do i=is+1,ie - uh_div(i,k) = uh2d(I-1,k) - uh2d(I,k) + do k=1,nz ; do i=is-1,ie + if(uh2d(I,k)<0.0) then + hup = h(i+1,j,k) - G%areaT(i+1,j)*min_h + hlos = MAX(0.0,uh2d(I+1,k)) + if (((hup + uh2d(I,k) - hlos) < 0.0) .and. ((0.5*hup + uh2d(I,k)) < 0.0)) & + uh2d(I,k) = MIN(-0.5*hup,-hup+hlos,0.0) + + elseif(uh2d(I,k)>0.0) then + hup = h(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-uh2d(I-1,k)) + if (((hup - uh2d(I,k) - hlos) < 0.0) .and. ((0.5*hup - uh2d(I,k)) < 0.0)) & + uh2d(I,k) = MAX(0.5*hup,hup-hlos,0.0) + endif enddo ; enddo - do k=1,nz ; do i=is+1,ie - ! Check to see if the uh-divergence will deplete the layer - if(uh_div(i,k)>h_budget2d(i,k)) then - scale = h_budget2d(i,k)/uh_div(i,k) - - ! Three divergent cases - ! <-- , --> - if( uh2d(I-1,k)<0.0 .and. uh2d(I,k)>0.0 ) then - uh2d(I-1,k) = uh2d(I-1,k)*scale - uh2d(I,k) = uh2d(I,k)*scale - ! <-- , <-- - elseif( uh2d(I-1,k)<0.0 .and. uh2d(I,k)<0.0 ) - uh2d(I-1,k) = uh2d(I-1,k)*scale - ! --> , --> - elseif( uh2d(I-1,k)>0.0 .and. uh2d(I,k)>0.0) - uh2d(I,k) = uh2d(I,k)*scale + do k=1,nz + do i=is-1,ie + uh(I,j,k) = uh2d(I,k) + enddo + do i=is,ie + h(i,j,k) = h(i,j,k) + (uh2d(I-1,k)-uh2d(I,k)) + if( h(i,j,k)<0.0 ) then + print *, i, j, k, h(i,j,k) endif - endif - enddo ; enddo - - do k=1,nz ; do i=is,ie - uh(I,j,k) = uh2d(I,k) - h(i,j,k) = h2d(i,k) + ( uh2d(I-1,k)-uh2d(I,k) ) - enddo ; enddo - enddo + enddo + enddo + enddo end subroutine flux_limiter_u @@ -834,35 +831,46 @@ subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) real, intent(in) :: max_off_cfl ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZJB_(G),SZK_(G)) :: vh2d - real, dimension(SZJ_(G),SZK_(G)) :: h2d, scale - real :: total_out_flux, h_budget + real, dimension(SZJ_(G),SZK_(G)) :: h2d + real :: hup, hlos, min_h integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isd ; ie = G%ied ; js = G%jsdB ; je = G%jedB ; nz = GV%ke - + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + min_h= 0.1*GV%Angstrom do i=is,ie - do k=1,nz ; do j=js,je - vh2d(J,k) = vh(i,J,k) - h2d(j,k) = h(i,j,k)*G%areaT(i,j) - scale(j,k) = 1.0 + do k=1,nz ; do j=js-1,je + vh2d(J,k) = vh(i,J,k) enddo ; enddo; - - do k=1,nz ; do j=js+1,je - h_budget = h2d(j,k)*max_off_cfl ! How much the layer can be depleted in any given step - ! based on the specified max CFL - total_out_flux = vh2d(J-1,k) - vh2d(J,k) - if (total_out_flux>h_budget) scale(j,k) = h_budget/total_out_flux - ! Scale back the outgoing flux(es) - if(-vh2d(J-1,k)>0.0) vh2d(J-1,k) = vh2d(J-1,k)*scale(j,k) - if( vh2d(J,k)>0.0) vh2d(J,k) = vh2d(J,k)*scale(j,k) - h2d(j,k) = h2d(j,k) + ( vh2d(J-1,k)-vh2d(J,k) ) + + do k=1,nz ; do j=js-1,je + if(vh2d(J,k)<0.0) then + hup = h(i,j+1,k) - G%areaT(i,j+1)*min_h + hlos = MAX(0.0,vh2d(J+1,k)) + if (((hup + vh2d(J,k) - hlos) < 0.0) .and. ((0.5*hup + vh2d(J,k)) < 0.0)) & + vh2d(J,k) = MIN(-0.5*hup,-hup+hlos,0.0) + + elseif(vh2d(J,k)>0.0) then + hup = h(i,j,k) - G%areaT(i,j)*min_h + hlos = MAX(0.0,-vh2d(J-1,k)) + if (((hup - vh2d(J,k) - hlos) < 0.0) .and. ((0.5*hup - vh2d(J,k)) < 0.0)) & + vh2d(J,k) = MAX(0.5*hup,hup-hlos,0.0) + endif enddo ; enddo - do k=1,nz ; do j=js,je - vh(i,J,k) = vh2d(J,k) - h(i,j,k) = h2d(j,k)*G%IareaT(i,j) - enddo ; enddo + do k=1,nz + do j=js-1,je + vh(i,J,k) = vh2d(J,k) + enddo + + do j=js,je + h(i,j,k) = h(i,j,k) + (vh2d(J-1,k)-vh2d(J,k)) + if( h(i,j,k)<0.0 ) then + print *, i, j, k, h(i,j,k) + endif + enddo + enddo + enddo end subroutine flux_limiter_v From 48d6ad1080fd248a978e3f6eac59487132de6945 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 27 Sep 2016 14:45:23 -0400 Subject: [PATCH 32/65] Convergence occurs faster when FIRST_DIRECTION=1, meridional first, consider using dzThickness as extra ea --- src/core/MOM.F90 | 94 ++++++++++------ .../vertical/MOM_diabatic_aux.F90 | 6 - .../vertical/MOM_diabatic_driver.F90 | 13 --- src/tracer/MOM_offline_control.F90 | 104 +++++++++--------- src/tracer/MOM_tracer_advect.F90 | 1 + src/tracer/MOM_tracer_flow_control.F90 | 36 ------ src/tracer/advection_test_tracer.F90 | 5 +- 7 files changed, 117 insertions(+), 142 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c385d48939..e38a51085d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1429,7 +1429,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! V-2D real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub - real :: sum_abs_fluxes + real :: sum_abs_fluxes, sum_u, sum_v ! Local variables real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & @@ -1499,7 +1499,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (CS%offline_CSp%id_vhtr_preadv>0) call post_data(CS%offline_CSp%id_vhtr_preadv, vhtr, CS%diag) if (CS%id_h>0) call post_data(CS%id_h, h_end, CS%diag) - h_pre = CS%h + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_pre(i,j,k) = CS%h(i,j,k) + enddo ; enddo; enddo + call pass_var(h_pre,G%Domain) CS%T = temp_old @@ -1544,7 +1547,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! First do vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 h_pre(i,j,k) = h_new(i,j,k) @@ -1586,7 +1589,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) @@ -1617,12 +1620,17 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! ! Calculate how close we are to converging by summing the remaining fluxes at each point sum_abs_fluxes = 0.0 + sum_u = 0.0 + sum_v = 0.0 do k=1,nz; do j=js,je; do i=is,ie + sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) + sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) enddo; enddo; enddo call sum_across_PEs(sum_abs_fluxes) - + + print *, "Remaining u-flux, v-flux:", sum_u, sum_v if (sum_abs_fluxes==0) then print *, 'Converged after iteration', iter exit @@ -1650,48 +1658,47 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! converged. ! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & ! CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) - - ea_zero(:,:,:) = 0.0 ; eb_zero(:,:,:) = 0.0 + + do k=1,nz ; do j=jsd,jed ; do i = isd,ied + ea_zero(i,j,k) = 0.0 + eb_zero(i,j,k) = 0.0 + enddo ; enddo; enddo do iter=1,CS%offline_CSp%num_off_iter - - uhtr_sub(:,:,:) = uhtr(:,:,:) - vhtr_sub(:,:,:) = vhtr(:,:,:) - call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, h_pre, CS%offline_CSp%max_off_cfl, & + + do k = 1, nz ; do j=jsd,jed ; do i=IsdB,IedB + uhtr_sub(i,j,k) = uhtr(i,j,k) + enddo ; enddo; enddo + do k = 1, nz ; do j=JsdB,JedB ; do i=isd,ied + vhtr_sub(i,j,k) = vhtr(i,j,k) + enddo ; enddo; enddo + + call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, h_pre, h_new, CS%offline_CSp%max_off_cfl, & z_first, x_before_y) ! Perform zonal and meridional advection - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=100, x_first_in=x_before_y) + call advect_tracer(h_end, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=10, x_first_in=x_before_y) x_before_y = .not. x_before_y - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k = 1, nz ; do i=is-2,ie ; do j=js-2,je h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Calculate the remaining transport - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k = 1, nz ; do j=js,je ; do i=is-1,ie uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k = 1, nz ; do j=js-1,je ; do i=is,ie vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo + if (CS%debug) then + call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) + call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) + call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) + endif - ! As a way of checking how close we are to converging, sum the absolute value of - ! the remaining horizontal fluxes - sum_abs_fluxes = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - ! - if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes - + ! Regridding/remapping is done here after each advection iteration so that ! layers which no longer exist can get 'reinflated' by ALE ! While this may call ALE many more times than is done in the online run, it should @@ -1727,8 +1734,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) endif - CS%tv%T = temp_old - CS%tv%S = salt_old +! CS%tv%T = temp_old +! CS%tv%S = salt_old call pass_var(CS%T,G%Domain) call pass_var(CS%S,G%Domain) @@ -1739,11 +1746,28 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call diag_update_target_grids(CS%diag) call post_diags_TS_vardec(G, CS, dt_iter) + ! As a way of checking how close we are to converging, sum the absolute value of + ! the remaining horizontal fluxes + sum_abs_fluxes = 0.0 + sum_u = 0.0 + sum_v = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) + sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) + sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + + print *, "Remaining u-flux, v-flux:", sum_u, sum_v + ! +! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes if (sum_abs_fluxes==0) then print *, 'Converged after iteration', iter exit endif + enddo ! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & @@ -1754,8 +1778,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) h_temp = h_end-h_pre diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index cdfbc5f217..cd478faa46 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -811,8 +811,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hloss_boundary !< Layer thickness lost in this - !< routine (H units) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics container !> If False, treat in/out fluxes separately. logical, intent(in) :: aggregate_FW_forcing @@ -980,7 +978,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & Temp_in = T2d(i,k) Salin_in = 0.0 dTemp = dTemp + dThickness*Temp_in - ea(i,j,1) = dThickness ! Diagnostics of heat content associated with mass fluxes if (ASSOCIATED(fluxes%heat_content_massin)) & @@ -1050,7 +1047,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Change in state due to forcing dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) - ea(i,j,k) = ea(i,j,k) + dThickness dTemp = fractionOfForcing*netHeat(i) ! ### The 0.9999 here should become a run-time parameter? dSalt = max( fractionOfForcing*netSalt(i), -0.9999*h2d(i,k)*tv%S(i,j,k)) @@ -1078,7 +1074,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Update state by the appropriate increment. hOld = h2d(i,k) ! Keep original thickness in hand h2d(i,k) = h2d(i,k) + dThickness ! New thickness - hloss(i,k) = hloss(i,k) + dThickness if (h2d(i,k) > 0.) then if (calculate_energetics) then @@ -1165,7 +1160,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & do k=1,nz ; do i=is,ie h(i,j,k) = h2d(i,k) tv%T(i,j,k) = T2d(i,k) - hloss_boundary(i,j,k) = hloss(i,k) enddo ; enddo ! Diagnose heating (W/m2) applied to a grid cell from SW penetration diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index d046c13567..2da02f34f2 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1090,19 +1090,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) enddo ; enddo ; enddo endif -<<<<<<< HEAD - ! Undo the effects of applyBoundaryFluxesInOut for passive tracers - if (CS%useALEalgorithm) then - k = 1 - do j=js,je ; do i=is,ie - hold(i,j,k) = hold(i,j,k) - ea(i,j,k) - enddo ; enddo - endif - - - -======= ->>>>>>> dfd2ea314137f383c9fb94d9adac22bb43f1778b ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 00a2e78aa9..99a95866ee 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -599,7 +599,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d - subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, z_first, x_before_y) + subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, h_end, max_off_cfl, z_first, x_before_y) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh @@ -607,6 +607,7 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_in + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_end real, intent(in) :: max_off_cfl logical, intent(in) :: z_first, x_before_y @@ -653,16 +654,23 @@ subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, max_off_cfl, call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) case (3) ! x -> y -> z - !call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) + call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) - call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) +! call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) case (4) ! y -> x -> z - !call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) + call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) - call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) +! call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) case default call MOM_error(FATAL, "Invalid choice of flux_order") end select + + do k=1,nz ; do j=js,je ; do i=is,ie + h_end(i,j,k) = h_budget(i,j,k)/G%areaT(i,j) + if (h_end(i,j,k)<0.0 ) then + print *, "i,j,k,h,",i,j,k,h_end(i,j,k) + endif + enddo ; enddo ; enddo end subroutine limit_mass_flux_ordered_3d @@ -781,7 +789,7 @@ subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) real :: max_off_cfl ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real :: hup, hlos, min_h + real :: hup, hlos, min_h, h_remain integer :: i, j, k, m, is, ie, js, je, nz min_h= 0.1*GV%Angstrom @@ -789,36 +797,37 @@ subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do i=is-2,ie uh2d(I,k) = uh(I,j,k) enddo ; enddo; - + do k=1,nz ; do i=is-1,ie if(uh2d(I,k)<0.0) then - hup = h(i+1,j,k) - G%areaT(i+1,j)*min_h - hlos = MAX(0.0,uh2d(I+1,k)) - if (((hup + uh2d(I,k) - hlos) < 0.0) .and. ((0.5*hup + uh2d(I,k)) < 0.0)) & - uh2d(I,k) = MIN(-0.5*hup,-hup+hlos,0.0) - - elseif(uh2d(I,k)>0.0) then + hup = h(i+1,j,k) - min_h*G%areaT(i+1,j) + hlos = max(0.0, uh2d(I+1,k)) + if (( ((hup-hlos)+uh2d(I,k))<0.0) .and. & + ((0.5*hup + uh2d(I,k))<0.0)) then + uh2d(I,k) = min(-0.5*hup,-hup+hlos,0.0) + endif + else hup = h(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-uh2d(I-1,k)) - if (((hup - uh2d(I,k) - hlos) < 0.0) .and. ((0.5*hup - uh2d(I,k)) < 0.0)) & - uh2d(I,k) = MAX(0.5*hup,hup-hlos,0.0) - endif + hlos = max(0.0,-uh2d(I-1,k)) + if ((((hup-hlos)-uh2d(I,k))<0.0) .and. & + ((0.5*hup-uh2d(I,k))<0.0)) then + uh2d(I,k) = max(0.5*hup,hup-hlos,0.0) + endif + endif enddo ; enddo do k=1,nz - do i=is-1,ie - uh(I,j,k) = uh2d(I,k) + do i=is-1,ie + uh(I,j,k) = uh2d(I,k) enddo do i=is,ie - h(i,j,k) = h(i,j,k) + (uh2d(I-1,k)-uh2d(I,k)) - if( h(i,j,k)<0.0 ) then - print *, i, j, k, h(i,j,k) - endif + h(i,j,k) = h(i,j,k) - (uh2d(I,k) - uh2d(I-1,k)) enddo enddo + enddo end subroutine flux_limiter_u @@ -832,45 +841,42 @@ subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZJB_(G),SZK_(G)) :: vh2d real, dimension(SZJ_(G),SZK_(G)) :: h2d - real :: hup, hlos, min_h + real :: hup, hlos, min_h, h_remain integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h= 0.1*GV%Angstrom do i=is,ie - do k=1,nz ; do j=js-1,je + do k=1,nz ; do j=js-2,je vh2d(J,k) = vh(i,J,k) enddo ; enddo; - do k=1,nz ; do j=js-1,je if(vh2d(J,k)<0.0) then - hup = h(i,j+1,k) - G%areaT(i,j+1)*min_h - hlos = MAX(0.0,vh2d(J+1,k)) - if (((hup + vh2d(J,k) - hlos) < 0.0) .and. ((0.5*hup + vh2d(J,k)) < 0.0)) & - vh2d(J,k) = MIN(-0.5*hup,-hup+hlos,0.0) - - elseif(vh2d(J,k)>0.0) then - hup = h(i,j,k) - G%areaT(i,j)*min_h - hlos = MAX(0.0,-vh2d(J-1,k)) - if (((hup - vh2d(J,k) - hlos) < 0.0) .and. ((0.5*hup - vh2d(J,k)) < 0.0)) & - vh2d(J,k) = MAX(0.5*hup,hup-hlos,0.0) - endif + hup = h(i,j+1,k)-G%areaT(i,j+1)*min_h + hlos = max(0.0,vh2d(J+1,k)) + if ((((hup-hlos)+vh2d(J,k))<0.0) .and. & + ((0.5*hup+vh2d(J,k))<0.0)) then + vh2d(J,k) = min(-0.5*hup,-hup+hlos,0.0) + endif + else + hup = h(i,j,k) -G%areaT(i,j)*min_h + hlos = max(0.0,-vh2d(J-1,k)) + if ((((hup-hlos)-vh2d(J,k))<0.0) .and. & + ((0.5*hup - vh2d(J,k))<0.0)) then + vh2d(J,k) = max(0.5*hup,hup-hlos,0.0) + endif + endif enddo ; enddo - - do k=1,nz - do j=js-1,je + + do k=1,nz + do j=js-1,je vh(i,J,k) = vh2d(J,k) enddo - - do j=js,je - h(i,j,k) = h(i,j,k) + (vh2d(J-1,k)-vh2d(J,k)) - if( h(i,j,k)<0.0 ) then - print *, i, j, k, h(i,j,k) - endif - enddo + do j=js,je + h(i,j,k) = h(i,j,k) - (vh2d(J,k) - vh2d(J-1,k)) + enddo enddo - enddo end subroutine flux_limiter_v diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 9852a966c2..6400e0fb22 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -281,6 +281,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, if (itt >= max_iter) then if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + call MOM_error(WARNING,"Tracer advection failed to converge") exit endif diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index c66c2592eb..30a1ddebf7 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -70,7 +70,6 @@ module MOM_tracer_flow_control use advection_test_tracer, only : register_advection_test_tracer, initialize_advection_test_tracer use advection_test_tracer, only : advection_test_tracer_column_physics, advection_test_tracer_surface_state use advection_test_tracer, only : advection_test_stock, advection_test_tracer_end, advection_test_tracer_CS ->>>>>>> dfd2ea314137f383c9fb94d9adac22bb43f1778b #ifdef _USE_GENERIC_TRACER use MOM_generic_tracer, only : register_MOM_generic_tracer, initialize_MOM_generic_tracer use MOM_generic_tracer, only : MOM_generic_tracer_column_physics, MOM_generic_tracer_surface_state @@ -398,33 +397,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, dt, G, GV, tv, o if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// & "Module must be initialized via call_tracer_register before it is used.") -<<<<<<< HEAD -! Add calls to tracer column functions here. - if (CS%use_USER_tracer_example) & - call tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%USER_tracer_example_CSp) - if (CS%use_DOME_tracer) & - call DOME_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%DOME_tracer_CSp) - if (CS%use_ISOMIP_tracer) & - call ISOMIP_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%ISOMIP_tracer_CSp) - if (CS%use_ideal_age) & - call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%ideal_age_tracer_CSp) - if (CS%use_regional_dyes) & - call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%dye_tracer_CSp) - if (CS%use_oil) & - call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%oil_tracer_CSp, tv) - if (CS%use_advection_test_tracer) & - call advection_test_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%advection_test_tracer_CSp) - if (CS%use_OCMIP2_CFC) & - call OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, CS%OCMIP2_CFC_CSp) -======= ! Use the applyTracerBoundaryFluxesInOut to handle surface fluxes if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! Add calls to tracer column functions here. @@ -467,7 +439,6 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, dt, G, GV, tv, o G, GV, CS%OCMIP2_CFC_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) ->>>>>>> dfd2ea314137f383c9fb94d9adac22bb43f1778b #ifdef _USE_GENERIC_TRACER if (CS%use_MOM_generic_tracer) & call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -630,13 +601,6 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif - if (CS%use_advection_test_tracer) then - ns = advection_test_stock( h, values, G, GV, CS%advection_test_tracer_CSp, & - names, units, stock_index ) - call store_stocks("advection_test_tracer", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) - endif - if (ns_tot == 0) stock_values(1) = 0.0 if (present(num_stocks)) num_stocks = ns_tot diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 452a15c503..95d80933d9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -84,14 +84,14 @@ module advection_test_tracer public advection_test_tracer_column_physics, advection_test_stock ! ntr is the number of tracers in this module. -integer, parameter :: ntr = 11 +integer, parameter :: NTR = 11 type p3d real, dimension(:,:,:), pointer :: p => NULL() end type p3d type, public :: advection_test_tracer_CS ; private - integer ntr ! Number of tracers in this module + integer :: ntr = NTR ! Number of tracers in this module logical :: coupled_tracers = .false. ! These tracers are not offered to the ! coupler. character(len=200) :: tracer_IC_file ! The full path to the IC file, or " " @@ -117,7 +117,6 @@ module advection_test_tracer integer, dimension(NTR) :: ind_tr ! Indices returned by aof_set_coupler_flux ! if it is used and the surface tracer concentrations are to be ! provided to the coupler. - integer :: ntr = NTR type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the ! timing of diagnostic output. From 756175ff9ed9136810fec54657635c0c1b658e33 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 28 Sep 2016 09:16:09 -0400 Subject: [PATCH 33/65] Added compile time option to change how often the ALE remapping is done when tracer performed offline. This seems to speed up the time to convergence considerably. --- src/ALE/MOM_ALE.F90 | 2 +- src/core/MOM.F90 | 12 ++++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 4887c302f3..cfc61a5a1e 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -419,7 +419,7 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) if (CS%show_call_tree) call callTree_leave("ALE_main()") - !if (CS%id_dzRegrid>0) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) end subroutine ALE_main diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e38a51085d..b7b1ad3e5e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1663,6 +1663,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ea_zero(i,j,k) = 0.0 eb_zero(i,j,k) = 0.0 enddo ; enddo; enddo + + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + do iter=1,CS%offline_CSp%num_off_iter do k = 1, nz ; do j=jsd,jed ; do i=IsdB,IedB @@ -1678,7 +1685,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Perform zonal and meridional advection call advect_tracer(h_end, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=10, x_first_in=x_before_y) - x_before_y = .not. x_before_y +! x_before_y = .not. x_before_y ! Done with horizontal so now h_pre should be h_new do k = 1, nz ; do i=is-2,ie ; do j=js-2,je @@ -1723,12 +1730,13 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) endif + if (mod(iter,2)==0) then call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & CS%ALE_CSp, dt_iter) call cpu_clock_end(id_clock_ALE) - + endif if (CS%debug) then call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) From bda7606a2dca158a84d0ff7b3be6cdc43431ff50 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 29 Sep 2016 15:25:51 -0400 Subject: [PATCH 34/65] Fixed a bug, tracer conserves --- src/core/MOM.F90 | 84 ++++++++++++++++-------------- src/tracer/MOM_offline_control.F90 | 2 +- 2 files changed, 45 insertions(+), 41 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b7b1ad3e5e..4502844e73 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1421,11 +1421,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid ! U-3D - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub, uh_max ! U-2D real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x, khdt_x_sub ! V-3D - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub, vh_max ! V-2D real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub @@ -1656,8 +1656,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! in layer thickness. Therefore, half of the diagnosed mixing is applied before the ! any horizontal advection occurs and half occurs after the horizontal advection has ! converged. -! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & -! CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & + CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics,& + CS%tracer_flow_CSp, CS%debug) do k=1,nz ; do j=jsd,jed ; do i = isd,ied ea_zero(i,j,k) = 0.0 @@ -1671,34 +1672,33 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_ALE) do iter=1,CS%offline_CSp%num_off_iter - do k = 1, nz ; do j=jsd,jed ; do i=IsdB,IedB uhtr_sub(i,j,k) = uhtr(i,j,k) - enddo ; enddo; enddo - do k = 1, nz ; do j=JsdB,JedB ; do i=isd,ied + enddo ; enddo ; enddo + do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied vhtr_sub(i,j,k) = vhtr(i,j,k) - enddo ; enddo; enddo + enddo ; enddo ; enddo - call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, h_pre, h_new, CS%offline_CSp%max_off_cfl, & - z_first, x_before_y) + call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, & + h_pre, h_new, CS%offline_CSp%max_off_cfl, z_first, x_before_y) ! Perform zonal and meridional advection - call advect_tracer(h_end, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=10, x_first_in=x_before_y) ! x_before_y = .not. x_before_y ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-2,ie ; do j=js-2,je + do k = 1, nz ; do i=isd,ied ; do j=jsd,jed h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Calculate the remaining transport - do k = 1, nz ; do j=js,je ; do i=is-1,ie + do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo; enddo ; enddo - - do k = 1, nz ; do j=js-1,je ; do i=is,ie + do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo; enddo ; enddo + if (CS%debug) then call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) @@ -1712,39 +1712,36 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! never result in more changes in thickness due to remapping ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - CS%tv%T = CS%offline_CSp%T_preale - CS%tv%S = CS%offline_CSp%S_preale +! CS%tv%T = CS%offline_CSp%T_preale +! CS%tv%S = CS%offline_CSp%S_preale call pass_var(h_pre,G%Domain) ! call do_group_pass(CS%pass_T_S_h, G%Domain) ! update squared quantities - if (associated(CS%S_squared)) & - CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - if (associated(CS%T_squared)) & - CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - - if (CS%debug) then - call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) - call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) - call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) - call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) - endif +! if (associated(CS%S_squared)) & +! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 +! if (associated(CS%T_squared)) & +! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 +! +! if (CS%debug) then +! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) +! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) +! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) +! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) +! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) +! endif if (mod(iter,2)==0) then - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) + call cpu_clock_end(id_clock_ALE) endif if (CS%debug) then call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) endif -! CS%tv%T = temp_old -! CS%tv%S = salt_old - call pass_var(CS%T,G%Domain) call pass_var(CS%S,G%Domain) @@ -1772,22 +1769,29 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes if (sum_abs_fluxes==0) then + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + print *, 'Converged after iteration', iter exit endif enddo -! call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & -! CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp) + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & + CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, & + CS%tracer_flow_CSp, CS%debug) endif call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion -! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) h_temp = h_end-h_pre @@ -1802,7 +1806,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call disable_averaging(CS%diag) do i = is, ie ; do j = js, je ; do k=1,nz - CS%h(i,j,k) = h_end(i,j,k) + CS%h(i,j,k) = h_pre(i,j,k) enddo ; enddo; enddo call pass_var(CS%h,G%Domain) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 99a95866ee..1a74522960 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -860,7 +860,7 @@ subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) vh2d(J,k) = min(-0.5*hup,-hup+hlos,0.0) endif else - hup = h(i,j,k) -G%areaT(i,j)*min_h + hup = h(i,j,k) - G%areaT(i,j)*min_h hlos = max(0.0,-vh2d(J-1,k)) if ((((hup-hlos)-vh2d(J,k))<0.0) .and. & ((0.5*hup - vh2d(J,k))<0.0)) then From 8ecb2c2b7d043c5552216d453453cd4e46094015 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 30 Sep 2016 13:40:05 -0400 Subject: [PATCH 35/65] Number of iterations might be limited by CFL, need to play around with flux limiting a little more to double check --- src/core/MOM.F90 | 200 ++++++++++++++++------------- src/tracer/MOM_offline_control.F90 | 88 +++---------- src/tracer/MOM_tracer_advect.F90 | 2 +- 3 files changed, 128 insertions(+), 162 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4502844e73..f0049abfd3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1421,11 +1421,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid ! U-3D - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub, uh_max + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub, uh_max, uh_zero ! U-2D real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x, khdt_x_sub ! V-3D - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub, vh_max + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub, vh_max, vh_zero ! V-2D real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub @@ -1447,7 +1447,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_temp, & temp_old, salt_old, & ea_zero, eb_zero ! - integer :: niter, iter + integer :: niter, iter, big_iter real :: Inum_iter, dt_iter integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. @@ -1487,6 +1487,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr_sub(:,:,:) = 0.0 eatr_sub(:,:,:) = 0.0 ebtr_sub(:,:,:) = 0.0 + uh_zero(:,:,:) = 0.0 + vh_zero(:,:,:) = 0.0 call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & @@ -1670,7 +1672,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & CS%ALE_CSp, dt_iter) call cpu_clock_end(id_clock_ALE) - + do iter=1,CS%offline_CSp%num_off_iter do k = 1, nz ; do j=jsd,jed ; do i=IsdB,IedB uhtr_sub(i,j,k) = uhtr(i,j,k) @@ -1682,108 +1684,126 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, & h_pre, h_new, CS%offline_CSp%max_off_cfl, z_first, x_before_y) - ! Perform zonal and meridional advection - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, max_iter_in=10, x_first_in=x_before_y) -! x_before_y = .not. x_before_y - - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=isd,ied ; do j=jsd,jed - h_pre(i,j,k) = h_new(i,j,k) + sum_u = 0.0 + do k = 1, nz ; do j=js,je ; do i=Is-1,Ie + sum_u = sum_u+abs(uhtr_sub(I,j,k)) enddo ; enddo ; enddo - ! Calculate the remaining transport - do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB - uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo - do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo - - if (CS%debug) then - call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) - call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) - call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) - endif - - - ! Regridding/remapping is done here after each advection iteration so that - ! layers which no longer exist can get 'reinflated' by ALE - ! While this may call ALE many more times than is done in the online run, it should - ! never result in more changes in thickness due to remapping - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - -! CS%tv%T = CS%offline_CSp%T_preale -! CS%tv%S = CS%offline_CSp%S_preale - call pass_var(h_pre,G%Domain) - ! call do_group_pass(CS%pass_T_S_h, G%Domain) - - ! update squared quantities -! if (associated(CS%S_squared)) & -! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 -! if (associated(CS%T_squared)) & -! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 -! -! if (CS%debug) then -! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) -! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) -! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) -! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) -! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) -! endif - if (mod(iter,2)==0) then + sum_u = 0.0 + do k = 1, nz ; do j=js-1,je ; do i=is,ie + sum_v = sum_v+abs(uhtr_sub(I,j,k)) + enddo ; enddo ; enddo + if(sum_u + sum_v == 0.0) then + print *, "ALE Remapped" call cpu_clock_begin(id_clock_ALE) call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & CS%ALE_CSp, dt_iter) call cpu_clock_end(id_clock_ALE) - endif - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) - endif + else - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_vol, & + max_iter_in=10, x_first_in=x_before_y) - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, dt_iter) + x_before_y = .not. x_before_y + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=isd,ied ; do j=jsd,jed + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + ! Calculate the remaining transport + do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo; enddo ; enddo + do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo - ! As a way of checking how close we are to converging, sum the absolute value of - ! the remaining horizontal fluxes - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - - print *, "Remaining u-flux, v-flux:", sum_u, sum_v + if (CS%debug) then + call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) + call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) + call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) + endif + + + ! Regridding/remapping is done here after each advection iteration so that + ! layers which no longer exist can get 'reinflated' by ALE + ! While this may call ALE many more times than is done in the online run, it should + ! never result in more changes in thickness due to remapping + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + + ! CS%tv%T = CS%offline_CSp%T_preale + ! CS%tv%S = CS%offline_CSp%S_preale + call pass_var(h_pre,G%Domain) + ! call do_group_pass(CS%pass_T_S_h, G%Domain) + + ! update squared quantities + ! if (associated(CS%S_squared)) & + ! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 + ! if (associated(CS%T_squared)) & + ! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 ! -! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes + ! if (CS%debug) then + ! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) + ! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) + ! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) + ! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) + ! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) + ! endif + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) + endif - if (sum_abs_fluxes==0) then - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - - print *, 'Converged after iteration', iter - exit - endif - + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, dt_iter) + + ! As a way of checking how close we are to converging, sum the absolute value of + ! the remaining horizontal fluxes + sum_abs_fluxes = 0.0 + sum_u = 0.0 + sum_v = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) + sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) + sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + call sum_across_PEs(sum_u) + call sum_across_PEs(sum_v) + + if (is_root_pe()) print *, "Remaining u-flux, v-flux:", sum_u, sum_v + ! + ! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes + + if (sum_abs_fluxes==0) then + print *, 'Converged after iteration', iter + exit + endif + endif + + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) enddo call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, & CS%tracer_flow_CSp, CS%debug) + + call pass_var(h_pre, G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) endif diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 1a74522960..9ca54be2e9 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -684,7 +684,7 @@ subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) ! Limits how much the a layer can be depleted in the vertical direction real, dimension(SZI_(G),SZK_(G)) :: ea2d, eb2d real, dimension(SZI_(G),SZK_(G)) :: h2d, scale - real, dimension(SZI_(G),SZK_(G)) :: top_flux, bottom_flux + real, dimension(SZI_(G),SZK_(G)+1) :: flux_interface, top_flux, bottom_flux real :: total_out_flux, h_budget integer :: i, j, k, m, is, ie, js, je, nz @@ -696,88 +696,34 @@ subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) ea2d(i,k) = ea(i,j,k) eb2d(i,k) = eb(i,j,k) h2d(i,k) = h(i,j,k) - scale(i,k) = 1.0 enddo ; enddo; + ! Calculate the fluxes through top and bottom faces of the cell k=1 ! Top layer do i=is,ie - top_flux(i,k) = -ea2d(i,k) - bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) - enddo - ! Interior layers - do k=2, nz-1 ; do i=is,ie - top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) - bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) - enddo ; enddo - k=nz ! Bottom layer - do i=is,ie - top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) - bottom_flux(i,k) = -eb2d(i,k) - enddo - - do k=1,nz ; do i=is,ie - h_budget = h2d(i,k)*max_off_cfl ! How much the layer can be depleted in any given step - ! based on the specified max CFL - total_out_flux = (max(0.0,top_flux(i,k)) + max(0.0, bottom_flux(i,k)))*G%areaT(i,j) - if (total_out_flux>h_budget) scale(i,k) = h_budget/total_out_flux - if (scale(j,k)>1.0) call MOM_error(FATAL, "scale(j,k) is larger than 1") - enddo ; enddo - - k=1 - do i=is,ie - if(top_flux(i,k)>0.0) then - ea2d(i,k) = ea2d(i,k)*scale(i,k) - endif - if(bottom_flux(i,k)>0.0) then - ea2d(i,k+1) = ea2d(i,k+1)*scale(i,k) - eb2d(i,k) = eb2d(i,k)*scale(i,k) - endif - enddo - ! Interior layers - do k=2, nz-1 ; do i=is,ie - if(top_flux(i,k)>0.0) then - ea2d(i,k) = ea2d(i,k)*scale(i,k) - eb2d(i,k-1) = eb2d(i,k-1)*scale(i,k) - endif - if(bottom_flux(i,k)>0.0) then - ea2d(i,k+1) = ea2d(i,k+1)*scale(i,k) - eb2d(i,k) = eb2d(i,k)*scale(i,k) - endif - enddo; enddo; - k=nz - do i=is,ie - if(top_flux(i,k)>0.0) then - ea2d(i,k) = ea2d(i,k)*scale(i,k) - eb2d(i,k-1) = eb2d(i,k-1)*scale(i,k) - endif - if(bottom_flux(i,k)>0.0) then - eb2d(i,k) = eb2d(i,k)*scale(i,k) - endif + flux_interface(i,k) = 0.0 enddo - ! Update h with new scaled fluxes - k=1 ! Top layer - do i=is,ie - top_flux(i,k) = -ea2d(i,k) - bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) - enddo - ! Interior layers do k=2, nz-1 ; do i=is,ie - top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) - bottom_flux(i,k) = -(eb2d(i,k)-ea2d(i,k+1)) + top_flux(i,k) = ea2d(i,k)-eb2d(i,k-1) + bottom_flux(i,k) = ea2d(i,k+1)-eb2d(i,k) enddo ; enddo k=nz ! Bottom layer do i=is,ie - top_flux(i,k) = -(ea2d(i,k)-eb2d(i,k-1)) + top_flux(i,k) = ea2d(i,k)-eb2d(i,k-1) bottom_flux(i,k) = -eb2d(i,k) enddo - + + ! Convert fluxes which are in units of thickness to units of volume do k=1,nz ; do i=is,ie - h(i,j,k) = h2d(i,k) - (top_flux(i,k)+bottom_flux(i,k))*G%areaT(i,j) - ea(i,j,k) = ea2d(i,k) - eb(i,j,k) = eb2d(i,k) + top_flux(i,k) = top_flux(i,k)*G%areaT(i,j) + bottom_flux(i,k) = bottom_flux(i,k)*G%areaT(i,j) enddo; enddo - + + do k=1,nz ; do i=is,ie + + enddo; enddo + enddo end subroutine flux_limiter_vertical @@ -796,7 +742,7 @@ subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - do j=js,je + do j=js-1,je do k=1,nz ; do i=is-2,ie uh2d(I,k) = uh(I,j,k) enddo ; enddo; @@ -847,7 +793,7 @@ subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h= 0.1*GV%Angstrom - do i=is,ie + do i=is-1,ie do k=1,nz ; do j=js-2,je vh2d(J,k) = vh(i,J,k) enddo ; enddo; diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 6400e0fb22..efa393c79a 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -150,7 +150,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, do i=is,ie ; do j=js,je hprev(i,j,k) = h_prev_opt(i,j,k); enddo ; enddo - endif + endif enddo From db3309f032bfdf8af78eae2e59c2a82e6f150e6f Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 30 Sep 2016 13:46:16 -0400 Subject: [PATCH 36/65] Forgot to add MOM.F90 --- src/core/MOM.F90 | 196 +++++++++++++++++++++-------------------------- 1 file changed, 88 insertions(+), 108 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f0049abfd3..a1b5f49adc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1684,128 +1684,108 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, & h_pre, h_new, CS%offline_CSp%max_off_cfl, z_first, x_before_y) - sum_u = 0.0 - do k = 1, nz ; do j=js,je ; do i=Is-1,Ie - sum_u = sum_u+abs(uhtr_sub(I,j,k)) - enddo ; enddo ; enddo - sum_u = 0.0 - do k = 1, nz ; do j=js-1,je ; do i=is,ie - sum_v = sum_v+abs(uhtr_sub(I,j,k)) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_vol, & + max_iter_in=10, x_first_in=x_before_y) + + x_before_y = .not. x_before_y + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=isd,ied ; do j=jsd,jed + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - if(sum_u + sum_v == 0.0) then - print *, "ALE Remapped" - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - else + ! Calculate the remaining transport + do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo; enddo ; enddo + do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_vol, & - max_iter_in=10, x_first_in=x_before_y) + if (CS%debug) then + call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) + call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) + call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) + endif - x_before_y = .not. x_before_y - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=isd,ied ; do j=jsd,jed - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - ! Calculate the remaining transport - do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB - uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo - do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo - if (CS%debug) then - call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) - call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) - call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) - endif + ! Regridding/remapping is done here after each advection iteration so that + ! layers which no longer exist can get 'reinflated' by ALE + ! While this may call ALE many more times than is done in the online run, it should + ! never result in more changes in thickness due to remapping + ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. +! CS%tv%T = CS%offline_CSp%T_preale +! CS%tv%S = CS%offline_CSp%S_preale + call pass_var(h_pre,G%Domain) + ! call do_group_pass(CS%pass_T_S_h, G%Domain) - ! Regridding/remapping is done here after each advection iteration so that - ! layers which no longer exist can get 'reinflated' by ALE - ! While this may call ALE many more times than is done in the online run, it should - ! never result in more changes in thickness due to remapping - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + ! update squared quantities +! if (associated(CS%S_squared)) & +! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 +! if (associated(CS%T_squared)) & +! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 +! +! if (CS%debug) then +! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) +! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) +! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) +! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) +! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) +! endif + if (CS%debug) then + call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) + call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) + endif - ! CS%tv%T = CS%offline_CSp%T_preale - ! CS%tv%S = CS%offline_CSp%S_preale - call pass_var(h_pre,G%Domain) - ! call do_group_pass(CS%pass_T_S_h, G%Domain) + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) - ! update squared quantities - ! if (associated(CS%S_squared)) & - ! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 - ! if (associated(CS%T_squared)) & - ! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 - ! - ! if (CS%debug) then - ! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) - ! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) - ! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) - ! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) - ! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) - ! endif - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) - endif + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. This needs to + ! happen after the H update and before the next post_data. + call diag_update_target_grids(CS%diag) + call post_diags_TS_vardec(G, CS, dt_iter) - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, dt_iter) - - ! As a way of checking how close we are to converging, sum the absolute value of - ! the remaining horizontal fluxes - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - call sum_across_PEs(sum_u) - call sum_across_PEs(sum_v) + ! As a way of checking how close we are to converging, sum the absolute value of + ! the remaining horizontal fluxes + sum_abs_fluxes = 0.0 + sum_u = 0.0 + sum_v = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) + sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) + sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + call sum_across_PEs(sum_u) + call sum_across_PEs(sum_v) - if (is_root_pe()) print *, "Remaining u-flux, v-flux:", sum_u, sum_v - ! - ! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes + if (is_root_pe()) print *, "Remaining u-flux, v-flux:", sum_u, sum_v + ! +! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes - if (sum_abs_fluxes==0) then - print *, 'Converged after iteration', iter - exit - endif - endif + if (sum_abs_fluxes==0) then + print *, 'Converged after iteration', iter + exit + endif - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - enddo + call cpu_clock_begin(id_clock_ALE) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & + CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & + CS%ALE_CSp, dt_iter) + call cpu_clock_end(id_clock_ALE) + enddo - call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & - CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, & - CS%tracer_flow_CSp, CS%debug) - - call pass_var(h_pre, G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & + CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, & + CS%tracer_flow_CSp, CS%debug) - endif + call pass_var(h_pre, G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion From 89a47b8501e4f2d3883bb5844961b1b745555b64 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 30 Sep 2016 18:13:32 -0400 Subject: [PATCH 37/65] Rewrote the ALE section of tracers. Eliminated calls to separate flux limiter and instead just used advect_tracer --- src/core/MOM.F90 | 167 +++++++---------------------- src/tracer/MOM_offline_control.F90 | 12 --- src/tracer/MOM_tracer_advect.F90 | 9 +- 3 files changed, 44 insertions(+), 144 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a1b5f49adc..3d095d16a2 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1654,142 +1654,57 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) elseif (CS%use_ALE_algorithm) then - ! When using ALE (or in z-mode), all mixing at interfaces results in no net change - ! in layer thickness. Therefore, half of the diagnosed mixing is applied before the - ! any horizontal advection occurs and half occurs after the horizontal advection has - ! converged. - call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & - CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics,& - CS%tracer_flow_CSp, CS%debug) + do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB + uhtr_sub(i,j,k) = uhtr(i,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do j=jsdB,jedB ; do i=isd,ied + vhtr_sub(i,j,k) = vhtr(i,j,k) + enddo ; enddo ; enddo + + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & + fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & + CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) - do k=1,nz ; do j=jsd,jed ; do i = isd,ied - ea_zero(i,j,k) = 0.0 - eb_zero(i,j,k) = 0.0 - enddo ; enddo; enddo - call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, dt_iter) - call cpu_clock_end(id_clock_ALE) - do iter=1,CS%offline_CSp%num_off_iter - do k = 1, nz ; do j=jsd,jed ; do i=IsdB,IedB - uhtr_sub(i,j,k) = uhtr(i,j,k) - enddo ; enddo ; enddo - do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr_sub(i,j,k) = vhtr(i,j,k) - enddo ; enddo ; enddo - - call limit_mass_flux_ordered_3d(G, GV, uhtr_sub, vhtr_sub, ea_zero, eb_zero, & - h_pre, h_new, CS%offline_CSp%max_off_cfl, z_first, x_before_y) - + do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_new, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_vol, & - max_iter_in=10, x_first_in=x_before_y) - - x_before_y = .not. x_before_y - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=isd,ied ; do j=jsd,jed - h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - ! Calculate the remaining transport - do k = 1, nz ; do j=jsd,jed ; do i=isdB,iedB - uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo - do k = 1, nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo - - if (CS%debug) then - call uchksum(uhtr, "Post sub-advection uh", G%HI, haloshift=1) - call vchksum(vhtr, "Post sub-advection vh", G%HI, haloshift=1) - call hchksum(h_pre, "Post sub-advection h", G%HI, haloshift=1) - endif - - - ! Regridding/remapping is done here after each advection iteration so that - ! layers which no longer exist can get 'reinflated' by ALE - ! While this may call ALE many more times than is done in the online run, it should - ! never result in more changes in thickness due to remapping - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - -! CS%tv%T = CS%offline_CSp%T_preale -! CS%tv%S = CS%offline_CSp%S_preale - call pass_var(h_pre,G%Domain) - ! call do_group_pass(CS%pass_T_S_h, G%Domain) - - ! update squared quantities -! if (associated(CS%S_squared)) & -! CS%S_squared(:,:,:) = CS%tv%S(:,:,:) ** 2 -! if (associated(CS%T_squared)) & -! CS%T_squared(:,:,:) = CS%tv%T(:,:,:) ** 2 -! -! if (CS%debug) then -! call uchksum(CS%offline_CSp%u_preale, "Pre-ALE 1 u", G%HI, haloshift=1) -! call vchksum(CS%offline_CSp%v_preale, "Pre-ALE 1 v", G%HI, haloshift=1) -! call hchksum(CS%offline_CSp%h_preale, "Pre-ALE 1 h", G%HI, haloshift=1) -! call hchksum(CS%tv%T,"Pre-ALE 1 T", G%HI, haloshift=1) -! call hchksum(CS%tv%S,"Pre-ALE 1 S", G%HI, haloshift=1) -! endif - if (CS%debug) then - call hchksum(CS%tv%T,"Post-ALE 1 T", G%HI, haloshift=1) - call hchksum(CS%tv%S,"Post-ALE 1 S", G%HI, haloshift=1) - endif - - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - - ! Whenever thickness changes let the diag manager know, target grids - ! for vertical remapping may need to be regenerated. This needs to - ! happen after the H update and before the next post_data. - call diag_update_target_grids(CS%diag) - call post_diags_TS_vardec(G, CS, dt_iter) - - ! As a way of checking how close we are to converging, sum the absolute value of - ! the remaining horizontal fluxes - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - call sum_across_PEs(sum_u) - call sum_across_PEs(sum_v) - - if (is_root_pe()) print *, "Remaining u-flux, v-flux:", sum_u, sum_v - ! -! if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes - - if (sum_abs_fluxes==0) then - print *, 'Converged after iteration', iter - exit - endif - + + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & + uhr_out=uhtr, vhr_out=vhtr, h_out=h_new) + + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + & + max(0.0, 1.0e-13*h_vol(i,j,k) - G%areaT(i,j)*h_new(i,j,k))/G%areaT(i,j) + enddo ; enddo ; enddo + call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, & - CS%offline_CSp%v_preale, CS%tv, CS%tracer_Reg, & - CS%ALE_CSp, dt_iter) + call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, CS%offline_CSp%v_preale, CS%tv, & + CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) - enddo - - call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, fluxes, & - CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, CS%diabatic_CSp%optics, & - CS%tracer_flow_CSp, CS%debug) - - call pass_var(h_pre, G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - + + do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB + uhtr_sub(i,j,k) = uhtr(i,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do j=jsdB,jedB ; do i=isd,ied + vhtr_sub(i,j,k) = vhtr(i,j,k) + enddo ; enddo ; enddo + + if( sum(abs(uhtr))+sum(abs(vhtr))==0.0) exit +! print *, "Remaining uflux, vflux:", sum(abs(uhtr)), sum(abs(vhtr)) + + enddo + + call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & + fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & + CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) + + endif call pass_var(h_pre, G%Domain) ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 9ca54be2e9..086245f3ea 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -257,18 +257,6 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=NORTH) -! do k=1,nz ; do j=js-1,je ; do i=is-1,ie -! if (G%mask2dCu(i,j)<1.0) then -! CS%u_preale(I,j,k) = 0.0 -! endif -! if (G%mask2dCv(i,j)<1.0) then -! CS%v_preale(I,j,k) = 0.0 -! endif -! if (G%mask2dT(i,j)<1.0) then -! CS%h_preale(i,j,k) = GV%Angstrom -! endif -! enddo; enddo; enddo - endif !! Make sure all halos have been updated diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index efa393c79a..d46026f4e1 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,7 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) @@ -59,6 +59,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, logical, optional :: x_first_in real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face (m3 or kg) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face (m3 or kg) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional :: h_out !< layer thickness before advection (m or kg m-2) type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -279,9 +280,6 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, ! If the advection just isn't finishing after max_iter, move on. if (itt >= max_iter) then - if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) - if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) - call MOM_error(WARNING,"Tracer advection failed to converge") exit endif @@ -293,8 +291,6 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, call cpu_clock_end(id_clock_sync) do k=1,nz ; do_any = do_any + domore_k(k) ; enddo if (do_any == 0) then - if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) - if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) exit endif @@ -304,6 +300,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, if(present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) if(present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) + if(present(h_out)) h_out(:,:,:) = hprev(:,:,:) call cpu_clock_end(id_clock_advect) From 1bfabc07694c2f8781778748c45a6103e5c8deec Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 3 Oct 2016 13:20:51 -0400 Subject: [PATCH 38/65] Code ready for testing in OM4 --- src/core/MOM.F90 | 14 +++++++- src/tracer/MOM_offline_control.F90 | 56 +++++++++++++++--------------- 2 files changed, 41 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3d095d16a2..162a3a127e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1693,8 +1693,20 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr_sub(i,j,k) = vhtr(i,j,k) enddo ; enddo ; enddo - if( sum(abs(uhtr))+sum(abs(vhtr))==0.0) exit + call pass_vector(uhtr_sub,vhtr_sub,G%Domain) + call pass_var(h_pre, G%Domain) + + sum_u=sum(abs(uhtr)) + sum_v=sum(abs(vhtr)) + + call sum_across_PEs(sum_u) + call sum_across_PEs(sum_v) + + if(sum_u+sum_v==0.0) then + if(is_root_pe()) print *, "Converged after iteration", iter + exit ! print *, "Remaining uflux, vflux:", sum(abs(uhtr)), sum(abs(vhtr)) + endif enddo diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 086245f3ea..d34f5fc9f0 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -216,7 +216,7 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=CENTER) - ! Apply masks at T, U, and V points + ! Apply masks at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie if(G%mask2dT(i,j)<1.0) then h_end(i,j,k) = GV%Angstrom @@ -240,24 +240,24 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, enddo; enddo ; enddo - if (do_ale) then - CS%h_preale = GV%Angstrom - CS%T_preale = 0.0 - CS%S_preale = 0.0 - CS%u_preale = 0.0 - CS%v_preale = 0.0 - call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) - call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) - - endif +! if (do_ale) then +! CS%h_preale = GV%Angstrom +! CS%T_preale = 0.0 +! CS%S_preale = 0.0 +! CS%u_preale = 0.0 +! CS%v_preale = 0.0 +! call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_snap,position=CENTER) +! call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_mean,position=CENTER) +! call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_mean,position=CENTER) +! call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_mean,position=EAST) +! call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & +! timelevel=CS%ridx_mean,position=NORTH) +! +! endif !! Make sure all halos have been updated ! Vector fields @@ -271,15 +271,15 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call pass_var(temp, G%Domain) call pass_var(salt, G%Domain) - if (do_ale) then - - call pass_vector(CS%u_preale,CS%v_preale,G%Domain) - call pass_var(CS%h_preale, G%Domain) - call pass_var(CS%T_preale, G%Domain) - call pass_var(CS%S_preale, G%Domain) - - - endif +! if (do_ale) then +! +! call pass_vector(CS%u_preale,CS%v_preale,G%Domain) +! call pass_var(CS%h_preale, G%Domain) +! call pass_var(CS%T_preale, G%Domain) +! call pass_var(CS%S_preale, G%Domain) +! +! +! endif ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) From b21e331a8cc1ea09a8dee96c3ed165dce6559b4c Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 5 Oct 2016 16:23:24 -0400 Subject: [PATCH 39/65] Tracer now conserves perfectly in ALE-z mode in the Baltic case --- src/ALE/MOM_ALE.F90 | 50 +++++++++++++++++++++- src/core/MOM.F90 | 66 +++++++++++++++++++++--------- src/core/MOM_forcing_type.F90 | 6 ++- src/tracer/MOM_offline_control.F90 | 25 +++++++++-- src/tracer/MOM_tracer_diabatic.F90 | 4 +- 5 files changed, 123 insertions(+), 28 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index cfc61a5a1e..30b8b271d5 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -105,7 +105,8 @@ module MOM_ALE ! Publicly available functions public ALE_init public ALE_end -public ALE_main +public ALE_main +public ALE_offline_tracer_final public ALE_build_grid public ALE_remap_scalar public pressure_gradient_plm @@ -424,6 +425,53 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) end subroutine ALE_main +!> Remaps all tracers from h onto h_target. This is intended to be called when tracers +!! are done offline. In the case where transports don't quite conserve, we still want to +!! make sure that layer thicknesses offline do not drift too far away from the online model +subroutine ALE_offline_tracer_final( G, GV, h, h_target, Reg, CS) + type(ocean_grid_type), intent(in) :: G !< Ocean grid informations + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_target !< Current 3D grid obtained after last time step (m or Pa) + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + type(ALE_CS), pointer :: CS !< Regridding parameters and options + ! Local variables + + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions + integer :: nk, i, j, k, isc, iec, jsc, jec + + nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec + + if (CS%show_call_tree) call callTree_enter("ALE_offline_tracer_final(), MOM_ALE.F90") + + ! It does not seem that remap_all_state_vars uses dzRegrid for tracers, only for u, v + dzRegrid(:,:,:) = 0.0 + + call check_grid( G, GV, h, 0. ) + call check_grid( G, GV, h_target, 0. ) + + if (CS%show_call_tree) call callTree_waypoint("Source and target grids checked (ALE_offline_tracer)") + + ! Remap all variables from old grid h onto new grid h_new + + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_target, -dzRegrid, Reg, & + debug=CS%show_call_tree ) + + if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_offline_tracer)") + + ! Override old grid with new one. The new grid 'h_new' is built in + ! one of the 'build_...' routines above. +!$OMP parallel do default(none) shared(isc,iec,jsc,jec,nk,h,h_target,CS) + do k = 1,nk + do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + h(i,j,k) = h_target(i,j,k) + enddo ; enddo + enddo + + if (CS%show_call_tree) call callTree_leave("ALE_offline_tracer()") + +end subroutine ALE_offline_tracer_final + !> Check grid for negative thicknesses subroutine check_grid( G, GV, h, threshold ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 162a3a127e..f95fbb0ae1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -63,6 +63,7 @@ module MOM use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags +use MOM_ALE, only : ALE_offline_tracer_final use MOM_continuity, only : continuity, continuity_init, continuity_CS use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS @@ -131,6 +132,8 @@ module MOM use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux use MOM_offline_transport, only : limit_mass_flux_ordered_3d +use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut + use time_manager_mod, only : print_date use MOM_sum_output, only : write_energy @@ -1430,6 +1433,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub real :: sum_abs_fluxes, sum_u, sum_v + real :: dt_offline ! Local variables real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & @@ -1446,7 +1450,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre, & h_temp, & temp_old, salt_old, & - ea_zero, eb_zero ! + zero_3dh ! integer :: niter, iter, big_iter real :: Inum_iter, dt_iter integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz @@ -1462,10 +1466,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + dt_offline = CS%offline_CSp%dt_offline niter = CS%offline_CSp%num_off_iter Inum_iter = 1./real(niter) - dt_iter = CS%offline_CSp%dt_offline*Inum_iter + dt_iter = dt_offline*Inum_iter ! T-cell pointer assignments @@ -1496,7 +1501,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Read in all fields that might be used this timestep call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & - khdt_x, khdt_y, temp_old, salt_old, CS%use_ALE_algorithm) + khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%use_ALE_algorithm) if (CS%offline_CSp%id_uhtr_preadv>0) call post_data(CS%offline_CSp%id_uhtr_preadv, uhtr, CS%diag) if (CS%offline_CSp%id_vhtr_preadv>0) call post_data(CS%offline_CSp%id_vhtr_preadv, vhtr, CS%diag) if (CS%id_h>0) call post_data(CS%id_h, h_end, CS%diag) @@ -1505,12 +1510,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(i,j,k) = CS%h(i,j,k) enddo ; enddo; enddo - call pass_var(h_pre,G%Domain) - - CS%T = temp_old - CS%S = salt_old - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) + call pass_var(h_pre,G%Domain) h_new(:,:,:) = GV%Angstrom @@ -1518,8 +1518,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) ! to make sure that offline advection is monotonic and positive-definite ! -! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first @@ -1654,6 +1654,15 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) elseif (CS%use_ALE_algorithm) then + ! Convert flux rates into explicit mass/height of freshwater flux. Also note, that + ! fluxes are halved because diabatic processes are split before and after advection + do j=jsd,jed ; do i=isd,ied + fluxes%netMassOut(i,j) = 0.5*fluxes%netMassOut(i,j) + fluxes%netMassIn(i,j) = 0.5*fluxes%netMassIn(i,j) + enddo ; enddo + + zero_3dh(:,:,:)=0.0 + do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB uhtr_sub(i,j,k) = uhtr(i,j,k) enddo ; enddo ; enddo @@ -1663,8 +1672,12 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & - CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) - + CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit=0.8, & + minimum_forcing_depth=0.001) + call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & + 0.8, 0.001) + do iter=1,CS%offline_CSp%num_off_iter @@ -1677,8 +1690,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) uhr_out=uhtr, vhr_out=vhtr, h_out=h_new) do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + & - max(0.0, 1.0e-13*h_vol(i,j,k) - G%areaT(i,j)*h_new(i,j,k))/G%areaT(i,j) + h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) !+ & +! max(0.0, 1.0e-13*h_vol(i,j,k) - G%areaT(i,j)*h_new(i,j,k))/G%areaT(i,j) enddo ; enddo ; enddo call cpu_clock_begin(id_clock_ALE) @@ -1708,16 +1721,29 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! print *, "Remaining uflux, vflux:", sum(abs(uhtr)), sum(abs(vhtr)) endif - enddo + enddo + ! Note here T/S are reset to the stored snap shot to ensure that the offline model + ! densities, used in the neutral diffusion code don't drift too far from the online + ! model + CS%T = temp_old + CS%S = salt_old + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & - CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) + CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit=0.8, & + minimum_forcing_depth=0.001) + call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & + 0.8, 0.001) + + call ALE_offline_tracer_final( G, GV, h_pre, h_end, CS%tracer_Reg, CS%ALE_CSp) endif - call pass_var(h_pre, G%Domain) + call pass_var(h_end, G%Domain) ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + call tracer_hordiff(h_end, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) h_temp = h_end-h_pre @@ -1733,7 +1759,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call disable_averaging(CS%diag) do i = is, ie ; do j = js, je ; do k=1,nz - CS%h(i,j,k) = h_pre(i,j,k) + CS%h(i,j,k) = h_end(i,j,k) enddo ; enddo; enddo call pass_var(CS%h,G%Domain) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 651eb3ee48..e035713fa3 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -1750,7 +1750,8 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) if(fluxes%vprec(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%vprec(i,j) if(fluxes%evap(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massout, sum, diag) +! call post_data(handles%id_net_massout, sum, diag) + call post_data(handles%id_net_massout,fluxes%netMassOut,diag) if(handles%id_total_net_massout > 0) then total_transport = global_area_integral(sum,G) call post_data(handles%id_total_net_massout, total_transport, diag) @@ -1766,7 +1767,8 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) ! fluxes%cond is not needed because it is derived from %evap > 0 if(fluxes%evap(i,j) > 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massin, sum, diag) +! call post_data(handles%id_net_massin, sum, diag) + call post_data(handles%id_net_massin, fluxes%netMassIn, diag) if(handles%id_total_net_massin > 0) then total_transport = global_area_integral(sum,G) call post_data(handles%id_total_net_massin, total_transport, diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index d34f5fc9f0..4398b2de20 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -56,6 +56,7 @@ module MOM_offline_transport use MOM_forcing_type, only : forcing use MOM_shortwave_abs, only : optics_type use MOM_diag_mediator, only : post_data + use MOM_forcing_type, only : forcing implicit none @@ -155,7 +156,7 @@ subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) end subroutine post_advection_fields subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, do_ale_in) + temp, salt, fluxes, do_ale_in) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(inout) :: GV type(offline_transport_CS), intent(inout) :: CS @@ -177,6 +178,7 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, h_end, & eatr, ebtr, & temp, salt + type(forcing) :: fluxes logical :: do_ale integer :: i, j, k, is, ie, js, je, nz @@ -239,6 +241,21 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, endif enddo; enddo ; enddo + if (do_ale) then + if (.not. ASSOCIATED(fluxes%netMassOut)) then + ALLOCATE(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) + fluxes%netMassOut(:,:) = 0.0 + endif + if (.not. ASSOCIATED(fluxes%netMassIn)) then + ALLOCATE(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) + fluxes%netMassIn(:,:) = 0.0 + endif + + call read_data(CS%sum_file,'net_massout_sum',fluxes%netMassOut, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=center) + call read_data(CS%sum_file,'net_massin_sum', fluxes%netMassIn, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_snap,position=center) + endif ! if (do_ale) then ! CS%h_preale = GV%Angstrom @@ -271,7 +288,9 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, call pass_var(temp, G%Domain) call pass_var(salt, G%Domain) -! if (do_ale) then + if (do_ale) then + call pass_var(fluxes%netMassOut,G%Domain) + call pass_var(fluxes%netMassIn,G%Domain) ! ! call pass_vector(CS%u_preale,CS%v_preale,G%Domain) ! call pass_var(CS%h_preale, G%Domain) @@ -279,7 +298,7 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, ! call pass_var(CS%S_preale, G%Domain) ! ! -! endif + endif ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index ee2b6daafa..de6a3595d5 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -248,8 +248,8 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - ! Only apply forcing if fluxes%sw is associated. - if (.not.ASSOCIATED(fluxes%sw)) return +! ! Only apply forcing if fluxes%sw is associated. +! if (.not.ASSOCIATED(fluxes%sw)) return in_flux(:,:) = 0.0 ; out_flux(:,:) = 0.0 if(present(in_flux_optional)) then From 724dc3ec152e005e038279bbec115667188e9efc Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 6 Oct 2016 14:43:43 -0400 Subject: [PATCH 40/65] Answers do not change across PE counts --- src/ALE/MOM_ALE.F90 | 56 ++++++ src/core/MOM.F90 | 98 ++++++++--- src/tracer/MOM_offline_control.F90 | 262 +---------------------------- 3 files changed, 132 insertions(+), 284 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 30b8b271d5..fa350742b6 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -106,6 +106,7 @@ module MOM_ALE public ALE_init public ALE_end public ALE_main +public ALE_main_offline public ALE_offline_tracer_final public ALE_build_grid public ALE_remap_scalar @@ -425,6 +426,61 @@ subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt) end subroutine ALE_main +!> Takes care of (1) building a new grid and (2) remapping all variables between +!! the old grid and the new grid. The creation of the new grid can be based +!! on z coordinates, target interface densities, sigma coordinates or any +!! arbitrary coordinate system. +subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) + type(ocean_grid_type), intent(in) :: G !< Ocean grid informations + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + type(ALE_CS), pointer :: CS !< Regridding parameters and options + real, optional, intent(in) :: dt !< Time step between calls to ALE_main() + ! Local variables + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step (m or Pa) + integer :: nk, i, j, k, isc, iec, jsc, jec + + nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec + + if (CS%show_call_tree) call callTree_enter("ALE_main_offline(), MOM_ALE.F90") + + if (present(dt)) then + call ALE_update_regrid_weights( dt, CS ) + endif + dzRegrid(:,:,:) = 0.0 + + ! 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. + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid ) + + call check_grid( G, GV, h, 0. ) + + if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_main)") + + ! Remap all variables from old grid h onto new grid h_new + + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, -dzRegrid, Reg, & + debug=CS%show_call_tree, dt=dt ) + + if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") + + ! Override old grid with new one. The new grid 'h_new' is built in + ! one of the 'build_...' routines above. +!$OMP parallel do default(none) shared(isc,iec,jsc,jec,nk,h,h_new,CS) + do k = 1,nk + do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + h(i,j,k) = h_new(i,j,k) + enddo ; enddo + enddo + + if (CS%show_call_tree) call callTree_leave("ALE_main()") + if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + +end subroutine ALE_main_offline + !> Remaps all tracers from h onto h_target. This is intended to be called when tracers !! are done offline. In the case where transports don't quite conserve, we still want to !! make sure that layer thicknesses offline do not drift too far away from the online model diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index f95fbb0ae1..4fbcb5931b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -63,7 +63,7 @@ module MOM use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags -use MOM_ALE, only : ALE_offline_tracer_final +use MOM_ALE, only : ALE_main_offline, ALE_offline_tracer_final use MOM_continuity, only : continuity, continuity_init, continuity_CS use MOM_CoriolisAdv, only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS @@ -131,7 +131,6 @@ module MOM use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux -use MOM_offline_transport, only : limit_mass_flux_ordered_3d use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut use time_manager_mod, only : print_date @@ -1502,14 +1501,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Read in all fields that might be used this timestep call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%use_ALE_algorithm) - if (CS%offline_CSp%id_uhtr_preadv>0) call post_data(CS%offline_CSp%id_uhtr_preadv, uhtr, CS%diag) - if (CS%offline_CSp%id_vhtr_preadv>0) call post_data(CS%offline_CSp%id_vhtr_preadv, vhtr, CS%diag) - if (CS%id_h>0) call post_data(CS%id_h, h_end, CS%diag) do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_pre(i,j,k) = CS%h(i,j,k) enddo ; enddo; enddo - call pass_var(h_pre,G%Domain) @@ -1654,6 +1649,25 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) elseif (CS%use_ALE_algorithm) then + ! Tracers are transported using the stored mass fluxes in the following way + ! 1) Using the layer thicknesses and tracer concentrations from the previous timestep, + ! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to tracer_column_fns. + ! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline + ! 2) Next half of the accumulated surface freshwater fluxes are applied + !! Steps 3, 4, and 5 are iterated + ! 3) Accumulated mass fluxes are used to do horizontal transport. The number of iterations used in + ! advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are stored for later use + ! and resulting layer thicknesses fed into the next step + ! 4) Tracers and the h-grid are regridded and remapped in a call to ALE. This allows for layers which might + ! 'vanish' because of horizontal mass transport to be 'reinflated' + ! 5) Check that transport is done if the remaining mass fluxes equals 0 or if the max number of iterations + ! has been reached + !! END ITERATION + ! 6) Repeat steps 1 and 2 + ! 7) Force a remapping to the stored layer thicknesses that correspond to the snapshot of the online model + ! 8) Reset T/S and h to their stored snapshotted values to prevent model drift + + ! Convert flux rates into explicit mass/height of freshwater flux. Also note, that ! fluxes are halved because diabatic processes are split before and after advection do j=jsd,jed ; do i=isd,ied @@ -1662,7 +1676,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo ; enddo zero_3dh(:,:,:)=0.0 - + + ! Copy over the horizontal mass fluxes from the remaining total mass fluxes do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB uhtr_sub(i,j,k) = uhtr(i,j,k) enddo ; enddo ; enddo @@ -1670,6 +1685,14 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr_sub(i,j,k) = vhtr(i,j,k) enddo ; enddo ; enddo + if(CS%debug) then + call uchksum(uhtr_sub,"uhtr_sub before transport",G%HI) + call vchksum(vhtr_sub,"vhtr_sub before transport",G%HI) + call hchksum(h_pre,"h_pre before transport",G%HI) + endif + + ! Note that here, h_new really shouldn't be used, should double check that any individual tracer + ! does not use h_new call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & @@ -1677,7 +1700,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) minimum_forcing_depth=0.001) call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & 0.8, 0.001) - + + if(CS%debug) then + call hchksum(h_pre,"h_pre after 1st diabatic",G%HI) + endif do iter=1,CS%offline_CSp%num_off_iter @@ -1687,18 +1713,27 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & - uhr_out=uhtr, vhr_out=vhtr, h_out=h_new) + uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + x_before_y = .not. x_before_y do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) !+ & -! max(0.0, 1.0e-13*h_vol(i,j,k) - G%areaT(i,j)*h_new(i,j,k))/G%areaT(i,j) + h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo ; enddo - + + + if(CS%debug) then + call hchksum(h_pre,"h_pre after advect_tracer",G%HI) + endif + call cpu_clock_begin(id_clock_ALE) - call ALE_main(G, GV, h_pre, CS%offline_CSp%u_preale, CS%offline_CSp%v_preale, CS%tv, & + call ALE_main_offline(G, GV, h_pre, CS%tv, & CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) call cpu_clock_end(id_clock_ALE) + if(CS%debug) then + call hchksum(h_pre,"h_pre after ALE",G%HI) + endif + do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB uhtr_sub(i,j,k) = uhtr(i,j,k) enddo ; enddo ; enddo @@ -1708,9 +1743,21 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call pass_vector(uhtr_sub,vhtr_sub,G%Domain) call pass_var(h_pre, G%Domain) + + if(CS%debug) then + call uchksum(uhtr_sub,"uhtr_sub after adv iteration",G%HI) + call vchksum(vhtr_sub,"vhtr_sub after adv iteration",G%HI) + call hchksum(h_pre,"h_pre after adv iteration",G%HI) + endif - sum_u=sum(abs(uhtr)) - sum_v=sum(abs(vhtr)) + sum_u = 0.0 + do k=1,nz; do j=js,je ; do i=is-1,ie + sum_u = sum_u + abs(uhtr_sub(i,j,k)) + enddo; enddo; enddo + sum_v = 0.0 + do k=1,nz; do j=js-1,je; do i=is,ie + sum_v = sum_v + abs(vhtr_sub(i,j,k)) + enddo; enddo ; enddo call sum_across_PEs(sum_u) call sum_across_PEs(sum_v) @@ -1724,12 +1771,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo ! Note here T/S are reset to the stored snap shot to ensure that the offline model ! densities, used in the neutral diffusion code don't drift too far from the online - ! model - CS%T = temp_old - CS%S = salt_old - call pass_var(CS%T,G%Domain) - call pass_var(CS%S,G%Domain) - + ! model call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & @@ -1737,11 +1779,15 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) minimum_forcing_depth=0.001) call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & 0.8, 0.001) - + + if(CS%debug) then + call hchksum(h_pre,"h_pre after 2nd diabatic",G%HI) + endif + call cpu_clock_begin(id_clock_ALE) call ALE_offline_tracer_final( G, GV, h_pre, h_end, CS%tracer_Reg, CS%ALE_CSp) - + call cpu_clock_end(id_clock_ALE) endif - call pass_var(h_end, G%Domain) + ! Tracer diffusion Strang split between advection and diffusion call tracer_hordiff(h_end, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) @@ -1759,10 +1805,14 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call disable_averaging(CS%diag) do i = is, ie ; do j = js, je ; do k=1,nz + CS%T(i,j,k) = temp_old(i,j,k) + CS%S(i,j,k) = salt_old(i,j,k) CS%h(i,j,k) = h_end(i,j,k) enddo ; enddo; enddo call pass_var(CS%h,G%Domain) + call pass_var(CS%T,G%Domain) + call pass_var(CS%S,G%Domain) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 4398b2de20..8e2f3b147f 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -209,9 +209,9 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, timelevel=CS%ridx_mean,position=CENTER) !! Time-averaged fields - call read_data(CS%snap_file, 'temp_preadv', temp, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'temp', temp, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) - call read_data(CS%snap_file, 'salt_preadv', salt, domain=G%Domain%mpp_domain, & + call read_data(CS%snap_file, 'salt', salt, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_mean,position=CENTER) !! Read snapshot fields (end of time interval timestamp) @@ -257,25 +257,6 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, timelevel=CS%ridx_snap,position=center) endif -! if (do_ale) then -! CS%h_preale = GV%Angstrom -! CS%T_preale = 0.0 -! CS%S_preale = 0.0 -! CS%u_preale = 0.0 -! CS%v_preale = 0.0 -! call read_data(CS%preale_file, 'h_preale', CS%h_preale, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_snap,position=CENTER) -! call read_data(CS%preale_file, 'T_preale', CS%T_preale, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_mean,position=CENTER) -! call read_data(CS%preale_file, 'S_preale', CS%S_preale, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_mean,position=CENTER) -! call read_data(CS%preale_file, 'u_preale', CS%u_preale, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_mean,position=EAST) -! call read_data(CS%preale_file, 'v_preale', CS%v_preale, domain=G%Domain%mpp_domain, & -! timelevel=CS%ridx_mean,position=NORTH) -! -! endif - !! Make sure all halos have been updated ! Vector fields call pass_vector(uhtr, vhtr, G%Domain) @@ -291,13 +272,6 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, if (do_ale) then call pass_var(fluxes%netMassOut,G%Domain) call pass_var(fluxes%netMassIn,G%Domain) -! -! call pass_vector(CS%u_preale,CS%v_preale,G%Domain) -! call pass_var(CS%h_preale, G%Domain) -! call pass_var(CS%T_preale, G%Domain) -! call pass_var(CS%S_preale, G%Domain) -! -! endif ! Update the read indices @@ -329,10 +303,6 @@ subroutine register_diags_offline_transport(Time, diag, CS) 'Meridional thickness fluxes remaining at end of timestep', 'kg') ! T-cell fields - CS%id_temp_preadv = register_diag_field('ocean_model', 'temp_preadv', diag%axesTL, Time, & - 'Temperature prior to advection', 'C') - CS%id_salt_preadv = register_diag_field('ocean_model', 'salt_preadv', diag%axesTL, Time, & - 'Salinity prior to advection', 'S') CS%id_hr = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & 'Difference between the stored and calculated layer thickness', 'm') CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & @@ -606,232 +576,4 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d - subroutine limit_mass_flux_ordered_3d(G, GV, uh, vh, ea, eb, h_in, h_end, max_off_cfl, z_first, x_before_y) - type(ocean_grid_type), pointer :: G - type(verticalGrid_type), pointer :: GV - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_in - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h_end - real, intent(in) :: max_off_cfl - logical, intent(in) :: z_first, x_before_y - - ! Local variables - integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_budget ! Tracks how much thickness - ! remains for other fluxes - integer :: flux_order = -1 - ! In this subroutine, fluxes out of the box are scaled down if they deplete - ! the layer. Here the positive direction is defined as flux out of the box as opposed to the - ! typical, strictly upwind convention. Hence, uh(I-1) is multipled by negative one, - ! but uh(I) is not. This routine differs from limit_mass_flux_3d because in this case, - ! the ordering of direction matters. While this is more aggressive than the other routine which, - ! Scales fluxes if they would deplete the layer (independent of any convergence within an - ! iteration), this routine should still maintain a CFL less than 1 - ! Because horizontal transport must always be together (i.e. cannot do x->z->y), - ! four cases are considered) - ! 1: z -> x -> y - ! 2: z -> y -> x - ! 3: x -> y -> z - ! 4: y -> x -> z - - ! Set index-related variables for fields on T-grid - is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed ; nz = GV%ke - ! Copy layer thicknesses into a working array for this subroutine - do k=1,nz ; do j=js,je ; do i=is,ie - h_budget(i,j,k) = h_in(i,j,k)*G%areaT(i,j) - enddo ; enddo ; enddo - - ! Set the flux order (corresponding to one of the four cases described previously) - if (z_first .and. x_before_y) flux_order = 1 - if (z_first .and. (.not. x_before_y)) flux_order = 2 - if ((.not. z_first) .and. x_before_y) flux_order = 3 - if ((.not. z_first) .and. (.not. x_before_y)) flux_order = 4 - - select case (flux_order) - case (1) ! z -> x -> y - ! Check first to see if either the top or bottom flux would deplete the layer - !call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) - call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) - call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) - case (2) ! z -> y -> x - !call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) - call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) - call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) - case (3) ! x -> y -> z - call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) - call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) -! call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) - case (4) ! y -> x -> z - call flux_limiter_v(G, GV, h_budget, vh, max_off_cfl) - call flux_limiter_u(G, GV, h_budget, uh, max_off_cfl) -! call flux_limiter_vertical(G, GV, h_budget, ea, eb, max_off_cfl) - case default - call MOM_error(FATAL, "Invalid choice of flux_order") - end select - - do k=1,nz ; do j=js,je ; do i=is,ie - h_end(i,j,k) = h_budget(i,j,k)/G%areaT(i,j) - if (h_end(i,j,k)<0.0 ) then - print *, "i,j,k,h,",i,j,k,h_end(i,j,k) - endif - enddo ; enddo ; enddo - - end subroutine limit_mass_flux_ordered_3d - - subroutine flux_limiter_vertical(G, GV, h, ea, eb, max_off_cfl) - type(ocean_grid_type), pointer :: G - type(verticalGrid_type), pointer :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h - real :: max_off_cfl - ! Limits how much the a layer can be depleted in the vertical direction - real, dimension(SZI_(G),SZK_(G)) :: ea2d, eb2d - real, dimension(SZI_(G),SZK_(G)) :: h2d, scale - real, dimension(SZI_(G),SZK_(G)+1) :: flux_interface, top_flux, bottom_flux - real :: total_out_flux, h_budget - integer :: i, j, k, m, is, ie, js, je, nz - - ! Set index-related variables for fields on T-grid - is = G%isd ; ie = G%ied ; js = G%jsd ; je = G%jed ; nz = GV%ke - - do j=js,je - do k=1,nz ; do i=is,ie - ea2d(i,k) = ea(i,j,k) - eb2d(i,k) = eb(i,j,k) - h2d(i,k) = h(i,j,k) - enddo ; enddo; - - ! Calculate the fluxes through top and bottom faces of the cell - k=1 ! Top layer - do i=is,ie - flux_interface(i,k) = 0.0 - enddo - - do k=2, nz-1 ; do i=is,ie - top_flux(i,k) = ea2d(i,k)-eb2d(i,k-1) - bottom_flux(i,k) = ea2d(i,k+1)-eb2d(i,k) - enddo ; enddo - k=nz ! Bottom layer - do i=is,ie - top_flux(i,k) = ea2d(i,k)-eb2d(i,k-1) - bottom_flux(i,k) = -eb2d(i,k) - enddo - - ! Convert fluxes which are in units of thickness to units of volume - do k=1,nz ; do i=is,ie - top_flux(i,k) = top_flux(i,k)*G%areaT(i,j) - bottom_flux(i,k) = bottom_flux(i,k)*G%areaT(i,j) - enddo; enddo - - do k=1,nz ; do i=is,ie - - enddo; enddo - - enddo - end subroutine flux_limiter_vertical - - subroutine flux_limiter_u(G, GV, h, uh, max_off_cfl) - type(ocean_grid_type), pointer :: G - type(verticalGrid_type), pointer :: GV - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h - real :: max_off_cfl - ! Limits how much the a layer can be depleted in the vertical direction - real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real :: hup, hlos, min_h, h_remain - integer :: i, j, k, m, is, ie, js, je, nz - - min_h= 0.1*GV%Angstrom - ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - - do j=js-1,je - do k=1,nz ; do i=is-2,ie - uh2d(I,k) = uh(I,j,k) - enddo ; enddo; - - do k=1,nz ; do i=is-1,ie - if(uh2d(I,k)<0.0) then - hup = h(i+1,j,k) - min_h*G%areaT(i+1,j) - hlos = max(0.0, uh2d(I+1,k)) - if (( ((hup-hlos)+uh2d(I,k))<0.0) .and. & - ((0.5*hup + uh2d(I,k))<0.0)) then - uh2d(I,k) = min(-0.5*hup,-hup+hlos,0.0) - endif - else - hup = h(i,j,k) - G%areaT(i,j)*min_h - hlos = max(0.0,-uh2d(I-1,k)) - if ((((hup-hlos)-uh2d(I,k))<0.0) .and. & - ((0.5*hup-uh2d(I,k))<0.0)) then - uh2d(I,k) = max(0.5*hup,hup-hlos,0.0) - endif - endif - enddo ; enddo - - do k=1,nz - do i=is-1,ie - uh(I,j,k) = uh2d(I,k) - enddo - do i=is,ie - h(i,j,k) = h(i,j,k) - (uh2d(I,k) - uh2d(I-1,k)) - enddo - enddo - - enddo - - end subroutine flux_limiter_u - - subroutine flux_limiter_v(G, GV, h, vh, max_off_cfl) - type(ocean_grid_type), pointer :: G - type(verticalGrid_type), pointer :: GV - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h - real, intent(in) :: max_off_cfl - ! Limits how much the a layer can be depleted in the vertical direction - real, dimension(SZJB_(G),SZK_(G)) :: vh2d - real, dimension(SZJ_(G),SZK_(G)) :: h2d - real :: hup, hlos, min_h, h_remain - integer :: i, j, k, m, is, ie, js, je, nz - - ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h= 0.1*GV%Angstrom - do i=is-1,ie - do k=1,nz ; do j=js-2,je - vh2d(J,k) = vh(i,J,k) - enddo ; enddo; - do k=1,nz ; do j=js-1,je - if(vh2d(J,k)<0.0) then - hup = h(i,j+1,k)-G%areaT(i,j+1)*min_h - hlos = max(0.0,vh2d(J+1,k)) - if ((((hup-hlos)+vh2d(J,k))<0.0) .and. & - ((0.5*hup+vh2d(J,k))<0.0)) then - vh2d(J,k) = min(-0.5*hup,-hup+hlos,0.0) - endif - else - hup = h(i,j,k) - G%areaT(i,j)*min_h - hlos = max(0.0,-vh2d(J-1,k)) - if ((((hup-hlos)-vh2d(J,k))<0.0) .and. & - ((0.5*hup - vh2d(J,k))<0.0)) then - vh2d(J,k) = max(0.5*hup,hup-hlos,0.0) - endif - endif - enddo ; enddo - - do k=1,nz - do j=js-1,je - vh(i,J,k) = vh2d(J,k) - enddo - do j=js,je - h(i,j,k) = h(i,j,k) - (vh2d(J,k) - vh2d(J-1,k)) - enddo - enddo - enddo - end subroutine flux_limiter_v - - end module MOM_offline_transport From 12091619b45afa4db39e8e77307b1e21c17725ad Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 7 Oct 2016 10:49:21 -0400 Subject: [PATCH 41/65] Cleaned up and commented in the code. Answers do not change across PE count. Ready for testing in OM4 --- src/core/MOM.F90 | 380 +++++++++++++++-------------- src/core/MOM_forcing_type.F90 | 16 +- src/tracer/MOM_offline_control.F90 | 203 ++++++--------- 3 files changed, 282 insertions(+), 317 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4fbcb5931b..a96bbed50e 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -128,15 +128,11 @@ module MOM ! Offline modules use MOM_offline_transport, only : offline_transport_CS -use MOM_offline_transport, only : transport_by_files, next_modulo_time, post_advection_fields +use MOM_offline_transport, only : transport_by_files, next_modulo_time use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut -use time_manager_mod, only : print_date -use MOM_sum_output, only : write_energy - - implicit none ; private #include @@ -357,6 +353,10 @@ module MOM integer :: id_S_preale = -1 integer :: id_e_preale = -1 + ! Diagnostics for tracer horizontal transport + integer :: id_uhtr = -1 + integer :: id_vhtr = -1 + ! The remainder provides pointers to child module control structures. type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL() type(MOM_dyn_unsplit_RK2_CS), pointer :: dyn_unsplit_RK2_CSp => NULL() @@ -503,10 +503,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB u => CS%u ; v => CS%v ; h => CS%h - write_all_3du(:,:,:) = 1. - write_all_3dv(:,:,:) = 1. - write_all_3dt(:,:,:) = 1. - call cpu_clock_begin(id_clock_ocean) call cpu_clock_begin(id_clock_other) @@ -1011,8 +1007,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_tracer) ! Post fields used for offline tracer model - call post_advection_fields( G, CS%offline_CSp, CS%diag, h, & - CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S ) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_trans, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h, CS%dt_trans, CS%MEKE, CS%VarMix, G, GV, & @@ -1201,6 +1195,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (CS%id_Sdiffx_2d > 0) call post_data(CS%id_Sdiffx_2d, CS%S_diffx_2d, CS%diag) if (CS%id_Sdiffy_2d > 0) call post_data(CS%id_Sdiffy_2d, CS%S_diffy_2d, CS%diag) + if (CS%id_uhtr > 0) call post_data(CS%id_uhtr, CS%uhtr, CS%diag) + if (CS%id_vhtr > 0) call post_data(CS%id_vhtr, CS%vhtr, CS%diag) + call post_diags_TS_tendency(G,GV,CS,dtdia) call disable_averaging(CS%diag) @@ -1220,6 +1217,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_other) call cpu_clock_begin(id_clock_thermo) + + + ! Reset the accumulated transports to 0. CS%uhtr(:,:,:) = 0.0 CS%vhtr(:,:,:) = 0.0 @@ -1410,6 +1410,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) end subroutine step_MOM +!> step_tracers is the main driver for running tracers offline in MOM6. This has been primarily +!! developed with ALE configurations in mind. Some work has been done in isopycnal configuration, but +!! the work is very preliminary. Some more detail about this capability along with some of the subroutines +!! called here can be found in tracers/MOM_offline_control.F90 subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: state !< surface ocean state @@ -1422,35 +1426,39 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid - ! U-3D - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub, uh_max, uh_zero - ! U-2D - real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x, khdt_x_sub - ! V-3D - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub, vh_max, vh_zero - ! V-2D - real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y, khdt_y_sub - - real :: sum_abs_fluxes, sum_u, sum_v - real :: dt_offline + ! Zonal mass transports + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr, uhtr_sub + ! Zonal diffusive transport + real, dimension(SZIB_(CS%G),SZJ_(CS%G)) :: khdt_x + ! Meridional mass transports + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub + ! Meridional diffusive transports + real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y + + real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are + real :: dt_offline ! Shorthand variable ! Local variables + ! Vertical diffusion related variables real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & - eatr, & ! Amount of fluid entrained from the layer above within + eatr, & ! Amount of fluid entrained from the layer above within ! one time step (m for Bouss, kg/m^2 for non-Bouss) - ebtr, & ! Amount of fluid entrained from the layer below within + ebtr, & ! Amount of fluid entrained from the layer below within ! one time step (m for Bouss, kg/m^2 for non-Bouss) eatr_sub, & - ebtr_sub, & - h_new, & ! Layer thickness after diapycnal entrainment - ! (m for Bouss, kg/m^2 for non-Bouss) + ebtr_sub + ! Variables used to keep track of layer thicknesses at various points in the code + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & + h_new, & h_end, & h_vol, & h_pre, & - h_temp, & + h_temp + ! Work arrays for temperature and salinity + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & temp_old, salt_old, & zero_3dh ! - integer :: niter, iter, big_iter + integer :: niter, iter real :: Inum_iter, dt_iter integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. @@ -1471,11 +1479,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) Inum_iter = 1./real(niter) dt_iter = dt_offline*Inum_iter - ! T-cell pointer assignments - - ! U-cell pointer assignments - - ! V-cell pointer assignments uhtr(:,:,:) = 0.0 vhtr(:,:,:) = 0.0 khdt_x(:,:) = 0.0 @@ -1491,8 +1494,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) vhtr_sub(:,:,:) = 0.0 eatr_sub(:,:,:) = 0.0 ebtr_sub(:,:,:) = 0.0 - uh_zero(:,:,:) = 0.0 - vh_zero(:,:,:) = 0.0 call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & @@ -1507,154 +1508,19 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo ; enddo; enddo call pass_var(h_pre,G%Domain) - h_new(:,:,:) = GV%Angstrom - ! Offline tracer advection is done by using a 3d flux-limited, Strang time-split method - ! The flux limiting follows the routine specified by Skamarock (Monthly Weather Review, 2005) - ! to make sure that offline advection is monotonic and positive-definite -! - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) - x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first - if (.not. CS%use_ALE_algorithm) then - do iter=1,CS%offline_CSp%num_off_iter - - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - eatr_sub(i,j,k) = eatr(i,j,k) - ebtr_sub(i,j,k) = ebtr(i,j,k) - enddo; enddo ; enddo - - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 - uhtr_sub(I,j,k) = uhtr(I,j,k) - enddo; enddo ; enddo - - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 - vhtr_sub(i,J,k) = vhtr(i,J,k) - enddo; enddo ; enddo - - - ! Calculate 3d mass transports to be used in this iteration - call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & - CS%offline_CSp%max_off_cfl) - - if (z_first) then - ! First do vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - call pass_var(h_pre,G%Domain) - - ! Second zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + if(CS%use_ALE_algorithm) then - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - - endif - - if (.not. z_first) then - - ! First zonal and meridional advection - call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo; enddo; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) - - ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - - - - ! Second vertical advection - call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) - call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) - ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - - - endif - - ! Update remaining transports - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) - ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) - enddo; enddo ; enddo - - - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 - uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) - enddo; enddo ; enddo - - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 - vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) - enddo; enddo ; enddo - - call pass_var(eatr,G%Domain) - call pass_var(ebtr,G%Domain) - call pass_var(h_pre,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - ! - ! Calculate how close we are to converging by summing the remaining fluxes at each point - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 - do k=1,nz; do j=js,je; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) - enddo; enddo; enddo - call sum_across_PEs(sum_abs_fluxes) - - print *, "Remaining u-flux, v-flux:", sum_u, sum_v - if (sum_abs_fluxes==0) then - print *, 'Converged after iteration', iter - exit - endif - ! - ! - if (is_root_pe()) print *, "Remaining fluxes: ", sum_abs_fluxes !, & - ! "UH: ", sum(abs(uhtr)), "VH: ", sum(abs(vhtr)), "EA: ", sum(abs(eatr)), "EB: ", sum(abs(ebtr)) - ! if ( sum_abs_fluxes == 0.0) then - ! print *, "Advection converged early at ", iter, "iterations" - ! exit - ! endif - - ! Switch order of Strang split every iteration - z_first = .not. z_first - x_before_y = .not. x_before_y - - end do - - elseif (CS%use_ALE_algorithm) then - - ! Tracers are transported using the stored mass fluxes in the following way + ! Tracers are transported using the stored mass fluxes. Where possible, operators are Strang-split around + ! the call to ! 1) Using the layer thicknesses and tracer concentrations from the previous timestep, ! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to tracer_column_fns. ! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline ! 2) Next half of the accumulated surface freshwater fluxes are applied - !! Steps 3, 4, and 5 are iterated + !! START ITERATION ! 3) Accumulated mass fluxes are used to do horizontal transport. The number of iterations used in ! advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are stored for later use ! and resulting layer thicknesses fed into the next step @@ -1666,10 +1532,14 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! 6) Repeat steps 1 and 2 ! 7) Force a remapping to the stored layer thicknesses that correspond to the snapshot of the online model ! 8) Reset T/S and h to their stored snapshotted values to prevent model drift - ! Convert flux rates into explicit mass/height of freshwater flux. Also note, that ! fluxes are halved because diabatic processes are split before and after advection + + ! Do horizontal diffusion first (but only half of it), remainder will be applied after advection + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + do j=jsd,jed ; do i=isd,ied fluxes%netMassOut(i,j) = 0.5*fluxes%netMassOut(i,j) fluxes%netMassIn(i,j) = 0.5*fluxes%netMassIn(i,j) @@ -1691,8 +1561,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(h_pre,"h_pre before transport",G%HI) endif - ! Note that here, h_new really shouldn't be used, should double check that any individual tracer - ! does not use h_new + ! Note that here, h_new does nto represent any physical, should double check that any individual + ! tracer does not use h_new call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & @@ -1705,6 +1575,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(h_pre,"h_pre after 1st diabatic",G%HI) endif + ! This loop does essentially a flux-limited, nonlinear advection scheme until all mass fluxes + ! are used. ALE is done after the horizontal advection. do iter=1,CS%offline_CSp%num_off_iter do k=1,nz ; do j=jsd,jed ; do i=isd,ied @@ -1714,8 +1586,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) - - x_before_y = .not. x_before_y + ! Switch the direction every iteration? Maybe not useful + ! x_before_y = .not. x_before_y + do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo ; enddo @@ -1769,9 +1642,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif enddo - ! Note here T/S are reset to the stored snap shot to ensure that the offline model - ! densities, used in the neutral diffusion code don't drift too far from the online - ! model + + ! Now do the other half of the vertical mixing and tracer source/sink functions call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & @@ -1783,9 +1655,133 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if(CS%debug) then call hchksum(h_pre,"h_pre after 2nd diabatic",G%HI) endif - call cpu_clock_begin(id_clock_ALE) + + ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses + ! stored from the forward run + call cpu_clock_begin(id_clock_ALE) call ALE_offline_tracer_final( G, GV, h_pre, h_end, CS%tracer_Reg, CS%ALE_CSp) - call cpu_clock_end(id_clock_ALE) + call cpu_clock_end(id_clock_ALE) + + ! Finish with the other half of the tracer horizontal diffusion + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + + elseif (.not. CS%use_ALE_algorithm) then + do iter=1,CS%offline_CSp%num_off_iter + + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + eatr_sub(i,j,k) = eatr(i,j,k) + ebtr_sub(i,j,k) = ebtr(i,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + uhtr_sub(I,j,k) = uhtr(I,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + vhtr_sub(i,J,k) = vhtr(i,J,k) + enddo; enddo ; enddo + + + ! Calculate 3d mass transports to be used in this iteration + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & + CS%offline_CSp%max_off_cfl) + + if (z_first) then + ! First do vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + call pass_var(h_pre,G%Domain) + + ! Second zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + endif + + if (.not. z_first) then + + ! First zonal and meridional advection + call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) + do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo; enddo; enddo + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + + ! Done with horizontal so now h_pre should be h_new + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + ! Second vertical advection + call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) + call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & + fluxes, dt_iter, G, GV, CS%tv, CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug) + ! We are now done with the vertical mass transports, so now h_new is h_sub + do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + + endif + + ! Update remaining transports + do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) + ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) + enddo; enddo ; enddo + + do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) + enddo; enddo ; enddo + + call pass_var(eatr,G%Domain) + call pass_var(ebtr,G%Domain) + call pass_var(h_pre,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) + ! + ! Calculate how close we are to converging by summing the remaining fluxes at each point + sum_abs_fluxes = 0.0 + sum_u = 0.0 + sum_v = 0.0 + do k=1,nz; do j=js,je; do i=is,ie + sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) + sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) + sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & + abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + enddo; enddo; enddo + call sum_across_PEs(sum_abs_fluxes) + + print *, "Remaining u-flux, v-flux:", sum_u, sum_v + if (sum_abs_fluxes==0) then + print *, 'Converged after iteration', iter + exit + endif + + ! Switch order of Strang split every iteration + z_first = .not. z_first + x_before_y = .not. x_before_y + + end do endif ! Tracer diffusion Strang split between advection and diffusion @@ -1804,6 +1800,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call disable_averaging(CS%diag) + ! Note here T/S are reset to the stored snap shot to ensure that the offline model + ! densities, used in the neutral diffusion code don't drift too far from the online + ! model do i = is, ie ; do j = js, je ; do k=1,nz CS%T(i,j,k) = temp_old(i,j,k) CS%S(i,j,k) = salt_old(i,j,k) @@ -2503,6 +2502,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) endif + ! If need a diagnostic field, then would have been allocated in register_diags. if (CS%use_temperature) then call add_tracer_diagnostics("T", CS%tracer_Reg, CS%T_adx, CS%T_ady, & @@ -2521,7 +2521,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) cmor_long_name ="Sea Water Salinity") endif - call offline_transport_init(param_file, CS%offline_CSp, CS%use_ALE_algorithm, G, GV) + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) @@ -2847,7 +2847,13 @@ subroutine register_diags(Time, G, GV, CS, ADp) CS%id_S_predia = register_diag_field('ocean_model', 'salt_predia', diag%axesTL, Time, & 'Salinity', 'PPT') endif - + + ! Diagnostics related to tracer transport + CS%id_uhtr = register_diag_field('ocean_model', 'uhtr', diag%axesCuL, Time, & + 'Accumulated zonal thickness fluxes to advect tracers', 'kg') + CS%id_vhtr = register_diag_field('ocean_model', 'vhtr', diag%axesCvL, Time, & + 'Accumulated meridional thickness fluxes to advect tracers', 'kg') + end subroutine register_diags diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e035713fa3..3f7969f0b4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -169,6 +169,7 @@ module MOM_forcing_type integer :: id_lprec = -1, id_fprec = -1 integer :: id_lrunoff = -1, id_frunoff = -1 integer :: id_net_massout = -1, id_net_massin = -1 + integer :: id_massout_flux = -1, id_massin_flux = -1 integer :: id_seaice_melt = -1 ! global area integrated mass flux diagnostic handles @@ -1025,7 +1026,12 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles) handles%id_net_massin = register_diag_field('ocean_model', 'net_massin', diag%axesT1, Time, & 'Net mass entering ocean due to precip, runoff, ice melt', 'kilogram meter-2 second-1') + handles%id_massout_flux = register_diag_field('ocean_model', 'massout_flux', diag%axesT1, Time, & + 'Net mass flux of freshwater out of the ocean (used in the boundary flux calculation)', & + 'kilogram meter-2') + handles%id_massin_flux = register_diag_field('ocean_model', 'massin_flux', diag%axesT1, Time, & + 'Net mass mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kilogram meter-2') !========================================================================= ! area integrated surface mass transport @@ -1750,13 +1756,14 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) if(fluxes%vprec(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%vprec(i,j) if(fluxes%evap(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) enddo ; enddo -! call post_data(handles%id_net_massout, sum, diag) - call post_data(handles%id_net_massout,fluxes%netMassOut,diag) + call post_data(handles%id_net_massout, sum, diag) if(handles%id_total_net_massout > 0) then total_transport = global_area_integral(sum,G) call post_data(handles%id_total_net_massout, total_transport, diag) endif endif + + if(handles%id_massout_flux > 0) call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) if(handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then sum(:,:) = 0.0 @@ -1767,13 +1774,14 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) ! fluxes%cond is not needed because it is derived from %evap > 0 if(fluxes%evap(i,j) > 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) enddo ; enddo -! call post_data(handles%id_net_massin, sum, diag) - call post_data(handles%id_net_massin, fluxes%netMassIn, diag) + call post_data(handles%id_net_massin, sum, diag) if(handles%id_total_net_massin > 0) then total_transport = global_area_integral(sum,G) call post_data(handles%id_total_net_massin, total_transport, diag) endif endif + + if(handles%id_massin_flux > 0) call post_data(handles%id_massin_flux,fluxes%netMassIn,diag) if ((handles%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 8e2f3b147f..c750bdaad6 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -24,17 +24,21 @@ !* * !* The subroutines here allow MOM6 to be run in a so-called 'offline' * !* mode ostensibly for the purpose of modeling tracers. Instead of * -!* calculating u, v, and h prognostically, these fields are read in * +!* calculating mass transports prognostically, these fields are read * !* at regular intervals which have been saved from a previous * !* integration of MOM6. * !* * -!* Users are warned that the usual diagnostics (i.e. conservation of * -!* mass) cannot be expected to be replicated to the same accuracy as * -!* the online model because some information is loss due to the * -!* averaging and snapshotting involved with saving offline files. The * -!* responsibility lies on the user that the loss of accuracy is * -!* acceptable for their application. +!* Users should note that by accumulating fluxes over a range dt, * +!* homogeneity over that time period is implictly assumed. For * +!* example, this means that for fluxes accumulated over a day, the * +!* diurnal cycling of the surface boundary layer is not resolved, but * +!* total transport should be conserved. It is the user's * +!* responsibility to determine what the appropriate offline time * +!* scale should be. As a general guidance for global configurations * +!* 5 days seems to be a reasonable choice. * !* * +!* The actual driver for offline tracer transport is in the * +!* subroutine step_tracers in MOM.F90 * !* Macros written all in capital letters are defined in MOM_memory.h * !* * !********+*********+*********+*********+*********+*********+*********+** @@ -42,21 +46,22 @@ module MOM_offline_transport - use data_override_mod, only : data_override_init, data_override - use MOM_time_manager, only : time_type - use MOM_domains, only : pass_var, pass_vector, To_All - use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe - use MOM_grid, only : ocean_grid_type - use MOM_verticalGrid, only : verticalGrid_type - use MOM_io, only : read_data - use MOM_file_parser, only : get_param, log_version, param_file_type - use MOM_diag_mediator, only : diag_ctrl, register_diag_field - use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST - use MOM_variables, only : vertvisc_type - use MOM_forcing_type, only : forcing - use MOM_shortwave_abs, only : optics_type - use MOM_diag_mediator, only : post_data - use MOM_forcing_type, only : forcing + use data_override_mod, only : data_override_init, data_override + use MOM_time_manager, only : time_type + use MOM_domains, only : pass_var, pass_vector, To_All + use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe + use MOM_grid, only : ocean_grid_type + use MOM_verticalGrid, only : verticalGrid_type + use MOM_io, only : read_data + use MOM_file_parser, only : get_param, log_version, param_file_type + use MOM_diag_mediator, only : diag_ctrl, register_diag_field + use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST + use MOM_variables, only : vertvisc_type + use MOM_forcing_type, only : forcing + use MOM_shortwave_abs, only : optics_type + use MOM_diag_mediator, only : post_data + use MOM_forcing_type, only : forcing + use MOM_diabatic_driver, only : diabatic_CS implicit none @@ -64,44 +69,31 @@ module MOM_offline_transport type, public :: offline_transport_CS + !> Variables related to reading in fields from online run integer :: start_index ! Timelevel to start - integer :: numtime ! How many timelevels in the input fields - + integer :: numtime ! How many timelevels in the input fields integer :: & ! Index of each of the variables to be read in - ridx_mean = -1, & ! Separate indices for each variabile if they are - ridx_snap = -1 ! setoff from each other in time - - + ridx_sum = -1, & ! Separate indices for each variabile if they are + ridx_snap = -1 ! setoff from each other in time character(len=200) :: offlinedir ! Directory where offline fields are stored - character(len=200) :: & ! Names - mean_file, & + character(len=200) :: & ! ! Names of input files snap_file, & - sum_file, & - preale_file - + sum_file logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level - - real :: max_off_cfl - ! These fields for preale are allocatable because they are not necessary for all runs - real, allocatable, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - T_preale, & - S_preale, & - h_preale - real, allocatable, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & - u_preale - real, allocatable, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & - v_preale - - real :: dt_offline ! Timestep used for offline tracers - + + !> Variables controlling some of the numerical considerations of offline transport integer :: num_off_iter + real :: dt_offline ! Timestep used for offline tracers + real :: max_off_cfl=0.5 ! Hardcoded for now, only used in non-ALE mode + real :: evap_CFL_limit, minimum_forcing_depth + !> Diagnostic manager IDs for use in the online model of additional fields necessary + !> for offline tracer modeling integer :: & id_uhtr_preadv = -1, & id_vhtr_preadv = -1, & - id_temp_preadv = -1, & - id_salt_preadv = -1, & + !> Diagnostic manager IDs for some fields that may be of interest when doing offline transport id_uhr = -1, & id_vhr = -1, & id_ear = -1, & @@ -113,7 +105,6 @@ module MOM_offline_transport #include "MOM_memory.h" #include "version_variable.h" public offline_transport_init - public post_advection_fields public transport_by_files public register_diags_offline_transport public update_h_horizontal_flux @@ -122,41 +113,10 @@ module MOM_offline_transport contains - ! Called right before tracer_advect call in MOM.F90 to ensure that all terms - ! in the tracer advection routine are the same online and offline - subroutine post_advection_fields( G, CS, diag, h_adv, uhtr, vhtr, temp, salt ) - - type(ocean_grid_type), intent(in) :: G - type(offline_transport_CS), intent(in) :: CS - type(diag_ctrl), intent(inout) :: diag - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_adv, temp, salt - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr !< accumulated volume/mass flux through zonal face (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr !< accumulated volume/mass flux through merid face (m3 or kg) - - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: write_all_3du - real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: write_all_3dv - - - write_all_3dt(:,:,:) = 1. - write_all_3du(:,:,:) = 1. - write_all_3dv(:,:,:) = 1. - - - if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag ) - if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag ) - if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag ) - if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag ) - -! if (CS%id_uhtr_preadv>0) call post_data(CS%id_uhtr_preadv, uhtr, diag, mask = write_all_3du ) -! if (CS%id_vhtr_preadv>0) call post_data(CS%id_vhtr_preadv, vhtr, diag, mask = write_all_3dv ) -! if (CS%id_temp_preadv>0) call post_data(CS%id_temp_preadv, temp, diag, mask = write_all_3dt ) -! if (CS%id_salt_preadv>0) call post_data(CS%id_salt_preadv, salt, diag, mask = write_all_3dt ) - - end subroutine post_advection_fields - subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, fluxes, do_ale_in) + temp, salt, fluxes, do_ale_in) + !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored + !! in a previous integration of the online model type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(inout) :: GV type(offline_transport_CS), intent(inout) :: CS @@ -193,26 +153,26 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, !! Time-summed fields ! U-grid - call read_data(CS%sum_file, 'uhtr_preadv_sum', uhtr,domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) + call read_data(CS%sum_file, 'uhtr_sum', uhtr,domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_sum,position=EAST) call read_data(CS%sum_file, 'khdt_x_sum', khdt_x,domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=EAST) + timelevel=CS%ridx_sum,position=EAST) ! V-grid - call read_data(CS%sum_file, 'vhtr_preadv_sum', vhtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) + call read_data(CS%sum_file, 'vhtr_sum', vhtr, domain=G%Domain%mpp_domain, & + timelevel=CS%ridx_sum,position=NORTH) call read_data(CS%sum_file, 'khdt_y_sum', khdt_y, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=NORTH) + timelevel=CS%ridx_sum,position=NORTH) ! T-grid call read_data(CS%sum_file, 'ea_sum', eatr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) + timelevel=CS%ridx_sum,position=CENTER) call read_data(CS%sum_file, 'eb_sum', ebtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) + timelevel=CS%ridx_sum,position=CENTER) !! Time-averaged fields call read_data(CS%snap_file, 'temp', temp, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) + timelevel=CS%ridx_sum,position=CENTER) call read_data(CS%snap_file, 'salt', salt, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_mean,position=CENTER) + timelevel=CS%ridx_sum,position=CENTER) !! Read snapshot fields (end of time interval timestamp) call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & @@ -241,6 +201,8 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, endif enddo; enddo ; enddo + ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, + ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine if (do_ale) then if (.not. ASSOCIATED(fluxes%netMassOut)) then ALLOCATE(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) @@ -251,9 +213,9 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, fluxes%netMassIn(:,:) = 0.0 endif - call read_data(CS%sum_file,'net_massout_sum',fluxes%netMassOut, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file,'massout_flux_sum',fluxes%netMassOut, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=center) - call read_data(CS%sum_file,'net_massin_sum', fluxes%netMassIn, domain=G%Domain%mpp_domain, & + call read_data(CS%sum_file,'massin_flux_sum', fluxes%netMassIn, domain=G%Domain%mpp_domain, & timelevel=CS%ridx_snap,position=center) endif @@ -276,7 +238,7 @@ subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) - CS%ridx_mean = next_modulo_time(CS%ridx_mean,CS%numtime) + CS%ridx_sum = next_modulo_time(CS%ridx_sum,CS%numtime) call callTree_leave("transport_by_file") @@ -291,14 +253,10 @@ subroutine register_diags_offline_transport(Time, diag, CS) ! U-cell fields - CS%id_uhtr_preadv = register_diag_field('ocean_model', 'uhtr_preadv', diag%axesCuL, Time, & - 'Accumulated zonal thickness fluxes to advect tracers', 'kg') CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & 'Zonal thickness fluxes remaining at end of timestep', 'kg') ! V-cell fields - CS%id_vhtr_preadv = register_diag_field('ocean_model', 'vhtr_preadv', diag%axesCvL, Time, & - 'Accumulated meridional thickness fluxes to advect tracers', 'kg') CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & 'Meridional thickness fluxes remaining at end of timestep', 'kg') @@ -312,13 +270,15 @@ subroutine register_diags_offline_transport(Time, diag, CS) end subroutine register_diags_offline_transport - subroutine offline_transport_init(param_file, CS, do_ale, G, GV) + ! Initializes the control structure for offline transport and reads in some of the + ! run time parameters from MOM_input + subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) - type(param_file_type) , intent(in) :: param_file - type(offline_transport_CS), pointer, intent(inout) :: CS - logical , intent(in) :: do_ale - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV + type(param_file_type), intent(in) :: param_file + type(offline_transport_CS), pointer, intent(inout) :: CS + type(diabatic_CS), pointer, intent(in) :: diabatic_CSp + type(ocean_grid_type), intent(in) :: G + type(verticalGrid_type), intent(in) :: GV character(len=40) :: mod = "offline_transport" @@ -343,14 +303,10 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) ! Parse MOM_input for offline control call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & "Input directory where the offline fields can be found", default=" ") - call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where time-averaged fields are fund can be found", default=" ") call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & "Filename where the accumulated fields can be found", default = " ") call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & "Filename where snapshot fields can be found",default=" ") - call get_param(param_file, mod, "OFF_PREALE_FILE", CS%preale_file, & - "Filename where the preale T, S, u, v, and h fields are found",default=" ") call get_param(param_file, mod, "START_INDEX", CS%start_index, & "Which time index to start from", default=1) call get_param(param_file, mod, "NUMTIME", CS%numtime, & @@ -362,33 +318,22 @@ subroutine offline_transport_init(param_file, CS, do_ale, G, GV) "Number of iterations to subdivide the offline tracer advection and diffusion" ) call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & "Length of the offline timestep") - call get_param(param_file, "MOM_mixed_layer", "MAX_OFF_CFL", CS%max_off_cfl, & - "Maximum CFL when advection is done offline. This should be less than 1 \n", & - units="nondim", default=0.9) ! Concatenate offline directory and file names - CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) - CS%preale_file = trim(CS%offlinedir)//trim(CS%preale_file) ! Set the starting read index for time-averaged and snapshotted fields - CS%ridx_mean = CS%start_index + CS%ridx_sum = CS%start_index if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index - if (do_ale) then - ALLOC_(CS%u_preale(IsdB:IedB,jsd:jed,nz)) ; CS%u_preale(:,:,:) = 0.0 - ALLOC_(CS%v_preale(isd:ied,JsdB:JedB,nz)) ; CS%v_preale(:,:,:) = 0.0 - ALLOC_(CS%h_preale(isd:ied,jsd:jed,nz)) ; CS%h_preale(:,:,:) = GV%Angstrom - ALLOC_(CS%T_preale(isd:ied,jsd:jed,nz)) ; CS%T_preale(:,:,:) = 0.0 - ALLOC_(CS%S_preale(isd:ied,jsd:jed,nz)) ; CS%S_preale(:,:,:) = 0.0 - endif - call callTree_leave("offline_transport_init") end subroutine offline_transport_init - + + !> Calculates the next timelevel to read from the input fields. This allows the 'looping' + !! of the fields function next_modulo_time(inidx, numtime) ! Returns the next time interval to be read integer :: numtime ! Number of time levels in input fields @@ -407,6 +352,8 @@ function next_modulo_time(inidx, numtime) end function next_modulo_time + !> This updates thickness based on the convergence of horizontal mass fluxes + !! NOTE: Only used in non-ALE mode subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV @@ -439,6 +386,8 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) enddo end subroutine update_h_horizontal_flux + !> Updates layer thicknesses due to vertical mass transports + !! NOTE: Only used in non-ALE configuration subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV @@ -483,6 +432,8 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) end subroutine update_h_vertical_flux + !> This routine limits the mass fluxes so that the a layer cannot be completely depleted. + !! NOTE: Only used in non-ALE mode subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV From e298f418dc97479214c4df1b1216b9168611f25b Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 7 Oct 2016 14:02:53 -0400 Subject: [PATCH 42/65] Tested with OM4. Ready for merge --- src/core/MOM.F90 | 36 ++++++++++++++++-------------- src/tracer/MOM_offline_control.F90 | 4 ++++ 2 files changed, 23 insertions(+), 17 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a96bbed50e..3062f638dd 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1435,8 +1435,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Meridional diffusive transports real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are - real :: dt_offline ! Shorthand variable + real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are + real :: dt_offline, minimum_forcing_depth, evap_CFL_limit ! Shorthand variables from offline CS ! Local variables ! Vertical diffusion related variables @@ -1468,17 +1468,21 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Grid-related pointer assignments G => CS%G GV => CS%GV - + + ! Initialize some shorthand variables from other structures is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB dt_offline = CS%offline_CSp%dt_offline + evap_CFL_limit = CS%offline_CSp%evap_CFL_limit + minimum_forcing_depth = CS%offline_CSp%minimum_forcing_depth niter = CS%offline_CSp%num_off_iter Inum_iter = 1./real(niter) dt_iter = dt_offline*Inum_iter + ! Initialize working arrays uhtr(:,:,:) = 0.0 vhtr(:,:,:) = 0.0 khdt_x(:,:) = 0.0 @@ -1496,19 +1500,18 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ebtr_sub(:,:,:) = 0.0 call cpu_clock_begin(id_clock_tracer) - call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), & - CS%diag) + call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), CS%diag) ! Read in all fields that might be used this timestep call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & khdt_x, khdt_y, temp_old, salt_old, fluxes, CS%use_ALE_algorithm) + ! Set the starting layer thicknesses to those from the previous timestep do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_pre(i,j,k) = CS%h(i,j,k) enddo ; enddo; enddo call pass_var(h_pre,G%Domain) - h_new(:,:,:) = GV%Angstrom x_before_y = (MOD(G%first_direction,2) == 0) z_first = CS%diabatic_first @@ -1519,7 +1522,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! 1) Using the layer thicknesses and tracer concentrations from the previous timestep, ! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to tracer_column_fns. ! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline - ! 2) Next half of the accumulated surface freshwater fluxes are applied + ! 2) Half of the accumulated surface freshwater fluxes are applied !! START ITERATION ! 3) Accumulated mass fluxes are used to do horizontal transport. The number of iterations used in ! advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are stored for later use @@ -1566,10 +1569,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit=0.8, & - minimum_forcing_depth=0.001) + evap_CFL_limit=evap_CFL_limit, & + minimum_forcing_depth=minimum_forcing_depth) + ! Add half of the total freshwater fluxes call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & - 0.8, 0.001) + evap_CFL_limit, minimum_forcing_depth) if(CS%debug) then call hchksum(h_pre,"h_pre after 1st diabatic",G%HI) @@ -1647,10 +1651,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call call_tracer_column_fns(h_pre, h_new, eatr*0.5, ebtr*0.5, & fluxes, CS%offline_CSp%dt_offline*0.5, G, GV, CS%tv, & CS%diabatic_CSp%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit=0.8, & - minimum_forcing_depth=0.001) + evap_CFL_limit=evap_CFL_limit, & + minimum_forcing_depth=minimum_forcing_depth) call applyTracerBoundaryFluxesInOut(G, GV, zero_3dh, 0.5*dt_offline, fluxes, h_pre, & - 0.8, 0.001) + evap_CFL_limit, minimum_forcing_depth) if(CS%debug) then call hchksum(h_pre,"h_pre after 2nd diabatic",G%HI) @@ -1782,12 +1786,10 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) x_before_y = .not. x_before_y end do + call tracer_hordiff(h_end, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) endif - ! Tracer diffusion Strang split between advection and diffusion - call tracer_hordiff(h_end, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) - h_temp = h_end-h_pre if (CS%offline_CSp%id_hr>0) call post_data(CS%offline_CSp%id_hr, h_temp, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index c750bdaad6..0a4c2c2506 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -327,6 +327,10 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) CS%ridx_sum = CS%start_index if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index + + ! Copy over parameters from other control structures + CS%evap_CFL_limit = diabatic_CSp%diabatic_aux_CSp%evap_CFL_limit + CS%minimum_forcing_depth = diabatic_CSp%diabatic_aux_CSp%minimum_forcing_depth call callTree_leave("offline_transport_init") From d9f8b8547474f2fd31a951af6924ce3adedc53aa Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 7 Oct 2016 14:28:12 -0400 Subject: [PATCH 43/65] Added some brief instructions of use to the end of MOM_offline_control.F90 --- src/tracer/MOM_offline_control.F90 | 87 +++++++++++++++++++++++++++++- 1 file changed, 86 insertions(+), 1 deletion(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 0a4c2c2506..6d9e3052f2 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -38,7 +38,11 @@ !* 5 days seems to be a reasonable choice. * !* * !* The actual driver for offline tracer transport is in the * -!* subroutine step_tracers in MOM.F90 * +!* subroutine step_tracers in MOM.F90. * +!* * +!* Brief instructions for how to use this capability are detailed * +!* at the end of this file. Also, see the Baltic_ALE_z test case. * +!* * !* Macros written all in capital letters are defined in MOM_memory.h * !* * !********+*********+*********+*********+*********+*********+*********+** @@ -532,3 +536,84 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d end module MOM_offline_transport + +! Instructions for running passive tracers offline in MOM6 +! Contact: Andrew Shao (andrew.shao@noaa.gov) +! Last modified: 7 October 2016 +! +! ---- +! QUICK-START +! ---- +! 1) Follow instructions to compile MOM6 executables using ice_ocean_SIS2 and ocean_only drivers +! 2) Link executables to Baltic_ALE_z directory (replace 'intel' and 'repro' as necessary) +! ln -s ../../build/intel/ice_ocean_SIS2/repro/MOM6 ./MOM6_coupled +! ln -s ../../build/intel/ice_ocean_SIS2/repro/MOM6 ./MOM6_ocean_only +! 3) Run model forward using the provided script to generate necessary fields +! source run_online.sh +! 4) Run model offline +! source run_offline.sh +! +! ---- +! OVERVIEW +! ---- +! 'Offline tracer modeling' uses physical fields (e.g. mass transports and layer thicknesses) saved +! from a previous integration of the physical model to transport passive tracers. These fields are +! accumulated or averaged over a period of time (in this test case, 1 day) and used to integrate +! portions of the MOM6 code base that handle the 3d advection and diffusion of passive tracers. +! This capability has currently targeted the Baltic_ALE_z test case, though some work has also been +! done with the OM4 1/2 degree configuration. Work is ongoing to develop recommendations and best +! practices for investigators seeking to use MOM6 for offline tracer modeling. +! +! The subroutine step_tracers that coordinates this can be found in MOM.F90 and is only called +! using the solo ocean driver. This is to avoid issues with coupling to other climate components +! that may be relying on fluxes from the ocean to be coupled more often than the offline time step. +! Other routines related to offline tracer modeling can be found in tracers/MOM_offline_control.F90 +! +! As can also be seen in the comments for the step_tracers subroutine, an offline time step +! comprises the following steps +! 1) Using the layer thicknesses and tracer concentrations from the previous timestep, +! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to +! tracer_column_fns. +! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline +! 2) Half of the accumulated surface freshwater fluxes are applied +! START ITERATION +! 3) Accumulated mass fluxes are used to do horizontal transport. The number of iterations +! used in advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are +! stored for later use and resulting layer thicknesses fed into the next step +! 4) Tracers and the h-grid are regridded and remapped in a call to ALE. This allows for +! layers which might 'vanish' because of horizontal mass transport to be 'reinflated' +! and essentially allows for the vertical transport of tracers +! 5) Check that transport is done if the remaining mass fluxes equals 0 or if the max +! number of iterations has been reached +! END ITERATION +! 6) Repeat steps 1 and 2 +! 7) Force a remapping to the stored layer thicknesses that correspond to the snapshot of +! the online model at the end of an accumulation interval +! 8) Reset T/S and h to their stored snapshotted values to prevent model drift +! +! ---- +! EVALUATING +! ---- +! A framework for formally regression testing the offline capability still needs to be developed. +! However, as a simple way of testing whether the offline model is nominally behaving as expected, +! the total inventory of the advection test tracers (tr1, tr2, etc.) should be conserved between +! time steps except for the last 4 decimal places. +! +! ---- +! MOM_input parameters +! ---- +! OFFLINEDIR ! default = "" +! ! Input directory where the offline fields can be found +! OFF_SUM_FILE ! default = "" +! ! Filename where the accumulated fields can be found +! OFF_SNAP_FILE ! default = "" +! ! Filename where snapshot fields can be found +! START_INDEX = ! default = 1 +! ! Which time index to start from +! NUMTIME = ! default = 0 +! ! Number of timelevels in offline input files +! FIELDS_ARE_OFFSET ! [Boolean] default = False +! ! True if the time-averaged fields and snapshot fields are offset by one time level +! NUM_OFF_ITER ! +! ! Number of iterations to subdivide the offline tracer advection and diffusion +! DT_OFFLINE ! Length of the offline timestep \ No newline at end of file From 966814fb52a003967e9ad0ea21dbb0c761b489c2 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 7 Oct 2016 14:30:30 -0400 Subject: [PATCH 44/65] Removed one unnecessary temporary file --- src/tracer/#salt_like_tracer.F90# | 506 ------------------------------ 1 file changed, 506 deletions(-) delete mode 100644 src/tracer/#salt_like_tracer.F90# diff --git a/src/tracer/#salt_like_tracer.F90# b/src/tracer/#salt_like_tracer.F90# deleted file mode 100644 index 00e150b42d..0000000000 --- a/src/tracer/#salt_like_tracer.F90# +++ /dev/null @@ -1,506 +0,0 @@ -module pseudo_salt_tracer -!*********************************************************************** -/sa::!* GNU General Public License * -!* This file is a part of MOM. * -!* * -!* MOM is free software; you can redistribute it and/or modify it and * -!* are expected to follow the terms of the GNU General Public License * -!* as published by the Free Software Foundation; either version 2 of * -!* the License, or (at your option) any later version. * -!* * -!* MOM is distributed in the hope that it will be useful, but WITHOUT * -!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * -!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * -!* License for more details. * -!* * -!* For the full text of the GNU General Public License, * -!* write to: Free Software Foundation, Inc., * -!* 675 Mass Ave, Cambridge, MA 02139, USA. * -!* or see: http://www.gnu.org/licenses/gpl.html * -!*********************************************************************** - -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Andrew Shao, 2016 * -!* * -!* This file contains the routines necessary to model a passive * -!* tracer that uses the same boundary fluxes as salinity. At the * -!* beginning of the run, salt is set to the same as tv%S. Any * -!* deviations between this salt-like tracer and tv%S signifies a * -!* difference between how active and passive tracers are treated. * -!* A single subroutine is called from within each file to register * -!* each of the tracers for reinitialization and advection and to * -!* register the subroutine that initializes the tracers and set up * -!* their output and the subroutine that does any tracer physics or * -!* chemistry along with diapycnal mixing (included here because some * -!* tracers may float or swim vertically or dye diapycnal processes). * -!* * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, tr * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - -use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr -use MOM_diag_mediator, only : diag_ctrl -use MOM_diag_to_Z, only : register_Z_tracer, diag_to_Z_CS -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, get_time -use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values -use MOM_tracer_vertical, only : tracer_vertdiff -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use coupler_util, only : set_coupler_values, ind_csurf -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux - -implicit none ; private - -#include - -public register_pseudo_salt_tracer, initialize_pseudo_salt_tracer -public pseudo_salt_tracer_column_physics, pseudo_salt_tracer_surface_state -public pseudo_salt_stock, pseudo_salt_tracer_end - -! NTR_MAX is the maximum number of tracers in this module. -integer, parameter :: NTR_MAX = 1 - -type p3d - real, dimension(:,:,:), pointer :: p => NULL() -end type p3d - -type, public :: pseudo_salt_tracer_CS ; private - integer :: ntr ! The number of tracers that are actually used. - logical :: coupled_tracers = .false. ! These tracers are not offered to the - ! coupler. - type(time_type), pointer :: Time ! A pointer to the ocean model's clock. - type(tracer_registry_type), pointer :: tr_Reg => NULL() - real, pointer :: tr(:,:,:,:) => NULL() ! The array of tracers used in this - ! subroutine, in g m-3? - type(p3d), dimension(NTR_MAX) :: & - tr_adx, &! Tracer zonal advective fluxes in g m-3 m3 s-1.An Error Has Occurred - - - tr_ady, &! Tracer meridional advective fluxes in g m-3 m3 s-1. - tr_dfx, &! Tracer zonal diffusive fluxes in g m-3 m3 s-1. - tr_dfy ! Tracer meridional diffusive fluxes in g m-3 m3 s-1. - logical :: mask_tracers ! If true, pseudo_salt is masked out in massless layers. - logical :: pseudo_salt_may_reinit = .true. ! Hard coding since this should not matter - integer, dimension(NTR_MAX) :: & - ind_tr, & ! Indices returned by aof_set_coupler_flux if it is used and the - ! surface tracer concentrations are to be provided to the coupler. - id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1, & - id_tr_dfx = -1, id_tr_dfy = -1 - real, dimension(NTR_MAX) :: land_val = -1.0 - - type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. - type(MOM_restart_CS), pointer :: restart_CSp => NULL() - - type(vardesc) :: tr_desc(NTR_MAX) -end type pseudo_salt_tracer_CS - -contains - -function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV - type(param_file_type), intent(in) :: param_file - type(pseudo_salt_tracer_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS -! This subroutine is used to register tracer fields and subroutines -! to be used with MOM. -! Arguments: HI - A horizontal index type structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! (in/out) tr_Reg - A pointer that is set to point to the control structure -! for the tracer advection and diffusion module. -! (in) restart_CS - A pointer to the restart control structure. - -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mod = "pseudo_salt_tracer" ! This module's name. - character(len=200) :: inputdir ! The directory where the input files are. - character(len=48) :: var_name ! The variable's name. - character(len=3) :: name_tag ! String for creating identifying pseudo_salt - real, pointer :: tr_ptr(:,:,:) => NULL() - logical :: register_pseudo_salt_tracer - integer :: isd, ied, jsd, jed, nz, m, i, j - isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke - - if (associated(CS)) then - call MOM_error(WARNING, "register_pseudo_salt_tracer called with an "// & - "associated control structure.") - return - endif - allocate(CS) - - ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - - CS%ntr = NTR_MAX - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 - - do m=1,CS%ntr - ! This is needed to force the compiler not to do a copy in the registration - ! calls. Curses on the designers and implementers of Fortran90. - CS%tr_desc(m) = var_desc("pseudo_salt", "kg", "Pseudo salt passive tracer", caller=mod) - tr_ptr => CS%tr(:,:,:,m) - call query_vardesc(CS%tr_desc(m), name=var_name, caller="register_pseudo_salt_tracer") - ! Register the tracer for the restart file. - call register_restart_field(tr_ptr, CS%tr_desc(m), & - .not. CS%pseudo_salt_may_reinit, restart_CS) - ! Register the tracer for horizontal advection & diffusion. - call register_tracer(tr_ptr, CS%tr_desc(m), param_file, HI, GV, tr_Reg, & - tr_desc_ptr=CS%tr_desc(m)) - - ! Set coupled_tracers to be true (hard-coded above) to provide the surface - ! values to the coupler (if any). This is meta-code and its arguments will - ! currently (deliberately) give fatal errors if it is used. - if (CS%coupled_tracers) & - CS%ind_tr(m) = aof_set_coupler_flux(trim(var_name)//'_flux', & - flux_type=' ', implementation=' ', caller="register_pseudo_salt_tracer") - enddo - - CS%tr_Reg => tr_Reg - CS%restart_CSp => restart_CS - register_pseudo_salt_tracer = .true. - -end function register_pseudo_salt_tracer - -subroutine initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS, & - sponge_CSp, diag_to_Z_CSp, tv) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(pseudo_salt_tracer_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in) :: tv -! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) -! and it sets up the tracer output. - -! Arguments: restart - .true. if the fields have already been read from -! a restart file. -! (in) day - Time of the start of the run. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) h - Layer thickness, in m or kg m-2. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in/out) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if -! they are in use. Otherwise this may be unassociated. -! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics -! in depth space. - character(len=16) :: name ! A variable's name in a NetCDF file. - character(len=72) :: longname ! The long name of that variable. - character(len=48) :: units ! The dimensions of the variable. - character(len=48) :: flux_units ! The units for age tracer fluxes, either - ! years m3 s-1 or years kg s-1. - logical :: OK - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m - integer :: IsdB, IedB, JsdB, JedB - - if (.not.associated(CS)) return - if (CS%ntr < 1) return - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - - CS%Time => day - CS%diag => diag - name = "pseudo_salt" - - do m=1,CS%ntr - call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_pseudo_salt_tracer") - if ((.not.restart) .or. (.not. & - query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%tr(i,j,k,m) = tv%S(i,j,k) - enddo ; enddo ; enddo - endif - enddo ! Tracer loop - - if (associated(OBC)) then - ! All tracers but the first have 0 concentration in their inflows. As this - ! is the default value, the following calls are unnecessary. - ! do m=1,CS%ntr - ! call add_tracer_OBC_values(trim(CS%tr_desc(m)%name), CS%tr_Reg, 0.0) - ! enddo - endif - - ! This needs to be changed if the units of tracer are changed above. - if (GV%Boussinesq) then ; flux_units = "kg salt/(m^2 s)" - else ; flux_units = "kg salt/(m^2 s)" ; endif - - do m=1,CS%ntr - ! Register the tracer for the restart file. - call query_vardesc(CS%tr_desc(m), name, units=units, longname=longname, & - caller="initialize_pseudo_salt_tracer") - CS%id_tracer(m) = register_diag_field("ocean_model", trim(name), CS%diag%axesTL, & - day, trim(longname) , trim(units)) - CS%id_tr_adx(m) = register_diag_field("ocean_model", trim(name)//"_adx", & - CS%diag%axesCuL, day, trim(longname)//" advective zonal flux" , & - trim(flux_units)) - CS%id_tr_ady(m) = register_diag_field("ocean_model", trim(name)//"_ady", & - CS%diag%axesCvL, day, trim(longname)//" advective meridional flux" , & - trim(flux_units)) - CS%id_tr_dfx(m) = register_diag_field("ocean_model", trim(name)//"_dfx", & - CS%diag%axesCuL, day, trim(longname)//" diffusive zonal flux" , & - trim(flux_units)) - CS%id_tr_dfy(m) = register_diag_field("ocean_model", trim(name)//"_dfy", & - CS%diag%axesCvL, day, trim(longname)//" diffusive zonal flux" , & - trim(flux_units)) - if (CS%id_tr_adx(m) > 0) call safe_alloc_ptr(CS%tr_adx(m)%p,IsdB,IedB,jsd,jed,nz) - if (CS%id_tr_ady(m) > 0) call safe_alloc_ptr(CS%tr_ady(m)%p,isd,ied,JsdB,JedB,nz) - if (CS%id_tr_dfx(m) > 0) call safe_alloc_ptr(CS%tr_dfx(m)%p,IsdB,IedB,jsd,jed,nz) - if (CS%id_tr_dfy(m) > 0) call safe_alloc_ptr(CS%tr_dfy(m)%p,isd,ied,JsdB,JedB,nz) - -! Register the tracer for horizontal advection & diffusion. - if ((CS%id_tr_adx(m) > 0) .or. (CS%id_tr_ady(m) > 0) .or. & - (CS%id_tr_dfx(m) > 0) .or. (CS%id_tr_dfy(m) > 0)) & - call add_tracer_diagnostics(name, CS%tr_Reg, CS%tr_adx(m)%p, & - CS%tr_ady(m)%p,CS%tr_dfx(m)%p,CS%tr_dfy(m)%p) - - call register_Z_tracer(CS%tr(:,:,:,m), trim(name), longname, units, & - day, G, diag_to_Z_CSp) - enddo - -end subroutine initialize_pseudo_salt_tracer - -subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, & - aggregate_FW_forcing, evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt - type(pseudo_salt_tracer_CS), pointer :: CS - type(thermo_var_ptrs), intent(in) :: tv - logical, optional,intent(in) :: aggregate_FW_forcing - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth -! This subroutine applies diapycnal diffusion and any other column -! tracer physics or chemistry to the tracers from this file. -! This is a simple example of a set of advected passive tracers. - -! Arguments: h_old - Layer thickness before entrainment, in m or kg m-2. -! (in) h_new - Layer thickness after entrainment, in m or kg m-2. -! (in) ea - an array to which the amount of fluid entrained -! from the layer above during this call will be -! added, in m or kg m-2. -! (in) eb - an array to which the amount of fluid entrained -! from the layer below during this call will be -! added, in m or kg m-2. -! (in) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. -! (in) dt - The amount of time covered by this call, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! -! The arguments to this subroutine are redundant in that -! h_new[k] = h_old[k] + ea[k] - eb[k-1] + eb[k] - ea[k+1] - - real :: Isecs_per_year = 1.0 / (365.0*86400.0) - real :: year, h_total, scale, htot, Ih_limit - integer :: secs, days - integer :: i, j, k, is, ie, js, je, nz, m, k_max - real, allocatable :: local_tr(:,:,:) - real, dimension(SZI_(G),SZJ_(G)) :: salt_sfc_src - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - - if (.not.associated(CS)) return - if (CS%ntr < 1) return - - ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode - if (present(aggregate_FW_forcing) .and. present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then - do j=js,je ; do i=is,ie - - ! The net flux of salt at the surface is determined in a similar way as - ! in extractFluxes1d found in MOM_forcing_type - htot= h_old(i,j,1) - do k=2,nz ; htot = htot + h_old(i,j,k) ; enddo - scale = 1.0 - Ih_limit = 1./max(GV%Angstrom, 1.E-30*GV%m_to_H) - if (htot*Ih_limit < 1.0) scale = htot*Ih_limit - salt_sfc_src(i,j) = (scale*1000.0 * fluxes%salt_flux(i,j)) - salt_sfc_src(i,j) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * -GV%kg_m2_H - enddo ; enddo; - do m=1,CS%ntr - call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV, & - aggregate_FW_forcing=aggregate_FW_forcing, evap_CFL_limit=evap_CFL_limit,& - minimum_forcing_depth=minimum_forcing_depth, fluxes=fluxes) - enddo - else - do m=1,CS%ntr - call tracer_vertdiff(h_old, ea, eb, dt, CS%tr(:,:,:,m), G, GV) - enddo - endif - - allocate(local_tr(G%isd:G%ied,G%jsd:G%jed,nz)) - do m=1,CS%ntr - if (CS%id_tracer(m)>0) then - if (CS%mask_tracers) then - do k=1,nz ; do j=js,je ; do i=is,ie - if (h_new(i,j,k) < 1.1*GV%Angstrom) then - local_tr(i,j,k) = CS%land_val(m) - else - local_tr(i,j,k) = CS%tr(i,j,k,m) - endif - enddo ; enddo ; enddo - else - do k=1,nz ; do j=js,je ; do i=is,ie - local_tr(i,j,k) = CS%tr(i,j,k,m) - enddo ; enddo ; enddo - endif ! CS%mask_tracers - call post_data(CS%id_tracer(m),local_tr,CS%diag) - endif ! CS%id_tracer(m)>0 - if (CS%id_tr_adx(m)>0) & - call post_data(CS%id_tr_adx(m),CS%tr_adx(m)%p(:,:,:),CS%diag) - if (CS%id_tr_ady(m)>0) & - call post_data(CS%id_tr_ady(m),CS%tr_ady(m)%p(:,:,:),CS%diag) - if (CS%id_tr_dfx(m)>0) & - call post_data(CS%id_tr_dfx(m),CS%tr_dfx(m)%p(:,:,:),CS%diag) - if (CS%id_tr_dfy(m)>0) & - call post_data(CS%id_tr_dfy(m),CS%tr_dfy(m)%p(:,:,:),CS%diag) - enddo - deallocate(local_tr) - -end subroutine pseudo_salt_tracer_column_physics - -function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) - type(ocean_grid_type), intent(in) :: G - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h - real, dimension(:), intent(out) :: stocks - type(pseudo_salt_tracer_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index - integer :: pseudo_salt_stock -! This function calculates the mass-weighted integral of all tracer stocks, -! returning the number of stocks it has calculated. If the stock_index -! is present, only the stock corresponding to that coded index is returned. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (out) stocks - the mass-weighted integrated amount of each tracer, -! in kg times concentration units. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. -! (out) names - the names of the stocks calculated. -! (out) units - the units of the stocks calculated. -! (in,opt) stock_index - the coded index of a specific stock being sought. -! Return value: the number of stocks calculated here. - - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - - pseudo_salt_stock = 0 - if (.not.associated(CS)) return - if (CS%ntr < 1) return - - if (present(stock_index)) then ; if (stock_index > 0) then - ! Check whether this stock is available from this routine. - - ! No stocks from this routine are being checked yet. Return 0. - return - endif ; endif - - do m=1,CS%ntr - call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="pseudo_salt_stock") - units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * & - (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = GV%H_to_kg_m2 * stocks(m) - enddo - pseudo_salt_stock = CS%ntr - -end function pseudo_salt_stock - -subroutine pseudo_salt_tracer_surface_state(state, h, G, CS) - type(ocean_grid_type), intent(in) :: G - type(surface), intent(inout) :: state - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h - type(pseudo_salt_tracer_CS), pointer :: CS -! This particular tracer package does not report anything back to the coupler. -! The code that is here is just a rough guide for packages that would. -! Arguments: state - A structure containing fields that describe the -! surface state of the ocean. -! (in) h - Layer thickness, in m or kg m-2. -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! register_pseudo_salt_tracer. - integer :: m, is, ie, js, je - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - - if (.not.associated(CS)) return - - if (CS%coupled_tracers) then - do m=1,CS%ntr - ! This call loads the surface vlues into the appropriate array in the - ! coupler-type structure. - call set_coupler_values(CS%tr(:,:,1,m), state%tr_fields, CS%ind_tr(m), & - ind_csurf, is, ie, js, je) - enddo - endif - -end subroutine pseudo_salt_tracer_surface_state - -subroutine pseudo_salt_tracer_end(CS) - type(pseudo_salt_tracer_CS), pointer :: CS - integer :: m - - if (associated(CS)) then - if (associated(CS%tr)) deallocate(CS%tr) - do m=1,CS%ntr - if (associated(CS%tr_adx(m)%p)) deallocate(CS%tr_adx(m)%p) - if (associated(CS%tr_ady(m)%p)) deallocate(CS%tr_ady(m)%p) - if (associated(CS%tr_dfx(m)%p)) deallocate(CS%tr_dfx(m)%p) - if (associated(CS%tr_dfy(m)%p)) deallocate(CS%tr_dfy(m)%p) - enddo - - deallocate(CS) - endif -end subroutine pseudo_salt_tracer_end - -end module pseudo_salt_tracer From e175527c99a2c8eab426da39fa495470b52c11ff Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 10 Oct 2016 12:27:54 -0400 Subject: [PATCH 45/65] Doxygenized comments in MOM_offline_control.F90 and responded to requests by @adcroft --- src/tracer/MOM_offline_control.F90 | 213 +++++++++++------------------ 1 file changed, 79 insertions(+), 134 deletions(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 6d9e3052f2..d0068f37e7 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -1,54 +1,6 @@ -!*********************************************************************** -!* GNU General Public License * -!* This file is a part of MOM. * -!* * -!* MOM is free software; you can redistribute it and/or modify it and * -!* are expected to follow the terms of the GNU General Public License * -!* as published by the Free Software Foundation; either version 2 of * -!* the License, or (at your option) any later version. * -!* * -!* MOM is distributed in the hope that it will be useful, but WITHOUT * -!* ANY WARRANTY; without even the impliec warranty of MERCHANTABILITY * -!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * -!* License for more details. * -!* * -!* For the full text of the GNU General Public License, * -!* write to: Free Software Foundation, Inc., * -!* 675 Mass Ave, Cambridge, MA 02139, USA. * -!* or see: http://www.gnu.org/licenses/gpl.html * -!*********************************************************************** - -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Andrew Shao 2016 * -!* * -!* The subroutines here allow MOM6 to be run in a so-called 'offline' * -!* mode ostensibly for the purpose of modeling tracers. Instead of * -!* calculating mass transports prognostically, these fields are read * -!* at regular intervals which have been saved from a previous * -!* integration of MOM6. * -!* * -!* Users should note that by accumulating fluxes over a range dt, * -!* homogeneity over that time period is implictly assumed. For * -!* example, this means that for fluxes accumulated over a day, the * -!* diurnal cycling of the surface boundary layer is not resolved, but * -!* total transport should be conserved. It is the user's * -!* responsibility to determine what the appropriate offline time * -!* scale should be. As a general guidance for global configurations * -!* 5 days seems to be a reasonable choice. * -!* * -!* The actual driver for offline tracer transport is in the * -!* subroutine step_tracers in MOM.F90. * -!* * -!* Brief instructions for how to use this capability are detailed * -!* at the end of this file. Also, see the Baltic_ALE_z test case. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h * -!* * -!********+*********+*********+*********+*********+*********+*********+** - +!> Contains routines related to offline transport of tracers module MOM_offline_transport - +! This file is part of MOM6. See LICENSE.md for the license. use data_override_mod, only : data_override_init, data_override use MOM_time_manager, only : time_type @@ -116,11 +68,11 @@ module MOM_offline_transport public limit_mass_flux_3d contains - - subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & - temp, salt, fluxes, do_ale_in) !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored !! in a previous integration of the online model + subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, khdt_x, khdt_y, & + temp, salt, fluxes, do_ale_in) + type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(inout) :: GV type(offline_transport_CS), intent(inout) :: CS @@ -534,86 +486,79 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) enddo ; enddo ; enddo end subroutine limit_mass_flux_3d - + +!> \namespace mom_offline_transport +!! \section offline_overview Offline Tracer Transport in MOM6 +!! 'Offline tracer modeling' uses physical fields (e.g. mass transports and layer thicknesses) saved +!! from a previous integration of the physical model to transport passive tracers. These fields are +!! accumulated or averaged over a period of time (in this test case, 1 day) and used to integrate +!! portions of the MOM6 code base that handle the 3d advection and diffusion of passive tracers. +!! +!! The distribution of tracers in the ocean modeled offline should not be expected to match an online +!! simulation. Accumulating transports over more than one online model timestep implicitly assumes +!! homogeneity over that time period and essentially aliases over processes that occur with higher +!! frequency. For example, consider the case of a surface boundary layer with a strong diurnal cycle. +!! An offline simulation with a 1 day timestep, captures the net transport into or out of that layer, +!! but not the exact cycling. This effective aliasing may also complicate online model configurations +!! which strongly-eddying regions. In this case, the offline model timestep must be limited to some +!! fraction of the eddy correlation timescale. Lastly, the nonlinear advection scheme which applies +!! limited mass-transports over a sequence of iterations means that tracers are not transported along +!! exactly the same path as they are in the online model. +!! +!! This capability has currently targeted the Baltic_ALE_z test case, though some work has also been +!! done with the OM4 1/2 degree configuration. Work is ongoing to develop recommendations and best +!! practices for investigators seeking to use MOM6 for offline tracer modeling. +!! +!! \section offline_technical Implementation of offline routine in MOM6 +!! +!! The subroutine step_tracers that coordinates this can be found in MOM.F90 and is only called +!! using the solo ocean driver. This is to avoid issues with coupling to other climate components +!! that may be relying on fluxes from the ocean to be coupled more often than the offline time step. +!! Other routines related to offline tracer modeling can be found in tracers/MOM_offline_control.F90 +!! +!! As can also be seen in the comments for the step_tracers subroutine, an offline time step +!! comprises the following steps: +!! -# Using the layer thicknesses and tracer concentrations from the previous timestep, +!! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to +!! tracer_column_fns. +!! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline +!! -# Half of the accumulated surface freshwater fluxes are applied +!! START ITERATION +!! -# Accumulated mass fluxes are used to do horizontal transport. The number of iterations +!! used in advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are +!! stored for later use and resulting layer thicknesses fed into the next step +!! -# Tracers and the h-grid are regridded and remapped in a call to ALE. This allows for +!! layers which might 'vanish' because of horizontal mass transport to be 'reinflated' +!! and essentially allows for the vertical transport of tracers +!! -# Check that transport is done if the remaining mass fluxes equals 0 or if the max +!! number of iterations has been reached +!! END ITERATION +!! -# Repeat steps 1 and 2 +!! -# Force a remapping to the stored layer thicknesses that correspond to the snapshot of +!! the online model at the end of an accumulation interval +!! -3 Reset T/S and h to their stored snapshotted values to prevent model drift +!! +!! \section offline_evaluation Evaluating the utility of an offline tracer model +!! How well an offline tracer model can be used as an alternative to integrating tracers online +!! with the prognostic model must be evaluated for each application. This efficacy may be related +!! to the native coordinate of the online model, to the length of the offline timestep, and to the +!! behavior of the tracer itself. +!! +!! A framework for formally regression testing the offline capability still needs to be developed. +!! However, as a simple way of testing whether the offline model is nominally behaving as expected, +!! the total inventory of the advection test tracers (tr1, tr2, etc.) should be conserved between +!! time steps except for the last 4 decimal places. As a general guideline, an offline timestep of +!! 5 days or less. +!! +!! \section offline_parameters Runtime parameters for offline tracers +!! - OFFLINEDIR: Input directory where the offline fields can be found +!! - OFF_SUM_FILE: Filename where the accumulated fields can be found (e.g. horizontal mass transports) +!! - OFF_SNAP_FILE: Filename where snapshot fields can be found (e.g. end of timestep layer thickness) +!! - START_INDEX: Which timelevel of the input files to read first +!! - NUMTIME: How many timelevels to read before 'looping' back to 1 +!! - FIELDS_ARE_OFFSET: True if the time-averaged fields and snapshot fields are offset by one +!! time level, probably not needed +!! -NUM_OFF_ITER: Maximum number of iterations to do for the nonlinear advection scheme + end module MOM_offline_transport -! Instructions for running passive tracers offline in MOM6 -! Contact: Andrew Shao (andrew.shao@noaa.gov) -! Last modified: 7 October 2016 -! -! ---- -! QUICK-START -! ---- -! 1) Follow instructions to compile MOM6 executables using ice_ocean_SIS2 and ocean_only drivers -! 2) Link executables to Baltic_ALE_z directory (replace 'intel' and 'repro' as necessary) -! ln -s ../../build/intel/ice_ocean_SIS2/repro/MOM6 ./MOM6_coupled -! ln -s ../../build/intel/ice_ocean_SIS2/repro/MOM6 ./MOM6_ocean_only -! 3) Run model forward using the provided script to generate necessary fields -! source run_online.sh -! 4) Run model offline -! source run_offline.sh -! -! ---- -! OVERVIEW -! ---- -! 'Offline tracer modeling' uses physical fields (e.g. mass transports and layer thicknesses) saved -! from a previous integration of the physical model to transport passive tracers. These fields are -! accumulated or averaged over a period of time (in this test case, 1 day) and used to integrate -! portions of the MOM6 code base that handle the 3d advection and diffusion of passive tracers. -! This capability has currently targeted the Baltic_ALE_z test case, though some work has also been -! done with the OM4 1/2 degree configuration. Work is ongoing to develop recommendations and best -! practices for investigators seeking to use MOM6 for offline tracer modeling. -! -! The subroutine step_tracers that coordinates this can be found in MOM.F90 and is only called -! using the solo ocean driver. This is to avoid issues with coupling to other climate components -! that may be relying on fluxes from the ocean to be coupled more often than the offline time step. -! Other routines related to offline tracer modeling can be found in tracers/MOM_offline_control.F90 -! -! As can also be seen in the comments for the step_tracers subroutine, an offline time step -! comprises the following steps -! 1) Using the layer thicknesses and tracer concentrations from the previous timestep, -! half of the accumulated vertical mixing (eatr and ebtr) is applied in the call to -! tracer_column_fns. -! For tracers whose source/sink terms need dt, this value is set to 1/2 dt_offline -! 2) Half of the accumulated surface freshwater fluxes are applied -! START ITERATION -! 3) Accumulated mass fluxes are used to do horizontal transport. The number of iterations -! used in advect_tracer is limited to 2 (e.g x->y->x->y). The remaining mass fluxes are -! stored for later use and resulting layer thicknesses fed into the next step -! 4) Tracers and the h-grid are regridded and remapped in a call to ALE. This allows for -! layers which might 'vanish' because of horizontal mass transport to be 'reinflated' -! and essentially allows for the vertical transport of tracers -! 5) Check that transport is done if the remaining mass fluxes equals 0 or if the max -! number of iterations has been reached -! END ITERATION -! 6) Repeat steps 1 and 2 -! 7) Force a remapping to the stored layer thicknesses that correspond to the snapshot of -! the online model at the end of an accumulation interval -! 8) Reset T/S and h to their stored snapshotted values to prevent model drift -! -! ---- -! EVALUATING -! ---- -! A framework for formally regression testing the offline capability still needs to be developed. -! However, as a simple way of testing whether the offline model is nominally behaving as expected, -! the total inventory of the advection test tracers (tr1, tr2, etc.) should be conserved between -! time steps except for the last 4 decimal places. -! -! ---- -! MOM_input parameters -! ---- -! OFFLINEDIR ! default = "" -! ! Input directory where the offline fields can be found -! OFF_SUM_FILE ! default = "" -! ! Filename where the accumulated fields can be found -! OFF_SNAP_FILE ! default = "" -! ! Filename where snapshot fields can be found -! START_INDEX = ! default = 1 -! ! Which time index to start from -! NUMTIME = ! default = 0 -! ! Number of timelevels in offline input files -! FIELDS_ARE_OFFSET ! [Boolean] default = False -! ! True if the time-averaged fields and snapshot fields are offset by one time level -! NUM_OFF_ITER ! -! ! Number of iterations to subdivide the offline tracer advection and diffusion -! DT_OFFLINE ! Length of the offline timestep \ No newline at end of file From 039baf56ceddd018ad35e9dfdba585a4bf0f5e71 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 10 Oct 2016 12:29:35 -0400 Subject: [PATCH 46/65] Revert changes to .DoxygenLayout.xml --- .DoxygenLayout.xml | 331 +++++++++++++++++++++++---------------------- 1 file changed, 166 insertions(+), 165 deletions(-) diff --git a/.DoxygenLayout.xml b/.DoxygenLayout.xml index 80047a4105..d51eb5f6f0 100644 --- a/.DoxygenLayout.xml +++ b/.DoxygenLayout.xml @@ -21,173 +21,174 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From e84577afe42ac503f46a2fe77bffff9f8d094b19 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 10 Oct 2016 15:14:53 -0400 Subject: [PATCH 47/65] Removed unused declaration of do_online from step_MOM in core/MOM.F90. --- src/core/MOM.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0298e53925..fdab1f939a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -200,8 +200,6 @@ module MOM !! set by calling the function useRegridding() from the !! MOM_regridding module. logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an - logical :: do_online !< If false, does not call step_MOM_dyn_*. This is an - !! undocumented run-time flag that is fragile. !! undocumented run-time flag that is fragile. real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) From 4513996b629f3113c2d87ed9a319bd7ec3b2a83f Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 10 Oct 2016 15:37:10 -0400 Subject: [PATCH 48/65] Removed references to MOM_CSp%do_online from step_tracers routine. The previous commit removed it from the control structure as it should not have been used. Compiles and runs with Baltic_ALE_z test case --- src/core/MOM.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fdab1f939a..ce10b0d99c 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1540,7 +1540,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Do horizontal diffusion first (but only half of it), remainder will be applied after advection call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & + read_khdt_y=khdt_y*0.5) do j=jsd,jed ; do i=isd,ied fluxes%netMassOut(i,j) = 0.5*fluxes%netMassOut(i,j) @@ -1667,7 +1668,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Finish with the other half of the tracer horizontal diffusion call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & + read_khdt_y=khdt_y*0.5) elseif (.not. CS%use_ALE_algorithm) then do iter=1,CS%offline_CSp%num_off_iter @@ -1786,7 +1788,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) end do call tracer_hordiff(h_end, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, CS%do_online, khdt_x*0.5, khdt_y*0.5) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & + read_khdt_y=khdt_y*0.5) endif h_temp = h_end-h_pre From 3010d0f6456b2649c7a8c2df6da12a847fca2dfe Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Tue, 11 Oct 2016 14:47:24 -0400 Subject: [PATCH 49/65] Added in checks to ensure that contained within non-associated control structures are not copied from during offline_transport_init. This should allow ocean_only cases to run again (double_gyre works). Need to figure out a solution so that offline_transport_init is not called unless MOM6 is being run in offline mode. --- config_src/solo_driver/MOM_driver.F90 | 45 ++++++++++--------- src/core/MOM.F90 | 37 +++++++++------ .../vertical/MOM_diabatic_driver.F90 | 2 - src/tracer/MOM_offline_control.F90 | 12 ++--- src/tracer/MOM_tracer_hor_diff.F90 | 7 +-- 5 files changed, 55 insertions(+), 48 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index ed6f4826bd..657e5a52d4 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -174,7 +174,7 @@ program MOM_main logical :: do_online ! If true, use the model in prognostic mode where ! the barotropic and baroclinic dynamics, thermodynamics, ! etc. are stepped forward integrated in time. - ! If false, the all of the above are bypassed with all + ! If false, then all of the above are bypassed with all ! fields necessary to integrate only the tracer advection ! and diffusion equation are read in from files stored from ! a previous integration of the prognostic model @@ -260,17 +260,18 @@ program MOM_main else Start_time = set_time(0,days=0) endif - + if (sum(date) >= 0) then ! In this case, the segment starts at a time fixed by ocean_solo.res segment_start_time = set_date(date(1),date(2),date(3),date(4),date(5),date(6)) Time = segment_start_time - call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time) + ! Note the not before CS%d + call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time, do_online = do_online) else ! In this case, the segment starts at a time read from the MOM restart file ! or left as Start_time by MOM_initialize. Time = Start_time - call initialize_MOM(Time, param_file, dirs, MOM_CSp) + call initialize_MOM(Time, param_file, dirs, MOM_CSp, do_online=do_online) endif fluxes%C_p = MOM_CSp%tv%C_p ! Copy the heat capacity for consistency. @@ -309,15 +310,14 @@ program MOM_main "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=dt) - call get_param(param_file, mod, "DO_ONLINE", do_online, & - "If true, use the model in prognostic mode where\n"//& - "the barotropic and baroclinic dynamics, thermodynamics,\n"//& - "etc. are stepped forward integrated in time.\n"//& - "If false, the all of the above are bypassed with all\n"//& - "fields necessary to integrate only the tracer advection\n"//& - "and diffusion equation are read in from files stored from\n"//& - "a previous integration of the prognostic model", default=.true.) + "If false, use the model in prognostic mode where\n"//& + "the barotropic and baroclinic dynamics, thermodynamics,\n"//& + "etc. are stepped forward integrated in time.\n"//& + "If true, the all of the above are bypassed with all\n"//& + "fields necessary to integrate only the tracer advection\n"//& + "and diffusion equation are read in from files stored from\n"//& + "a previous integration of the prognostic model", default=.true.) if (.not. do_online) then call get_param(param_file, mod, "DT_OFFLINE", time_step, & "Time step for the offline time step") @@ -478,16 +478,17 @@ program MOM_main call disable_averaging(MOM_CSp%diag) if (do_online) then - if (fluxes%fluxes_used) then - call enable_averaging(fluxes%dt_buoy_accum, Time, MOM_CSp%diag) - call forcing_diagnostics(fluxes, state, fluxes%dt_buoy_accum, grid, & - MOM_CSp%diag, surface_forcing_CSp%handles) - call accumulate_net_input(fluxes, state, fluxes%dt_buoy_accum, grid, sum_output_CSp) - call disable_averaging(MOM_CSp%diag) - else - call MOM_error(FATAL, "The solo MOM_driver is not yet set up to handle "//& - "thermodynamic time steps that are longer than the coupling timestep.") - endif ; endif + if (fluxes%fluxes_used) then + call enable_averaging(fluxes%dt_buoy_accum, Time, MOM_CSp%diag) + call forcing_diagnostics(fluxes, state, fluxes%dt_buoy_accum, grid, & + MOM_CSp%diag, surface_forcing_CSp%handles) + call accumulate_net_input(fluxes, state, fluxes%dt_buoy_accum, grid, sum_output_CSp) + call disable_averaging(MOM_CSp%diag) + else + call MOM_error(FATAL, "The solo MOM_driver is not yet set up to handle "//& + "thermodynamic time steps that are longer than the coupling timestep.") + endif + endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ce10b0d99c..51b16b0dbc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -200,7 +200,9 @@ module MOM !! set by calling the function useRegridding() from the !! MOM_regridding module. logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an - + !! undocumented run-time flag that is fragile. + logical :: do_online !< If false, step_tracers is called instead of step_MOM. + !! This is intended for running MOM6 in offline tracer mode real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time @@ -211,7 +213,7 @@ module MOM type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics type(time_type), pointer :: Time !< pointer to ocean clock - real :: rel_time = 0.0 !< relative time (sec) since start of current execution + real :: rel_time = 0.0 !< relative time (sec) sinc.e start of current execution real :: dtbt_reset_period !< The time interval in seconds between dynamic !! recalculation of the barotropic time step. If !! this is negative, it is never calculated, and @@ -463,10 +465,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) eta_av, & ! average sea surface height or column mass over a timestep (meter or kg/m2) ssh ! sea surface height based on eta_av (meter or kg/m2) - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: write_all_3du - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: write_all_3dv - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: write_all_3dt - real, allocatable, dimension(:,:) :: & tmp, & ! temporary 2d field zos, & ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh (meter) @@ -710,7 +708,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) - write_all_3dt(:,:,:) = 1. if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) @@ -1059,7 +1056,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! Regridding/remapping is done here, at the end of the thermodynamics time step ! (that may comprise several dynamical time steps) ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. - write_all_3dt(:,:,:) = 1. if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) @@ -1464,6 +1460,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) integer :: IsdB, IedB, JsdB, JedB logical :: z_first, x_before_y + ! Fail out if do_online is true + if(CS%do_online) call MOM_error(FATAL,"DO_ONLINE=True when calling step_tracers") + ! Grid-related pointer assignments G => CS%G GV => CS%GV @@ -1540,7 +1539,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Do horizontal diffusion first (but only half of it), remainder will be applied after advection call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=CS%do_online, read_khdt_x=khdt_x*0.5, & read_khdt_y=khdt_y*0.5) do j=jsd,jed ; do i=isd,ied @@ -1823,13 +1822,14 @@ end subroutine step_tracers !> This subroutine initializes MOM. -subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) +subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(param_file_type), intent(out) :: param_file !< structure indicating paramater file to parse type(directories), intent(out) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer set in this routine to MOM control structure type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when !! model is not being started from a restart file + logical, optional, intent(in) :: do_online !< .false. if tracers are being run offline ! local type(ocean_grid_type), pointer :: G => NULL() ! A pointer to a structure with metrics and related @@ -1957,8 +1957,8 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & "If true, interface heights are diffused with a \n"//& "coefficient of KHTH.", default=.false.) - call get_param(param_file, "MOM", "`_FIRST", & - CS%thickness_diffuse_first, & + call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", & + CS%thickness_diffuse_first, & "If true, do thickness diffusion before dynamics.\n"//& "This is only used if THICKNESSDIFFUSE is true.", & default=.false.) @@ -2525,8 +2525,17 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) cmor_long_name ="Sea Water Salinity") endif - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) + ! If running in offline tracer mode, initialize the necessary control structure and + ! parameters +! if(present(do_online)) then +! CS%do_online = do_online +! if(.not. CS%do_online) then + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) +! endif +! else +! CS%do_online = .true. +! endif ! This subroutine initializes any tracer packages. diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2da02f34f2..6eebe55005 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -331,7 +331,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) ! (H units = m for Bouss, kg/m^2 for non-Bouss). real :: dt_mix ! amount of time over which to apply mixing (seconds) real :: Idt ! inverse time step (1/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: write_all_3dt type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth integer :: num_z_diags ! number of diagnostics to be interpolated to depth @@ -1414,7 +1413,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - write_all_3dt(:,:,:) = 1. if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index d0068f37e7..73635ed28a 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -204,7 +204,7 @@ end subroutine transport_by_files subroutine register_diags_offline_transport(Time, diag, CS) type(offline_transport_CS), pointer :: CS !< control structure for MOM - type(time_type), intent(in) :: Time !< current model time + type(time_type), intent(in) :: Time !< current model time type(diag_ctrl) :: diag @@ -226,7 +226,7 @@ subroutine register_diags_offline_transport(Time, diag, CS) end subroutine register_diags_offline_transport - ! Initializes the control structure for offline transport and reads in some of the + !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) @@ -285,8 +285,10 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy over parameters from other control structures - CS%evap_CFL_limit = diabatic_CSp%diabatic_aux_CSp%evap_CFL_limit - CS%minimum_forcing_depth = diabatic_CSp%diabatic_aux_CSp%minimum_forcing_depth + if(associated(diabatic_CSp%diabatic_aux_CSp)) then + CS%evap_CFL_limit = diabatic_CSp%diabatic_aux_CSp%evap_CFL_limit + CS%minimum_forcing_depth = diabatic_CSp%diabatic_aux_CSp%minimum_forcing_depth + endif call callTree_leave("offline_transport_init") @@ -536,7 +538,7 @@ end subroutine limit_mass_flux_3d !! -# Repeat steps 1 and 2 !! -# Force a remapping to the stored layer thicknesses that correspond to the snapshot of !! the online model at the end of an accumulation interval -!! -3 Reset T/S and h to their stored snapshotted values to prevent model drift +!! -# Reset T/S and h to their stored snapshotted values to prevent model drift !! !! \section offline_evaluation Evaluating the utility of an offline tracer model !! How well an offline tracer model can be used as an alternative to integrating tracers online diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index b16497fa5c..9049072e7e 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -119,15 +119,13 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla ! the distance between adjacent tracer points, in m2. Coef_x, & ! The coefficients relating zonal tracer differences ! to time-integrated fluxes, in m3 or kg. - Kh_u, & ! Tracer mixing coefficient at u-points, in m2 s-1. - write_all_2du ! Make sure that all the data gets written + Kh_u ! Tracer mixing coefficient at u-points, in m2 s-1. real, dimension(SZI_(G),SZJB_(G)) :: & khdt_y, & ! The value of Khtr*dt times the open face width divided by ! the distance between adjacent tracer points, in m2. Coef_y, & ! The coefficients relating meridional tracer differences ! to time-integrated fluxes, in m3 or kg. - Kh_v, & ! Tracer mixing coefficient at u-points, in m2 s-1. - write_all_2dv ! Make sure that all the data gets written + Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. real :: max_CFL ! The global maximum of the diffusive CFL number. logical :: use_VarMix, Resoln_scaled @@ -481,7 +479,6 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla call vchksum(Coef_y,"After tracer diffusion Coef_y", G%HI, haloshift=2) endif - write_all_2du = 1. ; write_all_2dv = 1. if (CS%id_khdt_x > 0) call post_data(CS%id_khdt_x, khdt_x, CS%diag) if (CS%id_khdt_y > 0) call post_data(CS%id_khdt_y, khdt_y, CS%diag) From 7808bfd748b6c24035c9b8e08d874b892725b0d6 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 12 Oct 2016 13:04:44 -0400 Subject: [PATCH 50/65] Reorganized readin of offline mode runtime parameters to ensure that the offline_transport_init is only called when tracer are done offline --- config_src/solo_driver/MOM_driver.F90 | 14 +++---------- src/core/MOM.F90 | 30 +++++++++++++++------------ 2 files changed, 20 insertions(+), 24 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 657e5a52d4..6095761247 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -266,12 +266,12 @@ program MOM_main segment_start_time = set_date(date(1),date(2),date(3),date(4),date(5),date(6)) Time = segment_start_time ! Note the not before CS%d - call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time, do_online = do_online) + call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time, do_online_out = do_online) else ! In this case, the segment starts at a time read from the MOM restart file ! or left as Start_time by MOM_initialize. Time = Start_time - call initialize_MOM(Time, param_file, dirs, MOM_CSp, do_online=do_online) + call initialize_MOM(Time, param_file, dirs, MOM_CSp, do_online_out=do_online) endif fluxes%C_p = MOM_CSp%tv%C_p ! Copy the heat capacity for consistency. @@ -309,15 +309,7 @@ program MOM_main call get_param(param_file, mod, "DT_FORCING", time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& - "The default value is given by DT.", units="s", default=dt) - call get_param(param_file, mod, "DO_ONLINE", do_online, & - "If false, use the model in prognostic mode where\n"//& - "the barotropic and baroclinic dynamics, thermodynamics,\n"//& - "etc. are stepped forward integrated in time.\n"//& - "If true, the all of the above are bypassed with all\n"//& - "fields necessary to integrate only the tracer advection\n"//& - "and diffusion equation are read in from files stored from\n"//& - "a previous integration of the prognostic model", default=.true.) + "The default value is given by DT.", units="s", default=dt) if (.not. do_online) then call get_param(param_file, mod, "DT_OFFLINE", time_step, & "Time step for the offline time step") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 51b16b0dbc..f51129edc4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1822,14 +1822,14 @@ end subroutine step_tracers !> This subroutine initializes MOM. -subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online) +subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online_out) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(param_file_type), intent(out) :: param_file !< structure indicating paramater file to parse type(directories), intent(out) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer set in this routine to MOM control structure type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when !! model is not being started from a restart file - logical, optional, intent(in) :: do_online !< .false. if tracers are being run offline + logical, optional, intent(out) :: do_online_out !< .false. if tracers are being run offline ! local type(ocean_grid_type), pointer :: G => NULL() ! A pointer to a structure with metrics and related @@ -1942,7 +1942,15 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online) "If False, skips the dynamics calls that update u & v, as well as\n"//& "the gravity wave adjustment to h. This is a fragile feature and\n"//& "thus undocumented.", default=.true., do_not_log=.true. ) - + call get_param(param_file, "MOM", "DO_ONLINE", CS%do_online, & + "If false, use the model in prognostic mode where\n"//& + "the barotropic and baroclinic dynamics, thermodynamics,\n"//& + "etc. are stepped forward integrated in time.\n"//& + "If true, the all of the above are bypassed with all\n"//& + "fields necessary to integrate only the tracer advection\n"//& + "and diffusion equation are read in from files stored from\n"//& + "a previous integration of the prognostic model\n"//& + "NOTE: This option only used in the ocean_solo_driver.", default=.true.) call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) @@ -2527,16 +2535,12 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online) ! If running in offline tracer mode, initialize the necessary control structure and ! parameters -! if(present(do_online)) then -! CS%do_online = do_online -! if(.not. CS%do_online) then - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) -! endif -! else -! CS%do_online = .true. -! endif - + if(present(do_online_out)) do_online_out=CS%do_online + + if(.not. CS%do_online) then + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) + endif ! This subroutine initializes any tracer packages. new_sim = ((dirs%input_filename(1:1) == 'n') .and. & From 43a738c7764ed8afa6b4851adeaf6ada661e9649 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 13 Oct 2016 11:50:46 -0400 Subject: [PATCH 51/65] Add a scheme to redistribute remaining flux into water column --- src/core/MOM.F90 | 6 +++--- src/tracer/MOM_offline_control.F90 | 11 +++++++++++ 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ce10b0d99c..830540db08 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1667,9 +1667,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_ALE) ! Finish with the other half of the tracer horizontal diffusion - call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & - read_khdt_y=khdt_y*0.5) +! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & +! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & +! read_khdt_y=khdt_y*0.5) elseif (.not. CS%use_ALE_algorithm) then do iter=1,CS%offline_CSp%num_off_iter diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index d0068f37e7..b9d4ea059f 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -487,6 +487,17 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d + !> In the case where offline advection has failed to converge. Redistribute the flux + !! into remainder of the water column + subroutine redistribute_residual(G, GV, h, uhtr, vhtr) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea + + end subroutine distribute_residual_upwards + !> \namespace mom_offline_transport !! \section offline_overview Offline Tracer Transport in MOM6 !! 'Offline tracer modeling' uses physical fields (e.g. mass transports and layer thicknesses) saved From 44d71c9afce482c502d87c771df150ad30bdf78c Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 13 Oct 2016 15:30:20 -0400 Subject: [PATCH 52/65] Need to figure out why answers changed --- src/core/MOM.F90 | 7 ++++--- src/parameterizations/vertical/MOM_diabatic_aux.F90 | 4 +--- .../vertical/MOM_diabatic_driver.F90 | 13 +++---------- src/tracer/MOM_offline_control.F90 | 10 +++++----- 4 files changed, 13 insertions(+), 21 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ce10b0d99c..c70c043734 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2525,7 +2525,8 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) cmor_long_name ="Sea Water Salinity") endif - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call offline_transport_init(param_file, CS%offline_CSp, & + CS%diabatic_CSp%diabatic_aux_CSp, G, GV) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) @@ -2830,7 +2831,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) 'Layer Thickness before diabatic forcing', thickness_units, v_cell_method='sum') CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & 'Interface Heights before diabatic forcing', 'meter') -! if (CS%diabatic_first .and. (.not. CS%adiabatic)) then + if (CS%diabatic_first .and. (.not. CS%adiabatic)) then CS%id_u_preale = register_diag_field('ocean_model', 'u_preale', diag%axesCuL, Time, & 'Zonal velocity before remapping', 'meter second-1') CS%id_v_preale = register_diag_field('ocean_model', 'v_preale', diag%axesCvL, Time, & @@ -2843,7 +2844,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) 'Salinity before remapping', 'ppt') CS%id_e_preale = register_diag_field('ocean_model', 'e_preale', diag%axesTi, Time, & 'Interface Heights before remapping', 'meter') -! endif + endif if (CS%use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index cd478faa46..d7379f7a0e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -839,7 +839,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Pen_SW_bnd and netMassOut netSalt, & ! surface salt flux ( g(salt)/m2 for non-Bouss and ppt*H for Bouss ) nonpenSW ! non-downwelling SW, which is absorbed at ocean surface - real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d, hloss + real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand @@ -894,7 +894,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & do k=1,nz ; do i=is,ie h2d(i,k) = h(i,j,k) T2d(i,k) = tv%T(i,j,k) - hloss(i,k) = 0.0 do n=1,nsw opacityBand(n,i,k) = (1.0 / GV%m_to_H)*optics%opacity_band(n,i,j,k) enddo @@ -1010,7 +1009,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & ! Update state hOld = h2d(i,k) ! Keep original thickness in hand h2d(i,k) = h2d(i,k) + dThickness ! New thickness - hloss(i,k) = dThickness if (h2d(i,k) > 0.0) then if (calculate_energetics .and. (dThickness > 0.)) then ! Calculate the energy required to mix the newly added water over diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 2da02f34f2..024ababd63 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -158,7 +158,7 @@ module MOM_diabatic_driver integer :: id_Tdif_z = -1, id_Tadv_z = -1, id_Sdif_z = -1, id_Sadv_z = -1 integer :: id_Tdif = -1, id_Tadv = -1, id_Sdif = -1, id_Sadv = -1 integer :: id_MLD_003 = -1, id_MLD_0125 = -1, id_MLD_user = -1, id_mlotstsq = -1 - integer :: id_subMLN2 = -1, id_brine_lay = -1, id_hloss_boundary + integer :: id_subMLN2 = -1, id_brine_lay = -1 integer :: id_diabatic_diff_temp_tend = -1 integer :: id_diabatic_diff_saln_tend = -1 @@ -777,7 +777,6 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) eb(i,j,k-1) = eb(i,j,k-1) + Ent_int ea(i,j,k) = ea(i,j,k) + Ent_int -! eb(i,j,k-1) = ea(i,j,k) Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here ! for diagnostics @@ -1138,12 +1137,8 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif enddo ; enddo - - if (CS%useALEalgorithm) then - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo - else - do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo - endif + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + enddo if (CS%useALEalgorithm) then @@ -1938,8 +1933,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, 'Layer entrainment from above per timestep','meter') CS%id_eb = register_diag_field('ocean_model','eb',diag%axesTL,Time, & 'Layer entrainment from below per timestep', 'meter') - CS%id_hloss_boundary = register_diag_field('ocean_model','hloss_boundary',diag%axesTL,Time, & - 'Layer thickness lost/gained due to fluxes at the boundary', 'meter') CS%id_dudt_dia = register_diag_field('ocean_model','dudt_dia',diag%axesCuL,Time, & 'Zonal Acceleration from Diapycnal Mixing', 'meter second-2') CS%id_dvdt_dia = register_diag_field('ocean_model','dvdt_dia',diag%axesCvL,Time, & diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index d0068f37e7..3463b3ee40 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -17,7 +17,7 @@ module MOM_offline_transport use MOM_shortwave_abs, only : optics_type use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing - use MOM_diabatic_driver, only : diabatic_CS + use MOM_diabatic_aux, only : diabatic_aux_CS implicit none @@ -228,11 +228,11 @@ end subroutine register_diags_offline_transport ! Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input - subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) + subroutine offline_transport_init(param_file, CS, diabatic_aux_CSp, G, GV) type(param_file_type), intent(in) :: param_file type(offline_transport_CS), pointer, intent(inout) :: CS - type(diabatic_CS), pointer, intent(in) :: diabatic_CSp + type(diabatic_aux_CS), pointer, intent(in) :: diabatic_aux_CSp type(ocean_grid_type), intent(in) :: G type(verticalGrid_type), intent(in) :: GV @@ -285,8 +285,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy over parameters from other control structures - CS%evap_CFL_limit = diabatic_CSp%diabatic_aux_CSp%evap_CFL_limit - CS%minimum_forcing_depth = diabatic_CSp%diabatic_aux_CSp%minimum_forcing_depth + CS%evap_CFL_limit = diabatic_aux_CSp%evap_CFL_limit + CS%minimum_forcing_depth = diabatic_aux_CSp%minimum_forcing_depth call callTree_leave("offline_transport_init") From cb796e0f453d3867d662491d4e0efd7cec9a6bd9 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 13 Oct 2016 16:30:03 -0400 Subject: [PATCH 53/65] Need to figure otu why answers are changing --- src/core/MOM.F90 | 2 +- src/tracer/MOM_offline_control.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ae5e4d8e33..c9bbf647d4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2538,7 +2538,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online_out) if(present(do_online_out)) do_online_out=CS%do_online if(.not. CS%do_online) then - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp%diabatic_aux_CSp, G, GV) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) endif diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index a8d3ce8b58..2d971e2b1e 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -285,7 +285,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_aux_CSp, G, GV) if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy over parameters from other control structures - if(associated(diabatic_CSp%diabatic_aux_CSp)) then + if(associated(diabatic_aux_CSp)) then CS%evap_CFL_limit = diabatic_aux_CSp%evap_CFL_limit CS%minimum_forcing_depth = diabatic_aux_CSp%minimum_forcing_depth endif From f837dc59ba270a658c5f87d7210085789663e01e Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 13 Oct 2016 17:57:27 -0400 Subject: [PATCH 54/65] Answer changes were due to aggressive compiler optimizations on workstation. adding -fp-model precise and -fp-model source now leaves answers unchanged in a small suit of test cases. Some typos were fixed, but otherwise this code should work fine. --- src/core/MOM.F90 | 3 +-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 7 +++---- src/tracer/MOM_tracer_hor_diff.F90 | 6 +++--- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c9bbf647d4..74f8c1d90a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -213,7 +213,7 @@ module MOM type(time_type) :: Z_diag_interval !< amount of time between calculating Z-space diagnostics type(time_type) :: Z_diag_time !< next time to compute Z-space diagnostics type(time_type), pointer :: Time !< pointer to ocean clock - real :: rel_time = 0.0 !< relative time (sec) sinc.e start of current execution + real :: rel_time = 0.0 !< relative time (sec) since start of current execution real :: dtbt_reset_period !< The time interval in seconds between dynamic !! recalculation of the barotropic time step. If !! this is negative, it is never calculated, and @@ -1002,7 +1002,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call cpu_clock_begin(id_clock_tracer) - ! Post fields used for offline tracer model call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%dt_trans, G, GV, & CS%tracer_adv_CSp, CS%tracer_Reg) call tracer_hordiff(h, CS%dt_trans, CS%MEKE, CS%VarMix, G, GV, & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 88fceebd61..0ffc550558 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -256,8 +256,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). cTKE, & ! convective TKE requirements for each layer in J/m^2. u_h, & ! zonal and meridional velocities at thickness points after - v_h, & ! entrainment (m/s) - hloss_boundary ! Change in layer thickness because of freshwater fluxes at the surfac + v_h ! entrainment (m/s) real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) @@ -1143,7 +1142,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) if (CS%useALEalgorithm) then ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%diabatic_aux_CSp%evap_CFL_limit, & minimum_forcing_depth = CS%diabatic_aux_CSp%minimum_forcing_depth) @@ -1186,7 +1185,7 @@ subroutine diabatic(u, v, h, tv, fluxes, visc, ADp, CDp, dt, G, GV, CS) else if (CS%useALEalgorithm) then ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, dt, G, GV, tv, & + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%diabatic_aux_CSp%evap_CFL_limit, & minimum_forcing_depth = CS%diabatic_aux_CSp%minimum_forcing_depth) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 9049072e7e..643404e670 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -103,8 +103,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla logical, optional :: do_online_flag real, dimension(SZIB_(G),SZJ_(G)), optional, intent(in) :: read_khdt_x real, dimension(SZI_(G),SZJB_(G)), optional, intent(in) :: read_khdt_y - - logical :: do_online = .true. + real, dimension(SZI_(G),SZJ_(G)) :: & Ihdxdy, & ! The inverse of the volume or mass of fluid in a layer in a @@ -128,7 +127,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. real :: max_CFL ! The global maximum of the diffusive CFL number. - logical :: use_VarMix, Resoln_scaled + logical :: use_VarMix, Resoln_scaled, do_online integer :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num_itts real :: I_numitts ! The inverse of the number of iterations, num_itts. real :: scale ! The fraction of khdt_x or khdt_y that is applied in this @@ -143,6 +142,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + do_online = .true. if (present(do_online_flag)) do_online = do_online_flag if (.not. associated(CS)) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & From ecd412ee94db187b449ed5b1d9a8d72c4f805f81 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 14 Oct 2016 14:03:01 -0400 Subject: [PATCH 55/65] Test routine to redistribute the remaining horizontal fluxes --- src/core/MOM.F90 | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 830540db08..25a6a6fc14 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -131,6 +131,7 @@ module MOM use MOM_offline_transport, only : transport_by_files, next_modulo_time use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux +use MOM_offline_transport, only : distribute_residual_uh, distribute_residual_vh use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut implicit none ; private @@ -1660,6 +1661,25 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(h_pre,"h_pre after 2nd diabatic",G%HI) endif + if (CS%offline_CSp%redistribute_residual) then + + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo ; enddo ; enddo + + if (x_before_y) then + call distribute_residual_uh(G, GV, h_pre, uhtr) + call distribute_residual_vh(G, GV, h_pre, vhtr) + else + call distribute_residual_vh(G, GV, h_pre, vhtr) + call distribute_residual_uh(G, GV, h_pre, uhtr) + endif + + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & + uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + endif + ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run call cpu_clock_begin(id_clock_ALE) From 6e6ab5837594dfaf2abcc99372c251c5e29c3b8b Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 14 Oct 2016 14:03:34 -0400 Subject: [PATCH 56/65] Test routine to redistribute the remaining horizontal fluxes --- src/tracer/MOM_offline_control.F90 | 130 ++++++++++++++++++++++++++++- 1 file changed, 126 insertions(+), 4 deletions(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index b9d4ea059f..9702a9d258 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -37,6 +37,7 @@ module MOM_offline_transport sum_file logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level + logical :: redistribute_residual !> Variables controlling some of the numerical considerations of offline transport integer :: num_off_iter @@ -270,6 +271,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & "True if the time-averaged fields and snapshot fields are offset by one time level", & default=.false.) + call get_param(param_file, mod, "REDISTRIBUTE_RESIDUAL", CS%redistribute_residual, & + "Redistributes any remaining horizontal fluxes throughout the rest of water column", & + default=.true.) call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion" ) call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & @@ -488,15 +492,133 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge. Redistribute the flux - !! into remainder of the water column - subroutine redistribute_residual(G, GV, h, uhtr, vhtr) + !! into remainder of the water column in a barotropic sense + subroutine distribute_residual_uh(G, GV, h, uh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + + real, dimension(SZIB_(G),SZK_(G)) :: uh2d + real, dimension(SZIB_(G)) :: uh2d_sum + real, dimension(SZI_(G),SZK_(G)) :: h2d + real, dimension(SZI_(G)) :: h2d_sum + + integer :: i, j, k, m, is, ie, js, je, nz + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + do j=js,je + uh2d_sum(:) = 0.0 + ! Copy over uh to a working array and sum up the remaining fluxes in a column + do k=1,nz ; do i=is-1,ie + uh2d(I,k) = uh(I,j,k) + uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) + enddo ; enddo + + ! Copy over h to a working array and calculate column volume + h2d_sum(:) = 0.0 + do k=1,nz ; do i=is-2,ie + h2d(i,k) = h(i,j,k)*G%areaT(i,j) + if(h2d(i,k)>GV%Angstrom) then + h2d_sum(i) = h2d_sum(i) + h2d(i,k) + else + h2d_sum(i) = 0.0 + endif + enddo; enddo; + + + ! Distribute flux + do i=is-1,ie + if( uh2d_sum(I)>0.0 ) then + do k=1,nz + uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) + enddo + elseif (uh2d_sum(I)<0.0) then + do k=1,nz + uh2d(I,k) = uh2d_sum(I)*(h2d(i-1,k)/h2d_sum(i)) + enddo + else + uh2d(I,k) = 0.0 + endif + enddo + + ! Update layer thicknesses at the end + do k=1,nz ; do i=is-2,ie + h(i,j,k) = (h(i,j,k) + (uh2d(i-1,k) - uh2d(i,k)))/G%areaT(i,j) + enddo ; enddo + do k=1,nz ; do i=is-1,ie + uh(I,j,k) = uh2d(I,k) + enddo ; enddo + enddo + + end subroutine distribute_residual_uh + + !> In the case where offline advection has failed to converge. Redistribute the flux + !! into remainder of the water column in a barotropic sense + subroutine distribute_residual_vh(G, GV, h, vh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea - end subroutine distribute_residual_upwards + real, dimension(SZJB_(G),SZK_(G)) :: vh2d + real, dimension(SZJB_(G)) :: vh2d_sum + real, dimension(SZJ_(G),SZK_(G)) :: h2d + real, dimension(SZJ_(G)) :: h2d_sum + + integer :: i, j, k, m, is, ie, js, je, nz + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + do i=is,ie + vh2d_sum(:) = 0.0 + ! Copy over uh to a working array and sum up the remaining fluxes in a column + do k=1,nz ; do j=js-1,je + vh2d(J,k) = vh(i,J,k) + vh2d_sum(J) = vh2d_sum(J) + vh2d(J,k) + enddo ; enddo + + ! Copy over h to a working array and calculate column volume + h2d_sum(:) = 0.0 + do k=1,nz ; do j=js-2,je + h2d(j,k) = h(i,j,k)*G%areaT(i,j) + if(h2d(j,k)>GV%Angstrom) then + h2d_sum(j) = h2d_sum(j) + h2d(j,k) + else + h2d_sum(j) = 0.0 + endif + enddo; enddo; + + + ! Distribute flux + do j=js-1,je + if( vh2d_sum(J)>0.0 ) then + do k=1,nz + vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) + enddo + elseif (vh2d_sum(J)<0.0) then + do k=1,nz + vh2d(J,k) = vh2d_sum(J)*(h2d(j-1,k)/h2d_sum(j-1)) + enddo + else + vh2d(J,k) = 0.0 + endif + enddo + + ! Update layer thicknesses at the end + do k=1,nz ; do j=js-2,je + h(i,j,k) = (h(i,j,k) + (vh2d(J-1,k) - vh2d(J,k)))/G%areaT(i,j) + enddo ; enddo + do k=1,nz ; do j=js-1,je + vh(i,J,k) = vh2d(J,k) + enddo ; enddo + enddo + + end subroutine distribute_residual_vh + !> \namespace mom_offline_transport !! \section offline_overview Offline Tracer Transport in MOM6 From 73c5b156e7e3bfc9cf7b197dbf5963cd8df71c36 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Fri, 14 Oct 2016 18:53:18 -0400 Subject: [PATCH 57/65] Redistribution of residual fluxes works in Baltic_ALE_z, now test in OM4 --- src/core/MOM.F90 | 52 +++++++++++++++++++++----- src/tracer/MOM_offline_control.F90 | 59 +++++++++++++++++------------- src/tracer/MOM_tracer_advect.F90 | 3 +- 3 files changed, 79 insertions(+), 35 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 15c461fa58..22676216a9 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1429,6 +1429,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr, vhtr_sub ! Meridional diffusive transports real, dimension(SZI_(CS%G),SZJB_(CS%G)) :: khdt_y + + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are real :: dt_offline, minimum_forcing_depth, evap_CFL_limit ! Shorthand variables from offline CS @@ -1455,6 +1457,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) zero_3dh ! integer :: niter, iter real :: Inum_iter, dt_iter + logical :: converged = .false. integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB @@ -1587,7 +1590,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) ! Switch the direction every iteration? Maybe not useful ! x_before_y = .not. x_before_y @@ -1596,7 +1599,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo ; enddo - if(CS%debug) then call hchksum(h_pre,"h_pre after advect_tracer",G%HI) endif @@ -1640,10 +1642,12 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if(sum_u+sum_v==0.0) then if(is_root_pe()) print *, "Converged after iteration", iter + converged = .true. exit ! print *, "Remaining uflux, vflux:", sum(abs(uhtr)), sum(abs(vhtr)) + else + converged=.false. endif - enddo ! Now do the other half of the vertical mixing and tracer source/sink functions @@ -1659,23 +1663,53 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call hchksum(h_pre,"h_pre after 2nd diabatic",G%HI) endif - if (CS%offline_CSp%redistribute_residual) then + if(CS%offline_CSp%id_eta_diff>0) then + eta_pre(:,:) = 0.0 + eta_end(:,:) = 0.0 + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + if(h_pre(i,j,k)>GV%Angstrom) eta_pre(i,j) = eta_pre(i,j)+h_pre(i,j,k) + if(h_end(i,j,k)>GV%Angstrom) eta_end(i,j) = eta_end(i,j)+h_end(i,j,k) + enddo ; enddo; enddo + + call post_data(CS%offline_CSp%id_eta_diff,eta_pre-eta_end,CS%diag) + + endif + + if (CS%offline_CSp%redistribute_residual .and. (.not. converged)) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(h_pre,"h_pre after before redistribute",G%HI) + call uchksum(uhtr_sub,"uhtr_sub before redistribute",G%HI) + call vchksum(vhtr_sub,"vhtr_sub before redistribute",G%HI) + endif + if (x_before_y) then - call distribute_residual_uh(G, GV, h_pre, uhtr) - call distribute_residual_vh(G, GV, h_pre, vhtr) + call distribute_residual_uh(G, GV, h_pre, uhtr_sub) + call distribute_residual_vh(G, GV, h_pre, vhtr_sub) else - call distribute_residual_vh(G, GV, h_pre, vhtr) - call distribute_residual_uh(G, GV, h_pre, uhtr) + call distribute_residual_vh(G, GV, h_pre, vhtr_sub) + call distribute_residual_uh(G, GV, h_pre, uhtr_sub) endif + if (CS%debug) then + call hchksum(h_pre,"h_pre after after redistribute",G%HI) + call uchksum(uhtr_sub,"uhtr_sub after redistribute",G%HI) + call vchksum(vhtr_sub,"vhtr_sub after redistribute",G%HI) + endif + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + enddo ; enddo ; enddo + endif ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 74ae28565a..394cf19917 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -55,7 +55,8 @@ module MOM_offline_transport id_vhr = -1, & id_ear = -1, & id_ebr = -1, & - id_hr = -1 + id_hr = -1, & + id_eta_diff = -1 end type offline_transport_CS @@ -224,6 +225,8 @@ subroutine register_diags_offline_transport(Time, diag, CS) 'Remaining thickness entrained from above', 'm') CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & 'Remaining thickness entrained from below', 'm') + CS%id_eta_diff = register_diag_field('ocean_model','eta_diff', diag%axesT1, Time, & + 'Difference in total water column height from online and offline','m') end subroutine register_diags_offline_transport @@ -493,8 +496,8 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) end subroutine limit_mass_flux_3d - !> In the case where offline advection has failed to converge. Redistribute the flux - !! into remainder of the water column in a barotropic sense + !> In the case where offline advection has failed to converge, redistribute the u-flux + !! into remainder of the water column as a barotropic equivalent subroutine distribute_residual_uh(G, GV, h, uh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV @@ -503,7 +506,7 @@ subroutine distribute_residual_uh(G, GV, h, uh) real, dimension(SZIB_(G),SZK_(G)) :: uh2d real, dimension(SZIB_(G)) :: uh2d_sum - real, dimension(SZI_(G),SZK_(G)) :: h2d + real, dimension(SZI_(G),SZK_(G)) :: h2d real, dimension(SZI_(G)) :: h2d_sum integer :: i, j, k, m, is, ie, js, je, nz @@ -519,36 +522,39 @@ subroutine distribute_residual_uh(G, GV, h, uh) uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) enddo ; enddo - ! Copy over h to a working array and calculate column volume + ! Copy over h to a working array and calculate column height h2d_sum(:) = 0.0 - do k=1,nz ; do i=is-2,ie + do k=1,nz ; do i=is-2,ie+1 h2d(i,k) = h(i,j,k)*G%areaT(i,j) - if(h2d(i,k)>GV%Angstrom) then + if(h(i,j,k)>GV%Angstrom) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d_sum(i) = 0.0 + h2d(i,k) = 0.0 endif enddo; enddo; - ! Distribute flux + ! Distribute flux. Note min/max is intended to make sure that the mass transport + ! does not deplete a cell do i=is-1,ie if( uh2d_sum(I)>0.0 ) then do k=1,nz - uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) + uh2d(I,k) = min(uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)),h2d(i,k)) enddo elseif (uh2d_sum(I)<0.0) then do k=1,nz - uh2d(I,k) = uh2d_sum(I)*(h2d(i-1,k)/h2d_sum(i)) + uh2d(I,k) = max(uh2d_sum(I)*(h2d(i+1,k)/h2d_sum(i+1)),-h2d(i+1,k)) enddo else - uh2d(I,k) = 0.0 + do k=1,nz + uh2d(I,k) = 0.0 + enddo endif enddo ! Update layer thicknesses at the end - do k=1,nz ; do i=is-2,ie - h(i,j,k) = (h(i,j,k) + (uh2d(i-1,k) - uh2d(i,k)))/G%areaT(i,j) + do k=1,nz ; do i=is-2,ie+1 + h(i,j,k) = h(i,j,k) + (uh2d(I-1,k) - uh2d(I,k))/G%areaT(i,j) enddo ; enddo do k=1,nz ; do i=is-1,ie uh(I,j,k) = uh2d(I,k) @@ -557,8 +563,7 @@ subroutine distribute_residual_uh(G, GV, h, uh) end subroutine distribute_residual_uh - !> In the case where offline advection has failed to converge. Redistribute the flux - !! into remainder of the water column in a barotropic sense + !> Redistribute the v-flux as a barotropic equivalent subroutine distribute_residual_vh(G, GV, h, vh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV @@ -585,34 +590,38 @@ subroutine distribute_residual_vh(G, GV, h, vh) ! Copy over h to a working array and calculate column volume h2d_sum(:) = 0.0 - do k=1,nz ; do j=js-2,je + do k=1,nz ; do j=js-2,je+1 h2d(j,k) = h(i,j,k)*G%areaT(i,j) - if(h2d(j,k)>GV%Angstrom) then + if(h(i,j,k)>GV%Angstrom) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d_sum(j) = 0.0 + h2d(j,k) = 0.0 endif enddo; enddo; - ! Distribute flux + ! Distribute flux. Note min/max is intended to make sure that the mass transport + ! does not deplete a cell do j=js-1,je if( vh2d_sum(J)>0.0 ) then do k=1,nz - vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) + vh2d(J,k) = min(vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)),h2d(j,k)) enddo elseif (vh2d_sum(J)<0.0) then do k=1,nz - vh2d(J,k) = vh2d_sum(J)*(h2d(j-1,k)/h2d_sum(j-1)) + vh2d(J,k) = max(vh2d_sum(J)*(h2d(j+1,k)/h2d_sum(j+1)),-h2d(j+1,k)) enddo else - vh2d(J,k) = 0.0 + do k=1,nz + vh2d(J,k) = 0.0 + enddo endif enddo + ! Update layer thicknesses at the end - do k=1,nz ; do j=js-2,je - h(i,j,k) = (h(i,j,k) + (vh2d(J-1,k) - vh2d(J,k)))/G%areaT(i,j) + do k=1,nz ; do j=js-2,je+1 + h(i,j,k) = h(i,j,k) + (vh2d(J-1,k) - vh2d(J,k))/G%areaT(i,j) enddo ; enddo do k=1,nz ; do j=js-1,je vh(i,J,k) = vh2d(J,k) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index d46026f4e1..3cc14993c5 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -44,7 +44,8 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, CS, Reg, & + h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_end !< layer thickness after advection (m or kg m-2) From af2c6b8bdaf8f30b0ba5fc42e26e398353260bf6 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Wed, 19 Oct 2016 16:24:05 -0400 Subject: [PATCH 58/65] Beginning work on second option of redistributing fluxes more locally --- src/core/MOM.F90 | 24 +++++--- src/tracer/MOM_offline_control.F90 | 93 ++++++++++++++++++++++++++++-- 2 files changed, 104 insertions(+), 13 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22676216a9..fa997626bc 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -131,7 +131,8 @@ module MOM use MOM_offline_transport, only : transport_by_files, next_modulo_time use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux -use MOM_offline_transport, only : distribute_residual_uh, distribute_residual_vh +use MOM_offline_transport, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic +use MOM_offline_transport, only : distribute_residual_uh_upwards use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut implicit none ; private @@ -1677,6 +1678,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (CS%offline_CSp%redistribute_residual .and. (.not. converged)) then + call cpu_clock_begin(id_clock_ALE) + call ALE_main_offline(G, GV, h_pre, CS%tv, & + CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) + call cpu_clock_end(id_clock_ALE) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) enddo ; enddo ; enddo @@ -1689,11 +1695,11 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (x_before_y) then - call distribute_residual_uh(G, GV, h_pre, uhtr_sub) - call distribute_residual_vh(G, GV, h_pre, vhtr_sub) + call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) + call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) else - call distribute_residual_vh(G, GV, h_pre, vhtr_sub) - call distribute_residual_uh(G, GV, h_pre, uhtr_sub) + call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) + call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) endif if (CS%debug) then @@ -1703,7 +1709,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=5, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) do k=1,nz ; do j=jsd,jed ; do i=isd,ied @@ -1719,9 +1725,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call cpu_clock_end(id_clock_ALE) ! Finish with the other half of the tracer horizontal diffusion -! call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & -! CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & -! read_khdt_y=khdt_y*0.5) + call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.false., read_khdt_x=khdt_x*0.5, & + read_khdt_y=khdt_y*0.5) elseif (.not. CS%use_ALE_algorithm) then do iter=1,CS%offline_CSp%num_off_iter diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 394cf19917..1fa754d370 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -498,7 +498,7 @@ end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge, redistribute the u-flux !! into remainder of the water column as a barotropic equivalent - subroutine distribute_residual_uh(G, GV, h, uh) + subroutine distribute_residual_uh_barotropic(G, GV, h, uh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h @@ -558,13 +558,14 @@ subroutine distribute_residual_uh(G, GV, h, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie uh(I,j,k) = uh2d(I,k) + uh2d_sum(I) = uh2d_sum(I)-uh2d(I,k) enddo ; enddo enddo - end subroutine distribute_residual_uh + end subroutine distribute_residual_uh_barotropic !> Redistribute the v-flux as a barotropic equivalent - subroutine distribute_residual_vh(G, GV, h, vh) + subroutine distribute_residual_vh_barotropic(G, GV, h, vh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h @@ -628,7 +629,91 @@ subroutine distribute_residual_vh(G, GV, h, vh) enddo ; enddo enddo - end subroutine distribute_residual_vh + end subroutine distribute_residual_vh_barotropic + + !> In the case where offline advection has failed to converge, redistribute the u-flux + !! into layers above + subroutine distribute_residual_uh_upwards(G, GV, h, uh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh + + real, dimension(SZIB_(G),SZK_(G)) :: uh2d + real, dimension(SZIB_(G)) :: uh2d_sum + real, dimension(SZI_(G),SZK_(G)) :: h2d + real, dimension(SZI_(G)) :: h2d_sum + + real :: uh_neglect, uh_remain, uh_add, hup, hlos + integer :: i, j, k, m, is, ie, js, je, nz, k_rev + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + do j=js,je + uh2d_sum(:) = 0.0 + ! Copy over uh and cell volume to working arrays + do k=1,nz ; do i=is-1,ie + uh2d(I,k) = uh(I,j,k) + enddo ; enddo + do k=1,nz ; do i=is-2,ie+1 + h2d(j,k) = h(i,j,k)*G%areaT(i,j) + enddo ; enddo + + do i=is-1,ie ; do k=1,nz + uh_remain = uh2d(I,k) + + if (uh_remain>0.0) then + uh_neglect = G%areaT(i,j)*GV%H_subroundoff + ! Set the amount in the layer with remaining fluxes to zero + ! This will get reset in the first iteration of the redistribution loop + uh2d(I,k) = 0.0 + ! Loop to distribute remaining flux in layers above + do k_rev=k,1,-1 + hup = h2d(i,k_rev) - G%areaT(i,j)*GV%H_subroundoff + ! How much lost on the other side + hlos = min(uh2d(I-1,k_rev),0.0) - max(uh2d(I,k_rev),0.0) + + ! Check to see if the cell can accommodate more flux + if(0.5*hup+hlos>0.0) then + uh_add = min(0.5*hup+hlos,uh_remain) + uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add + uh_remain = uh_remain - uh_add + if(uh_remain0.0) then + uh_add = max( -(0.5*hup+hlos),uh_remain ) + uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add + uh_remain = uh_remain - uh_add + if(uh_remain>-uh_neglect) exit + endif + enddo + endif + enddo ; enddo + + ! Update layer thicknesses at the end + do k=1,nz ; do i=is-2,ie+1 + h(i,j,k) = h(i,j,k) + (uh2d(I-1,k) - uh2d(I,k))/G%areaT(i,j) + enddo ; enddo + do k=1,nz ; do i=is-1,ie + uh(I,j,k) = uh2d(I,k) + enddo ; enddo + enddo + + end subroutine distribute_residual_uh_upwards !> \namespace mom_offline_transport From 54eea3b4fc22d6537515072b33b97575e1d5e04a Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Thu, 20 Oct 2016 17:32:31 -0400 Subject: [PATCH 59/65] Added redistrubtion of fluxes up the column for u-direction, need to make one for v-direction then test in OM4_05 --- src/core/MOM.F90 | 8 ++++ src/tracer/MOM_offline_control.F90 | 69 +++++++++++++++++++----------- 2 files changed, 51 insertions(+), 26 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index fa997626bc..a156c5bf8a 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1696,9 +1696,17 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) if (x_before_y) then call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) +! call cpu_clock_begin(id_clock_ALE) +! call ALE_main_offline(G, GV, h_pre, CS%tv, & +! CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) +! call cpu_clock_end(id_clock_ALE) call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) else call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) +! call cpu_clock_begin(id_clock_ALE) +! call ALE_main_offline(G, GV, h_pre, CS%tv, & +! CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) +! call cpu_clock_end(id_clock_ALE) call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) endif diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 1fa754d370..0e9f9fd554 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -636,7 +636,7 @@ end subroutine distribute_residual_vh_barotropic subroutine distribute_residual_uh_upwards(G, GV, h, uh) type(ocean_grid_type), pointer :: G type(verticalGrid_type), pointer :: GV - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZIB_(G),SZK_(G)) :: uh2d @@ -644,7 +644,7 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) real, dimension(SZI_(G),SZK_(G)) :: h2d real, dimension(SZI_(G)) :: h2d_sum - real :: uh_neglect, uh_remain, uh_add, hup, hlos + real :: uh_neglect, uh_remain, uh_max, uh_add, hup, hlos, hdown integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid @@ -657,51 +657,68 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) uh2d(I,k) = uh(I,j,k) enddo ; enddo do k=1,nz ; do i=is-2,ie+1 - h2d(j,k) = h(i,j,k)*G%areaT(i,j) + h2d(i,k) = h(i,j,k)*G%areaT(i,j) enddo ; enddo do i=is-1,ie ; do k=1,nz uh_remain = uh2d(I,k) - if (uh_remain>0.0) then - uh_neglect = G%areaT(i,j)*GV%H_subroundoff + if(uh_remain<0.0) then + uh_neglect = G%areaT(i+1,j)*GV%Angstrom +! print *, "i, j, k, uh_remain, uh_neglect", i,j,k,uh_remain,uh_neglect ! Set the amount in the layer with remaining fluxes to zero ! This will get reset in the first iteration of the redistribution loop uh2d(I,k) = 0.0 ! Loop to distribute remaining flux in layers above do k_rev=k,1,-1 - hup = h2d(i,k_rev) - G%areaT(i,j)*GV%H_subroundoff - ! How much lost on the other side - hlos = min(uh2d(I-1,k_rev),0.0) - max(uh2d(I,k_rev),0.0) + hup = h2d(i+1,k_rev) - G%areaT(i+1,j)*GV%H_subroundoff + hlos = max(uh2d(I+1,k_rev),0.0) - ! Check to see if the cell can accommodate more flux - if(0.5*hup+hlos>0.0) then - uh_add = min(0.5*hup+hlos,uh_remain) - uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add - uh_remain = uh_remain - uh_add - if(uh_remain0.0) call MOM_error(WARNING,"UH will switch signs because of redistribution") + if(uh_adduh_neglect) then + call MOM_error(WARNING,"Residual UH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") + uh2d(I,k) = uh2d(I,k) + uh_remain + endif + elseif (uh_remain>0.0) then + + uh_neglect = G%areaT(i,j)*GV%Angstrom +! print *, "i, j, k, uh_remain, uh_neglect", i,j,k,uh_remain,uh_neglect ! Set the amount in the layer with remaining fluxes to zero ! This will get reset in the first iteration of the redistribution loop uh2d(I,k) = 0.0 ! Loop to distribute remaining flux in layers above do k_rev=k,1,-1 - hup = h2d(i+1,k_rev) - G%areaT(i+1,j)*GV%H_subroundoff - ! Total depletion in a cell is the sum of outgoing fluxes - hlos = -max(uh2d(I+1,k_rev),0.0) + min(uh2d(I,k_rev),0.0) - - ! Check to see if the cell can accommodate more flux - if(0.5*hup+hlos>0.0) then - uh_add = max( -(0.5*hup+hlos),uh_remain ) - uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add - uh_remain = uh_remain - uh_add - if(uh_remain>-uh_neglect) exit + hup = h2d(i,k_rev) - G%areaT(i,j)*GV%H_subroundoff + hlos = max(0.0,-uh2d(I-1,k_rev)) + uh_add = max(0.5*hup,hup-hlos,0.0) + uh_add = min(uh_add,uh_remain) + if(uh2d(I,k_rev)<0.0) call MOM_error(WARNING,"UH will switch signs because of redistribution") + if(uh_add>uh2d(I,k_rev)) then + uh_remain = uh_remain - (uh_add-uh2d(I,k_rev)) + uh2d(I,k_rev) = uh_add + else + uh_add = 0.0 endif +! print *, "k_rev, uh2d, h, uh_add, uh_remain", k_rev, h2d(I,k_rev), uh2d(I,k_rev), uh_add, uh_remain + if(abs(uh_remain)uh_neglect) then + call MOM_error(WARNING,"Residual UH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") + uh2d(I,k) = uh2d(I,k) + uh_remain + endif endif + enddo ; enddo ! Update layer thicknesses at the end From 2dc1be6f96e0bb3baf9d424630542cf7560f5546 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Oct 2016 14:44:52 -0400 Subject: [PATCH 60/65] Corrected cell_method for h_preale diagnostic - New code looks like it was cut and pasted from an out of date code. --- src/core/MOM.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 69760b17a3..6e821a7e26 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2848,7 +2848,7 @@ subroutine register_diags(Time, G, GV, CS, ADp) CS%id_v_preale = register_diag_field('ocean_model', 'v_preale', diag%axesCvL, Time, & 'Meridional velocity before remapping', 'meter second-1') CS%id_h_preale = register_diag_field('ocean_model', 'h_preale', diag%axesTL, Time, & - 'Layer Thickness before remapping', thickness_units) + 'Layer Thickness before remapping', thickness_units, v_cell_method='sum') CS%id_T_preale = register_diag_field('ocean_model', 'T_preale', diag%axesTL, Time, & 'Temperature before remapping', 'degC') CS%id_S_preale = register_diag_field('ocean_model', 'S_preale', diag%axesTL, Time, & From 50b145ac5c9a34dd3ed23def1cf78dc2e38777d7 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Oct 2016 14:53:31 -0400 Subject: [PATCH 61/65] Reverse logic so that (online) dynamics is the normal mode - This replaces "do_online" with "offline_tracer_mode" which means all other configurations and other drivers are unaffected. - Corrected description of parameter which for DO_ONLINE was diametrically opposite of "do online". - Parameter name "OFFLINE_TRACER_MODE" is more descriptive! --- config_src/solo_driver/MOM_driver.F90 | 40 ++++++++++++++------------- src/core/MOM.F90 | 38 ++++++++++++------------- 2 files changed, 40 insertions(+), 38 deletions(-) diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 6095761247..ed8df7f91b 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -171,13 +171,13 @@ program MOM_main logical :: unit_in_use integer :: initClock, mainClock, termClock - logical :: do_online ! If true, use the model in prognostic mode where - ! the barotropic and baroclinic dynamics, thermodynamics, - ! etc. are stepped forward integrated in time. - ! If false, then all of the above are bypassed with all - ! fields necessary to integrate only the tracer advection - ! and diffusion equation are read in from files stored from - ! a previous integration of the prognostic model + logical :: offline_tracer_mode ! If false, use the model in prognostic mode where + ! the barotropic and baroclinic dynamics, thermodynamics, + ! etc. are stepped forward integrated in time. + ! If true, then all of the above are bypassed with all + ! fields necessary to integrate only the tracer advection + ! and diffusion equation are read in from files stored from + ! a previous integration of the prognostic model type(MOM_control_struct), pointer :: MOM_CSp => NULL() type(surface_forcing_CS), pointer :: surface_forcing_CSp => NULL() @@ -266,12 +266,12 @@ program MOM_main segment_start_time = set_date(date(1),date(2),date(3),date(4),date(5),date(6)) Time = segment_start_time ! Note the not before CS%d - call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time, do_online_out = do_online) + call initialize_MOM(Time, param_file, dirs, MOM_CSp, segment_start_time, offline_tracer_mode = offline_tracer_mode) else ! In this case, the segment starts at a time read from the MOM restart file ! or left as Start_time by MOM_initialize. Time = Start_time - call initialize_MOM(Time, param_file, dirs, MOM_CSp, do_online_out=do_online) + call initialize_MOM(Time, param_file, dirs, MOM_CSp, offline_tracer_mode=offline_tracer_mode) endif fluxes%C_p = MOM_CSp%tv%C_p ! Copy the heat capacity for consistency. @@ -310,7 +310,7 @@ program MOM_main "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=dt) - if (.not. do_online) then + if (offline_tracer_mode) then call get_param(param_file, mod, "DT_OFFLINE", time_step, & "Time step for the offline time step") dt = time_step @@ -415,7 +415,7 @@ program MOM_main call callTree_enter("Main loop, MOM_driver.F90",n) ! Set the forcing for the next steps. - if (do_online) then + if (.not. offline_tracer_mode) then call set_forcing(state, fluxes, Time, Time_step_ocean, grid, & surface_forcing_CSp) endif @@ -441,11 +441,14 @@ program MOM_main ! This call steps the model over a time time_step. Time1 = Master_Time ; Time = Master_Time - if (do_online) call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) - if (.not. do_online) call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) + if (offline_tracer_mode) then + call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) + else + call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) + endif -! Time = Time + Time_step_ocean -! This is here to enable fractional-second time steps. +! Time = Time + Time_step_ocean +! This is here to enable fractional-second time steps. elapsed_time = elapsed_time + time_step if (elapsed_time > 2e9) then ! This is here to ensure that the conversion from a real to an integer @@ -469,7 +472,7 @@ program MOM_main surface_forcing_CSp%handles) call disable_averaging(MOM_CSp%diag) - if (do_online) then + if (.not. offline_tracer_mode) then if (fluxes%fluxes_used) then call enable_averaging(fluxes%dt_buoy_accum, Time, MOM_CSp%diag) call forcing_diagnostics(fluxes, state, fluxes%dt_buoy_accum, grid, & @@ -482,8 +485,6 @@ program MOM_main endif endif - - ! See if it is time to write out the energy. if ((Time + (Time_step_ocean/2) > write_energy_time) .and. & (MOM_CSp%dt_trans == 0.0)) then @@ -525,7 +526,8 @@ program MOM_main if (Restart_control>=0) then if (MOM_CSp%dt_trans > 0.0) call MOM_error(WARNING, "End of MOM_main reached "//& "with a non-zero dt_trans. Additional restart fields are required.") - if (.not.fluxes%fluxes_used .and. do_online) call MOM_error(FATAL, "End of MOM_main reached "//& + if (.not.fluxes%fluxes_used .and. .not. offline_tracer_mode) call MOM_error(FATAL, & + "End of MOM_main reached "//& "with unused buoyancy fluxes. For conservation, the ocean restart "//& "files can only be created after the buoyancy forcing is applied.") diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 6e821a7e26..1c988290c5 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -201,7 +201,8 @@ module MOM !! MOM_regridding module. logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an !! undocumented run-time flag that is fragile. - logical :: do_online !< If false, step_tracers is called instead of step_MOM. + logical :: offline_tracer_mode = .false. + !< If true, step_tracers() is called instead of step_MOM(). !! This is intended for running MOM6 in offline tracer mode real :: dt !< (baroclinic) dynamics time step (seconds) real :: dt_therm !< thermodynamics time step (seconds) @@ -1459,9 +1460,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) integer :: IsdB, IedB, JsdB, JedB logical :: z_first, x_before_y - ! Fail out if do_online is true - if(CS%do_online) call MOM_error(FATAL,"DO_ONLINE=True when calling step_tracers") - + ! Fail out if offline_tracer_mode is not true + if (.not.CS%offline_tracer_mode) call MOM_error(FATAL,"OFFLINE_TRACER_MODE=False when calling step_tracers") + ! Grid-related pointer assignments G => CS%G GV => CS%GV @@ -1538,8 +1539,8 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) ! Do horizontal diffusion first (but only half of it), remainder will be applied after advection call tracer_hordiff(h_pre, CS%offline_CSp%dt_offline*0.5, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=CS%do_online, read_khdt_x=khdt_x*0.5, & - read_khdt_y=khdt_y*0.5) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv, do_online_flag=.not.CS%offline_tracer_mode, & + read_khdt_x=khdt_x*0.5, read_khdt_y=khdt_y*0.5) do j=jsd,jed ; do i=isd,ied fluxes%netMassOut(i,j) = 0.5*fluxes%netMassOut(i,j) @@ -1821,14 +1822,14 @@ end subroutine step_tracers !> This subroutine initializes MOM. -subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online_out) +subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mode) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(param_file_type), intent(out) :: param_file !< structure indicating paramater file to parse type(directories), intent(out) :: dirs !< structure with directory paths type(MOM_control_struct), pointer :: CS !< pointer set in this routine to MOM control structure type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when !! model is not being started from a restart file - logical, optional, intent(out) :: do_online_out !< .false. if tracers are being run offline + logical, optional, intent(out) :: offline_tracer_mode !< True if tracers are being run offline ! local type(ocean_grid_type), pointer :: G => NULL() ! A pointer to a structure with metrics and related @@ -1941,15 +1942,14 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online_out) "If False, skips the dynamics calls that update u & v, as well as\n"//& "the gravity wave adjustment to h. This is a fragile feature and\n"//& "thus undocumented.", default=.true., do_not_log=.true. ) - call get_param(param_file, "MOM", "DO_ONLINE", CS%do_online, & - "If false, use the model in prognostic mode where\n"//& - "the barotropic and baroclinic dynamics, thermodynamics,\n"//& - "etc. are stepped forward integrated in time.\n"//& - "If true, the all of the above are bypassed with all\n"//& - "fields necessary to integrate only the tracer advection\n"//& - "and diffusion equation are read in from files stored from\n"//& - "a previous integration of the prognostic model\n"//& - "NOTE: This option only used in the ocean_solo_driver.", default=.true.) + if (present(offline_tracer_mode)) then ! Only read this parameter in solo mode + call get_param(param_file, "MOM", "OFFLINE_TRACER_MODE", CS%offline_tracer_mode, & + "If true, barotropic and baroclinic dynamics, thermodynamics\n"//& + "are all bypassed with all the fields necessary to integrate\n"//& + "the tracer advection and diffusion equation are read in from\n"//& + "files stored from a previous integration of the prognostic model.\n"//& + "NOTE: This option only used in the ocean_solo_driver.", default=.false.) + endif call get_param(param_file, "MOM", "USE_REGRIDDING", CS%use_ALE_algorithm , & "If True, use the ALE algorithm (regridding/remapping).\n"//& "If False, use the layered isopycnal algorithm.", default=.false. ) @@ -2534,9 +2534,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, do_online_out) ! If running in offline tracer mode, initialize the necessary control structure and ! parameters - if(present(do_online_out)) do_online_out=CS%do_online + if(present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode - if(.not. CS%do_online) then + if(CS%offline_tracer_mode) then call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp%diabatic_aux_CSp, G, GV) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) endif From 0190b7bcc8e48a62015538633993fc14cfef22ea Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 24 Oct 2016 10:14:04 -0400 Subject: [PATCH 62/65] Ready to test the two vertical redistribution methods on OM4_05 --- src/core/MOM.F90 | 61 ++++---- src/tracer/MOM_offline_control.F90 | 232 +++++++++++++++++++++-------- 2 files changed, 209 insertions(+), 84 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index a156c5bf8a..6d8cccbff6 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -132,7 +132,7 @@ module MOM use MOM_offline_transport, only : offline_transport_init, register_diags_offline_transport use MOM_offline_transport, only : limit_mass_flux_3d, update_h_horizontal_flux, update_h_vertical_flux use MOM_offline_transport, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic -use MOM_offline_transport, only : distribute_residual_uh_upwards +use MOM_offline_transport, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut implicit none ; private @@ -1676,12 +1676,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) endif - if (CS%offline_CSp%redistribute_residual .and. (.not. converged)) then - - call cpu_clock_begin(id_clock_ALE) - call ALE_main_offline(G, GV, h_pre, CS%tv, & - CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) - call cpu_clock_end(id_clock_ALE) + if (.not. converged) then do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) @@ -1693,22 +1688,40 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call vchksum(vhtr_sub,"vhtr_sub before redistribute",G%HI) endif + if (CS%offline_CSp%id_h_redist>0) call post_data(CS%offline_CSp%id_h_redist, h_pre, CS%diag) + if (CS%offline_CSp%id_uhr_redist>0) call post_data(CS%offline_CSp%id_uhr_redist, uhtr, CS%diag) + if (CS%offline_CSp%id_vhr_redist>0) call post_data(CS%offline_CSp%id_vhr_redist, vhtr, CS%diag) + + select case (CS%offline_CSp%redistribute_method) + case ('barotropic') + if (x_before_y) then + call distribute_residual_uh_barotropic(G, GV, h_pre, uhtr_sub) + call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) + else + call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) + call distribute_residual_uh_barotropic(G, GV, h_pre, uhtr_sub) + endif + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & + uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) - if (x_before_y) then - call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) -! call cpu_clock_begin(id_clock_ALE) -! call ALE_main_offline(G, GV, h_pre, CS%tv, & -! CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) -! call cpu_clock_end(id_clock_ALE) - call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) - else - call distribute_residual_vh_barotropic(G, GV, h_pre, vhtr_sub) -! call cpu_clock_begin(id_clock_ALE) -! call ALE_main_offline(G, GV, h_pre, CS%tv, & -! CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) -! call cpu_clock_end(id_clock_ALE) - call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) - endif + case ('upwards') + if (x_before_y) then + call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) + call distribute_residual_vh_upwards(G, GV, h_pre, vhtr_sub) + else + call distribute_residual_vh_upwards(G, GV, h_pre, vhtr_sub) + call distribute_residual_uh_upwards(G, GV, h_pre, uhtr_sub) + endif + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & + uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + case ('none') + call MOM_error(WARNING,"Offline advection did not converge") + + case default + call MOM_error(FATAL,"Unrecognized REDISTRIBUTE_METHOD") + end select if (CS%debug) then call hchksum(h_pre,"h_pre after after redistribute",G%HI) @@ -1716,10 +1729,6 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) call vchksum(vhtr_sub,"vhtr_sub after redistribute",G%HI) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=5, & - uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) - do k=1,nz ; do j=jsd,jed ; do i=isd,ied h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo ; enddo diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 0e9f9fd554..b782f57432 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -35,10 +35,9 @@ module MOM_offline_transport character(len=200) :: & ! ! Names of input files snap_file, & sum_file + character(len=20) :: redistribute_method logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are ! offset by one time level - logical :: redistribute_residual - !> Variables controlling some of the numerical considerations of offline transport integer :: num_off_iter real :: dt_offline ! Timestep used for offline tracers @@ -56,6 +55,9 @@ module MOM_offline_transport id_ear = -1, & id_ebr = -1, & id_hr = -1, & + id_uhr_redist = -1, & + id_vhr_redist = -1, & + id_h_redist = -1, & id_eta_diff = -1 end type offline_transport_CS @@ -68,6 +70,10 @@ module MOM_offline_transport public update_h_horizontal_flux public update_h_vertical_flux public limit_mass_flux_3d + public distribute_residual_uh_barotropic + public distribute_residual_vh_barotropic + public distribute_residual_uh_upwards + public distribute_residual_vh_upwards contains !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored @@ -213,10 +219,14 @@ subroutine register_diags_offline_transport(Time, diag, CS) ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & 'Zonal thickness fluxes remaining at end of timestep', 'kg') + CS%id_uhr_redist = register_diag_field('ocean_model', 'uhr_redist', diag%axesCuL, Time, & + 'Zonal thickness fluxes to be redistributed vertically', 'kg') ! V-cell fields CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & 'Meridional thickness fluxes remaining at end of timestep', 'kg') + CS%id_vhr_redist = register_diag_field('ocean_model', 'vhr_redist', diag%axesCvL, Time, & + 'Meridional thickness to be redistributed vertically', 'kg') ! T-cell fields CS%id_hr = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & @@ -227,6 +237,8 @@ subroutine register_diags_offline_transport(Time, diag, CS) 'Remaining thickness entrained from below', 'm') CS%id_eta_diff = register_diag_field('ocean_model','eta_diff', diag%axesT1, Time, & 'Difference in total water column height from online and offline','m') + CS%id_h_redist = register_diag_field('ocean_model','h_redist', diag%axesTL, Time, & + 'Layer thicknesses before redistribution of mass fluxes','m') end subroutine register_diags_offline_transport @@ -274,9 +286,9 @@ subroutine offline_transport_init(param_file, CS, diabatic_aux_CSp, G, GV) call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & "True if the time-averaged fields and snapshot fields are offset by one time level", & default=.false.) - call get_param(param_file, mod, "REDISTRIBUTE_RESIDUAL", CS%redistribute_residual, & + call get_param(param_file, mod, "REDISTRIBUTE_METHOD", CS%redistribute_method, & "Redistributes any remaining horizontal fluxes throughout the rest of water column", & - default=.true.) + default='barotropic') call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion" ) call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & @@ -606,11 +618,11 @@ subroutine distribute_residual_vh_barotropic(G, GV, h, vh) do j=js-1,je if( vh2d_sum(J)>0.0 ) then do k=1,nz - vh2d(J,k) = min(vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)),h2d(j,k)) + vh2d(J,k) = min(vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)),0.5*h2d(j,k)) enddo elseif (vh2d_sum(J)<0.0) then do k=1,nz - vh2d(J,k) = max(vh2d_sum(J)*(h2d(j+1,k)/h2d_sum(j+1)),-h2d(j+1,k)) + vh2d(J,k) = max(vh2d_sum(J)*(h2d(j+1,k)/h2d_sum(j+1)),-0.5*h2d(j+1,k)) enddo else do k=1,nz @@ -640,90 +652,99 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZIB_(G),SZK_(G)) :: uh2d - real, dimension(SZIB_(G)) :: uh2d_sum real, dimension(SZI_(G),SZK_(G)) :: h2d - real, dimension(SZI_(G)) :: h2d_sum + logical, dimension(SZK_(G)) :: filled - real :: uh_neglect, uh_remain, uh_max, uh_add, hup, hlos, hdown + real :: uh_neglect, uh_remain, uh_LB, uh_UB, uh_add, uh_max, uh_sum + real :: hup, hdown, hlos, min_h integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + min_h = 0.1*GV%Angstrom + do j=js,je - uh2d_sum(:) = 0.0 ! Copy over uh and cell volume to working arrays do k=1,nz ; do i=is-1,ie uh2d(I,k) = uh(I,j,k) enddo ; enddo do k=1,nz ; do i=is-2,ie+1 - h2d(i,k) = h(i,j,k)*G%areaT(i,j) + ! Subtract just a little bit of thickness to avoid roundoff errors + h2d(i,k) = max(h(i,j,k)*G%areaT(i,j)-min_h*G%areaT(i,j),min_h*G%areaT(i,j)) enddo ; enddo - do i=is-1,ie ; do k=1,nz + do i=is-1,ie + uh_sum = sum(uh2d(I,:)) + do k=1,nz uh_remain = uh2d(I,k) - - if(uh_remain<0.0) then - uh_neglect = G%areaT(i+1,j)*GV%Angstrom -! print *, "i, j, k, uh_remain, uh_neglect", i,j,k,uh_remain,uh_neglect - ! Set the amount in the layer with remaining fluxes to zero - ! This will get reset in the first iteration of the redistribution loop - uh2d(I,k) = 0.0 - ! Loop to distribute remaining flux in layers above + uh_neglect = GV%H_subroundoff*min(G%areaT(i,j),G%areaT(i+1,j)) + + if(uh_remain<-uh_neglect) then + ! Set the mass flux to zero. This will be refilled in the first iteration + uh2d(I,k) = 0.0 + do k_rev=k,1,-1 - hup = h2d(i+1,k_rev) - G%areaT(i+1,j)*GV%H_subroundoff + ! Calculate the lower bound of uh(I) hlos = max(uh2d(I+1,k_rev),0.0) - - uh_add = min(-0.5*hup,-hup+hlos,0.0) - uh_add = max(uh_add,uh_remain) - if(uh2d(I,k_rev)>0.0) call MOM_error(WARNING,"UH will switch signs because of redistribution") - if(uh_add-uh_neglect) exit enddo - if(abs(uh_remain)>uh_neglect) then + + if(uh_remain<-uh_neglect) then call MOM_error(WARNING,"Residual UH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") uh2d(I,k) = uh2d(I,k) + uh_remain endif - elseif (uh_remain>0.0) then - uh_neglect = G%areaT(i,j)*GV%Angstrom -! print *, "i, j, k, uh_remain, uh_neglect", i,j,k,uh_remain,uh_neglect - ! Set the amount in the layer with remaining fluxes to zero - ! This will get reset in the first iteration of the redistribution loop - uh2d(I,k) = 0.0 + + elseif (uh_remain>uh_neglect) then + ! Set the amount in the layer with remaining fluxes to zero. This will be reset + ! in the first iteration of the redistribution loop + uh2d(I,k) = 0.0 ! Loop to distribute remaining flux in layers above do k_rev=k,1,-1 - hup = h2d(i,k_rev) - G%areaT(i,j)*GV%H_subroundoff hlos = max(0.0,-uh2d(I-1,k_rev)) - uh_add = max(0.5*hup,hup-hlos,0.0) - uh_add = min(uh_add,uh_remain) - if(uh2d(I,k_rev)<0.0) call MOM_error(WARNING,"UH will switch signs because of redistribution") - if(uh_add>uh2d(I,k_rev)) then - uh_remain = uh_remain - (uh_add-uh2d(I,k_rev)) - uh2d(I,k_rev) = uh_add + ! Calculate the upper bound of uh(I) + uh_UB = max(0.5*h2d(i,k_rev), 0.5*h2d(i,k_rev)-hlos, 0.0) + ! Calculate the maximum amount that could be added + uh_max = uh_UB-uh2d(I,k_rev) + ! Calculate how much will actually be added to uh(I) + uh_add = min(uh_max,uh_remain) + ! Reduce the remaining flux + uh_remain = uh_remain - uh_add + uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add + if(uh_remainuh_neglect) then + if(kuh_neglect) then - call MOM_error(WARNING,"Residual UH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") - uh2d(I,k) = uh2d(I,k) + uh_remain + endif endif - - enddo ; enddo + enddo + if(abs(uh_sum-sum(uh2d(I,:)))>uh_neglect) then + print *, i,j,uh_sum,sum(uh2d(I,:)) + call MOM_error(WARNING,"Difference in column integrated UH") + endif + + enddo ! Update layer thicknesses at the end - do k=1,nz ; do i=is-2,ie+1 - h(i,j,k) = h(i,j,k) + (uh2d(I-1,k) - uh2d(I,k))/G%areaT(i,j) + do k=1,nz ; do i=is,ie + h(i,j,k) = (h(i,j,k)*G%areaT(i,j) + (uh2d(I-1,k) - uh2d(I,k)))/G%areaT(i,j) enddo ; enddo do k=1,nz ; do i=is-1,ie uh(I,j,k) = uh2d(I,k) @@ -732,6 +753,101 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) end subroutine distribute_residual_uh_upwards + !> In the case where offline advection has failed to converge, redistribute the u-flux + !! into layers above + subroutine distribute_residual_vh_upwards(G, GV, h, vh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h + real, dimension(SZIB_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh + + real, dimension(SZJB_(G),SZK_(G)) :: vh2d + real, dimension(SZJB_(G)) :: vh2d_sum + real, dimension(SZJ_(G),SZK_(G)) :: h2d + real, dimension(SZJ_(G)) :: h2d_sum + + real :: vh_neglect, vh_remain, vh_max, vh_add, vh_UB, vh_LB, vh_sum + real :: hup, hlos, min_h + integer :: i, j, k, m, is, ie, js, je, nz, k_rev + + ! Set index-related variables for fields on T-grid + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + min_h = 0.1*GV%Angstrom + + do i=is,ie + ! Copy over uh and cell volume to working arrays + do k=1,nz ; do j=js-1,je + vh2d(J,k) = vh(i,J,k) + enddo ; enddo + do k=1,nz ; do j=js-2,je+1 + h2d(j,k) = (h(i,j,k)-min_h)*G%areaT(i,j) + enddo ; enddo + + do j=js,je + vh_sum=sum(vh2d(J,:)) + do k=1,nz + vh_remain = vh2d(J,k) + vh_neglect = GV%H_subroundoff*min(G%areaT(i,j),G%areaT(i,j+1)) + if(vh_remain<0.0) then + ! Set the amount in the layer with remaining fluxes to zero. This will be reset + ! in the first iteration of the redistribution loop + vh2d(J,k) = 0.0 + do k_rev=k,1,-1 + ! Calculate the lower bound of uh(I) + hlos = max(vh2d(J+1,k_rev),0.0) + vh_LB = min(-0.5*h2d(j+1,k_rev), -0.5*h2d(j+1,k_rev)+hlos, 0.0) + ! Calculate the maximum amount that could be added + vh_max = vh_LB-vh2d(J,k_rev) + ! Calculate how much will actually be added to uh(I) + vh_add = max(vh_max,vh_remain) + ! Reduce the remaining flux + vh_remain = vh_remain - vh_add + vh2d(J,k_rev) = vh2d(J,k_rev) + vh_add + if(vh_remain>-vh_neglect) exit + + enddo + if(vh_remain<-vh_neglect) then + call MOM_error(WARNING,"Residual VH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") + vh2d(J,k) = vh2d(J,k) + vh_remain + endif + elseif (vh_remain>0.0) then + ! Set the amount in the layer with remaining fluxes to zero. This will be reset + ! in the first iteration of the redistribution loop + vh2d(J,k) = 0 + ! Loop to distribute remaining flux in layers above + do k_rev=k,1,-1 + hlos = max(-vh2d(J-1,k_rev),0.0) + ! Calculate the upper bound of uh(I) + vh_UB = max(0.5*h2d(j,k_rev), 0.5*h2d(j,k_rev)-hlos, 0.0) + ! Calculate the maximum amount that could be added + vh_max = vh_UB-vh2d(J,k_rev) + ! Calculate how much will actually be added to uh(I) + vh_add = min(vh_max,vh_remain) + ! Reduce the remaining flux + vh_remain = vh_remain - vh_add + vh2d(J,k_rev) = vh2d(J,k_rev) + vh_add + if(vh_remainvh_neglect) then + call MOM_error(WARNING,"Residual VH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") + vh2d(J,k) = vh2d(J,k) + vh_remain + endif + endif + enddo + + enddo + + ! Update layer thicknesses at the end + do k=1,nz ; do j=js,je + h(i,j,k) = (h(i,j,k)*G%areaT(i,j) + (vh2d(J-1,k) - vh2d(J,k)))/G%areaT(i,j) + enddo ; enddo + do k=1,nz ; do j=js-1,je + vh(i,J,k) = vh2d(J,k) + enddo ; enddo + enddo + + end subroutine distribute_residual_vh_upwards !> \namespace mom_offline_transport !! \section offline_overview Offline Tracer Transport in MOM6 From 8fc16983b788276bb66abe72219b7855c720bdf6 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 24 Oct 2016 11:13:27 -0400 Subject: [PATCH 63/65] Tested both barotropic and upwards options for redistributing residual mass fluxes with OM4_05 --- src/tracer/MOM_offline_control.F90 | 47 +++++++++++++----------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index b782f57432..279df71e63 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -284,10 +284,14 @@ subroutine offline_transport_init(param_file, CS, diabatic_aux_CSp, G, GV) call get_param(param_file, mod, "NUMTIME", CS%numtime, & "Number of timelevels in offline input files", default=0) call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & - "True if the time-averaged fields and snapshot fields are offset by one time level", & - default=.false.) + "True if the time-averaged fields and snapshot fields\n"//& + "are offset by one time level", default=.false.) call get_param(param_file, mod, "REDISTRIBUTE_METHOD", CS%redistribute_method, & - "Redistributes any remaining horizontal fluxes throughout the rest of water column", & + "Redistributes any remaining horizontal fluxes throughout\n"//& + "the rest of water column. Options are 'barotropic' which\n"//& + "evenly distributes flux throughout the entire water column,\n"//& + "'upwards' which adds the maximum of the remaining flux in\n"//& + "each layer above, and 'none' which does no redistribution", & default='barotropic') call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion" ) @@ -700,12 +704,6 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) if(uh_remain>-uh_neglect) exit enddo - if(uh_remain<-uh_neglect) then - call MOM_error(WARNING,"Residual UH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") - uh2d(I,k) = uh2d(I,k) + uh_remain - endif - - elseif (uh_remain>uh_neglect) then ! Set the amount in the layer with remaining fluxes to zero. This will be reset ! in the first iteration of the redistribution loop @@ -725,20 +723,16 @@ subroutine distribute_residual_uh_upwards(G, GV, h, uh) if(uh_remainuh_neglect) then - if(kuh_neglect) then + if(kuh_neglect) then - print *, i,j,uh_sum,sum(uh2d(I,:)) - call MOM_error(WARNING,"Difference in column integrated UH") - endif enddo @@ -807,10 +801,6 @@ subroutine distribute_residual_vh_upwards(G, GV, h, vh) if(vh_remain>-vh_neglect) exit enddo - if(vh_remain<-vh_neglect) then - call MOM_error(WARNING,"Residual VH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") - vh2d(J,k) = vh2d(J,k) + vh_remain - endif elseif (vh_remain>0.0) then ! Set the amount in the layer with remaining fluxes to zero. This will be reset ! in the first iteration of the redistribution loop @@ -829,9 +819,12 @@ subroutine distribute_residual_vh_upwards(G, GV, h, vh) vh2d(J,k_rev) = vh2d(J,k_rev) + vh_add if(vh_remainvh_neglect) then - call MOM_error(WARNING,"Residual VH remains after redistribution. Tracer will not be conserved. Increase NUM_OFF_ITER") - vh2d(J,k) = vh2d(J,k) + vh_remain + endif + if(abs(vh_remain)>vh_neglect) then + if(k Date: Mon, 24 Oct 2016 13:25:08 -0400 Subject: [PATCH 64/65] Merged in commits from dev/offline_tracers which introduce two different ways of dealing with residual mass fluxes if advection fails to converge --- src/tracer/MOM_offline_control.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/tracer/MOM_offline_control.F90 b/src/tracer/MOM_offline_control.F90 index 279df71e63..88a2582204 100644 --- a/src/tracer/MOM_offline_control.F90 +++ b/src/tracer/MOM_offline_control.F90 @@ -889,6 +889,8 @@ end subroutine distribute_residual_vh_upwards !! number of iterations has been reached !! END ITERATION !! -# Repeat steps 1 and 2 +!! -# Redistribute any residual mass fluxes that remain after the advection iterations +!! in a barotropic manner, progressively upward through the water column. !! -# Force a remapping to the stored layer thicknesses that correspond to the snapshot of !! the online model at the end of an accumulation interval !! -# Reset T/S and h to their stored snapshotted values to prevent model drift @@ -914,6 +916,10 @@ end subroutine distribute_residual_vh_upwards !! - FIELDS_ARE_OFFSET: True if the time-averaged fields and snapshot fields are offset by one !! time level, probably not needed !! -NUM_OFF_ITER: Maximum number of iterations to do for the nonlinear advection scheme +!! -REDISTRIBUTE_METHOD: Redistributes any remaining horizontal fluxes throughout the rest of water column. +!! Options are 'barotropic' which "evenly distributes flux throughout the entire water +!! column,'upwards' which adds the maximum of the remaining flux in each layer above, +!! and 'none' which does no redistribution" end module MOM_offline_transport From 4a728ca98c25678e938fc3f58a8f0cb0b3bf8d27 Mon Sep 17 00:00:00 2001 From: Andrew Shao Date: Mon, 24 Oct 2016 15:00:26 -0400 Subject: [PATCH 65/65] Make sure that logical flag 'converged' is initialized to .false. every call of step_tracers --- src/core/MOM.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 6d8cccbff6..edd8b2c500 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1458,7 +1458,7 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) zero_3dh ! integer :: niter, iter real :: Inum_iter, dt_iter - logical :: converged = .false. + logical :: converged integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. integer :: IsdB, IedB, JsdB, JedB @@ -1501,6 +1501,9 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) eatr_sub(:,:,:) = 0.0 ebtr_sub(:,:,:) = 0.0 + ! Initialize logicals + converged = .false. + call cpu_clock_begin(id_clock_tracer) call enable_averaging(time_interval, Time_start+set_time(int(time_interval)), CS%diag)