ROMS
Loading...
Searching...
No Matches
i4dvar_roms.h
Go to the documentation of this file.
1 MODULE roms_kernel_mod
2!
3!git $Id$
4!================================================== Hernan G. Arango ===
5! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! ROMS Strong Constraint 4-Dimensional Variational Data Assimilation !
11! Driver, Incremental Approach (I4D-Var) !
12! !
13! This driver is used for the primal formulation (model space) strong !
14! constraint, incremental 4D-Var where the only errors considered are !
15! those for the observations. The model is assumed to be perfect. !
16! !
17! The routines in this driver control the initialization, time- !
18! stepping, and finalization of ROMS model following ESMF/NUOPC !
19! conventions: !
20! !
21! ROMS_initialize !
22! ROMS_run !
23! ROMS_finalize !
24! !
25! References: !
26! !
27! Moore, A.M., H.G. Arango, G. Broquet, B.S. Powell, A.T. Weaver, !
28! and J. Zavala-Garay, 2011: The Regional Ocean Modeling System !
29! (ROMS) 4-dimensional variational data assimilations systems, !
30! Part I - System overview and formulation, Prog. Oceanogr., 91, !
31! 34-49, doi:10.1016/j.pocean.2011.05.004. !
32! !
33! Moore, A.M., H.G. Arango, G. Broquet, C. Edward, M. Veneziani, !
34! B. Powell, D. Foley, J.D. Doyle, D. Costa, and P. Robinson, !
35! 2011: The Regional Ocean Modeling System (ROMS) 4-dimensional !
36! variational data assimilations systems, Part II - Performance !
37! and application to the California Current System, Prog. !
38! Oceanogr., 91, 50-73, doi:10.1016/j.pocean.2011.05.003. !
39! !
40!=======================================================================
41!
42 USE mod_param
43 USE mod_parallel
44 USE mod_arrays
45 USE mod_fourdvar
46 USE mod_iounits
47 USE mod_ncparam
48 USE mod_scalars
49 USE mod_stepping
50!
51 USE i4dvar_mod
52!
54 USE def_dai_mod, ONLY : def_dai
55 USE inp_par_mod, ONLY : inp_par
56#ifdef MCT_LIB
57# ifdef ATM_COUPLING
58 USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling
59# endif
60# ifdef WAV_COUPLING
61 USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling
62# endif
63#endif
66 USE strings_mod, ONLY : founderror
67 USE wrt_dai_mod, ONLY : wrt_dai
68 USE wrt_rst_mod, ONLY : wrt_rst
69!
70 implicit none
71!
72 PUBLIC :: roms_initialize
73 PUBLIC :: roms_run
74 PUBLIC :: roms_finalize
75!
76 CONTAINS
77!
78 SUBROUTINE roms_initialize (first, mpiCOMM)
79!
80!=======================================================================
81! !
82! This routine allocates and initializes ROMS state variables and !
83! and internal parameters. It reads standard input parameters. !
84! !
85!=======================================================================
86!
87! Imported variable declarations.
88!
89 logical, intent(inout) :: first
90!
91 integer, intent(in), optional :: mpiCOMM
92!
93! Local variable declarations.
94!
95 logical :: allocate_vars = .true.
96!
97#ifdef DISTRIBUTE
98 integer :: MyError, MySize
99#endif
100 integer :: chunk_size, ng, thread
101#ifdef _OPENMP
102 integer :: my_threadnum
103#endif
104!
105 character (len=*), parameter :: MyFile = &
106 & __FILE__//", ROMS_initialize"
107
108#ifdef DISTRIBUTE
109!
110!-----------------------------------------------------------------------
111! Set distribute-memory (mpi) world communictor.
112!-----------------------------------------------------------------------
113!
114 IF (PRESENT(mpicomm)) THEN
115 ocn_comm_world=mpicomm
116 ELSE
117 ocn_comm_world=mpi_comm_world
118 END IF
119 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
120 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
121#endif
122!
123!-----------------------------------------------------------------------
124! On first pass, initialize model parameters a variables for all
125! nested/composed grids. Notice that the logical switch "first"
126! is used to allow multiple calls to this routine during ensemble
127! configurations.
128!-----------------------------------------------------------------------
129!
130 IF (first) THEN
131 first=.false.
132!
133! Initialize parallel control switches. These scalars switches are
134! independent from standard input parameters.
135!
137!
138! Set the ROMS standard output unit to write verbose execution info.
139! Notice that the default standard out unit in Fortran is 6.
140!
141! In some applications like coupling or disjointed mpi-communications,
142! it is advantageous to write standard output to a specific filename
143! instead of the default Fortran standard output unit 6. If that is
144! the case, it opens such formatted file for writing.
145!
146 IF (set_stdoutunit) THEN
148 set_stdoutunit=.false.
149 END IF
150!
151! Read in model tunable parameters from standard input. Allocate and
152! initialize variables in several modules after the number of nested
153! grids and dimension parameters are known.
154!
155 CALL inp_par (inlm)
156 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
157!
158! Initialize counters. The 'Nrun' counter will be recomputed in the
159! RBL4D-Var phases to process the obervation operator correctly.
160!
161 nrun=1 ! run counter
162 erstr=1 ! ensemble start counter
163 erend=nouter ! ensemble end counter
164!
165! Set domain decomposition tile partition range. This range is
166! computed only once since the "first_tile" and "last_tile" values
167! are private for each parallel thread/node.
168!
169#if defined _OPENMP
170 mythread=my_threadnum()
171#elif defined DISTRIBUTE
173#else
174 mythread=0
175#endif
176 DO ng=1,ngrids
177 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
178 first_tile(ng)=mythread*chunk_size
179 last_tile(ng)=first_tile(ng)+chunk_size-1
180 END DO
181!
182! Initialize internal wall clocks. Notice that the timings does not
183! includes processing standard input because several parameters are
184! needed to allocate clock variables.
185!
186 IF (master) THEN
187 WRITE (stdout,10)
188 10 FORMAT (/,' Process Information:',/)
189 END IF
190!
191 DO ng=1,ngrids
192 DO thread=thread_range
193 CALL wclock_on (ng, inlm, 0, __line__, myfile)
194 END DO
195 END DO
196!
197! Allocate and initialize modules variables.
198!
199 CALL roms_allocate_arrays (allocate_vars)
201 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
202
203 END IF
204
205#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
206!
207!-----------------------------------------------------------------------
208! Initialize coupling streams between model(s).
209!-----------------------------------------------------------------------
210!
211 DO ng=1,ngrids
212# ifdef ATM_COUPLING
213 CALL initialize_ocn2atm_coupling (ng, myrank)
214# endif
215# ifdef WAV_COUPLING
216 CALL initialize_ocn2wav_coupling (ng, myrank)
217# endif
218 END DO
219#endif
220!
221!-----------------------------------------------------------------------
222! Set application grid, metrics, and associated variables. Then,
223! proccess background prior error covariance standard deviations
224! and normalization coefficients.
225!-----------------------------------------------------------------------
226!
227 lgetstd=.true.
228 lgetnrm=.true.
229
230 DO ng=1,ngrids
231#ifdef STD_MODEL
232 ldefstd(ng)=.true.
233 lwrtstd(ng)=.true.
234#else
235 lreadstd(ng)=.true.
236#endif
237 CALL prior_error (ng)
238 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
239 setgridconfig(ng)=.false.
240 END DO
241!
242 RETURN
243 END SUBROUTINE roms_initialize
244!
245 SUBROUTINE roms_run (RunInterval)
246!
247!=======================================================================
248! !
249! This routine runs the incremental, strong constraint I4D-Var data !
250! assimilation algorithm. It time-steps ROMS nonlinear, tangent !
251! linear, and adjoint kernels. !
252! !
253! On Input: !
254! !
255! RunInterval Execution time stepping window (seconds) !
256! !
257!=======================================================================
258!
259! Imported variable declarations
260!
261 real(dp), intent(in) :: RunInterval
262!
263! Local variable declarations.
264!
265 integer :: my_outer, ng
266!
267 character (len=*), parameter :: MyFile = &
268 & __FILE__//", ROMS_run"
269!
270!=======================================================================
271! Run I4D-Var algorithm (primal formulation).
272!=======================================================================
273!
274! Initialize relevant parameters.
275!
276 DO ng=1,ngrids
277#if defined ADJUST_BOUNDARY || defined ADJUST_STFLUX || \
278 defined adjust_wstress
279 lfinp(ng)=1 ! forcing index for input
280 lfout(ng)=1 ! forcing index for output history files
281#endif
282#ifdef ADJUST_BOUNDARY
283 lbinp(ng)=1 ! boundary index for input
284 lbout(ng)=1 ! boundary index for output history files
285#endif
286 lold(ng)=1 ! old minimization time index
287 lnew(ng)=2 ! new minimization time index
288 END DO
289!
290! Start outer loop iterations.
291!
292 outer_loop : DO my_outer=1,nouter
293 outer=my_outer
294 inner=0
295!
296! Compute nonlinear background state trajectory, Xb(t)|n-1. Interpolate
297! the background at the observation locations, and compute the quality
298! control accept/reject flag, ObsScale. The background state is used
299! to linearize the tangent linear and adjoint models during the
300! minimization.
301!
302 CALL background (my_outer, runinterval)
303 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
304!
305! Compute 4D-Var data assimilation increment, dXa, by iterating over
306! the inner loops, and minimizing the cost function.
307!
308 CALL increment (my_outer, runinterval)
309 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
310!
311! Compute 4D-Var data assimilation analysis, Xa = Xb + dXa. Set
312! nonlinear model initial conditions for next outer loop.
313!
314 CALL analysis (my_outer, runinterval)
315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
316
317 END DO outer_loop
318!
319! Initialize the nonlinear model with the estimated 4D-Var state and
320! interpolate the solution at observation locations for posterior
321! analysis.
322!
323 CALL posterior_analysis (runinterval)
324 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
325!
326 RETURN
327 END SUBROUTINE roms_run
328!
329 SUBROUTINE roms_finalize
330!
331!=======================================================================
332! !
333! This routine terminates ROMS I4D-Var execution. !
334! !
335!=======================================================================
336!
337! Local variable declarations.
338!
339 integer :: Fcount, ng, thread
340!
341 character (len=*), parameter :: MyFile = &
342 & __FILE__//", ROMS_finalize"
343!
344!-----------------------------------------------------------------------
345! Write out 4D-Var analysis fields that used as initial conditions for
346! the next data assimilation cycle.
347!-----------------------------------------------------------------------
348!
349 IF (exit_flag.eq.noerror) THEN
350 DO ng=1,ngrids
351 ldefdai(ng)=.true.
352 CALL def_dai (ng)
353 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
354!
355#ifdef DISTRIBUTE
356 CALL wrt_dai (ng, myrank)
357#else
358 CALL wrt_dai (ng, -1)
359#endif
360 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
361 END DO
362 END IF
363!
364!-----------------------------------------------------------------------
365! Compute and report model-observation comparison statistics.
366!-----------------------------------------------------------------------
367!
368 IF (exit_flag.eq.noerror) THEN
369 DO ng=1,ngrids
370#ifdef DISTRIBUTE
371 CALL stats_modobs (ng, myrank)
372#else
373 CALL stats_modobs (ng, -1)
374#endif
375 END DO
376 END IF
377!
378!-----------------------------------------------------------------------
379! If blowing-up, save latest model state into RESTART NetCDF file.
380!-----------------------------------------------------------------------
381!
382! If cycling restart records, write solution into record 3.
383!
384 IF (exit_flag.eq.1) THEN
385 DO ng=1,ngrids
386 IF (lwrtrst(ng)) THEN
387 IF (master) WRITE (stdout,10)
388 10 FORMAT (/,' Blowing-up: Saving latest model state into ', &
389 & ' RESTART file',/)
390 fcount=rst(ng)%load
391 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
392 rst(ng)%Rindex=2
393 lcyclerst(ng)=.false.
394 END IF
397#ifdef DISTRIBUTE
398 CALL wrt_rst (ng, myrank)
399#else
400 CALL wrt_rst (ng, -1)
401#endif
402 END IF
403 END DO
404 END IF
405!
406!-----------------------------------------------------------------------
407! Stop model and time profiling clocks, report memory requirements,
408! and close output NetCDF files.
409!-----------------------------------------------------------------------
410!
411! Stop time clocks.
412!
413 IF (master) THEN
414 WRITE (stdout,20)
415 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
416 END IF
417!
418 DO ng=1,ngrids
419 DO thread=thread_range
420 CALL wclock_off (ng, inlm, 0, __line__, myfile)
421 END DO
422 END DO
423!
424! Report dynamic memory and automatic memory requirements.
425!
426 CALL memory
427!
428! Close IO files.
429!
430 DO ng=1,ngrids
431 CALL close_inp (ng, inlm)
432 END DO
433 CALL close_out
434!
435 RETURN
436 END SUBROUTINE roms_finalize
437!
438 END MODULE roms_kernel_mod
subroutine memory
Definition memory.F:3
subroutine, public close_out
Definition close_io.F:175
subroutine, public close_inp(ng, model)
Definition close_io.F:92
subroutine, public def_dai(ng)
Definition def_dai.F:52
logical lgetnrm
Definition i4dvar.F:166
subroutine, public prior_error(ng)
Definition i4dvar.F:2470
subroutine, public increment(my_outer, runinterval)
Definition i4dvar.F:767
logical lgetstd
Definition i4dvar.F:167
subroutine, public background(my_outer, runinterval)
Definition i4dvar.F:548
subroutine, public posterior_analysis(runinterval)
Definition i4dvar.F:2255
subroutine, public analysis(my_outer, runinterval)
Definition i4dvar.F:1702
subroutine, public inp_par(model)
Definition inp_par.F:56
subroutine, public roms_initialize_arrays
Definition mod_arrays.F:351
subroutine, public roms_allocate_arrays(allocate_vars)
Definition mod_arrays.F:114
type(t_io), dimension(:), allocatable rst
integer stdout
subroutine, public initialize_parallel
integer numthreads
integer, dimension(:), allocatable first_tile
integer mythread
logical master
integer, dimension(:), allocatable last_tile
integer ocn_comm_world
integer, parameter inlm
Definition mod_param.F:662
integer, dimension(:), allocatable ntilex
Definition mod_param.F:685
integer ngrids
Definition mod_param.F:113
integer, dimension(:), allocatable ntilee
Definition mod_param.F:686
integer nouter
logical, dimension(:), allocatable lreadstd
logical, dimension(:), allocatable setgridconfig
integer blowup
integer erend
integer exit_flag
integer erstr
logical, dimension(:), allocatable lwrtrst
integer nrun
logical, dimension(:), allocatable ldefdai
integer inner
integer noerror
logical, dimension(:), allocatable lcyclerst
integer outer
integer, dimension(:), allocatable lold
integer, dimension(:), allocatable lbout
integer, dimension(:), allocatable lfinp
integer, dimension(:), allocatable lbinp
integer, dimension(:), allocatable lnew
integer, dimension(:), allocatable lfout
subroutine, public roms_finalize
Definition ad_roms.h:283
subroutine, public roms_run(runinterval)
Definition ad_roms.h:239
subroutine, public roms_initialize(first, mpicomm)
Definition ad_roms.h:52
subroutine, public stats_modobs(ng, tile)
integer function, public stdout_unit(mymaster)
Definition stdout_mod.F:48
logical, save set_stdoutunit
Definition stdout_mod.F:41
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
subroutine, public wrt_dai(ng, tile)
Definition wrt_dai.F:46
subroutine, public wrt_rst(ng, tile)
Definition wrt_rst.F:63
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3