ROMS
Loading...
Searching...
No Matches
nl_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 !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! ROMS Nonlinear Model Driver: !
11! !
12! This driver executes ROMS standard nonlinear model. It !
13! controls the initialization, time-stepping, and finalization !
14! of the nonlinear model execution following ESMF conventions: !
15! !
16! ROMS_initialize !
17! ROMS_run !
18! ROMS_finalize !
19! !
20!=======================================================================
21!
22 USE mod_param
23 USE mod_parallel
24 USE mod_arrays
25#ifdef VERIFICATION
26 USE mod_fourdvar
27#endif
28 USE mod_iounits
29 USE mod_ncparam
30 USE mod_scalars
31!
32#ifdef VERIFICATION
33 USE def_mod_mod, ONLY : def_mod
34#endif
36 USE inp_par_mod, ONLY : inp_par
37#ifdef MCT_LIB
38# ifdef ATM_COUPLING
39 USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling
40# endif
41# ifdef WAV_COUPLING
42 USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling
43# endif
44#endif
45#ifdef VERIFICATION
47#endif
49 USE strings_mod, ONLY : founderror
50 USE wrt_rst_mod, ONLY : wrt_rst
51!
52 implicit none
53!
54 PRIVATE
55 PUBLIC :: roms_initialize
56 PUBLIC :: roms_run
57 PUBLIC :: roms_finalize
58!
59 CONTAINS
60!
61 SUBROUTINE roms_initialize (first, mpiCOMM)
62!
63!=======================================================================
64! !
65! This routine allocates and initializes ROMS state variables !
66! and internal and external parameters. !
67! !
68!=======================================================================
69!
70! Imported variable declarations.
71!
72 logical, intent(inout) :: first
73!
74 integer, intent(in), optional :: mpiCOMM
75!
76! Local variable declarations.
77!
78 logical :: allocate_vars = .true.
79!
80#ifdef DISTRIBUTE
81 integer :: MyError, MySize
82#endif
83 integer :: chunk_size, ng, thread
84#ifdef _OPENMP
85 integer :: my_threadnum
86#endif
87!
88 character (len=*), parameter :: MyFile = &
89 & __FILE__//", ROMS_initialize"
90
91#ifdef DISTRIBUTE
92!
93!-----------------------------------------------------------------------
94! Set distribute-memory (mpi) world communictor.
95!-----------------------------------------------------------------------
96!
97 IF (PRESENT(mpicomm)) THEN
98 ocn_comm_world=mpicomm
99 ELSE
100 ocn_comm_world=mpi_comm_world
101 END IF
102 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
103 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
104#endif
105!
106!-----------------------------------------------------------------------
107! On first pass, initialize model parameters a variables for all
108! nested/composed grids. Notice that the logical switch "first"
109! is used to allow multiple calls to this routine during ensemble
110! configurations.
111!-----------------------------------------------------------------------
112!
113 IF (first) THEN
114 first=.false.
115!
116! Initialize parallel control switches. These scalars switches are
117! independent from standard input parameters.
118!
120!
121! Set the ROMS standard output unit to write verbose execution info.
122! Notice that the default standard out unit in Fortran is 6.
123!
124! In some applications like coupling or disjointed mpi-communications,
125! it is advantageous to write standard output to a specific filename
126! instead of the default Fortran standard output unit 6. If that is
127! the case, it opens such formatted file for writing.
128!
129 IF (set_stdoutunit) THEN
131 set_stdoutunit=.false.
132 END IF
133!
134! Read in model tunable parameters from standard input. Allocate and
135! initialize variables in several modules after the number of nested
136! grids and dimension parameters are known.
137!
138 CALL inp_par (inlm)
139 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
140!
141! Set domain decomposition tile partition range. This range is
142! computed only once since the "first_tile" and "last_tile" values
143! are private for each parallel thread/node.
144!
145!$OMP PARALLEL
146#if defined _OPENMP
147 mythread=my_threadnum()
148#elif defined DISTRIBUTE
150#else
151 mythread=0
152#endif
153 DO ng=1,ngrids
154 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
155 first_tile(ng)=mythread*chunk_size
156 last_tile(ng)=first_tile(ng)+chunk_size-1
157 END DO
158!$OMP END PARALLEL
159!
160! Initialize internal wall clocks. Notice that the timings does not
161! includes processing standard input because several parameters are
162! needed to allocate clock variables.
163!
164 IF (master) THEN
165 WRITE (stdout,10)
166 10 FORMAT (/,' Process Information:',/)
167 END IF
168!
169 DO ng=1,ngrids
170!$OMP PARALLEL
171 DO thread=thread_range
172 CALL wclock_on (ng, inlm, 0, __line__, myfile)
173 END DO
174!$OMP END PARALLEL
175 END DO
176!
177! Allocate and initialize all model state arrays.
178!
179!$OMP PARALLEL
180 CALL roms_allocate_arrays (allocate_vars)
182!$OMP END PARALLEL
183 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
184
185 END IF
186
187#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
188!
189!-----------------------------------------------------------------------
190! Initialize coupling streams between model(s).
191!-----------------------------------------------------------------------
192!
193 DO ng=1,ngrids
194# ifdef ATM_COUPLING
195 CALL initialize_ocn2atm_coupling (ng, myrank)
196# endif
197# ifdef WAV_COUPLING
198 CALL initialize_ocn2wav_coupling (ng, myrank)
199# endif
200 END DO
201#endif
202!
203!-----------------------------------------------------------------------
204! Initialize nonlinear model state variables over all nested grids,
205! if applicable.
206!-----------------------------------------------------------------------
207!
208!$OMP PARALLEL
209 CALL initial
210!$OMP END PARALLEL
211 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
212!
213! Initialize run or ensemble counter.
214!
215 nrun=1
216
217#ifdef VERIFICATION
218!
219! Create NetCDF file for model solution at observation locations.
220!
221 IF (nrun.eq.1) THEN
222 DO ng=1,ngrids
223 ldefmod(ng)=.true.
224 wrtnlmod(ng)=.true.
225 wrtobsscale(ng)=.true.
226 CALL def_mod (ng)
227 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
228 END DO
229 END IF
230#endif
231#ifdef ENKF_RESTART
232!
233! Create Ensenble Kalman Filter (EnKF) reastart NetCDF file.
234!
235 IF (nrun.eq.1) THEN
236 DO ng=1,ngrids
237 ldefdai(ng)=.true.
238 CALL def_dai (ng)
239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
240 END DO
241 END IF
242#endif
243!
244 RETURN
245 END SUBROUTINE roms_initialize
246!
247 SUBROUTINE roms_run (RunInterval)
248!
249!=======================================================================
250! !
251! This routine runs ROMS nonlinear model for the specified time !
252! interval (seconds), RunInterval. It RunInterval=0, ROMS advances !
253! one single time-step. !
254! !
255!=======================================================================
256!
257! Imported variable declarations.
258!
259 real(dp), intent(in) :: RunInterval ! seconds
260!
261! Local variable declarations.
262!
263 integer :: ng
264#if defined MODEL_COUPLING && !defined MCT_LIB
265 integer :: NstrStep, NendStep, extra
266!
267 real(dp) :: ENDtime, NEXTtime
268#endif
269!
270 character (len=*), parameter :: MyFile = &
271 & __FILE__//", ROMS_run"
272!
273!-----------------------------------------------------------------------
274! Time-step nonlinear model over nested grids, if applicable.
275#if defined MODEL_COUPLING && !defined MCT_LIB
276! Since the ROMS kernel has a delayed output and line diagnostics by
277! one timestep, subtact an extra value to the report of starting and
278! ending timestep for clarity. Usually, the model coupling interval
279! is of the same size as ROMS timestep.
280#endif
281!-----------------------------------------------------------------------
282!
283 myruninterval=runinterval
284 IF (master) WRITE (stdout,'(1x)')
285 DO ng=1,ngrids
286#if defined MODEL_COUPLING && !defined MCT_LIB
287 nexttime=time(ng)+runinterval
288 endtime=initime(ng)+(ntimes(ng)-1)*dt(ng)
289 IF ((nexttime.eq.endtime).and.(ng.eq.1)) THEN
290 extra=0 ! last time interval
291 ELSE
292 extra=1
293 END IF
294 step_counter(ng)=0
295 nstrstep=iic(ng)
296 nendstep=nstrstep+int((myruninterval)/dt(ng))-extra
297 IF (master) WRITE (stdout,10) 'NL', ng, nstrstep, nendstep
298#else
299 IF (master) WRITE (stdout,10) 'NL', ng, ntstart(ng), ntend(ng)
300#endif
301 END DO
302 IF (master) WRITE (stdout,'(1x)')
303!
304!$OMP PARALLEL
305#ifdef SOLVE3D
306 CALL main3d (myruninterval)
307#else
308 CALL main2d (myruninterval)
309#endif
310!$OMP END PARALLEL
311
312 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
313!
314 10 FORMAT (1x,a,1x,'ROMS: started time-stepping:', &
315 & ' (Grid: ',i2.2,' TimeSteps: ',i12.12,' - ',i12.12,')')
316!
317 RETURN
318 END SUBROUTINE roms_run
319!
320 SUBROUTINE roms_finalize
321!
322!=======================================================================
323! !
324! This routine terminates ROMS nonlinear model execution. !
325! !
326!=======================================================================
327!
328! Local variable declarations.
329!
330 integer :: Fcount, ng, thread
331!
332 character (len=*), parameter :: MyFile = &
333 & __FILE__//", ROMS_finalize"
334
335#ifdef ENKF_RESTART
336!
337!-----------------------------------------------------------------------
338! Write out initial conditions for the next time window of the Ensemble
339! Kalman (EnKF) filter.
340!-----------------------------------------------------------------------
341!
342 IF (exit_flag.eq.noerror) THEN
343 DO ng=1,ngrids
344# ifdef DISTRIBUTE
345 CALL wrt_dai (ng, myrank)
346# else
347 CALL wrt_dai (ng, -1)
348# endif
349 END DO
350 END IF
351#endif
352#ifdef VERIFICATION
353!
354!-----------------------------------------------------------------------
355! Compute and report model-observation comparison statistics.
356!-----------------------------------------------------------------------
357!
358 DO ng=1,ngrids
359# ifdef DISTRIBUTE
360 CALL stats_modobs (ng, myrank)
361# else
362 CALL stats_modobs (ng, -1)
363# endif
364 END DO
365#endif
366!
367!-----------------------------------------------------------------------
368! If blowing-up, save latest model state into RESTART NetCDF file.
369!-----------------------------------------------------------------------
370!
371! If cycling restart records, write solution into the next record.
372!
373 IF (exit_flag.eq.1) THEN
374 DO ng=1,ngrids
375 IF (lwrtrst(ng)) THEN
376 IF (master) WRITE (stdout,10) trim(blowup_string)
377 10 FORMAT (/,' Blowing-up: Saving latest model state into ', &
378 & ' RESTART file',/,' REASON: ',a,/)
379 fcount=rst(ng)%load
380 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
381 rst(ng)%Rindex=2
382 lcyclerst(ng)=.false.
383 END IF
386#ifdef DISTRIBUTE
387 CALL wrt_rst (ng, myrank)
388#else
389 CALL wrt_rst (ng, -1)
390#endif
391 END IF
392 END DO
393 END IF
394!
395!-----------------------------------------------------------------------
396! Stop model and time profiling clocks, report memory requirements, and
397! close output NetCDF files.
398!-----------------------------------------------------------------------
399!
400! Stop time clocks.
401!
402 IF (master) THEN
403 WRITE (stdout,20)
404 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
405 END IF
406!
407 DO ng=1,ngrids
408!$OMP PARALLEL
409 DO thread=thread_range
410 CALL wclock_off (ng, inlm, 0, __line__, myfile)
411 END DO
412!$OMP END PARALLEL
413 END DO
414!
415! Report dynamic memory and automatic memory requirements.
416!
417!$OMP PARALLEL
418 CALL memory
419!$OMP END PARALLEL
420!
421! Close IO files.
422!
423 DO ng=1,ngrids
424 CALL close_inp (ng, inlm)
425 END DO
426 CALL close_out
427!
428 RETURN
429 END SUBROUTINE roms_finalize
430
431 END MODULE roms_kernel_mod
subroutine initial
Definition initial.F:3
subroutine main2d
Definition main2d.F:746
subroutine main3d(runinterval)
Definition main3d.F:4
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_mod(ng)
Definition def_mod.F:49
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
logical, dimension(:), allocatable wrtnlmod
logical, dimension(:), allocatable wrtobsscale
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, dimension(:), allocatable ntimes
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
integer blowup
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable ldefmod
integer exit_flag
real(dp) myruninterval
logical, dimension(:), allocatable lwrtrst
real(dp), dimension(:), allocatable time
character(len=80) blowup_string
integer, dimension(:), allocatable ntstart
integer nrun
integer, dimension(:), allocatable step_counter
logical, dimension(:), allocatable ldefdai
real(dp), dimension(:), allocatable initime
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
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_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