ROMS
Loading...
Searching...
No Matches
ad_roms.h
Go to the documentation of this file.
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 Adjoint Adjoint Model Driver: !
11! !
12! This driver executes ROMS generic adjoint model. It controls !
13! the initialization, time-stepping, and finalization of the adjoint !
14! 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 (iadm)
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#if defined _OPENMP
137#elif defined DISTRIBUTE
139#else
140 mythread=0
141#endif
142 DO ng=1,ngrids
143 chunk_size=(ntilex(ng)*ntilee(ng)+numthreads-1)/numthreads
144 first_tile(ng)=mythread*chunk_size
145 last_tile(ng)=first_tile(ng)+chunk_size-1
146 END DO
147!
148! Initialize internal wall clocks. Notice that the timings does not
149! includes processing standard input because several parameters are
150! needed to allocate clock variables.
151!
152 IF (master) THEN
153 WRITE (stdout,10)
154 10 FORMAT (/,' Process Information:',/)
155 END IF
156!
157 DO ng=1,ngrids
158 DO thread=thread_range
159 CALL wclock_on (ng, iadm, 0, __line__, myfile)
160 END DO
161 END DO
162!
163! Allocate and initialize modules variables.
164!
165 CALL roms_allocate_arrays (allocate_vars)
167 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
168
169 END IF
170
171#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
172!
173!-----------------------------------------------------------------------
174! Initialize coupling streams between model(s).
175!-----------------------------------------------------------------------
176!
177 DO ng=1,ngrids
178# ifdef ATM_COUPLING
179 CALL initialize_ocn2atm_coupling (ng, myrank)
180# endif
181# ifdef WAV_COUPLING
182 CALL initialize_ocn2wav_coupling (ng, myrank)
183# endif
184 END DO
185#endif
186!
187!-----------------------------------------------------------------------
188! Initialize adjoint model state variables over all nested grids, if
189! applicable.
190!-----------------------------------------------------------------------
191
192#ifdef FORWARD_FLUXES
193!
194! Set the BLK structure to contain the nonlinear model surface fluxes
195! needed by the tangent linear and adjoint models. Also, set switches
196! to process that structure in routine "check_multifile". Notice that
197! it is possible to split the solution into multiple NetCDF files to
198! reduce their size.
199!
200! The switch LreadFRC is deactivated because all the atmospheric
201! forcing, including shortwave radiation, is read from the NLM
202! surface fluxes or is assigned during ESM coupling. Such fluxes
203! are available from the QCK structure. There is no need for reading
204! and processing from the FRC structure input forcing-files.
205!
206 CALL edit_multifile ('QCK2BLK')
207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
208 DO ng=1,ngrids
209 lreadblk(ng)=.true.
210 lreadfrc(ng)=.false.
211 END DO
212#endif
213!
214! Initialize adjoint model.
215!
216 lstiffness=.false.
217 DO ng=1,ngrids
218 lreadfwd(ng)=.true.
219 CALL ad_initial (ng)
220 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
221 END DO
222!
223! Initialize run or ensemble counter.
224!
225 nrun=1
226!
227! Activate adjoint output.
228!
229 DO ng=1,ngrids
230 ldefadj(ng)=.true.
231 lwrtadj(ng)=.true.
232 lcycleadj(ng)=.false.
233 END DO
234!
235 RETURN
236 END SUBROUTINE roms_initialize
237!
238 SUBROUTINE roms_run (RunInterval)
239!
240!=======================================================================
241! !
242! This routine runs ROMS adjoint model backwards for the !
243! specified time interval (seconds), RunInterval. !
244! !
245!=======================================================================
246!
247! Imported variable declarations.
248!
249 real(dp), intent(in) :: runinterval ! seconds
250!
251! Local variable declarations.
252!
253 integer :: ng
254!
255 character (len=*), parameter :: myfile = &
256 & __FILE__//", ROMS_run"
257!
258!-----------------------------------------------------------------------
259! Time-step adjoint model over all nested grids, if applicable.
260!-----------------------------------------------------------------------
261!
262 DO ng=1,ngrids
263 IF (master) THEN
264 WRITE (stdout,10) 'AD', ng, ntstart(ng), ntend(ng)
265 END IF
266 END DO
267!
268#ifdef SOLVE3D
269 CALL ad_main3d (runinterval)
270#else
271 CALL ad_main2d (runinterval)
272#endif
273
274 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
275!
276 10 FORMAT (/,1x,a,1x,'ROMS: started time-stepping:', &
277 & ' (Grid: ',i2.2,' TimeSteps: ',i8.8,' - ',i8.8,')',/)
278!
279 RETURN
280 END SUBROUTINE roms_run
281!
282 SUBROUTINE roms_finalize
283!
284!=======================================================================
285! !
286! This routine terminates ROMS adjoint model execution. !
287! !
288!=======================================================================
289!
290! Local variable declarations.
291!
292 integer :: fcount, ng, thread
293!
294 character (len=*), parameter :: myfile = &
295 & __FILE__//", ROMS_finalize"
296!
297!-----------------------------------------------------------------------
298! If blowing-up, save latest model state into RESTART NetCDF file.
299!-----------------------------------------------------------------------
300!
301! If cycling restart records, write solution into the next record.
302!
303 IF (exit_flag.eq.1) THEN
304 DO ng=1,ngrids
305 IF (lwrtrst(ng)) THEN
306 IF (master) WRITE (stdout,10)
307 10 FORMAT (/,' Blowing-up: Saving latest model state into ', &
308 & ' RESTART file',/)
309 fcount=rst(ng)%load
310 IF (lcyclerst(ng).and.(rst(ng)%Nrec(fcount).ge.2)) THEN
311 rst(ng)%Rindex=2
312 lcyclerst(ng)=.false.
313 END IF
316#ifdef DISTRIBUTE
317 CALL wrt_rst (ng, myrank)
318#else
319 CALL wrt_rst (ng, -1)
320#endif
321 END IF
322 END DO
323 END IF
324!
325!-----------------------------------------------------------------------
326! Stop model and time profiling clocks, report memory requirements, and
327! close output NetCDF files.
328!-----------------------------------------------------------------------
329!
330! Stop time clocks.
331!
332 IF (master) THEN
333 WRITE (stdout,20)
334 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/)
335 END IF
336!
337 DO ng=1,ngrids
338 DO thread=thread_range
339 CALL wclock_off (ng, iadm, 0, __line__, myfile)
340 END DO
341 END DO
342!
343! Report dynamic memory and automatic memory requirements.
344!
345 CALL memory
346!
347! Close IO files.
348!
349 DO ng=1,ngrids
350 CALL close_inp (ng, iadm)
351 END DO
352 CALL close_out
353!
354 RETURN
355 END SUBROUTINE roms_finalize
356
357 END MODULE roms_kernel_mod
subroutine ad_initial(ng)
Definition ad_initial.F:4
subroutine ad_main2d
Definition ad_main2d.F:586
subroutine ad_main3d(runinterval)
Definition ad_main3d.F:4
subroutine edit_multifile(task)
subroutine memory
Definition memory.F:3
integer function my_threadnum()
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, dimension(:), allocatable ntilex
Definition mod_param.F:685
integer, parameter iadm
Definition mod_param.F:665
integer ngrids
Definition mod_param.F:113
integer, dimension(:), allocatable ntilee
Definition mod_param.F:686
logical lstiffness
integer blowup
logical, dimension(:), allocatable lreadfrc
logical, dimension(:), allocatable ldefadj
logical, dimension(:), allocatable lcycleadj
logical, dimension(:), allocatable lwrtadj
integer, dimension(:), allocatable ntend
integer exit_flag
logical, dimension(:), allocatable lwrtrst
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
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