ROMS
Loading...
Searching...
No Matches
picard_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 Picard Iterations Driver: !
11! !
12! This driver is used to perform the Picard iterations test for the !
13! representers tangent linear model used in IOMs weak constraint 4D !
14! variational data assimilation (R4D-Var). Recall that all tangent !
15! linear variables are in term of the full fields and the model can !
16! expressed symbolically as: !
17! !
18! d(S')/d(t) = N(So) + A(S' - So) !
19! !
20! where S' is the tangent linear state and So is the "basic state". !
21! The "basic state" here is the solution of previous tangent linear !
22! model iteration. !
23! !
24! This driver uses ESMF conventions for the initialization, time- !
25! stepping, and finalization of the representer tangent linear !
26! model via: !
27! !
28! ROMS_initialize !
29! ROMS_run !
30! ROMS_finalize !
31! !
32!=======================================================================
33!
34 USE mod_param
35 USE mod_parallel
36 USE mod_arrays
37 USE mod_iounits
38 USE mod_ncparam
39 USE mod_scalars
40!
42 USE inp_par_mod, ONLY : inp_par
43#ifdef MCT_LIB
44# ifdef ATM_COUPLING
45 USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling
46# endif
47# ifdef WAV_COUPLING
48 USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling
49# endif
50#endif
52 USE strings_mod, ONLY : founderror
53 USE wrt_rst_mod, ONLY : wrt_rst
54!
55 implicit none
56!
57 PUBLIC :: roms_initialize
58 PUBLIC :: roms_run
59 PUBLIC :: roms_finalize
60!
61 CONTAINS
62!
63 SUBROUTINE roms_initialize (first, mpiCOMM)
64!
65!=======================================================================
66! !
67! This routine allocates and initializes ROMS state variables !
68! and internal and external parameters. !
69! !
70!=======================================================================
71!
72! Imported variable declarations.
73!
74 logical, intent(inout) :: first
75!
76 integer, intent(in), optional :: mpiCOMM
77!
78! Local variable declarations.
79!
80 logical :: allocate_vars = .true.
81!
82#ifdef DISTRIBUTE
83 integer :: MyError, MySize
84#endif
85 integer :: chunk_size, ng, thread
86#ifdef _OPENMP
87 integer :: my_threadnum
88#endif
89!
90 character (len=*), parameter :: MyFile = &
91 & __FILE__//", ROMS_initialize"
92
93#ifdef DISTRIBUTE
94!
95!-----------------------------------------------------------------------
96! Set distribute-memory (mpi) world communictor.
97!-----------------------------------------------------------------------
98!
99 IF (PRESENT(mpicomm)) THEN
100 ocn_comm_world=mpicomm
101 ELSE
102 ocn_comm_world=mpi_comm_world
103 END IF
104 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
105 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
106#endif
107!
108!-----------------------------------------------------------------------
109! On first pass, initialize model parameters a variables for all
110! nested/composed grids. Notice that the logical switch "first"
111! is used to allow multiple calls to this routine during ensemble
112! configurations.
113!-----------------------------------------------------------------------
114!
115 IF (first) THEN
116 first=.false.
117!
118! Initialize parallel control switches. These scalars switches are
119! independent from standard input parameters.
120!
122!
123! Set the ROMS standard output unit to write verbose execution info.
124! Notice that the default standard out unit in Fortran is 6.
125!
126! In some applications like coupling or disjointed mpi-communications,
127! it is advantageous to write standard output to a specific filename
128! instead of the default Fortran standard output unit 6. If that is
129! the case, it opens such formatted file for writing.
130!
131 IF (set_stdoutunit) THEN
133 set_stdoutunit=.false.
134 END IF
135!
136! Read in model tunable parameters from standard input. Allocate and
137! initialize variables in several modules after the number of nested
138! grids and dimension parameters are known.
139!
140 CALL inp_par (inlm)
141 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
142!
143! Set domain decomposition tile partition range. This range is
144! computed only once since the "first_tile" and "last_tile" values
145! are private for each parallel thread/node.
146!
147!$OMP PARALLEL
148#if defined _OPENMP
149 mythread=my_threadnum()
150#elif defined DISTRIBUTE
152#else
153 mythread=0
154#endif
155 DO ng=1,ngrids
156 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
157 first_tile(ng)=mythread*chunk_size
158 last_tile(ng)=first_tile(ng)+chunk_size-1
159 END DO
160!$OMP END PARALLEL
161!
162! Initialize internal wall clocks. Notice that the timings does not
163! includes processing standard input because several parameters are
164! needed to allocate clock variables.
165!
166 IF (master) THEN
167 WRITE (stdout,10)
168 10 FORMAT (/,' Process Information:',/)
169 END IF
170!
171 DO ng=1,ngrids
172!$OMP PARALLEL
173 DO thread=thread_range
174 CALL wclock_on (ng, inlm, 0, __line__, myfile)
175 END DO
176!$OMP END PARALLEL
177 END DO
178!
179! Allocate and initialize modules variables.
180!
181!$OMP PARALLEL
182 CALL roms_allocate_arrays (allocate_vars)
184!$OMP END PARALLEL
185 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
186
187 END IF
188
189#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
190!
191!-----------------------------------------------------------------------
192! Initialize coupling streams between model(s).
193!-----------------------------------------------------------------------
194!
195 DO ng=1,ngrids
196# ifdef ATM_COUPLING
197 CALL initialize_ocn2atm_coupling (ng, myrank)
198# endif
199# ifdef WAV_COUPLING
200 CALL initialize_ocn2wav_coupling (ng, myrank)
201# endif
202 END DO
203#endif
204!
205 RETURN
206 END SUBROUTINE roms_initialize
207!
208 SUBROUTINE roms_run (RunInterval)
209!
210!=======================================================================
211! !
212! This routine time-steps ROMS representer tangent linear model !
213! for the specified time interval (seconds), RunInterval. !
214! !
215!=======================================================================
216!
217! Imported variable declarations
218!
219 real(dp), intent(in) :: RunInterval ! seconds
220!
221! Local variable declarations.
222!
223 integer :: ng
224!
225 character (len=*), parameter :: MyFile = &
226 & __FILE__//", ROMS_run"
227!
228!-----------------------------------------------------------------------
229! Run Picard iteratons.
230!-----------------------------------------------------------------------
231!
232! Use ensemble parameters for Picard itereations.
233!
234 iter_loop : DO nrun=erstr,erend
235!
236! Cycle history and forward file names in such a way that the history
237! from the previous iteration becomes the basic state for the next.
238!
239 DO ng=1,ngrids
240 WRITE (tlm(ng)%name,10) trim(tlm(ng)%head), nrun
241 WRITE (fwd(ng)%name,10) trim(tlm(ng)%head), nrun-1
242
243 IF (master) THEN
244 WRITE (stdout,20) 'ROMS Picard Iteration: ', nrun, ng, &
245 & trim(tlm(ng)%name), &
246 & trim(fwd(ng)%name)
247 END IF
248 END DO
249!
250! Activate defining history an restart files on each iteration. The
251! restart file is used to the store the solution of each iteration.
252!
253 DO ng=1,ngrids
254 iic(ng)=0
255 ldeftlm(ng)=.true.
256 lwrttlm(ng)=.true.
257 ldefrst(ng)=.false.
258 END DO
259!
260! Initialize representer tangent linear model.
261!
262 DO ng=1,ngrids
263!$OMP PARALLEL
264 CALL rp_initial (ng)
265!$OMP END PARALLEL
266 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
267 END DO
268!
269! Time-step representers tangent linear model
270!
271 DO ng=1,ngrids
272 IF (master) THEN
273 WRITE (stdout,30) 'RP', ng, ntstart(ng), ntend(ng)
274 END IF
275 END DO
276
277!$OMP PARALLEL
278#ifdef SOLVE3D
279 CALL rp_main3d (runinterval)
280#else
281 CALL rp_main2d (runinterval)
282#endif
283!$OMP END PARALLEL
284 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
285!
286! Close IO and re-initialize NetCDF switches.
287!
288 DO ng=1,ngrids
289 CALL close_file (ng, irpm, tlm(ng))
290 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
291!
292 CALL close_file (ng, irpm, fwd(ng))
293 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
294 END DO
295
296 END DO iter_loop
297!
298 10 FORMAT (a,'_',i3.3,'.nc')
299 20 FORMAT (/,a,i3,2x,'(Grid: ',i0,')',/, &
300 & /,5x,' History file: ',a, &
301 & /,5x,' Forward file: ',a,/)
302 30 FORMAT (/,1x,a,1x,'ROMS: started time-stepping:', &
303 & ' (Grid: ',i0,' TimeSteps: ',i0,' - ',i0,')',/)
304!
305 RETURN
306 END SUBROUTINE roms_run
307!
308 SUBROUTINE roms_finalize
309!
310!=======================================================================
311! !
312! This routine terminates ROMS nonlinear model execution. !
313! !
314!=======================================================================
315!
316! Local variable declarations.
317!
318 integer :: Fcount, ng, thread
319!
320 character (len=*), parameter :: MyFile = &
321 & __FILE__//", ROMS_finalize"
322!
323!-----------------------------------------------------------------------
324! If blowing-up, save latest model state into RESTART NetCDF file.
325!-----------------------------------------------------------------------
326!
327! If cycling restart records, write solution into the next record.
328!
329 IF (exit_flag.eq.1) THEN
330 DO ng=1,ngrids
331 IF (lwrtrst(ng)) THEN
332 IF (master) WRITE (stdout,10)
333 10 FORMAT (/,' Blowing-up: Saving latest model state into ', &
334 & ' RESTART file',/)
335 fcount=rst(ng)%load
336 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
337 rst(ng)%Rindex=2
338 lcyclerst(ng)=.false.
339 END IF
342#ifdef DISTRIBUTE
343 CALL wrt_rst (ng, myrank)
344#else
345 CALL wrt_rst (ng, -1)
346#endif
347 END IF
348 END DO
349 END IF
350!
351!-----------------------------------------------------------------------
352! Stop model and time profiling clocks, report memory requirements, and
353! close output NetCDF files.
354!-----------------------------------------------------------------------
355!
356! Stop time clocks.
357!
358 IF (master) THEN
359 WRITE (stdout,20)
360 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
361 END IF
362!
363 DO ng=1,ngrids
364!$OMP PARALLEL
365 DO thread=thread_range
366 CALL wclock_off (ng, inlm, 0, __line__, myfile)
367 END DO
368!$OMP END PARALLEL
369 END DO
370!
371! Report dynamic memory and automatic memory requirements.
372!
373!$OMP PARALLEL
374 CALL memory
375!$OMP END PARALLEL
376!
377! Close IO files.
378!
379 DO ng=1,ngrids
380 CALL close_inp (ng, inlm)
381 END DO
382 CALL close_out
383!
384 RETURN
385 END SUBROUTINE roms_finalize
386
387 END MODULE roms_kernel_mod
subroutine memory
Definition memory.F:3
subroutine, public close_out
Definition close_io.F:175
subroutine, public close_file(ng, model, s, ncname, lupdate)
Definition close_io.F:43
subroutine, public close_inp(ng, model)
Definition close_io.F:92
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 tlm
type(t_io), dimension(:), allocatable fwd
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, 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
integer, dimension(:), allocatable iic
integer blowup
integer erend
integer, dimension(:), allocatable ntend
integer exit_flag
integer erstr
logical, dimension(:), allocatable ldefrst
logical, dimension(:), allocatable lwrttlm
logical, dimension(:), allocatable lwrtrst
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable ntstart
integer nrun
integer noerror
logical, dimension(:), allocatable lcyclerst
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
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_rst(ng, tile)
Definition wrt_rst.F:63
subroutine rp_initial(ng)
Definition rp_initial.F:4
subroutine rp_main2d
Definition rp_main2d.F:410
subroutine rp_main3d(runinterval)
Definition rp_main3d.F:4
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