Skip to content

Commit

Permalink
Merge pull request #764 from Hallberg-NOAA/code_standardization
Browse files Browse the repository at this point in the history 
Code standardization and dOxyGenization of framework code
  • Loading branch information
@adcroft
adcroft authored May 9, 2018
2 parents 999e343 + c8ff495 commit 12d2eff
Show file tree
Hide file tree
Showing 109 changed files with 2,130 additions and 1,601 deletions.
14 changes: 7 additions & 7 deletions config_src/coupled_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -305,7 +305,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
do j=js-2,je+2 ; do i=is-2,ie+2
fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j)
fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j)
enddo; enddo
enddo ; enddo

if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed)

Expand Down Expand Up @@ -353,15 +353,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice
do j=js,je ; do i=is,ie
if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0
enddo; enddo
enddo ; enddo
endif
if (CS%salt_restore_as_sflux) then
do j=js,je ; do i=is,ie
delta_sss = data_restore(i,j)- sfc_state%SSS(i,j)
delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore)
fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* &
(CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1
enddo; enddo
enddo ; enddo
if (CS%adjust_net_srestore_to_zero) then
if (CS%adjust_net_srestore_by_scaling) then
call adjust_area_mean_to_zero(fluxes%salt_flux, G, fluxes%saltFluxGlobalScl)
Expand All @@ -382,7 +382,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
(CS%Rho0*CS%Flux_const) * &
delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j)))
endif
enddo; enddo
enddo ; enddo
if (CS%adjust_net_srestore_to_zero) then
if (CS%adjust_net_srestore_by_scaling) then
call adjust_area_mean_to_zero(fluxes%vprec, G, fluxes%vPrecGlobalScl)
Expand All @@ -392,7 +392,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
fluxes%vPrecGlobalAdj = reproducing_sum(work_sum(:,:), isr, ier, jsr, jer) / CS%area_surf
do j=js,je ; do i=is,ie
fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%vPrecGlobalAdj ) * G%mask2dT(i,j)
enddo; enddo
enddo ; enddo
endif
endif
endif
Expand Down Expand Up @@ -536,12 +536,12 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
call adjust_area_mean_to_zero(net_FW2, G, fluxes%netFWGlobalScl)
do j=js,je ; do i=is,ie
fluxes%vprec(i,j) = fluxes%vprec(i,j) + (net_FW2(i,j) - net_FW(i,j)/G%areaT(i,j)) * G%mask2dT(i,j)
enddo; enddo
enddo ; enddo
else
fluxes%netFWGlobalAdj = reproducing_sum(net_FW(:,:), isr, ier, jsr, jer) / CS%area_surf
do j=js,je ; do i=is,ie
fluxes%vprec(i,j) = ( fluxes%vprec(i,j) - fluxes%netFWGlobalAdj ) * G%mask2dT(i,j)
enddo; enddo
enddo ; enddo
endif

endif
Expand Down
4 changes: 2 additions & 2 deletions config_src/coupled_driver/ocean_model_MOM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1079,9 +1079,9 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc)
case('mask')
array2D(isc:,jsc:) = OS%grid%mask2dT(g_isc:g_iec,g_jsc:g_jec)
!OR same result
! do j=g_jsc,g_jec; do i=g_isc,g_iec
! do j=g_jsc,g_jec ; do i=g_isc,g_iec
! array2D(isc+i-g_isc,jsc+j-g_jsc) = OS%grid%mask2dT(i,j)
! enddo; enddo
! enddo ; enddo
case('t_surf')
array2D(isc:,jsc:) = Ocean%t_surf(isc:,jsc:)-CELSIUS_KELVIN_OFFSET
case('t_pme')
Expand Down
111 changes: 70 additions & 41 deletions config_src/ice_solo_driver/coupler_types.F90
View file

Large diffs are not rendered by default.

3 changes: 2 additions & 1 deletion config_src/ice_solo_driver/ice_shelf_driver.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -265,7 +265,8 @@ program SHELF_main
Time_end = daymax
endif

if (is_root_pe()) print *,"Time_step_shelf", time_type_to_real(Time_step_shelf), "TIme_end", time_type_to_real(Time_end)
if (is_root_pe()) print *,"Time_step_shelf", time_type_to_real(Time_step_shelf), &
"TIme_end", time_type_to_real(Time_end)
if (Time >= Time_end) call MOM_error(FATAL, &
"MOM_driver: The run has been started at or after the end time of the run.")

