6 use mpp_mod
, only : stdout, stdlog, mpp_error, npes=>mpp_npes,pe=>mpp_pe
7 use mpp_mod
, only : set_current_pelist => mpp_set_current_pelist
8 use mpp_mod
, only : set_root_pe => mpp_set_root_pe
9 use mpp_mod
, only : mpp_sync_self, mpp_sum, get_pelist=>mpp_get_current_pelist, mpp_root_pe
10 use mpp_mod
, only : set_stack_size=>mpp_set_stack_size, broadcast=>mpp_broadcast
11 use mpp_io_mod
, only : io_set_stack_size=>mpp_io_set_stack_size
12 use mpp_io_mod
, only : mpp_single,mpp_multi
13 use mpp_domains_mod
, only : domain2d, mpp_global_field
14 use mpp_domains_mod
, only : mpp_get_compute_domain, mpp_get_data_domain
15 use mpp_domains_mod
, only : mpp_redistribute, mpp_broadcast_domain
16 use mpp_domains_mod
, only : set_domains_stack_size=>mpp_domains_set_stack_size
17 use diag_manager_mod
, only : register_diag_field, diag_axis_init, send_data
18 use ensemble_manager_mod
, only : get_ensemble_id, get_ensemble_size
19 use ensemble_manager_mod
, only : get_ensemble_pelist, get_ensemble_filter_pelist
20 use time_manager_mod
, only : time_type, decrement_time, increment_time
21 use time_manager_mod
, only : get_date,
operator(>=),
operator(/=),
operator(==),
operator(<)
22 use constants_mod
, only : radius, epsln
44 use mom_ale, only :
ale_cs, ale_initthicknesstocoord, ale_init, ale_updateverticalgridtype
53 implicit none ;
private 55 public :: init_oda, oda_end, set_prior_tracer, get_posterior_tracer
56 public :: set_analysis_time, oda, save_obs_diff, apply_oda_tracer_increments
58 #include <MOM_memory.h> 73 type(domain2d),
pointer :: mpp_domain => null()
75 real,
pointer,
dimension(:,:,:) :: h => null()
79 logical :: reentrant_x
80 logical :: reentrant_y
83 integer :: assim_method
84 integer :: ensemble_size
85 integer :: ensemble_id = 0
86 integer,
pointer,
dimension(:,:) :: ensemble_pelist
87 integer,
pointer,
dimension(:) :: filter_pelist
88 integer :: assim_frequency
92 type(
kd_root),
pointer :: kdroot => null()
94 logical :: use_ale_algorithm
97 type(time_type) :: time
103 type(domain2d),
pointer :: mpp_domain => null()
107 integer,
parameter :: no_assim = 0, oi_assim=1, eakf_assim=2
114 subroutine init_oda(Time, G, GV, CS)
116 type(time_type),
intent(in) :: Time
119 type(
oda_cs),
pointer,
intent(inout) :: CS
128 real,
dimension(:,:),
allocatable :: global2D, global2D_old
129 real,
dimension(:),
allocatable :: lon1D, lat1D, glon1D, glat1D
131 integer :: n, m, k, i, j, nk
132 integer :: is,ie,js,je,isd,ied,jsd,jed
133 integer :: stdout_unit
134 character(len=32) :: assim_method
135 integer :: npes_pm, ens_info(6), ni, nj
136 character(len=128) :: mesg
137 character(len=32) :: fldnam
138 character(len=30) :: coord_mode
139 character(len=200) :: inputdir, basin_file
140 logical :: reentrant_x, reentrant_y, tripolar_N, symmetric
142 if (
associated(cs))
call mpp_error(fatal,
'Calling oda_init with associated control structure')
147 call get_mom_input(pf,dirs,ensemble_num=0)
149 call unit_scaling_init(pf, cs%US)
151 call get_param(pf,
"MOM",
"ASSIM_METHOD", assim_method, &
152 "String which determines the data assimilation method "//&
153 "Valid methods are: \'EAKF\',\'OI\', and \'NO_ASSIM\'", default=
'NO_ASSIM')
154 call get_param(pf,
"MOM",
"ASSIM_FREQUENCY", cs%assim_frequency, &
155 "data assimilation frequency in hours")
156 call get_param(pf,
"MOM",
"USE_REGRIDDING", cs%use_ALE_algorithm , &
157 "If True, use the ALE algorithm (regridding/remapping).\n"//&
158 "If False, use the layered isopycnal algorithm.", default=.false. )
159 call get_param(pf,
"MOM",
"REENTRANT_X", cs%reentrant_x, &
160 "If true, the domain is zonally reentrant.", default=.true.)
161 call get_param(pf,
"MOM",
"REENTRANT_Y", cs%reentrant_y, &
162 "If true, the domain is meridionally reentrant.", &
164 call get_param(pf,
"MOM",
"TRIPOLAR_N", cs%tripolar_N, &
165 "Use tripolar connectivity at the northern edge of the "//&
166 "domain. With TRIPOLAR_N, NIGLOBAL must be even.", &
168 call get_param(pf,
"MOM",
"NIGLOBAL", cs%ni, &
169 "The total number of thickness grid points in the "//&
170 "x-direction in the physical domain.")
171 call get_param(pf,
"MOM",
"NJGLOBAL", cs%nj, &
172 "The total number of thickness grid points in the "//&
173 "y-direction in the physical domain.")
174 call get_param(pf,
'MOM',
"INPUTDIR", inputdir)
175 inputdir = slasher(inputdir)
177 select case(lowercase(trim(assim_method)))
179 cs%assim_method = eakf_assim
181 cs%assim_method = oi_assim
183 cs%assim_method = no_assim
185 call mpp_error(fatal,
'Invalid assimilation method provided')
188 ens_info = get_ensemble_size()
189 cs%ensemble_size = ens_info(1)
191 cs%ensemble_id = get_ensemble_id()
193 allocate(cs%ensemble_pelist(cs%ensemble_size,npes_pm))
194 allocate(cs%filter_pelist(cs%ensemble_size*npes_pm))
195 call get_ensemble_pelist(cs%ensemble_pelist,
'ocean')
196 call get_ensemble_filter_pelist(cs%filter_pelist,
'ocean')
198 call set_current_pelist(cs%filter_pelist)
200 allocate(cs%domains(cs%ensemble_size))
201 cs%domains(cs%ensemble_id)%mpp_domain => g%Domain%mpp_domain
202 do n=1,cs%ensemble_size
203 if (.not.
associated(cs%domains(n)%mpp_domain))
allocate(cs%domains(n)%mpp_domain)
204 call set_root_pe(cs%ensemble_pelist(n,1))
205 call mpp_broadcast_domain(cs%domains(n)%mpp_domain)
207 call set_root_pe(cs%filter_pelist(1))
210 call mom_domains_init(cs%Grid%Domain,pf,param_suffix=
'_ODA')
212 call hor_index_init(cs%Grid%Domain, hi, pf, &
213 local_indexing=.false.)
214 call verticalgridinit( pf, cs%GV, cs%US )
216 call create_dyn_horgrid(dg, hi)
218 call set_grid_metrics(dg,pf)
219 call mom_initialize_topography(dg%bathyT,dg%max_depth,dg,pf)
220 call mom_initialize_coord(cs%GV, cs%US, pf, .false., &
221 dirs%output_directory, tv_dummy, dg%max_depth)
222 call ale_init(pf, cs%GV, cs%US, dg%max_depth, cs%ALE_CS)
223 call mom_grid_init(cs%Grid, pf, global_indexing=.true.)
224 call ale_updateverticalgridtype(cs%ALE_CS, cs%GV)
225 call copy_dyngrid_to_mom_grid(dg, cs%Grid, cs%US)
226 cs%mpp_domain => cs%Grid%Domain%mpp_domain
227 cs%Grid%ke = cs%GV%ke
230 allocate(cs%Ocean_prior)
231 call init_ocean_ensemble(cs%Ocean_prior,cs%Grid,cs%GV,cs%ensemble_size)
232 allocate(cs%Ocean_posterior)
233 call init_ocean_ensemble(cs%Ocean_posterior,cs%Grid,cs%GV,cs%ensemble_size)
236 call get_param(pf,
'oda_driver',
"REGRIDDING_COORDINATE_MODE", coord_mode, &
237 "Coordinate mode for vertical regridding.", &
238 default=
"ZSTAR", fail_if_missing=.false.)
239 call initialize_regridding(cs%regridCS, cs%GV, cs%US, dg%max_depth,pf,
'oda_driver',coord_mode,
'',
'')
240 call initialize_remapping(cs%remapCS,
'PLM')
241 call set_regrid_params(cs%regridCS, min_thickness=0.)
242 call mpp_get_data_domain(g%Domain%mpp_domain,isd,ied,jsd,jed)
243 if (.not.
associated(cs%h))
then 244 allocate(cs%h(isd:ied,jsd:jed,cs%GV%ke)); cs%h(:,:,:)=0.0
246 call ale_initthicknesstocoord(cs%ALE_CS,g,cs%GV,cs%h)
248 allocate(cs%tv%T(isd:ied,jsd:jed,cs%GV%ke)); cs%tv%T(:,:,:)=0.0
249 allocate(cs%tv%S(isd:ied,jsd:jed,cs%GV%ke)); cs%tv%S(:,:,:)=0.0
251 call set_axes_info(cs%Grid, cs%GV, cs%US, pf, cs%diag_cs, set_vertical=.true.)
253 call mpp_get_data_domain(cs%mpp_domain,isd,ied,jsd,jed)
254 allocate(cs%oda_grid)
255 cs%oda_grid%x => cs%Grid%geolonT
256 cs%oda_grid%y => cs%Grid%geolatT
258 call get_param(pf,
'oda_driver',
"BASIN_FILE", basin_file, &
259 "A file in which to find the basin masks, in variable 'basin'.", &
261 basin_file = trim(inputdir) // trim(basin_file)
262 allocate(cs%oda_grid%basin_mask(isd:ied,jsd:jed))
263 cs%oda_grid%basin_mask(:,:) = 0.0
264 call mom_read_data(basin_file,
'basin',cs%oda_grid%basin_mask,cs%Grid%domain, timelevel=1)
268 allocate(t_grid%x(cs%ni,cs%nj))
269 allocate(t_grid%y(cs%ni,cs%nj))
270 allocate(t_grid%basin_mask(cs%ni,cs%nj))
271 call mpp_global_field(cs%mpp_domain, cs%Grid%geolonT, t_grid%x)
272 call mpp_global_field(cs%mpp_domain, cs%Grid%geolatT, t_grid%y)
273 call mpp_global_field(cs%mpp_domain, cs%oda_grid%basin_mask, t_grid%basin_mask)
277 allocate(t_grid%mask(cs%ni,cs%nj,cs%nk))
278 allocate(t_grid%z(cs%ni,cs%nj,cs%nk))
279 allocate(global2d(cs%ni,cs%nj))
280 allocate(global2d_old(cs%ni,cs%nj))
281 t_grid%mask(:,:,:) = 0.0
282 t_grid%z(:,:,:) = 0.0
285 call mpp_global_field(g%Domain%mpp_domain, cs%h(:,:,k), global2d)
286 do i=1, cs%ni;
do j=1, cs%nj
287 if ( global2d(i,j) > 1 )
then 288 t_grid%mask(i,j,k) = 1.0
292 t_grid%z(:,:,k) = global2d/2
294 t_grid%z(:,:,k) = t_grid%z(:,:,k-1) + (global2d + global2d_old)/2
296 global2d_old = global2d
299 call ocean_da_core_init(cs%mpp_domain, t_grid, cs%Profiles, time)
303 call set_current_pelist(cs%ensemble_pelist(cs%ensemble_id,:))
304 end subroutine init_oda
307 subroutine set_prior_tracer(Time, G, GV, h, tv, CS)
308 type(time_type),
intent(in) :: Time
311 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)),
intent(in) :: h
314 type(
oda_cs),
pointer :: CS
315 real,
dimension(:,:,:),
allocatable :: T, S
317 integer :: i,j, m, n, ss
318 integer :: is, ie, js, je
319 integer :: isc, iec, jsc, jec
320 integer :: isd, ied, jsd, jed
325 if (time < cs%Time)
return 327 if (.not.
associated(cs%Grid))
call mom_error(fatal,
'ODA_CS ensemble horizontal grid not associated')
328 if (.not.
associated(cs%GV))
call mom_error(fatal,
'ODA_CS ensemble vertical grid not associated')
331 call set_current_pelist(cs%filter_pelist)
332 call mom_mesg(
'Setting prior')
334 isc=cs%Grid%isc;iec=cs%Grid%iec;jsc=cs%Grid%jsc;jec=cs%Grid%jec
335 call mpp_get_compute_domain(cs%domains(cs%ensemble_id)%mpp_domain,is,ie,js,je)
336 call mpp_get_data_domain(cs%domains(cs%ensemble_id)%mpp_domain,isd,ied,jsd,jed)
337 allocate(t(isd:ied,jsd:jed,cs%nk))
338 allocate(s(isd:ied,jsd:jed,cs%nk))
340 do j=js,je;
do i=is,ie
341 call remapping_core_h(cs%remapCS, gv%ke, h(i,j,:), tv%T(i,j,:), &
342 cs%nk, cs%h(i,j,:), t(i,j,:))
343 call remapping_core_h(cs%remapCS, gv%ke, h(i,j,:), tv%S(i,j,:), &
344 cs%nk, cs%h(i,j,:), s(i,j,:))
347 do m=1,cs%ensemble_size
348 call mpp_redistribute(cs%domains(m)%mpp_domain, t,&
349 cs%mpp_domain, cs%Ocean_prior%T(:,:,:,m), complete=.true.)
350 call mpp_redistribute(cs%domains(m)%mpp_domain, s,&
351 cs%mpp_domain, cs%Ocean_prior%S(:,:,:,m), complete=.true.)
356 call set_current_pelist(cs%ensemble_pelist(cs%ensemble_id,:))
360 end subroutine set_prior_tracer
364 subroutine get_posterior_tracer(Time, CS, h, tv, increment)
365 type(time_type),
intent(in) :: Time
366 type(
oda_cs),
pointer :: CS
367 real,
dimension(:,:,:),
pointer :: h
369 logical,
optional,
intent(in) :: increment
373 logical :: used, get_inc
376 if (time < cs%Time)
return 380 call set_current_pelist(cs%filter_pelist)
381 call mom_mesg(
'Getting posterior')
384 if (
present(increment)) get_inc = increment
387 allocate(ocean_increment)
388 call init_ocean_ensemble(ocean_increment,cs%Grid,cs%GV,cs%ensemble_size)
389 ocean_increment%T = cs%Ocean_posterior%T - cs%Ocean_prior%T
390 ocean_increment%S = cs%Ocean_posterior%S - cs%Ocean_prior%S
392 do m=1,cs%ensemble_size
394 call mpp_redistribute(cs%mpp_domain, ocean_increment%T(:,:,:,m), &
395 cs%domains(m)%mpp_domain, cs%tv%T, complete=.true.)
396 call mpp_redistribute(cs%mpp_domain, ocean_increment%S(:,:,:,m), &
397 cs%domains(m)%mpp_domain, cs%tv%S, complete=.true.)
399 call mpp_redistribute(cs%mpp_domain, cs%Ocean_posterior%T(:,:,:,m), &
400 cs%domains(m)%mpp_domain, cs%tv%T, complete=.true.)
401 call mpp_redistribute(cs%mpp_domain, cs%Ocean_posterior%S(:,:,:,m), &
402 cs%domains(m)%mpp_domain, cs%tv%S, complete=.true.)
409 call set_current_pelist(cs%ensemble_pelist(cs%ensemble_id,:))
411 end subroutine get_posterior_tracer
414 subroutine oda(Time, CS)
415 type(time_type),
intent(in) :: Time
416 type(
oda_cs),
intent(inout) :: CS
420 integer :: yr, mon, day, hr, min, sec
422 if ( time >= cs%Time )
then 425 call set_current_pelist(cs%filter_pelist)
427 call get_profiles(time, cs%Profiles, cs%CProfiles)
429 call ensemble_filter(cs%Ocean_prior, cs%Ocean_posterior, cs%CProfiles, cs%kdroot, cs%mpp_domain, cs%oda_grid)
433 call set_current_pelist(cs%ensemble_pelist(cs%ensemble_id,:))
441 subroutine oda_end(CS)
444 end subroutine oda_end
447 subroutine init_ocean_ensemble(CS,Grid,GV,ens_size)
451 integer,
intent(in) :: ens_size
453 integer :: n,is,ie,js,je,nk
456 is=grid%isd;ie=grid%ied
457 js=grid%jsd;je=grid%jed
458 cs%ensemble_size=ens_size
459 allocate(cs%T(is:ie,js:je,nk,ens_size))
460 allocate(cs%S(is:ie,js:je,nk,ens_size))
461 allocate(cs%SSH(is:ie,js:je,ens_size))
471 end subroutine init_ocean_ensemble
474 subroutine set_analysis_time(Time,CS)
475 type(time_type),
intent(in) :: Time
476 type(
oda_cs),
pointer,
intent(inout) :: CS
478 character(len=160) :: mesg
479 integer :: yr, mon, day, hr, min, sec
481 if (time >= cs%Time)
then 482 cs%Time=increment_time(cs%Time,cs%assim_frequency*3600)
484 call get_date(time, yr, mon, day, hr, min, sec)
485 write(mesg,*)
'Model Time: ', yr, mon, day, hr, min, sec
486 call mom_mesg(
"set_analysis_time: "//trim(mesg))
487 call get_date(cs%time, yr, mon, day, hr, min, sec)
488 write(mesg,*)
'Assimilation Time: ', yr, mon, day, hr, min, sec
489 call mom_mesg(
"set_analysis_time: "//trim(mesg))
491 if (cs%Time < time)
then 492 call mom_error(fatal,
" set_analysis_time: " // &
493 "assimilation interval appears to be shorter than " // &
494 "the model timestep")
498 end subroutine set_analysis_time
501 subroutine save_obs_diff(filename,CS)
502 character(len=*),
intent(in) :: filename
503 type(
oda_cs),
pointer,
intent(in) :: CS
508 fid = open_profile_file(trim(filename), nvar=2, thread=mpp_single, fset=mpp_single)
514 do while (
associated(prof))
515 call write_profile(fid,prof)
518 call close_profile_file(fid)
524 end subroutine save_obs_diff
528 subroutine apply_oda_tracer_increments(dt,G,tv,h,CS)
529 real,
intent(in) :: dt
532 real,
dimension(SZI_(G),SZJ_(G),SZK_(G)), &
534 type(
oda_cs),
intent(inout) :: CS
536 end subroutine apply_oda_tracer_increments
A structure with a pointer to a domain2d, to allow for the creation of arrays of pointers.
Interfaces for MOM6 ensembles and data assimilation.
This module contains the main regridding routines.
A set of dummy interfaces for compiling the MOM6 DA driver code.
Initializes fixed aspects of the model, such as horizontal grid metrics, topography and Coriolis...
Ocean grid type. See mom_grid for details.
A structure that can be parsed to read and document run-time parameters.
Provides the ocean grid type.
Example type for ocean ensemble DA state.
Generates vertical grids as part of the ALE algorithm.
Provides column-wise vertical remapping functions.
Initializes horizontal grid.
Describes the horizontal ocean grid with only dynamic memory arrays.
This module contains I/O framework code.
The MOM6 facility to parse input files for runtime parameters.
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Container for horizontal index ranges for data, computational and global domains. ...
Container for remapping parameters.
Control structure that contains a transpose of the ocean state across ensemble members.
Describes various unit conversion factors.
Copy one MOM_domain_type into another.
Regridding control structure.
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Describes the decomposed MOM domain and has routines for communications across PEs.
Dummy interfaces for writing ODA data.
Routines for error handling and I/O management.
Describes the vertical ocean grid, including unit conversion factors.
The MOM_domain_type contains information about the domain decompositoin.
Initializes fixed aspects of the related to its vertical coordinate.
An overloaded interface to read various types of parameters.
Example of a profile type.
A null version of K-d tree from geoKdTree.
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Module with routines for copying information from a shared dynamic horizontal grid to an ocean-specif...
Contains a shareable dynamic type for describing horizontal grids and metric data and utilty routines...
Handy functions for manipulating strings.
Provides a transparent vertical ocean grid type and supporting routines.
Provides transparent structures with groups of MOM6 variables and supporting routines.
Read a data field from a file.
Dummy aata structures and methods for ocean data assimilation.
An overloaded interface to read and log the values of various types of parameters.