From ebccf60af7ed275dfbe17645fdb86e8fca067f47 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 4 Mar 2018 13:46:06 -0900 Subject: [PATCH 001/261] Resolving merge --- src/core/MOM_open_boundary.F90 | 59 +++++++++++++++++----------------- 1 file changed, 29 insertions(+), 30 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index dfc4dce29b..c9eee7cdda 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -18,7 +18,7 @@ module MOM_open_boundary use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_obsolete_params, only : obsolete_logical, obsolete_int, obsolete_real, obsolete_char use MOM_string_functions, only : extract_word, remove_spaces -use MOM_tracer_registry, only : tracer_registry_type +use MOM_tracer_registry, only : tracer_type, tracer_registry_type, tracer_name_lookup use MOM_variables, only : thermo_var_ptrs use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init @@ -86,7 +86,7 @@ module MOM_open_boundary real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array real :: OBC_inflow_conc = 0.0 !< tracer concentration for generic inflows character(len=32) :: name !< tracer name used for error messages - type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer + type(tracer_type), pointer :: Tr => NULL() !< metadata describing the tracer real, dimension(:,:,:), pointer :: tres => NULL() !< tracer reservoir array logical :: is_initialized !< reservoir values have been set when True end type OBC_segment_tracer_type @@ -2441,21 +2441,22 @@ subroutine segment_tracer_registry_init(param_file, segment) end subroutine segment_tracer_registry_init -subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr, & +subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_scalar, OBC_array) - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(vardesc), intent(in) :: tr_desc !< metadata about the tracer - type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values - type(OBC_segment_type), intent(inout) :: segment !< current segment data structure - type(vardesc), target, optional :: tr_desc_ptr !< A target that can be used to set a pointer to the - !! stored value of tr%tr_desc. This target must be - !! an enduring part of the control structure, - !! because the tracer registry will use this memory, - !! but it also means that any updates to this - !! structure in the calling module will be - !! available subsequently to the tracer registry. - real, optional :: OBC_scalar !< If present, use scalar value for segment tracer inflow concentration. - logical, optional :: OBC_array !< If true, use array values for segment tracer inflow concentration. + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(tracer_type), target :: tr_ptr !< A target that can be used to set a pointer to the + !! stored value of tr. This target must be + !! an enduring part of the control structure, + !! because the tracer registry will use this memory, + !! but it also means that any updates to this + !! structure in the calling module will be + !! available subsequently to the tracer registry. + type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values + type(OBC_segment_type), intent(inout) :: segment !< current segment data structure + real, optional :: OBC_scalar !< If present, use scalar value for segment tracer + !! inflow concentration. + logical, optional :: OBC_array !< If true, use array values for segment tracer + !! inflow concentration. ! Local variables @@ -2464,7 +2465,6 @@ subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr integer :: IsdB, IedB, JsdB, JedB character(len=256) :: mesg ! Message for error messages. -! if (.not. associated(segment%tr_Reg)) call segment_tracer_registry_init(param_file, segment) call segment_tracer_registry_init(param_file, segment) if (segment%tr_Reg%ntseg>=MAX_FIELDS_) then @@ -2480,13 +2480,8 @@ subroutine register_segment_tracer(tr_desc, param_file, GV, segment, tr_desc_ptr IsdB = segment%HI%IsdB ; IedB = segment%HI%IedB JsdB = segment%HI%JsdB ; JedB = segment%HI%JedB - if (present(tr_desc_ptr)) then - segment%tr_Reg%Tr(ntseg)%vd => tr_desc_ptr - else - allocate(segment%tr_Reg%Tr(ntseg)%vd) ; segment%tr_Reg%Tr(ntseg)%vd = tr_desc - endif - - call query_vardesc(segment%tr_Reg%Tr(ntseg)%vd, name=segment%tr_Reg%Tr(ntseg)%name) + segment%tr_Reg%Tr(ntseg)%Tr => tr_ptr + segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name if (segment%tr_Reg%locked) call MOM_error(FATAL, & "MOM register_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//& @@ -2522,18 +2517,18 @@ subroutine segment_tracer_registry_end(Reg) endif end subroutine segment_tracer_registry_end -subroutine register_temp_salt_segments(GV, OBC, tv, vd_T, vd_S, param_file) +subroutine register_temp_salt_segments(GV, OBC, tr_Reg, param_file) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - type(vardesc), intent(in) :: vd_T !< Temperature descriptor - type(vardesc), intent(in) :: vd_S !< Salinity descriptor + type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry type(param_file_type), intent(in) :: param_file !< file to parse for model parameter values ! Local variables integer :: isd, ied, IsdB, IedB, jsd, jed, JsdB, JedB, nz, nf integer :: i, j, k, n + character(len=32) :: name type(OBC_segment_type), pointer :: segment => NULL() ! pointer to segment type list + type(tracer_type), pointer :: tr_ptr if (.not. associated(OBC)) return @@ -2544,9 +2539,13 @@ subroutine register_temp_salt_segments(GV, OBC, tv, vd_T, vd_S, param_file) if (associated(segment%tr_Reg)) & call MOM_error(FATAL,"register_temp_salt_segments: tracer array was previously allocated") - call register_segment_tracer(vd_T, param_file, GV, segment, & + name = 'Heat' + call tracer_name_lookup(tr_Reg, tr_ptr, name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_array=segment%temp_segment_data_exists) - call register_segment_tracer(vd_S, param_file, GV, segment, & + name = 'Salt' + call tracer_name_lookup(tr_Reg, tr_ptr, name) + call register_segment_tracer(tr_ptr, param_file, GV, segment, & OBC_array=segment%salt_segment_data_exists) enddo From 45442d5bcbaf1564a989c48e1d718a7c66a0b567 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 29 Apr 2018 10:15:45 -0800 Subject: [PATCH 002/261] Cleaning up last min/max on OBLIQUE --- src/core/MOM_open_boundary.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2317fbc146..1595ae42f7 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1464,11 +1464,11 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, dt) dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 if (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) > 0.0) then - ry_new = min(segment%grad_normal(J-1,1,k), rx_max) + ry_new = segment%grad_normal(J-1,1,k) elseif (dhdt*(segment%grad_normal(J,1,k) + segment%grad_normal(J-1,1,k)) == 0.0) then ry_new = 0.0 else - ry_new = min(segment%grad_normal(J,1,k), rx_max) + ry_new = segment%grad_normal(J,1,k) endif if (dhdt*dhdx < 0.0) dhdt = 0.0 Cx = dhdt*dhdx From e729a18c23a08db40939d58f381655a1fc4bc3f1 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Mon, 11 Jun 2018 14:00:02 -0400 Subject: [PATCH 003/261] doxygenize oda_driver --- src/ocean_data_assim/MOM_oda_driver.F90 | 73 ++++++++++++++----------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index de5a97363b..75eff8347e 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -1,23 +1,7 @@ +!> Interfaces for MOM6 ensembles and data assimilation. module MOM_oda_driver_mod -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! This is the top-level module for MOM6 ocean data assimilation. -! It can be used to gather an ensemble of ocean states -! before calling ensemble filter routines which calculate -! increments based on cross-ensemble co-variance. It can also -! be used to compare gridded model state variables to in-situ -! observations without applying DA incrementa. -! -! init_oda: Initialize the ODA module -! set_analysis_time : update time for performing next analysis -! set_prior: Store prior model state -! oda: call to filter -! get_posterior : returns posterior increments (or full state) for the current ensemble member -! -! Authors: Matthew.Harrison@noaa.gov -! Feiyu.Liu@noaa.gov and -! Tony.Rosati@noaa.gov -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! This file is part of MOM6. see LICENSE.md for the license. use fms_mod, only : open_namelist_file, close_file, check_nml_error use fms_mod, only : error_mesg, FATAL use mpp_mod, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe @@ -74,6 +58,7 @@ module MOM_oda_driver_mod #include + !> Control structure that contains a transpose of the ocean state across ensemble members. type, public :: ODA_CS; private type(ocean_control_struct), pointer :: Ocean_prior=> NULL() !< ensemble ocean prior states in DA space type(ocean_control_struct), pointer :: Ocean_posterior=> NULL() !< ensemble ocean posterior states @@ -110,24 +95,26 @@ module MOM_oda_driver_mod type(diag_ctrl) :: diag_cs ! pointer to a mpp_domain object type :: pointer_mpp_domain type(domain2d), pointer :: mpp_domain => NULL() end type pointer_mpp_domain - + !>@{ + !! DA parameters integer, parameter :: NO_ASSIM = 0, OI_ASSIM=1, EAKF_ASSIM=2 + !>@} contains -!V initialize First_guess (prior) and Analysis grid +!> initialize First_guess (prior) and Analysis grid !! information for all ensemble members -!! subroutine init_oda(Time, G, GV, CS) type(time_type), intent(in) :: Time !< The current model time. type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(ODA_CS), pointer, intent(inout) :: CS + type(ODA_CS), pointer, intent(inout) :: CS !< The DA control structure ! Local variables type(thermo_var_ptrs) :: tv_dummy @@ -325,6 +312,7 @@ subroutine init_oda(Time, G, GV, CS) call set_current_pelist(CS%ensemble_pelist(CS%ensemble_id,:)) end subroutine init_oda + !> Copy ensemble member tracers to ensemble vector. subroutine set_prior_tracer(Time, G, GV, h, tv, CS) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), pointer :: G !< domain and grid information for ocean model @@ -393,8 +381,7 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(:,:,:), pointer :: h !< Layer thicknesses, in H (usually m or kg m-2) type(thermo_var_ptrs), pointer :: tv !< A structure pointing to various thermodynamic variables - - logical, optional, intent(in) :: increment + logical, optional, intent(in) :: increment !< True if returning increment only type(ocean_grid_type), pointer :: Grid=>NULL() type(ocean_control_struct), pointer :: Ocean_increment=>NULL() @@ -458,13 +445,14 @@ subroutine get_posterior_tracer(Time, CS, G, GV, h, tv, increment) end subroutine get_posterior_tracer + !> Gather observations and sall ODA routines subroutine oda(Time, CS) - type(time_type), intent(in) :: Time - type(oda_CS), intent(inout) :: CS + type(time_type), intent(in) :: Time !< the current model time + type(oda_CS), intent(inout) :: CS !< the ocean DA control structure integer :: i, j integer :: m - integer :: yr, mon, day, hr, min, sec + integer :: yr, mon, day, hr, min, sec if ( Time >= CS%Time ) then @@ -484,11 +472,13 @@ subroutine oda(Time, CS) return end subroutine oda + !> Finalize DA module subroutine oda_end(CS) - type(ODA_CS), intent(inout) :: CS + type(ODA_CS), intent(inout) :: CS !< the ocean DA control structure end subroutine oda_end + !> Initialize DA module subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) type(ocean_control_struct), pointer :: CS !< Pointer to ODA control structure type(ocean_grid_type), pointer :: Grid !< Pointer to ocean analysis grid @@ -515,9 +505,10 @@ subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) return end subroutine init_ocean_ensemble + !> Set the next analysis time subroutine set_analysis_time(Time,CS) - type(time_type), intent(in) :: Time - type(ODA_CS), pointer, intent(inout) :: CS + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer, intent(inout) :: CS !< the DA control structure integer :: yr, mon, day, hr, min, sec @@ -538,9 +529,10 @@ subroutine set_analysis_time(Time,CS) end subroutine set_analysis_time + !> Write observation differences to a file subroutine save_obs_diff(filename,CS) - character(len=*), intent(in) :: filename - type(ODA_CS), pointer, intent(in) :: CS + character(len=*), intent(in) :: filename !< name of output file + type(ODA_CS), pointer, intent(in) :: CS !< pointer to DA control structure integer :: fid ! profile file handle type(ocean_profile_type), pointer :: Prof=>NULL() @@ -563,6 +555,8 @@ subroutine save_obs_diff(filename,CS) return end subroutine save_obs_diff + + !> Apply increments to tracers subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) real, intent(in) :: dt ! the tracer timestep (seconds) type(ocean_grid_type), intent(in) :: G !< ocean grid structure @@ -572,4 +566,19 @@ subroutine apply_oda_tracer_increments(dt,G,tv,h,CS) type(ODA_CS), intent(inout) :: CS !< the data assimilation structure end subroutine apply_oda_tracer_increments + +!> \namespace MOM_oda_driver_mod +!! +!! \section section_ODA The Ocean data assimilation (DA) and Ensemble Framework +!! +!! The DA framework implements ensemble capability in MOM6. Currently, this framework +!! is enabled using the cpp directive ENSEMBLE_OCEAN. The ensembles need to be generated +!! at the level of the calling routine for oda_init or above. The ensemble instances may +!! exist on overlapping or non-overlapping processors. The ensemble information is accessed +!! via the FMS ensemble manager. An independent PE layout is used to gather (prior) ensemble +!! member information where this information is stored in the ODA control structure. This +!! module was developed in collaboration with Feiyu Lu and Tony Rosati in the GFDL prediction +!! group for use in their coupled ensemble framework. These interfaces should be suitable for +!! interfacing MOM6 to other data assimilation packages as well. + end module MOM_oda_driver_mod From 130b056d67a504a44507ed7c24614595240d9e46 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Mon, 11 Jun 2018 16:49:24 -0400 Subject: [PATCH 004/261] doxygenize horizontal regridding --- src/framework/MOM_horizontal_regridding.F90 | 79 ++++++++++----------- 1 file changed, 36 insertions(+), 43 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index d4f8dbff57..43c93aa42d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -56,9 +56,9 @@ module MOM_horizontal_regridding subroutine myStats(array, missing, is, ie, js, je, k, mesg) - real, dimension(:,:), intent(in) :: array - real, intent(in) :: missing - integer :: is,ie,js,je,k + real, dimension(:,:), intent(in) :: array !< input array (ND) + real, intent(in) :: missing !< missing value (ND) + integer :: is,ie,js,je,k character(len=*) :: mesg ! Local variables real :: minA, maxA @@ -97,41 +97,26 @@ end subroutine myStats !! Then use a previous guess (prev). Optionally (smooth) !! blend the filled points to achieve a more desirable result. subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug,debug) - ! - !# Use ICE-9 algorithm to populate points (fill=1) with - !# valid data (good=1). If no information is available, - !# Then use a previous guess (prev). Optionally (smooth) - !# blend the filled points to achieve a more desirable result. - ! - ! (in) a : input 2-d array with missing values - ! (in) good : valid data mask for incoming array (1==good data; 0==missing data) - ! (in) fill : same shape array of points which need filling (1==please fill;0==leave it alone) - ! (in) prev : first guess where isolated holes exist, - ! use MOM_coms, only : sum_across_PEs type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: aout !< The array with missing values to fill - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: good !< Valid data mask for incoming array - !! (1==good data; 0==missing data). + real, dimension(SZI_(G),SZJ_(G)), & !< The array with missing values to fill + intent(inout) :: aout !! + real, dimension(SZI_(G),SZJ_(G)), & !< Valid data mask for incoming array + intent(in) :: good !! (1==good data; 0==missing data). real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: fill !< Same shape array of points which need - !! filling (1==please fill;0==leave - !! it alone). - real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: prev !< First guess where isolated holes exist. + !! filling (1==fill;0==dont fill) + + real, dimension(SZI_(G),SZJ_(G)), & !< First guess where isolated holes exist. + optional, intent(in) :: prev !! logical, optional, intent(in) :: smooth !< If present and true, apply a number of - !! Laplacian smoothing passes to the interpolated data - integer, optional, intent(in) :: num_pass !< The maximum number of smoothing passes - !! to apply. - real, optional, intent(in) :: relc !< A nondimensional relaxation coefficient for - !! the smoothing passes. - real, optional, intent(in) :: crit !< A minimal value for changes in the array - !! at which point the smoothing is stopped. + !! Laplacian iterations to the interpolated data + integer, optional, intent(in) :: num_pass !< The maximum number of iterations + real, optional, intent(in) :: relc !< A relaxation coefficient for Laplacian (ND) + real, optional, intent(in) :: crit !< A minimal value for deltas between iterations. logical, optional, intent(in) :: keep_bug !< Use an algorithm with a bug that dates - !! to the "sienna" code release. + !! to the "sienna" code release. logical, optional, intent(in) :: debug !< If true, write verbose debugging messages. @@ -276,6 +261,7 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug end subroutine fill_miss_2d +!> Extrapolate and interpolate from a file record subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, recnum, G, tr_z, mask_z, z_in, & z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) @@ -594,6 +580,7 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, end subroutine horiz_interp_and_extrap_tracer_record +!> Extrapolate and interpolate using a FMS time interpolation handle subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, tr_z, mask_z, z_in, & z_edges_in, missing_value, reentrant_x, tripolar_n, homogenize ) @@ -870,13 +857,15 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t enddo ! kd end subroutine horiz_interp_and_extrap_tracer_fms_id + + subroutine meshgrid(x,y,x_T,y_T) !< create a 2d-mesh of grid coordinates !! from 1-d arrays. -real, dimension(:), intent(in) :: x,y -real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T,y_T +real, dimension(:), intent(in) :: x,y !< input 1-dimensional vectors +real, dimension(size(x,1),size(y,1)), intent(inout) :: x_T,y_T !< output 2-dimensional arrays integer :: ni,nj,i,j @@ -893,13 +882,16 @@ subroutine meshgrid(x,y,x_T,y_T) return end subroutine meshgrid + + function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) ! ! fill grid edges ! -integer, dimension(:,:), intent(in) :: m -logical, intent(in) :: cyclic_x, tripolar_n -real, dimension(size(m,1),size(m,2)) :: m_real +integer, dimension(:,:), intent(in) :: m !< input array (ND) +logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant +logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold +real, dimension(size(m,1),size(m,2)) :: m_real real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp @@ -947,20 +939,21 @@ function fill_boundaries_real(m,cyclic_x,tripolar_n) result(mp) end function fill_boundaries_real -subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) !< Solve del2 (zi) = 0 using successive iterations !! with a 5 point stencil. Only points fill==1 are !! modified. Except where bad==1, information propagates !! isotropically in index space. The resulting solution !! in each region is an approximation to del2(zi)=0 subject to !! boundary conditions along the valid points curve bounding this region. +subroutine smooth_heights(zi,fill,bad,sor,niter,cyclic_x, tripolar_n) -real, dimension(:,:), intent(inout) :: zi -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill -integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad -real, intent(in) :: sor -integer, intent(in) :: niter -logical, intent(in) :: cyclic_x, tripolar_n +real, dimension(:,:), intent(inout) :: zi !< input and output array (ND) +integer, dimension(size(zi,1),size(zi,2)), intent(in) :: fill !< same shape as zi, 1=fill +integer, dimension(size(zi,1),size(zi,2)), intent(in) :: bad !< same shape as zi, 1=bad data +real, intent(in) :: sor !< relaxation coefficient (ND) +integer, intent(in) :: niter !< maximum number of iterations +logical, intent(in) :: cyclic_x !< true if domain is zonally reentrant +logical, intent(in) :: tripolar_n !< true if domain has an Arctic fold integer :: i,j,k,n integer :: ni,nj From b60007ca71a11664edc378c76d35f5e7b8e4ab56 Mon Sep 17 00:00:00 2001 From: matthew harrison Date: Mon, 11 Jun 2018 17:00:46 -0400 Subject: [PATCH 005/261] remove trailing whitespace --- src/framework/MOM_horizontal_regridding.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 43c93aa42d..bb226c5a1c 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -58,7 +58,7 @@ module MOM_horizontal_regridding subroutine myStats(array, missing, is, ie, js, je, k, mesg) real, dimension(:,:), intent(in) :: array !< input array (ND) real, intent(in) :: missing !< missing value (ND) - integer :: is,ie,js,je,k + integer :: is,ie,js,je,k character(len=*) :: mesg ! Local variables real :: minA, maxA @@ -101,13 +101,13 @@ subroutine fill_miss_2d(aout,good,fill,prev,G,smooth,num_pass,relc,crit,keep_bug type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G)), & !< The array with missing values to fill - intent(inout) :: aout !! + intent(inout) :: aout !! real, dimension(SZI_(G),SZJ_(G)), & !< Valid data mask for incoming array - intent(in) :: good !! (1==good data; 0==missing data). + intent(in) :: good !! (1==good data; 0==missing data). real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: fill !< Same shape array of points which need !! filling (1==fill;0==dont fill) - + real, dimension(SZI_(G),SZJ_(G)), & !< First guess where isolated holes exist. optional, intent(in) :: prev !! logical, optional, intent(in) :: smooth !< If present and true, apply a number of @@ -891,7 +891,7 @@ function fill_boundaries_int(m,cyclic_x,tripolar_n) result(mp) integer, dimension(:,:), intent(in) :: m !< input array (ND) logical, intent(in) :: cyclic_x !< True if domain is zonally re-entrant logical, intent(in) :: tripolar_n !< True if domain has an Arctic fold -real, dimension(size(m,1),size(m,2)) :: m_real +real, dimension(size(m,1),size(m,2)) :: m_real real, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp_real integer, dimension(0:size(m,1)+1,0:size(m,2)+1) :: mp From 75d59732b510509cf64076111c08c73302d584a0 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Mon, 11 Jun 2018 17:31:15 -0400 Subject: [PATCH 006/261] Fixing doxygen in MOM_wave_interface. - Fixed many doxygen related issues in MOM_wave_interface - Fixed formatting and commenting to standardize w/ the rest of MOM6. - Fixed 1 bug in wavenumber computation (missing factor of gravity) for x-direction Stokes dri ft in data_override method. Bug-fix should not impact any present model test cases/implementatio ns, but it has been fixed/noted in code. --- src/user/MOM_wave_interface.F90 | 903 +++++++++++++++++--------------- 1 file changed, 473 insertions(+), 430 deletions(-) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index c464a2b1f6..337036838c 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1,35 +1,31 @@ module MOM_wave_interface ! This file is part of MOM6. See LICENSE.md for the license. - -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Brandon Reichl, 2018. * -!* * -!* This module should be moved as wave coupling progresses and * -!* likely will should mirror the iceberg or sea-ice model set-up. * -!* * -!* This module is meant to contain the routines to read in and * -!* interpret surface wave data for MOM6. In its original form, the * -!* capabilities include setting the Stokes drift in the model (from a * -!* variety of sources including prescribed, empirical, and input * -!* files). In short order, the plan is to also ammend the subroutine * -!* to accept Stokes drift information from an external coupler. * -!* Eventually, it will be necessary to break this file apart so that * -!* general wave information may be stored in the control structure * -!* and the Stokes drift effect can be isolated from processes such as * -!* sea-state dependent momentum fluxes, gas fluxes, and other wave * -!* related air-sea interaction and boundary layer phenomenon. * -!* * -!* The Stokes drift are stored on the C-grid with the conventional * -!* protocol to interpolate to the h-grid to compute Langmuir number, * -!* the primary quantity needed for Langmuir turbulence * -!* parameterizations in both the ePBL and KPP approach. This module * -!* also computes full 3d Stokes drift profiles, which will be useful * -!* if second-order type boundary layer parameterizations are * -!* implemented (perhaps via GOTM, work in progress). * -!* * -!********+*********+*********+*********+*********+*********+*********+** +! +! By Brandon Reichl, 2018. +! +! This module should be moved as wave coupling progresses and +! likely will should mirror the iceberg or sea-ice model set-up. +! +! This module is meant to contain the routines to read in and +! interpret surface wave data for MOM6. In its original form, the +! capabilities include setting the Stokes drift in the model (from a +! variety of sources including prescribed, empirical, and input +! files). In short order, the plan is to also ammend the subroutine +! to accept Stokes drift information from an external coupler. +! Eventually, it will be necessary to break this file apart so that +! general wave information may be stored in the control structure +! and the Stokes drift effect can be isolated from processes such as +! sea-state dependent momentum fluxes, gas fluxes, and other wave +! related air-sea interaction and boundary layer phenomenon. +! +! The Stokes drift are stored on the C-grid with the conventional +! protocol to interpolate to the h-grid to compute Langmuir number, +! the primary quantity needed for Langmuir turbulence +! parameterizations in both the ePBL and KPP approach. This module +! also computes full 3d Stokes drift profiles, which will be useful +! if second-order type boundary layer parameterizations are +! implemented (perhaps via GOTM, work in progress). use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : diag_ctrl @@ -44,7 +40,10 @@ module MOM_wave_interface time_type_to_real,real_to_time_type use MOM_variables, only : thermo_var_ptrs, surface use data_override_mod, only : data_override_init, data_override -implicit none ; private + +implicit none + +private #include @@ -69,62 +68,68 @@ module MOM_wave_interface !> Container for all surface wave related parameters type, public:: wave_parameters_CS ; private - !> Main surface wave options - logical, public :: UseWaves ! Flag to enable surface gravity wave feature - logical, public :: LagrangianMixing ! NOT READY - ! True if Stokes drift is present and mixing - ! should be applied to Lagrangian current - ! (mean current + Stokes drift). - ! See Reichl et al., 2016 KPP-LT approach - logical, public :: StokesMixing ! NOT READY - ! True if vertical mixing of momentum - ! should be applied directly to Stokes current - ! (with separate mixing parameter for Eulerian - ! mixing contribution). - ! See Harcourt 2013, 2015 Second-Moment approach - logical, public :: CoriolisStokes ! NOT READY + !Main surface wave options + logical, public :: UseWaves !< Flag to enable surface gravity wave feature + logical, public :: LagrangianMixing !< This feature is in development and not ready + !! True if Stokes drift is present and mixing + !! should be applied to Lagrangian current + !! (mean current + Stokes drift). + !! See Reichl et al., 2016 KPP-LT approach + logical, public :: StokesMixing !< This feature is in development and not ready. + !! True if vertical mixing of momentum + !! should be applied directly to Stokes current + !! (with separate mixing parameter for Eulerian + !! mixing contribution). + !! See Harcourt 2013, 2015 Second-Moment approach + logical, public :: CoriolisStokes !< This feature is in development and not ready. ! True if Coriolis-Stokes acceleration should be applied. - integer, public :: StkLevelMode=1 ! = 0 if mid-point value of Stokes drift is used - ! = 1 if average value of Stokes drift over level. - ! If advecting with Stokes transport, 1 is the correct - ! approach. + integer, public :: StkLevelMode=1 !< Sets if Stokes drift is defined at mid-points + !! or layer averaged. Set to 0 if mid-point and set to + !! 1 if average value of Stokes drift over level. + !! If advecting with Stokes transport, 1 is the correct + !! approach. - !> Surface Wave Dependent 1d/2d/3d vars + ! Surface Wave Dependent 1d/2d/3d vars + real, allocatable, dimension(:), public :: & + WaveNum_Cen !< Wavenumber bands for read/coupled + real, allocatable, dimension(:), public :: & + Freq_Cen !< Frequency bands for read/coupled + real, allocatable, dimension(:), public :: & + PrescribedSurfStkX !< Surface Stokes drift if prescribed real, allocatable, dimension(:), public :: & - WaveNum_Cen,& ! Wavenumber bands for read/coupled - Freq_Cen, & ! Frequency bands for read/coupled - PrescribedSurfStkX,& ! Surface Stokes drift if prescribed - PrescribedSurfStkY ! Surface Stokes drift if prescribed + PrescribedSurfStkY !< Surface Stokes drift if prescribed real, allocatable, dimension(:,:,:), public :: & - Us_x ! 3d Stokes drift profile (zonal) - ! Horizontal -> U points - ! Vertical -> Mid-points + Us_x !< 3d Stokes drift profile (zonal) + !! Horizontal -> U points + !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - Us_y ! 3d Stokes drift profile (meridional) - ! Horizontal -> V points - ! Vertical -> Mid-points - real, allocatable, dimension(:,:), public :: & - LangNum, & ! Langmuir number (directionality factored later) - ! Horizontal -> H points - US0_x, & ! Surface Stokes Drift (zonal) - ! Horizontal -> U points - US0_y ! Surface Stokes Drift (meridional) - ! Horizontal -> V points + Us_y !< 3d Stokes drift profile (meridional) + !! Horizontal -> V points + !! Vertical -> Mid-points + real, allocatable, dimension(:,:), public :: & + LangNum !< Langmuir number (directionality factored later) + !! Horizontal -> H points + real, allocatable, dimension(:,:), public :: & + US0_x !< Surface Stokes Drift (zonal) + !! Horizontal -> U points + real, allocatable, dimension(:,:), public :: & + US0_y !< Surface Stokes Drift (meridional) + !! Horizontal -> V points real, allocatable, dimension(:,:,:), public :: & - STKx0 ! Stokes Drift spectrum (zonal) - ! Horizontal -> U points - ! 3rd dimension -> Freq/Wavenumber + STKx0 !< Stokes Drift spectrum (zonal) + !! Horizontal -> U points + !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - STKy0 ! Stokes Drift spectrum (meridional) - ! Horizontal -> V points - ! 3rd dimension -> Freq/Wavenumber + STKy0 !< Stokes Drift spectrum (meridional) + !! Horizontal -> V points + !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear + KvS !< Viscosity for Stokes Drift shear ! Pointers to auxiliary fields - type(time_type), pointer, public :: Time ! A pointer to the ocean model's clock. - type(diag_ctrl), pointer, public :: diag ! A structure that is used to regulate the - ! timing of diagnostic output. + type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. + type(diag_ctrl), pointer, public :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. ! Diagnostic handles integer, public :: id_surfacestokes_x, id_surfacestokes_y @@ -134,49 +139,47 @@ module MOM_wave_interface !Options not needed outside of this module -!> Main Option -integer :: WaveMethod=-99 - ! Options for including wave information - ! Valid (tested) choices are: - ! 0 - Test Profile - ! 1 - Surface Stokes Drift Bands - ! 2 - DHH85 - ! 3 - LF17 - ! -99 - No waves computed, but empirical Langmuir number used. - -!> Options if WaveMethod is Surface Stokes Drift Bands (1) +integer :: WaveMethod=-99 !< Options for including wave information + !! Valid (tested) choices are: + !! 0 - Test Profile + !! 1 - Surface Stokes Drift Bands + !! 2 - DHH85 + !! 3 - LF17 + !! -99 - No waves computed, but empirical Langmuir number used. + +! Options if WaveMethod is Surface Stokes Drift Bands (1) integer, public :: NumBands =0 !< Number of wavenumber/frequency partitions to receive !! This needs to match the number of bands provided !! via either coupling or file. integer, public :: PartitionMode !< Method for partition mode (meant to check input) !! 0 - wavenumbers !! 1 - frequencies -integer :: DataSource ! Integer that specifies where the Model Looks for Data - ! Valid choices are: - ! 1 - FMS DataOverride Routine - ! 2 - Reserved For Coupler - ! 3 - User input (fixed values, useful for 1d testing) -!>> Options if using FMS DataOverride Routine -character(len=40) :: SurfBandFileName ! Filename if using DataOverride -logical :: dataoverrideisinitialized ! Flag for DataOverride Initialization - -!> Options for computing Langmuir number +integer :: DataSource !< Integer that specifies where the Model Looks for Data + !! Valid choices are: + !! 1 - FMS DataOverride Routine + !! 2 - Reserved For Coupler + !! 3 - User input (fixed values, useful for 1d testing) +! Options if using FMS DataOverride Routine +character(len=40) :: SurfBandFileName !< Filename if using DataOverride +logical :: dataoverrideisinitialized !< Flag for DataOverride Initialization + +! Options for computing Langmuir number real :: LA_FracHBL !< Fraction of OSBL for averaging Langmuir number logical :: LA_Misalignment = .false. !< Flag to use misalignment in Langmuir number ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mdl = "MOM_wave_interface" ! This module's name. +character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. ! Switches needed in import_stokes_drift integer, parameter :: TESTPROF = 0, SURFBANDS = 1, & DHH85 = 2, LF17 = 3, NULL_WaveMethod=-99, & DATAOVR = 1, COUPLER = 2, INPUT = 3 -! For Test Prof +! Options For Test Prof Real :: TP_STKX0, TP_STKY0, TP_WVL -logical :: WaveAgePeakFreq !> Flag to use W +logical :: WaveAgePeakFreq ! Flag to use W real :: WaveAge, WaveWind real :: PI @@ -184,8 +187,6 @@ module MOM_wave_interface !> Initializes parameters related to MOM_wave_interface subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) - - !Arguments type(time_type), target, intent(in) :: Time !< Time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -194,7 +195,6 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer ! Local variables - ! I/O character*(13) :: TMPSTRING1,TMPSTRING2 character*(5), parameter :: NULL_STRING = "EMPTY" @@ -206,7 +206,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) character*(7), parameter :: COUPLER_STRING = "COUPLER" character*(5), parameter :: INPUT_STRING = "INPUT" - !/ Dummy Check + ! Dummy Check if (associated(CS)) then call MOM_error(FATAL, "wave_interface_init called with an associated"//& "control structure.") @@ -215,7 +215,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) PI=4.0*atan(1.0) - !/ Allocate CS and set pointers + ! Allocate CS and set pointers allocate(CS) CS%diag => diag @@ -235,25 +235,25 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) "Flag to use Lagrangian Mixing of momentum", units="", & Default=.false.) if (CS%LagrangianMixing) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Lagrangian Mixing? Code not ready.") endif call get_param(param_file, mdl, "STOKES_MIXING", CS%StokesMixing, & "Flag to use Stokes Mixing of momentum", units="", & Default=.false.) if (CS%StokesMixing) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Stokes Mixing? Code not ready.") endif call get_param(param_file, mdl, "CORIOLIS_STOKES", CS%CoriolisStokes, & "Flag to use Coriolis Stokes acceleration", units="", & Default=.false.) if (CS%CoriolisStokes) then - !Force Code Intervention + ! Force Code Intervention call MOM_error(FATAL,"Should you be enabling Coriolis-Stokes? Code not ready.") endif - ! 1. Get Wave Method and write to integer WaveMethod + ! Get Wave Method and write to integer WaveMethod call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, & "Choice of wave method, valid options include: \n"// & " TEST_PROFILE - Prescribed from surface Stokes drift \n"// & @@ -279,7 +279,7 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) units='m/s',default=0.0) call get_param(param_file,mdl,"TP_WVL",TP_WVL,& units='m',default=50.0) - case (SURFBANDS_STRING)!Surface Stokes Drift Bands + case (SURFBANDS_STRING)! Surface Stokes Drift Bands WaveMethod = SURFBANDS call get_param(param_file, mdl, "SURFBAND_SOURCE",TMPSTRING2, & "Choice of SURFACE_BANDS data mode, valid options include: \n"// & @@ -288,27 +288,32 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) " INPUT - Testing with fixed values.", & units='', default=NULL_STRING) select case (TRIM(TMPSTRING2)) - case (NULL_STRING)! + case (NULL_STRING)! Default call MOM_error(FATAL, "wave_interface_init called with SURFACE_BANDS"//& " but no SURFBAND_SOURCE.") - case (DATAOVR_STRING)!Using Data Override + case (DATAOVR_STRING)! Using Data Override DataSource = DATAOVR call get_param(param_file, mdl, "SURFBAND_FILENAME", SurfBandFileName, & "Filename of surface Stokes drift input band data.", default="StkSpec.nc") - case (COUPLER_STRING)!Reserved for coupling + case (COUPLER_STRING)! Reserved for coupling DataSource = Coupler - case (INPUT_STRING) + case (INPUT_STRING)! A method to input the Stokes band (globally uniform) DataSource = Input call get_param(param_file,mdl,"SURFBAND_NB",NumBands, & "Prescribe number of wavenumber bands for Stokes drift. \n"// & " Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and \n"// & " STOKES_Y, there are no safety checks in the code.", & units='', default=1) - allocate( CS%WaveNum_Cen(1:NumBands) ) ; CS%WaveNum_Cen(:)=0.0 - allocate( CS%PrescribedSurfStkX(1:NumBands)) ; CS%PrescribedSurfStkX(:) = 0.0 - allocate( CS%PrescribedSurfStkY(1:NumBands)) ; CS%PrescribedSurfStkY(:) = 0.0 - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) ; CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(1:NumBands) ) + CS%WaveNum_Cen(:)=0.0 + allocate( CS%PrescribedSurfStkX(1:NumBands)) + CS%PrescribedSurfStkX(:) = 0.0 + allocate( CS%PrescribedSurfStkY(1:NumBands)) + CS%PrescribedSurfStkY(:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:NumBands)) + CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:NumBands)) + CS%STKy0(:,:,:) = 0.0 partitionmode=0 call get_param(param_file,mdl,"SURFBAND_WAVENUMBERS",CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.",units='rad/m', & @@ -319,12 +324,14 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) call get_param(param_file,mdl,"SURFBAND_STOKES_Y",CS%PrescribedSurfStkY, & "Y-direction surface Stokes drift for bands.",units='m/s', & default=0.0) - case default + case default! No method provided call MOM_error(FATAL,'Check WAVE_METHOD.') end select case (DHH85_STRING)!Donelan et al., 1985 spectrum WaveMethod = DHH85 + call MOM_error(WARNING,"DHH85 only ever set-up for uniform cases w/"//& + " Stokes drift in x-direction.") call get_param(param_file,mdl,"DHH85_AGE_FP",WaveAgePeakFreq, & "Choose true to use waveage in peak frequency.", & units='', default=.false.) @@ -349,25 +356,27 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) "Flag (logical) if using misalignment bt shear and waves in LA",& default=.false.) - ! 2. Allocate and initialize - ! Stokes drift - ! Profiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) ; CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) ; CS%Us_y(:,:,:) = 0.0 - ! Surface Values - allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) ; CS%US0_x(:,:) = 0.0 - allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) ; CS%US0_y(:,:) = 0.0 - ! Langmuir number - allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) ; CS%LangNum(:,:) = 0.0 - + ! Allocate and initialize + ! a. Stokes driftProfiles + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke)) + CS%Us_x(:,:,:) = 0.0 + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke)) + CS%Us_y(:,:,:) = 0.0 + ! b. Surface Values + allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) + CS%US0_x(:,:) = 0.0 + allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) + CS%US0_y(:,:) = 0.0 + ! c. Langmuir number + allocate(CS%LangNum(G%isc:G%iec,G%jsc:G%jec)) + CS%LangNum(:,:) = 0.0 + ! d. Viscosity for Stokes drift if (CS%StokesMixing) then - ! Viscosity for Stokes drift - allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) ; CS%KvS(:,:,:) = 0.0 + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,G%ke)) + CS%KvS(:,:,:) = 0.0 endif - ! - ! 3. Initialize Wave related outputs - ! + ! Initialize Wave related outputs CS%id_surfacestokes_y = register_diag_field('ocean_model','surface_stokes_y', & CS%diag%axesCu1,Time,'Surface Stokes drift (y)','m s-1') CS%id_surfacestokes_x = register_diag_field('ocean_model','surface_stokes_x', & @@ -378,18 +387,12 @@ subroutine MOM_wave_interface_init(time,G,GV,param_file, CS, diag ) CS%diag%axesCuL,Time,'3d Stokes drift (y)','m s-1') return - end subroutine MOM_wave_interface_init - +!> A 'lite' init subroutine to initialize a few inputs needed if using wave information +!! with the wind-speed dependent Stokes drift formulation of LF17 subroutine MOM_wave_interface_init_lite(param_file) - !It is possible to estimate Stokes drift without the Wave data (if WaveMethod=LF17). - ! In this case there are still a couple inputs we need to read in, which is done - ! here in a reduced wave_interface_init that doesn't allocate the CS. - - !Arguments - type(param_file_type), intent(in) :: param_file !< Input parameter structure - + type(param_file_type), intent(in) :: param_file !< Input parameter structure ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", LA_FracHBL, & @@ -406,19 +409,18 @@ subroutine MOM_wave_interface_init_lite(param_file) return end subroutine MOM_wave_interface_init_lite -! Place to add update of surface wave parameters. +!> Subroutine that handles updating of surface wave/Stokes drift related properties subroutine Update_Surface_Waves(G,GV,Day,DT,CS) -!Arguments - type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure - type(ocean_grid_type), intent(inout) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(time_type), intent(in) :: Day !