ROMS
Loading...
Searching...
No Matches
split_r4dvar_roms.h
Go to the documentation of this file.
1 MODULE roms_kernel_mod
2!
3!git $Id$
4!=================================================== Andrew M. Moore ===
5! Copyright (c) 2002-2025 The ROMS Group Hernan G. Arango !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! ROMS Strong/Weak Constraint Split 4-Dimensional Variational Data !
11! Assimilation Driver: Indirect Representer Approach !
12! (R4D-Var). !
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 R4D-Var algorithm is split into multiple executables to !
19! facilitate various configurations: !
20! !
21! (1) Executable A computes ROMS nonlinear trajectory used to !
22! linearize the tangent linear and adjoint models used in !
23! the iterations of the inner loop for the minimization of !
24! the cost function. It allows the nonlinear trajectory to !
25! be part of a coupling system and or include nested grids. !
26! It calls either the RBL4D-Var "background" or "analysis" !
27! routines. !
28! !
29! (2) Executable B calls either R4D-Var "increment" or !
30! "posterior_error". The R4D-Var increment is obtained by !
31! minimizing the cost function over Ninner loops. It is !
32! possible to use a coarser grid resolution in the inner !
33! loop. If so, the finer background trajectory needs to !
34! be interpolated into the coarser grid. Then, at the end !
35! of inner loops, the coarse grid increment needs to be !
36! interpolated to the finer grid. The increment phase !
37! may be run at a lower precision. !
38! !
39! The routines in this driver control the initialization, time- !
40! stepping, and finalization of ROMS model following ESMF/NUOPC !
41! conventions: !
42! !
43! ROMS_initialize !
44! ROMS_run !
45! ROMS_finalize !
46! !
47! References: !
48! !
49! Moore, A.M., H.G. Arango, G. Broquet, B.S. Powell, A.T. Weaver, !
50! and J. Zavala-Garay, 2011: The Regional Ocean Modeling System !
51! (ROMS) 4-dimensional variational data assimilations systems, !
52! Part I - System overview and formulation, Prog. Oceanogr., 91, !
53! 34-49, doi:10.1016/j.pocean.2011.05.004. !
54! !
55! Moore, A.M., H.G. Arango, G. Broquet, C. Edward, M. Veneziani, !
56! B. Powell, D. Foley, J.D. Doyle, D. Costa, and P. Robinson, !
57! 2011: The Regional Ocean Modeling System (ROMS) 4-dimensional !
58! variational data assimilations systems, Part II - Performance !
59! and application to the California Current System, Prog. !
60! Oceanogr., 91, 50-73, doi:10.1016/j.pocean.2011.05.003. !
61! !
62!=======================================================================
63!
64 USE mod_param
65 USE mod_parallel
66 USE mod_arrays
67 USE mod_fourdvar
68 USE mod_iounits
69 USE mod_ncparam
70 USE mod_netcdf
71#if defined PIO_LIB && defined DISTRIBUTE
73#endif
74 USE mod_scalars
75 USE mod_stepping
76!
77 USE r4dvar_mod
78!
80 USE def_dai_mod, ONLY : def_dai
81 USE get_state_mod, ONLY : get_state
82 USE inp_par_mod, ONLY : inp_par
83#ifdef MCT_LIB
84# ifdef ATM_COUPLING
85 USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling
86# endif
87# ifdef WAV_COUPLING
88 USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling
89# endif
90#endif
92 USE stdinp_mod, ONLY : getpar_s
95 USE wrt_dai_mod, ONLY : wrt_dai
96 USE wrt_rst_mod, ONLY : wrt_rst
97!
98 implicit none
99!
100 PUBLIC :: roms_initialize
101 PUBLIC :: roms_run
102 PUBLIC :: roms_finalize
103!
104 CONTAINS
105!
106 SUBROUTINE roms_initialize (first, mpiCOMM)
107!
108!=======================================================================
109! !
110! This routine allocates and initializes ROMS state variables and !
111! internal parameters. It reads standard input parameters. !
112! !
113!=======================================================================
114!
115! Imported variable declarations.
116!
117 logical, intent(inout) :: first
118!
119 integer, intent(in), optional :: mpiCOMM
120!
121! Local variable declarations.
122!
123 logical :: allocate_vars = .true.
124!
125#ifdef DISTRIBUTE
126 integer :: MyError, MySize
127#endif
128 integer :: chunk_size, ng, thread
129#ifdef _OPENMP
130 integer :: my_threadnum
131#endif
132!
133 character (len=*), parameter :: MyFile = &
134 & __FILE__//", ROMS_initialize"
135
136#ifdef DISTRIBUTE
137!
138!-----------------------------------------------------------------------
139! Set distribute-memory (mpi) world communictor.
140!-----------------------------------------------------------------------
141!
142 IF (PRESENT(mpicomm)) THEN
143 ocn_comm_world=mpicomm
144 ELSE
145 ocn_comm_world=mpi_comm_world
146 END IF
147 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
148 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
149#endif
150!
151!-----------------------------------------------------------------------
152! On first pass, initialize model parameters a variables for all
153! nested/composed grids. Notice that the logical switch "first"
154! is used to allow multiple calls to this routine during ensemble
155! configurations.
156!-----------------------------------------------------------------------
157!
158 IF (first) THEN
159 first=.false.
160!
161! Initialize parallel control switches. These scalars switches are
162! independent from standard input parameters.
163!
165!
166! Set the ROMS standard output unit to write verbose execution info.
167! Notice that the default standard out unit in Fortran is 6.
168!
169! In some applications like coupling or disjointed mpi-communications,
170! it is advantageous to write standard output to a specific filename
171! instead of the default Fortran standard output unit 6. If that is
172! the case, it opens such formatted file for writing.
173!
174 IF (set_stdoutunit) THEN
176 set_stdoutunit=.false.
177 END IF
178!
179! Get 4D-Var phase from APARNAM input script file.
180!
181 CALL getpar_s (master, aparnam, 'APARNAM')
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183!
184 CALL getpar_s (master, phase4dvar, 'Phase4DVAR', aparnam)
185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
186!
187! Determine ROMS standard output append switch. It is only relevant if
188! "ROMS_STDINP" is activated. The standard output is created in the
189! "background" phase and open to append in the other phases. Set
190! switch so the "stiffness" routine is only called in the "background"
191! phase.
192!
193 IF (index(trim(uppercase(phase4dvar)),'BACKG').ne.0) THEN
194 lappend=.false.
195 lstiffness=.true.
196 ELSE
197 lappend=.true.
198 lstiffness=.false.
199 END IF
200!
201! Read in model tunable parameters from standard input. Allocate and
202! initialize variables in several modules after the number of nested
203! grids and dimension parameters are known.
204!
205 CALL inp_par (inlm)
206 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
207!
208! Initialize counters. The 'Nrun' counter will be recomputed in the
209! RBL4D-Var phases to process the obervation operator correctly.
210!
211 nrun=1 ! run counter
212 erstr=1 ! ensemble start counter
213 erend=nouter ! ensemble end counter
214!
215! Set domain decomposition tile partition range. This range is
216! computed only once since the "first_tile" and "last_tile" values
217! are private for each parallel thread/node.
218!
219#if defined _OPENMP
220 mythread=my_threadnum()
221#elif defined DISTRIBUTE
223#else
224 mythread=0
225#endif
226 DO ng=1,ngrids
227 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
228 first_tile(ng)=mythread*chunk_size
229 last_tile(ng)=first_tile(ng)+chunk_size-1
230 END DO
231!
232! Initialize internal wall clocks. Notice that the timings does not
233! includes processing standard input because several parameters are
234! needed to allocate clock variables.
235!
236 IF (master) THEN
237 WRITE (stdout,10)
238 10 FORMAT (/,' Process Information:',/)
239 END IF
240!
241 DO ng=1,ngrids
242 DO thread=thread_range
243 CALL wclock_on (ng, inlm, 0, __line__, myfile)
244 END DO
245 END DO
246!
247! Allocate and initialize modules variables.
248!
249 CALL roms_allocate_arrays (allocate_vars)
251 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
252
253 END IF
254
255#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
256!
257!-----------------------------------------------------------------------
258! Initialize coupling streams between model(s).
259!-----------------------------------------------------------------------
260!
261 DO ng=1,ngrids
262# ifdef ATM_COUPLING
263 CALL initialize_ocn2atm_coupling (ng, myrank)
264# endif
265# ifdef WAV_COUPLING
266 CALL initialize_ocn2wav_coupling (ng, myrank)
267# endif
268 END DO
269#endif
270!
271!-----------------------------------------------------------------------
272! Set application grid, metrics, and associated variables. Then,
273! proccess background and mode prior error covariance standard
274! deviations and normalization coefficients.
275!-----------------------------------------------------------------------
276!
277 DO ng=1,ngrids
278#ifdef STD_MODEL
279 lwrtstd(ng)=.true.
280 IF (index(trim(uppercase(phase4dvar)),'BACKG').ne.0) THEN
281 ldefstd(ng)=.true.
282 lreadstd(ng)=.false.
283 ELSE
284 ldefstd(ng)=.false.
285 lreadstd(ng)=.true.
286 END IF
287#else
288 lreadstd(ng)=.true.
289#endif
290 CALL prior_error (ng)
291 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
292 setgridconfig(ng)=.false.
293 END DO
294!
295 RETURN
296 END SUBROUTINE roms_initialize
297!
298 SUBROUTINE roms_run (RunInterval)
299!
300!=======================================================================
301! !
302! This subroutine runs the Strong or Weak constraint, Indirect !
303! Representers 4D-Var data assimilation (R4D-Var) algorithm. It !
304! time-steps ROMS nonlinear, representer, tangent linear, and !
305! adjoint kernels. !
306! !
307! On Input: !
308! !
309! RunInterval Execution time stepping window (seconds) !
310! !
311!=======================================================================
312!
313! Imported variable declarations
314!
315 real(dp), intent(in) :: RunInterval
316!
317! Local variable declarations.
318!
319 integer :: my_outer, ng
320!
321 character (len=*), parameter :: MyFile = &
322 & __FILE__//", ROMS_run"
323!
324!=======================================================================
325! Run Split R4D-Var Data Assimilation algorithm.
326!=======================================================================
327!
328! Initialize several global parameters.
329!
330 DO ng=1,ngrids
331#if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
332 lfinp(ng)=1 ! forcing index for input
333 lfout(ng)=1 ! forcing index for output history files
334#endif
335#ifdef ADJUST_BOUNDARY
336 lbinp(ng)=1 ! boundary index for input
337 lbout(ng)=1 ! boundary index for output history files
338#endif
339 lold(ng)=1 ! old minimization time index
340 lnew(ng)=2 ! new minimization time index
341 END DO
342!
343 ldone=.false. ! 4D-Var cycle finish switch
344!
345! Select R4D-Var phase to execute.
346!
347 SELECT CASE (uppercase(phase4dvar(1:6)))
348
349!
350! Compute nonlinear background state trajectory, Xb(t)|n-1. Interpolate
351! the background at the observation locations, and compute the quality
352! control accept/reject flag, ObsScale. The background state is used
353! to linearize the tangent linear and adjoint models during the
354! minimization.
355!
356 CASE ('BACKGR')
357
358 my_outer=0
359 outer=0
360 inner=0
361
362 CALL background (outer, runinterval)
363 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
364!
365! Compute 4D-Var data assimilation increment, dXa, by iterating over
366! the inner loops, and minimizing the cost function.
367!
368 CASE ('INCREM')
369
370 my_outer=outerloop
372 inner=0
373
374 CALL increment (my_outer, runinterval)
375 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
376!
377! Compute 4D-Var data assimilation analysis, Xa = Xb + dXa. Set
378! nonlinear model initial conditions for next outer loop.
379!
380 CASE ('ANALYS')
381
382 my_outer=outerloop
385
386 CALL analysis (my_outer, runinterval)
387 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
388
389
390#if defined POSTERIOR_ERROR_I || \
391 defined posterior_error_f || \
392 defined posterior_eofs
393!
394! Compute full (diagonal) posterior analysis error covariance matrix.
395! (NOTE: Currently, this code only works for a single outer-loop).
396!
397 CASE ('POST_E')
398
399 CALL posterior_error (runinterval)
400 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
401#endif
402!
403! Issue an error if incorrect 4D-Var phase.
404!
405 CASE DEFAULT
406
407 IF (master) THEN
408 WRITE (stdout,10) trim(phase4dvar)
409 10 FORMAT (' ROMS_run - illegal 4D-Var phase: ''',a,'''')
410 END IF
411 exit_flag=5
412 RETURN
413
414 END SELECT
415!
416! Set finish R4D-Var cycle switch.
417!
418 IF ((outerloop.eq.nouter).and. &
419#if defined POSTERIOR_ERROR_I || \
420 defined posterior_error_f || \
421 defined posterior_eofs
422 & (index(trim(uppercase(phase4dvar)),'POST_E').ne.0)) THEN
423 ldone=.true.
424#else
425 & (index(trim(uppercase(phase4dvar)),'ANALYS').ne.0)) THEN
426 ldone=.true.
427#endif
428 END IF
429!
430 RETURN
431 END SUBROUTINE roms_run
432!
433 SUBROUTINE roms_finalize
434!
435!=======================================================================
436! !
437! This routine terminates ROMS R4D-Var execution. !
438! !
439!=======================================================================
440!
441! Local variable declarations.
442!
443 integer :: Fcount, InpRec, Nfiles, Tindex
444 integer :: ifile, lstr, ng, thread
445!
446 character (len=10) :: suffix
447
448 character (len=*), parameter :: MyFile = &
449 & __FILE__//", ROMS_finalize"
450!
451!-----------------------------------------------------------------------
452! Write out 4D-Var analysis fields that can be used as the initial
453! conditions for the next data assimilation cycle. Here, use the
454! last record of the RPM for the final outer loop.
455!-----------------------------------------------------------------------
456!
457 IF (ldone.and.(exit_flag.eq.noerror)) THEN
458 DO ng=1,ngrids
459 ldefdai(ng)=.true.
460 CALL def_dai (ng)
461 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
462!
463 WRITE (tlm(ng)%name,10) trim(fwd(ng)%head), nouter
464 10 FORMAT (a,'_outer',i0,'.nc')
465 lstr=len_trim(tlm(ng)%name)
466 tlm(ng)%base=tlm(ng)%name(1:lstr-3)
467 IF (tlm(ng)%Nfiles.gt.1) THEN
468 nfiles=tlm(ng)%Nfiles
469 DO ifile=1,nfiles
470 WRITE (suffix,"('_',i4.4,'.nc')") ifile
471 tlm(ng)%files(ifile)=trim(tlm(ng)%base)//trim(suffix)
472 END DO
473 tlm(ng)%name=trim(tlm(ng)%files(nfiles))
474 ELSE
475 tlm(ng)%files(1)=trim(tlm(ng)%name)
476 END IF
477!
478 SELECT CASE (tlm(ng)%IOtype)
479 CASE (io_nf90)
480 CALL netcdf_get_dim (ng, irpm, tlm(ng)%name, &
481 & dimname = 'ocean_time', &
482 & dimsize = inprec)
483
484#if defined PIO_LIB && defined DISTRIBUTE
485 CASE (io_pio)
486 CALL pio_netcdf_get_dim (ng, irpm, tlm(ng)%name, &
487 & dimname = 'ocean_time', &
488 & dimsize = inprec)
489#endif
490 END SELECT
491 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
492!
493 tindex=1
494 CALL get_state (ng, irpm, 1, tlm(ng), inprec, tindex)
495 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
496!
497 kout=tindex
498 nout=tindex
499#ifdef DISTRIBUTE
500 CALL wrt_dai (ng, myrank)
501#else
502 CALL wrt_dai (ng, -1)
503#endif
504 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
505 END DO
506 END IF
507!
508!-----------------------------------------------------------------------
509! Compute and report model-observation comparison statistics.
510!-----------------------------------------------------------------------
511!
512 IF (ldone.or.(exit_flag.eq.1)) THEN
513 DO ng=1,ngrids
514#ifdef DISTRIBUTE
515 CALL stats_modobs (ng, myrank)
516#else
517 CALL stats_modobs (ng, -1)
518#endif
519 END DO
520 END IF
521!
522!-----------------------------------------------------------------------
523! If blowing-up, save latest model state into RESTART NetCDF file.
524!-----------------------------------------------------------------------
525!
526! If cycling restart records, write solution into record 3.
527!
528 IF (exit_flag.eq.1) THEN
529 DO ng=1,ngrids
530 IF (lwrtrst(ng)) THEN
531 IF (master) WRITE (stdout,20)
532 20 FORMAT (/,' Blowing-up: Saving latest model state into ', &
533 & ' RESTART file',/)
534 fcount=rst(ng)%load
535 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
536 rst(ng)%Rindex=2
537 lcyclerst(ng)=.false.
538 END IF
541#ifdef DISTRIBUTE
542 CALL wrt_rst (ng, myrank)
543#else
544 CALL wrt_rst (ng, -1)
545#endif
546 END IF
547 END DO
548 END IF
549!
550!-----------------------------------------------------------------------
551! Stop model and time profiling clocks, report memory requirements,
552! and close output NetCDF files.
553!-----------------------------------------------------------------------
554!
555! Stop time clocks.
556!
557 IF (master) THEN
558 WRITE (stdout,30)
559 30 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
560 END IF
561!
562 DO ng=1,ngrids
563 DO thread=thread_range
564 CALL wclock_off (ng, inlm, 0, __line__, myfile)
565 END DO
566 END DO
567!
568! Report dynamic memory and automatic memory requirements.
569!
570 CALL memory
571!
572! Close IO files.
573!
574 DO ng=1,ngrids
575 CALL close_inp (ng, inlm)
576 END DO
577 CALL close_out
578!
579 RETURN
580 END SUBROUTINE roms_finalize
581
582 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 get_state(ng, model, msg, s, inirec, tindex)
Definition get_state.F:90
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
character(len=256) aparnam
type(t_io), dimension(:), allocatable tlm
type(t_io), dimension(:), allocatable fwd
type(t_io), dimension(:), allocatable rst
integer stdout
integer, parameter io_nf90
Definition mod_ncparam.F:95
integer, parameter io_pio
Definition mod_ncparam.F:96
subroutine, public netcdf_get_dim(ng, model, ncname, ncid, dimname, dimsize, dimid)
Definition mod_netcdf.F:330
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, parameter irpm
Definition mod_param.F:664
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
subroutine, public pio_netcdf_get_dim(ng, model, ncname, piofile, dimname, dimsize, dimid)
integer ninner
integer nouter
logical, dimension(:), allocatable lreadstd
logical lappend
logical, dimension(:), allocatable setgridconfig
logical lstiffness
integer blowup
integer outerloop
integer erend
integer exit_flag
integer erstr
character(len=20) phase4dvar
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 posterior_error(runinterval)
Definition r4dvar.F:1946
subroutine, public increment(my_outer, runinterval)
Definition r4dvar.F:380
subroutine, public analysis(my_outer, runinterval)
Definition r4dvar.F:1384
subroutine, public prior_error(ng)
Definition r4dvar.F:1782
subroutine, public background(my_outer, runinterval)
Definition r4dvar.F:158
logical ldone
Definition r4dvar.F:147
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
character(len(sinp)) function, public uppercase(sinp)
Definition strings.F:582
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