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