Skip to content

Commit

Permalink
Merge pull request #76 from gustavo-marques/merge-candidate-2018-07-16
Browse files Browse the repository at this point in the history 
Merge candidate 2018 07 16
  • Loading branch information
@alperaltuntas
alperaltuntas authored Aug 3, 2018
2 parents 02d9be2 + 0a55527 commit 12011de
Show file tree
Hide file tree
Showing 177 changed files with 11,701 additions and 14,199 deletions.
141 changes: 66 additions & 75 deletions config_src/coupled_driver/MOM_surface_forcing.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -61,9 +61,6 @@ module MOM_surface_forcing
logical :: use_temperature ! If true, temp and saln used as state variables
real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress (nondim).

! smg: remove when have A=B code reconciled
logical :: bulkmixedlayer ! If true, model based on bulk mixed layer code

real :: Rho0 ! Boussinesq reference density (kg/m^3)
real :: area_surf = -1.0 ! total ocean surface area (m^2)
real :: latent_heat_fusion ! latent heat of fusion (J/kg)
Expand Down Expand Up @@ -114,7 +111,7 @@ module MOM_surface_forcing
logical :: adjust_net_srestore_by_scaling ! adjust srestore w/o moving zero contour
logical :: adjust_net_fresh_water_to_zero ! adjust net surface fresh-water (w/ restoring) to zero
logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW
logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour
logical :: adjust_net_fresh_water_by_scaling ! adjust net surface fresh-water w/o moving zero contour
logical :: mask_srestore_under_ice ! If true, use an ice mask defined by frazil
! criteria for salinity restoring.
real :: ice_salt_concentration ! salt concentration for sea ice (kg/kg)
Expand Down Expand Up @@ -203,8 +200,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, CS, &
type(ice_ocean_boundary_type), &
target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive
!! the ocean in a coupled model
type(forcing), intent(inout) :: fluxes !< A structure containing pointers to
!! all possible mass, heat or salt flux forcing fields.
type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all
!! possible mass, heat or salt flux forcing fields.
!! Unused fields have NULL ptrs.
integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB.
type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the
Expand Down Expand Up @@ -950,46 +947,41 @@ subroutine apply_force_adjustments(G, CS, Time, forces)

end subroutine apply_force_adjustments

!> Save any restart files associated with the surface forcing.
subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, &
filename_suffix)
type(surface_forcing_CS), pointer :: CS
type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned
!! by a previous call to surface_forcing_init
type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure
type(time_type), intent(in) :: Time
character(len=*), intent(in) :: directory
logical, optional, intent(in) :: time_stamped
character(len=*), optional, intent(in) :: filename_suffix
! Arguments: CS - A pointer to the control structure returned by a previous
! call to surface_forcing_init.
! (in) G - The ocean's grid structure.
! (in) Time - The model time at this call. This is needed for mpp_write calls.
! (in, opt) directory - An optional directory into which to write these restart files.
! (in, opt) time_stamped - If true, the restart file names include
! a unique time stamp. The default is false.
! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append
! to the restart file names.
type(time_type), intent(in) :: Time !< The current model time
character(len=*), intent(in) :: directory !< The directory into which to write the
!! restart files
logical, optional, intent(in) :: time_stamped !< If true, the restart file names include
!! a unique time stamp. The default is false.
character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-
!! stamp) to append to the restart file names.

if (.not.associated(CS)) return
if (.not.associated(CS%restart_CSp)) return
call save_restart(directory, Time, G, CS%restart_CSp, time_stamped)

end subroutine forcing_save_restart

!> Initialize the surface forcing, including setting parameters and allocating permanent memory.
subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, restore_temp)
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(inout) :: diag
type(surface_forcing_CS), pointer :: CS
logical, optional, intent(in) :: restore_salt, restore_temp
! 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
! model parameter values.
! (in) diag - A structure that is used to regulate diagnostic output.
! (in/out) CS - A pointer that is set to point to the control structure
! for this module
! (in) restore_salt - If present and true, salinity restoring will be
! applied in this model.
type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate
!! diagnostic output
type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control
!! structure for this module
logical, optional, intent(in) :: restore_salt !< If present and true surface salinity
!! restoring will be applied in this model.
logical, optional, intent(in) :: restore_temp !< If present and true surface temperature
!! restoring will be applied in this model.