Expand Down
106 changes: 55 additions & 51 deletions config_src/ice_solo_driver/user_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,8 @@ module user_surface_forcing
!* *
!* USER_buoyancy forcing is used to set the surface buoyancy *
!* forcing, which may include a number of fresh water flux fields *
!* (evap, liq_precip, froz_precip, liq_runoff, froz_runoff, and *
!* virt_precip) and the surface heat fluxes (sw, lw, latent and sens) *
!* (evap, lprec, fprec, lrunoff, frunoff, and *
!* vprec) and the surface heat fluxes (sw, lw, latent and sens) *
!* if temperature and salinity are state variables, or it may simply *
!* be the buoyancy flux if it is not. This routine also has coded a *
!* restoring to surface values of temperature and salinity. *
Expand All @@ -44,13 +44,14 @@ module user_surface_forcing
!* *
!********+*********+*********+*********+*********+*********+*********+**
use MOM_diag_mediator, only : post_data, query_averaging_enabled
use MOM_diag_mediator, only : register_diag_field, diag_ctrl
use MOM_diag_mediator, only : register_diag_field, diag_ctrl, safe_alloc_ptr
use MOM_domains, only : pass_var, pass_vector, AGRID
use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_file_parser, only : get_param, param_file_type, log_version
use MOM_forcing_type, only : forcing, mech_forcing
use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing
use MOM_grid, only : ocean_grid_type
use MOM_io, only : file_exists, MOM_read_data
use MOM_io, only : file_exists, read_data
use MOM_time_manager, only : time_type, operator(+), operator(/), get_time
use MOM_tracer_flow_control, only : call_tracer_set_forcing
use MOM_tracer_flow_control, only : tracer_flow_control_CS
Expand Down Expand Up @@ -84,14 +85,17 @@ module user_surface_forcing

contains

!> This subroutine sets the surface wind stresses, forces%taux and forces%tauy.
!! These are the stresses in the direction of the model grid (i.e. the same
!! direction as the u- and v- velocities.) They are both in Pa.
subroutine USER_wind_forcing(sfc_state, forces, day, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
type(time_type), intent(in) :: day
type(time_type), intent(in) :: day !< The time of the fluxes
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by
!! a previous call to user_surface_forcing_init
type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned
!! by a previous call to user_surface_forcing_init

! This subroutine sets the surface wind stresses, forces%taux and forces%tauy.
! These are the stresses in the direction of the model grid (i.e. the same
Expand Down Expand Up @@ -121,6 +125,9 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, 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

! Allocate the forcing arrays, if necessary.
call allocate_mech_forcing(G, forces, stress=.true., ustar=.true.)

! Set the surface wind stresses, in units of Pa. A positive taux
! accelerates the ocean to the (pseudo-)east.

Expand All @@ -144,15 +151,19 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, CS)

end subroutine USER_wind_forcing

!> This subroutine specifies the current surface fluxes of buoyancy or
!! temperature and fresh water. It may also be modified to add
!! surface fluxes of user provided tracers.
subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
type(surface), intent(inout) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
type(forcing), intent(inout) :: fluxes
type(time_type), intent(in) :: day
!! describe the surface state of the ocean.
type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
type(time_type), intent(in) :: day !< The time of the fluxes
real, intent(in) :: dt !< The amount of time over which
!! the fluxes apply, in s
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(user_surface_forcing_CS), pointer :: CS
type(user_surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned
!! by a previous call to user_surface_forcing_init

! This subroutine specifies the current surface fluxes of buoyancy or
! temperature and fresh water. It may also be modified to add
Expand All @@ -161,9 +172,9 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
! When temperature is used, there are long list of fluxes that need to be
! set - essentially the same as for a full coupled model, but most of these
! can be simply set to zero. The net fresh water flux should probably be
! set in fluxes%evap and fluxes%liq_precip, with any salinity restoring
! appearing in fluxes%virt_precip, and the other water flux components
! (froz_precip, liq_runoff and froz_runoff) left as arrays full of zeros.
! set in fluxes%evap and fluxes%lprec, with any salinity restoring
! appearing in fluxes%vprec, and the other water flux components
! (fprec, lrunoff and frunoff) left as arrays full of zeros.
! Evap is usually negative and precip is usually positive. All heat fluxes
! are in W m-2 and positive for heat going into the ocean. All fresh water
! fluxes are in kg m-2 s-1 and positive for water moving into the ocean.
Expand Down Expand Up @@ -201,19 +212,19 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
! Allocate and zero out the forcing arrays, as necessary. This portion is
! usually not changed.
if (CS%use_temperature) then
call alloc_if_needed(fluxes%evap, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%liq_precip, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%froz_precip, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%liq_runoff, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%froz_runoff, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%virt_precip, isd, ied, jsd, jed)

call alloc_if_needed(fluxes%sw, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%lw, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%latent, isd, ied, jsd, jed)
call alloc_if_needed(fluxes%sens, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%evap, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%lprec, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%fprec, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%lrunoff, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%frunoff, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%vprec, isd, ied, jsd, jed)

call safe_alloc_ptr(fluxes%sw, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%lw, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%latent, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%sens, isd, ied, jsd, jed)
else ! This is the buoyancy only mode.
call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%buoy, isd, ied, jsd, jed)
endif


Expand All @@ -226,10 +237,10 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
! Fluxes of fresh water through the surface are in units of kg m-2 s-1
! and are positive downward - i.e. evaporation should be negative.
fluxes%evap(i,j) = -0.0 * G%mask2dT(i,j)
fluxes%liq_precip(i,j) = 0.0 * G%mask2dT(i,j)
fluxes%lprec(i,j) = 0.0 * G%mask2dT(i,j)

! virt_precip will be set later, if it is needed for salinity restoring.
fluxes%virt_precip(i,j) = 0.0
! vprec will be set later, if it is needed for salinity restoring.
fluxes%vprec(i,j) = 0.0

! Heat fluxes are in units of W m-2 and are positive into the ocean.
fluxes%lw(i,j) = 0.0 * G%mask2dT(i,j)
Expand All @@ -247,7 +258,7 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)

