ROMS
Loading...
Searching...
No Matches
rp_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 Representers Tangent Linear Model Driver: !
11! !
12! This driver executes ROMS representers tangent linear model. !
13! It controls the initialization, time-stepping, and finalization !
14! of the representers 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 USE mod_iounits
26 USE mod_ncparam
27 USE mod_scalars
28!
30 USE inp_par_mod, ONLY : inp_par
31#ifdef MCT_LIB
32# ifdef ATM_COUPLING
33 USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling
34# endif
35# ifdef WAV_COUPLING
36 USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling
37# endif
38#endif
40 USE strings_mod, ONLY : founderror
41 USE wrt_rst_mod, ONLY : wrt_rst
42!
43 implicit none
44!
45 PUBLIC :: roms_initialize
46 PUBLIC :: roms_run
47 PUBLIC :: roms_finalize
48!
49 CONTAINS
50!
51 SUBROUTINE roms_initialize (first, mpiCOMM)
52!
53!=======================================================================
54! !
55! This routine allocates and initializes ROMS state variables !
56! and internal and external parameters. !
57! !
58!=======================================================================
59!
60! Imported variable declarations.
61!
62 logical, intent(inout) :: first
63!
64 integer, intent(in), optional :: mpiCOMM
65!
66! Local variable declarations.
67!
68 logical :: allocate_vars = .true.
69!
70#ifdef DISTRIBUTE
71 integer :: MyError, MySize
72#endif
73 integer :: chunk_size, ng, thread
74#ifdef _OPENMP
75 integer :: my_threadnum
76#endif
77!
78 character (len=*), parameter :: MyFile = &
79 & __FILE__//", ROMS_initialize"
80
81#ifdef DISTRIBUTE
82!
83!-----------------------------------------------------------------------
84! Set distribute-memory (mpi) world communictor.
85!-----------------------------------------------------------------------
86!
87 IF (PRESENT(mpicomm)) THEN
88 ocn_comm_world=mpicomm
89 ELSE
90 ocn_comm_world=mpi_comm_world
91 END IF
92 CALL mpi_comm_rank (ocn_comm_world, myrank, myerror)
93 CALL mpi_comm_size (ocn_comm_world, mysize, myerror)
94#endif
95!
96!-----------------------------------------------------------------------
97! On first pass, initialize model parameters a variables for all
98! nested/composed grids. Notice that the logical switch "first"
99! is used to allow multiple calls to this routine during ensemble
100! configurations.
101!-----------------------------------------------------------------------
102!
103 IF (first) THEN
104 first=.false.
105!
106! Initialize parallel control switches. These scalars switches are
107! independent from standard input parameters.
108!
110!
111! Set the ROMS standard output unit to write verbose execution info.
112! Notice that the default standard out unit in Fortran is 6.
113!
114! In some applications like coupling or disjointed mpi-communications,
115! it is advantageous to write standard output to a specific filename
116! instead of the default Fortran standard output unit 6. If that is
117! the case, it opens such formatted file for writing.
118!
119 IF (set_stdoutunit) THEN
121 set_stdoutunit=.false.
122 END IF
123!
124! Read in model tunable parameters from standard input. Allocate and
125! initialize variables in several modules after the number of nested
126! grids and dimension parameters are known.
127!
128 CALL inp_par (irpm)
129 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
130!
131! Set domain decomposition tile partition range. This range is
132! computed only once since the "first_tile" and "last_tile" values
133! are private for each parallel thread/node.
134!
135!$OMP PARALLEL
136#if defined _OPENMP
137 mythread=my_threadnum()
138#elif defined DISTRIBUTE
140#else
141 mythread=0
142#endif
143 DO ng=1,ngrids
144 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
145 first_tile(ng)=mythread*chunk_size
146 last_tile(ng)=first_tile(ng)+chunk_size-1
147 END DO
148!$OMP END PARALLEL
149!
150! Initialize internal wall clocks. Notice that the timings does not
151! includes processing standard input because several parameters are
152! needed to allocate clock variables.
153!
154 IF (master) THEN
155 WRITE (stdout,10)
156 10 FORMAT (/,' Process Information:',/)
157 END IF
158!
159 DO ng=1,ngrids
160!$OMP PARALLEL
161 DO thread=thread_range
162 CALL wclock_on (ng, irpm, 0, __line__, myfile)
163 END DO
164!$OMP END PARALLEL
165 END DO
166!
167! Allocate and initialize modules variables.
168!
169!$OMP PARALLEL
170 CALL roms_allocate_arrays (allocate_vars)
172!$OMP END PARALLEL
173 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
174
175 END IF
176
177#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
178!
179!-----------------------------------------------------------------------
180! Initialize coupling streams between model(s).
181!-----------------------------------------------------------------------
182!
183 DO ng=1,ngrids
184# ifdef ATM_COUPLING
185 CALL initialize_ocn2atm_coupling (ng, myrank)
186# endif
187# ifdef WAV_COUPLING
188 CALL initialize_ocn2wav_coupling (ng, myrank)
189# endif
190 END DO
191#endif
192!
193!-----------------------------------------------------------------------
194! Initialize representers model state variables over all nested grids,
195! if applicable.
196!-----------------------------------------------------------------------
197
198#ifdef FORWARD_FLUXES
199!
200! Set the BLK structure to contain the nonlinear model surface fluxes
201! needed by the tangent linear and adjoint models. Also, set switches
202! to process that structure in routine "check_multifile". Notice that
203! it is possible to split the solution into multiple NetCDF files to
204! reduce their size.
205!
206! The switch LreadFRC is deactivated because all the atmospheric
207! forcing, including shortwave radiation, is read from the NLM
208! surface fluxes or is assigned during ESM coupling. Such fluxes
209! are available from the QCK structure. There is no need for reading
210! and processing from the FRC structure input forcing-files.
211!
212 CALL edit_multifile ('QCK2BLK')
213 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
214 DO ng=1,ngrids
215 lreadblk(ng)=.true.
216 lreadfrc(ng)=.false.
217 END DO
218#endif
219!
220! Initialize finite amplitude tangent linear (representer) model.
221!
222 lstiffness=.false.
223 DO ng=1,ngrids
224 lreadfwd(ng)=.true.
225!$OMP PARALLEL
226 CALL rp_initial (ng)
227!$OMP END PARALLEL
228 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
229 END DO
230!
231! Initialize run or ensemble counter.
232!
233 nrun=1
234!
235! Activate tangent linear output.
236!
237 DO ng=1,ngrids
238 ldeftlm(ng)=.true.
239 lwrttlm(ng)=.true.
240 lcycletlm(ng)=.false.
241 END DO
242!
243 RETURN
244 END SUBROUTINE roms_initialize
245!
246 SUBROUTINE roms_run (RunInterval)
247!
248!=======================================================================
249! !
250! This routine runs ROMS representers tangent linear model for !
251! the specified time interval (seconds), RunInterval. !
252! !
253!=======================================================================
254!
255! Imported variable declarations.
256!
257 real(dp), intent(in) :: RunInterval ! seconds
258!
259! Local variable declarations.
260!
261 integer :: ng
262!
263 character (len=*), parameter :: MyFile = &
264 & __FILE__//", ROMS_run"
265!
266!-----------------------------------------------------------------------
267! Time-step representers model over all nested grids, if applicable.
268!-----------------------------------------------------------------------
269!
270 DO ng=1,ngrids
271 IF (master) THEN
272 WRITE (stdout,10) 'RP', ng, ntstart(ng), ntend(ng)
273 END IF
274 END DO
275
276!$OMP PARALLEL
277#ifdef SOLVE3D
278 CALL rp_main3d (runinterval)
279#else
280 CALL rp_main2d (runinterval)
281#endif
282!$OMP END PARALLEL
283
284 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
285!
286 10 FORMAT (/,1x,a,1x,'ROMS: started time-stepping:', &
287 & ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')',/)
288!
289 RETURN
290 END SUBROUTINE roms_run
291!
292 SUBROUTINE roms_finalize
293!
294!=======================================================================
295! !
296! This routine terminates ROMS representers model execution. !
297! !
298!=======================================================================
299!
300! Local variable declarations.
301!
302 integer :: Fcount, ng, thread
303!
304 character (len=*), parameter :: MyFile = &
305 & __FILE__//", ROMS_finalize"
306!
307!-----------------------------------------------------------------------
308! If blowing-up, save latest model state into RESTART NetCDF file.
309!-----------------------------------------------------------------------
310!
311! If cycling restart records, write solution into the next record.
312!
313 IF (exit_flag.eq.1) THEN
314 DO ng=1,ngrids
315 IF (lwrtrst(ng)) THEN
316 IF (master) WRITE (stdout,10)
317 10 FORMAT (/,' Blowing-up: Saving latest model state into ', &
318 & ' RESTART file',/)
319 fcount=rst(ng)%load
320 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
321 rst(ng)%Rindex=2
322 lcyclerst(ng)=.false.
323 END IF
326#ifdef DISTRIBUTE
327 CALL wrt_rst (ng, myrank)
328#else
329 CALL wrt_rst (ng, -1)
330#endif
331 END IF
332 END DO
333 END IF
334!
335!-----------------------------------------------------------------------
336! Stop model and time profiling clocks, report memory requirements, and
337! close output NetCDF files.
338!-----------------------------------------------------------------------
339!
340! Stop time clocks.
341!
342 IF (master) THEN
343 WRITE (stdout,20)
344 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
345 END IF
346!
347 DO ng=1,ngrids
348!$OMP PARALLEL
349 DO thread=thread_range
350 CALL wclock_off (ng, irpm, 0, __line__, myfile)
351 END DO
352!$OMP END PARALLEL
353 END DO
354!
355! Report dynamic memory and automatic memory requirements.
356!
357!$OMP PARALLEL
358 CALL memory
359!$OMP END PARALLEL
360!
361! Close IO files.
362!
363 DO ng=1,ngrids
364 CALL close_inp (ng, irpm)
365 END DO
366 CALL close_out
367!
368 RETURN
369 END SUBROUTINE roms_finalize
370
371 END MODULE roms_kernel_mod
subroutine edit_multifile(task)
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 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 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
logical lstiffness
integer blowup
logical, dimension(:), allocatable lreadfrc
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable lcycletlm
integer exit_flag
logical, dimension(:), allocatable lwrttlm
logical, dimension(:), allocatable lwrtrst
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable ntstart
integer nrun
logical, dimension(:), allocatable lreadfwd
integer noerror
logical, dimension(:), allocatable lcyclerst
logical, dimension(:), allocatable lreadblk
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