! Local variables
real :: utide ! The RMS tidal velocity, in m s-1.
type(directories) :: dirs
logical :: new_sim, iceberg_flux_diags
Expand Down Expand Up @@ -1081,11 +1073,6 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"limited by max_p_surf instead of the full atmospheric \n"//&
"pressure.", default=.true.)

! smg: should get_param call should be removed when have A=B code reconciled.
! this param is used to distinguish how to diagnose surface heat content from water.
call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, &
default=CS%use_temperature,do_not_log=.true.)

call get_param(param_file, mdl, "WIND_STAGGER", stagger, &
"A case-insensitive character string to indicate the \n"//&
"staggering of the input wind stress field. Valid \n"//&
Expand Down Expand Up @@ -1161,7 +1148,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
"The name of the surface temperature variable to read from "//&
"SST_RESTORE_FILE for restoring sst.", &
default="temp")
! Convert CS%Flux_const from m day-1 to m s-1.
! Convert CS%Flux_const from m day-1 to m s-1.
CS%Flux_const = CS%Flux_const / 86400.0

call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, &
Expand Down Expand Up @@ -1312,13 +1299,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res
call cpu_clock_end(id_clock_forcing)
end subroutine surface_forcing_init

!> Clean up and deallocate any memory associated with this module and its children.
subroutine surface_forcing_end(CS, fluxes)
type(surface_forcing_CS), pointer :: CS
type(forcing), optional, intent(inout) :: fluxes
! Arguments: CS - A pointer to the control structure returned by a previous
! call to surface_forcing_init, it will be deallocated here.
! (inout) fluxes - A structure containing pointers to any possible
! forcing fields. Unused fields have NULL ptrs.
type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by
!! a previous call to surface_forcing_init, it will
!! be deallocated here.
type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all
!! possible mass, heat or salt flux forcing fields.
!! If present, it will be deallocated here.

if (present(fluxes)) call deallocate_forcing_type(fluxes)

Expand All @@ -1329,40 +1317,43 @@ subroutine surface_forcing_end(CS, fluxes)

end subroutine surface_forcing_end

!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type
subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)

character(len=*), intent(in) :: id
integer , intent(in) :: timestep
type(ice_ocean_boundary_type), intent(in) :: iobt
integer :: n,m, outunit

outunit = stdout()

write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir)
write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif)
write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir)
write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif)
write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff )
write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
if (associated(iobt%ustar_berg)) &
write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
if (associated(iobt%area_berg)) &
write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
if (associated(iobt%mass_berg)) &
write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
character(len=*), intent(in) :: id !< An identifying string for this call
integer, intent(in) :: timestep !< The number of elapsed timesteps
type(ice_ocean_boundary_type), &
intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the
!! ocean in a coupled model whose checksums are reported
integer :: n,m, outunit

outunit = stdout()

write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep
write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux )
write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux )
write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux )
write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux )
write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux )
write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux )
write(outunit,100) 'iobt%sw_flux_vis_dir', mpp_chksum( iobt%sw_flux_vis_dir)
write(outunit,100) 'iobt%sw_flux_vis_dif', mpp_chksum( iobt%sw_flux_vis_dif)
write(outunit,100) 'iobt%sw_flux_nir_dir', mpp_chksum( iobt%sw_flux_nir_dir)
write(outunit,100) 'iobt%sw_flux_nir_dif', mpp_chksum( iobt%sw_flux_nir_dif)
write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec )
write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec )
write(outunit,100) 'iobt%runoff ', mpp_chksum( iobt%runoff )
write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving )
write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p )
if (associated(iobt%ustar_berg)) &
write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg )
if (associated(iobt%area_berg)) &
write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg )
if (associated(iobt%mass_berg)) &
write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg )
100 FORMAT(" CHECKSUM::",A20," = ",Z20)

call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')

end subroutine ice_ocn_bnd_type_chksum