if (CS%restorebuoy) then
if (CS%use_temperature) then
call alloc_if_needed(fluxes%heat_restore, isd, ied, jsd, jed)
call safe_alloc_ptr(fluxes%heat_added, isd, ied, jsd, jed)
! When modifying the code, comment out this error message. It is here
! so that the original (unmodified) version is not accidentally used.
call MOM_error(FATAL, "User_buoyancy_surface_forcing: " // &
Expand All @@ -260,9 +271,9 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)
Temp_restore = 0.0
Salin_restore = 0.0

fluxes%heat_restore(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * &
fluxes%heat_added(i,j) = (G%mask2dT(i,j) * (rhoXcp * CS%Flux_const)) * &
(Temp_restore - sfc_state%SST(i,j))
fluxes%virt_precip(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * &
fluxes%vprec(i,j) = - (G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)) * &
((Salin_restore - sfc_state%SSS(i,j)) / &
(0.5 * (Salin_restore + sfc_state%SSS(i,j))))
enddo ; enddo
Expand All @@ -287,24 +298,15 @@ subroutine USER_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS)

end subroutine USER_buoyancy_forcing

subroutine alloc_if_needed(ptr, isd, ied, jsd, jed)
! If ptr is not associated, this routine allocates it with the given size
! and zeros out its contents. This is equivalent to safe_alloc_ptr in
! MOM_diag_mediator, but is here so as to be completely transparent.
real, pointer :: ptr(:,:)
integer :: isd, ied, jsd, jed
if (.not.associated(ptr)) then
allocate(ptr(isd:ied,jsd:jed))
ptr(:,:) = 0.0
endif
end subroutine alloc_if_needed

!> This subroutine initializes the USER_surface_forcing module
subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS)
type(time_type), intent(in) :: Time
type(time_type), intent(in) :: Time !< The current model time
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters
type(diag_ctrl), target, intent(in) :: diag
type(user_surface_forcing_CS), pointer :: CS
type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output.
type(user_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to
!! the control structure for this module

! Arguments: Time - The current model time.
! (in) G - The ocean's grid structure.
! (in) param_file - A structure indicating the open file to parse for
Expand All @@ -330,18 +332,20 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS)
call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, &
"If true, Temperature and salinity are used as state \n"//&
"variables.", default=.true.)

call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, &
"The gravitational acceleration of the Earth.", &
units="m s-2", default = 9.80)
call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, &
"The background gustiness in the winds.", units="Pa", &
default=0.02)
call get_param(param_file, mdl, "RHO_0", CS%Rho0, &
"The mean ocean density used with BOUSSINESQ true to \n"//&
"calculate accelerations and the mass for conservation \n"//&
"properties, or with BOUSSINSEQ false to convert some \n"//&
"parameters from vertical units of m to kg m-2.", &
units="kg m-3", default=1035.0)
call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, &
"The background gustiness in the winds.", units="Pa", &
default=0.02)

call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, &
"If true, the buoyancy fluxes drive the model back \n"//&
"toward some specified surface state with a rate \n"//&
Expand Down
9 changes: 6 additions & 3 deletions config_src/mct_driver/ocn_comp_mct.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1622,7 +1622,8 @@ subroutine ocn_run_mct( EClock, cdata_o, x2o_o, o2x_o)
glb%ocn_state%dirs%restart_output_dir, .true.)
! Once we start using the ice shelf module, the following will be needed
if (glb%ocn_state%use_ice_shelf) then
call ice_shelf_save_restart(glb%ocn_state%Ice_shelf_CSp, glb%ocn_state%Time, glb%ocn_state%dirs%restart_output_dir, .true.)
call ice_shelf_save_restart(glb%ocn_state%Ice_shelf_CSp, glb%ocn_state%Time, &
glb%ocn_state%dirs%restart_output_dir, .true.)
endif

endif
Expand Down Expand Up @@ -1732,7 +1733,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, &
! GMM, check ocean_model_MOM.F90 to enable the following option
!if (OS%icebergs_apply_rigid_boundary) then
! This assumes that the iceshelf and ocean are on the same grid. I hope this is true.
! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, &
! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
!endif

! Indicate that there are new unused fluxes.
Expand All @@ -1752,7 +1754,8 @@ subroutine update_ocean_model(OS, Ocean_sfc, time_start_update, &
! GMM, check ocean_model_MOM.F90 to enable the following option
!if (OS%icebergs_apply_rigid_boundary) then
!This assumes that the iceshelf and ocean are on the same grid. I hope this is true
! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg,OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, &
! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold)
!endif

! Accumulate the forcing over time steps
Expand Down
Loading

0 comments on commit 12d2eff

Please sign in to comment.