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