Expand Down
61 changes: 27 additions & 34 deletions config_src/coupled_driver/coupler_util.F90
View file
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
!> Provides a couple of interfaces to allow more transparent and
!! robust extraction of the various fields in the coupler types.
module coupler_util

! This file is part of MOM6. See LICENSE.md for the license.

! This code provides a couple of interfaces to allow more transparent and
! robust extraction of the various fields in the coupler types.
use MOM_error_handler, only : MOM_error, FATAL, WARNING
use coupler_types_mod, only : coupler_2d_bc_type, ind_flux, ind_alpha
use coupler_types_mod, only : ind_csurf
Expand All @@ -15,24 +15,20 @@ module coupler_util

contains

!> Extract an array of values in a coupler bc type
subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &
is, ie, js, je, conversion)
type(coupler_2d_bc_type), intent(in) :: BC_struc
integer, intent(in) :: BC_index, BC_element
real, dimension(:,:), intent(out) :: array_out
integer, optional, intent(in) :: is, ie, js, je
real, optional, intent(in) :: conversion
! Arguments: BC_struc - The type from which the data is being extracted.
! (in) BC_index - The boundary condition number being extracted.
! (in) BC_element - The element of the boundary condition being extracted.
! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
! (out) array_out - The array being filled with the input values.
! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
! These must match the size of the corresponding value array or an
! error message is issued.
! (in, opt) conversion - A number that every element is multiplied by, to
! permit sign convention or unit conversion.

type(coupler_2d_bc_type), intent(in) :: BC_struc !< The type from which the data is being extracted.
integer, intent(in) :: BC_index !< The boundary condition number being extracted.
integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
real, dimension(:,:), intent(out) :: array_out !< The array being filled with the input values.
integer, optional, intent(in) :: is !< Start i-index
integer, optional, intent(in) :: ie !< End i-index
integer, optional, intent(in) :: js !< Start j-index
integer, optional, intent(in) :: je !< End j-index
real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
!! permit sign convention or unit conversion.
! Local variables
real, pointer, dimension(:,:) :: Array_in
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
Expand Down Expand Up @@ -78,24 +74,21 @@ subroutine extract_coupler_values(BC_struc, BC_index, BC_element, array_out, &

end subroutine extract_coupler_values

!> Set an array of values in a coupler bc type
subroutine set_coupler_values(array_in, BC_struc, BC_index, BC_element, &
is, ie, js, je, conversion)
real, dimension(:,:), intent(in) :: array_in
type(coupler_2d_bc_type), intent(inout) :: BC_struc
integer, intent(in) :: BC_index, BC_element
integer, optional, intent(in) :: is, ie, js, je
real, optional, intent(in) :: conversion
! Arguments: array_in - The array containing the values to load into the BC.
! (out) BC_struc - The type into which the data is being loaded.
! (in) BC_index - The boundary condition number being extracted.
! (in) BC_element - The element of the boundary condition being extracted.
! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
! (in, opt) is, ie, js, je - The i- and j- limits of array_out to be filled.
! These must match the size of the corresponding value array or an
! error message is issued.
! (in, opt) conversion - A number that every element is multiplied by, to
! permit sign convention or unit conversion.

real, dimension(:,:), intent(in) :: array_in !< The array containing the values to load into the BC.
type(coupler_2d_bc_type), intent(inout) :: BC_struc !< The type from which the data is being extracted.
integer, intent(in) :: BC_index !< The boundary condition number being extracted.
integer, intent(in) :: BC_element !< The element of the boundary condition being extracted.
!! This could be ind_csurf, ind_alpha, ind_flux or ind_deposition.
integer, optional, intent(in) :: is !< Start i-index
integer, optional, intent(in) :: ie !< End i-index
integer, optional, intent(in) :: js !< Start j-index
integer, optional, intent(in) :: je !< End j-index
real, optional, intent(in) :: conversion !< A number that every element is multiplied by, to
!! permit sign convention or unit conversion.
! Local variables
real, pointer, dimension(:,:) :: Array_out
real :: conv
integer :: i, j, is0, ie0, js0, je0, i_offset, j_offset
Expand Down
Loading

0 comments on commit 12011de

Please sign in to comment.