ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
ad_output.F File Reference
#include "cppdefs.h"
Include dependency graph for ad_output.F:

Go to the source code of this file.

Functions/Subroutines

subroutine ad_output (ng)
 

Function/Subroutine Documentation

◆ ad_output()

subroutine ad_output ( integer, intent(in) ng)

Definition at line 3 of file ad_output.F.

4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This routine manages adjoint model output. It creates output NetCDF !
13! files and writes out data into NetCDF files. If requested, it can !
14! create several adjoint history files to avoid generating too large !
15! files during a single model run. !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_parallel
21 USE mod_iounits
22 USE mod_ncparam
23 USE mod_scalars
24!
25 USE ad_def_his_mod, ONLY : ad_def_his
26 USE ad_wrt_his_mod, ONLY : ad_wrt_his
27 USE close_io_mod, ONLY : close_file
28# ifdef AD_AVERAGES
29 USE def_avg_mod, ONLY : def_avg
30# endif
31# ifdef DISTRIBUTE
32 USE distribute_mod, ONLY : mp_bcasts
33# endif
34 USE strings_mod, ONLY : founderror
35# ifdef AD_AVERAGES
36 USE wrt_avg_mod, ONLY : wrt_avg
37# endif
38!
39 implicit none
40!
41! Imported variables declarations.
42!
43 integer, intent(in) :: ng
44!
45! Local variable declarations.
46!
47 logical :: Ldefine, Lupdate, NewFile, wrtHIS
48
49 integer :: Fcount, ifile, status
50!
51 character (len=*), parameter :: MyFile = &
52 & __FILE__
53!
54 sourcefile=myfile
55
56# ifdef PROFILE
57!
58!-----------------------------------------------------------------------
59! Turn on output data time wall clock.
60!-----------------------------------------------------------------------
61!
62 CALL wclock_on (ng, iadm, 8, __line__, myfile)
63# endif
64!
65!-----------------------------------------------------------------------
66! If appropriate, process adjoint history NetCDF file.
67!-----------------------------------------------------------------------
68!
69! Turn off checking for analytical header files.
70!
71 IF (lanafile) THEN
72 lanafile=.false.
73 END IF
74!
75! If appropriate, set switch for updating biology header file global
76! attribute in output NetCDF files.
77!
78#ifdef BIOLOGY
79 lupdate=.true.
80#else
81 lupdate=.false.
82#endif
83!
84! Create output adjoint NetCDF file or prepare existing file to
85! append new data to it. Also, notice that it is possible to
86! create several files during a single model run.
87!
88 IF (ldefadj(ng)) THEN
89 IF (ndefadj(ng).gt.0) THEN
90 IF (idefadj(ng).lt.0) THEN
91 idefadj(ng)=((ntstart(ng)-1)/ndefadj(ng))*ndefadj(ng)
92 IF (idefadj(ng).lt.iic(ng)-1) THEN
93 idefadj(ng)=idefadj(ng)+ndefadj(ng)
94 END IF
95 END IF
96 IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
97 IF ((iic(ng)-1).eq.idefadj(ng)) THEN
98 adm(ng)%load=0 ! restart, reset counter
99 ldefine=.false. ! finished file, delay
100 ELSE ! creation of next file
101 ldefine=.true.
102 newfile=.false. ! unfinished file, inquire
103 END IF ! content for appending
104 idefadj(ng)=idefadj(ng)+nadj(ng) ! restart offset
105 ELSE IF ((iic(ng)-1).eq.idefadj(ng)) THEN
106 idefadj(ng)=idefadj(ng)+ndefadj(ng)
107 IF (nadj(ng).ne.ndefadj(ng).and.iic(ng).eq.ntstart(ng)) THEN
108 idefadj(ng)=idefadj(ng)+nadj(ng) ! multiple record offset
109 END IF
110 ldefine=.true.
111 newfile=.true.
112 ELSE
113 ldefine=.false.
114 END IF
115 IF (ldefine) THEN ! create new file or
116 IF (iic(ng).eq.ntstart(ng)) THEN ! inquire existing file
117 adm(ng)%load=0 ! reset filename counter
118 END IF
119 ifile=(iic(ng)-1)/ndefadj(ng)+1 ! next filename suffix
120 adm(ng)%load=adm(ng)%load+1
121 IF (adm(ng)%load.gt.adm(ng)%Nfiles) THEN
122 IF (master) THEN
123 WRITE (stdout,10) 'TLM(ng)%load = ', adm(ng)%load, &
124 & adm(ng)%Nfiles, trim(adm(ng)%base), &
125 & ifile
126 END IF
127 exit_flag=4
128 IF (founderror(exit_flag, noerror, &
129 & __line__, myfile)) RETURN
130 END IF
131 fcount=adm(ng)%load
132 adm(ng)%Nrec(fcount)=0
133 IF (master) THEN
134 WRITE (adm(ng)%name,20) trim(adm(ng)%base), ifile
135 END IF
136# ifdef DISTRIBUTE
137 CALL mp_bcasts (ng, iadm, adm(ng)%name)
138# endif
139 adm(ng)%files(fcount)=trim(adm(ng)%name)
140 CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
141 CALL ad_def_his (ng, newfile)
142 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
143 END IF
144 IF ((iic(ng).eq.ntstart(ng)).and.(nrrec(ng).ne.0)) THEN
145 lwrtadj(ng)=.false. ! avoid writing initial
146 ELSE ! fields during restart
147 lwrtadj(ng)=.true.
148 END IF
149 ELSE
150 IF (iic(ng).eq.ntstart(ng)) THEN
151 CALL ad_def_his (ng, ldefout(ng))
152 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
153 lwrtadj(ng)=.true.
154 ldefadj(ng)=.false.
155 END IF
156 END IF
157 END IF
158!
159! Write out data into adjoint NetCDF file.
160!
161 IF (lwrtadj(ng)) THEN
162 IF (lwrtper(ng)) THEN
163 IF ((iic(ng).ne.ntstart(ng)).and. &
164 & (mod(iic(ng)-1,nadj(ng)).eq.0)) THEN
165# ifdef DISTRIBUTE
166 CALL ad_wrt_his (ng, myrank)
167# else
168 CALL ad_wrt_his (ng, -1)
169# endif
170 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
171 END IF
172 ELSE
173# ifdef HESSIAN_SO
174 wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0) ! otherwise
175# else
176 IF (nadj(ng).eq.ntimes(ng)) THEN
177 wrthis=(iic(ng).ne.ntstart(ng)).and. &
178 & (mod(iic(ng)-1,nadj(ng)).eq.0) ! avoid ntstart rec
179 ELSE
180# if defined WEAK_CONSTRAINT && !defined WEAK_NOINTERP
181# ifdef SP4DVAR
182 wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0)
183# endif
184 wrthis=(iic(ng).ne.ntstart(ng)).and. &
185 & (mod(iic(ng)-1,nadj(ng)).eq.0) ! avoid ntstart-1 rec
186# else
187 wrthis=(mod(iic(ng)-1,nadj(ng)).eq.0) ! otherwise
188# endif
189 END IF
190# endif
191 IF (wrthis) THEN
192# ifdef DISTRIBUTE
193 CALL ad_wrt_his (ng, myrank)
194# else
195 CALL ad_wrt_his (ng, -1)
196# endif
197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
198 END IF
199 END IF
200 END IF
201
202# ifdef AD_AVERAGES
203!
204!-----------------------------------------------------------------------
205! If appropriate, process time-averaged NetCDF file.
206!-----------------------------------------------------------------------
207!
208! Create output time-averaged NetCDF file or prepare existing file
209! to append new data to it. Also, notice that it is possible to
210! create several files during a single model run.
211!
212 IF (ldefavg(ng)) THEN
213 IF (ndefavg(ng).gt.0) THEN
214 IF (idefavg(ng).lt.0) THEN
215 idefavg(ng)=((ntstart(ng)-1)/ndefavg(ng))*ndefavg(ng)
216 IF ((ndefavg(ng).eq.navg(ng)).and.(idefavg(ng).le.0)) THEN
217 idefavg(ng)=ndefavg(ng) ! one file per record
218 ELSE IF (idefavg(ng).lt.iic(ng)-1) THEN
219 idefavg(ng)=idefavg(ng)+ndefavg(ng)
220 END IF
221 END IF
222 IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
223 IF ((iic(ng)-1).eq.idefavg(ng)) THEN
224 ldefine=.false. ! finished file, delay
225 ELSE ! creation of next file
226 newfile=.false.
227 ldefine=.true. ! unfinished file, inquire
228 END IF ! content for appending
229 idefavg(ng)=idefavg(ng)+navg(ng) ! restart offset
230 ELSE IF ((iic(ng)-1).eq.idefavg(ng)) THEN
231 idefavg(ng)=idefavg(ng)+ndefavg(ng)
232 IF (navg(ng).ne.ndefavg(ng).and.iic(ng).eq.ntstart(ng)) THEN
233 idefavg(ng)=idefavg(ng)+navg(ng)
234 END IF
235 ldefine=.true.
236 newfile=.true.
237 ELSE
238 ldefine=.false.
239 END IF
240 IF (ldefine) THEN
241 IF (iic(ng).eq.ntstart(ng)) THEN
242 avg(ng)%load=0 ! reset filename counter
243 END IF
244 IF (ndefavg(ng).eq.navg(ng)) THEN ! next filename suffix
245 ifile=(iic(ng)-1)/ndefavg(ng)
246 ELSE
247 ifile=(iic(ng)-1)/ndefavg(ng)+1
248 END IF
249 avg(ng)%load=avg(ng)%load+1
250 IF (avg(ng)%load.gt.avg(ng)%Nfiles) THEN
251 IF (master) THEN
252 WRITE (stdout,10) 'AVG(ng)%load = ', avg(ng)%load, &
253 & avg(ng)%Nfiles, trim(avg(ng)%base), &
254 & ifile
255 END IF
256 exit_flag=4
257 IF (founderror(exit_flag, noerror, &
258 & __line__, myfile)) RETURN
259 END IF
260 fcount=avg(ng)%load
261 avg(ng)%Nrec(fcount)=0
262 IF (master) THEN
263 WRITE (avg(ng)%name,20) trim(avg(ng)%base), ifile
264 END IF
265# ifdef DISTRIBUTE
266 CALL mp_bcasts (ng, iadm, avg(ng)%name)
267# endif
268 avg(ng)%files(fcount)=trim(avg(ng)%name)
269 CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
270 CALL def_avg (ng, newfile)
271 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
272 lwrtavg(ng)=.true.
273 END IF
274 ELSE
275 IF (iic(ng).eq.ntstart(ng)) THEN
276 CALL def_avg (ng, ldefout(ng))
277 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
278 lwrtavg(ng)=.true.
279 ldefavg(ng)=.false.
280 END IF
281 END IF
282 END IF
283!
284! Write out data into time-averaged NetCDF file.
285!
286 IF (lwrtavg(ng)) THEN
287 IF ((iic(ng).ne.ntstart(ng)).and. &
288 & (mod(iic(ng),navg(ng)).eq.1)) THEN
289# ifdef DISTRIBUTE
290 CALL wrt_avg (ng, myrank)
291# else
292 CALL wrt_avg (ng, -1)
293# endif
294 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
295 END IF
296 END IF
297# endif
298
299# ifdef PROFILE
300!
301!-----------------------------------------------------------------------
302! Turn off output data time wall clock.
303!-----------------------------------------------------------------------
304!
305 CALL wclock_off (ng, iadm, 8, __line__, myfile)
306# endif
307!
308 10 FORMAT (/,' AD_OUTPUT - multi-file counter ',a,i0, &
309 & ', is greater than Nfiles = ',i0,1x,'dimension', &
310 & /,13x,'in structure when creating next file: ', &
311 & a,'_',i4.4,'.nc', &
312 & /,13x,'Incorrect OutFiles logic in ''read_phypar''.')
313 20 FORMAT (a,'_',i4.4,'.nc')
314!
315 RETURN
distribute_mod::mp_bcasts
Definition distribute.F:101
ad_def_his_mod
Definition ad_def_his.F:2
ad_def_his_mod::ad_def_his
subroutine, public ad_def_his(ng, ldef)
Definition ad_def_his.F:51
ad_wrt_his_mod
Definition ad_wrt_his.F:2
ad_wrt_his_mod::ad_wrt_his
subroutine, public ad_wrt_his(ng, tile)
Definition ad_wrt_his.F:66
close_io_mod
Definition close_io.F:2
close_io_mod::close_file
subroutine, public close_file(ng, model, s, ncname, lupdate)
Definition close_io.F:43
def_avg_mod
Definition def_avg.F:2
def_avg_mod::def_avg
subroutine, public def_avg(ng, ldef)
Definition def_avg.F:79
distribute_mod
Definition distribute.F:3
mod_iounits
Definition mod_iounits.F:2
mod_iounits::adm
type(t_io), dimension(:), allocatable adm
Definition mod_iounits.F:200
mod_iounits::avg
type(t_io), dimension(:), allocatable avg
Definition mod_iounits.F:202
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::idefadj
integer, dimension(:), allocatable idefadj
Definition mod_ncparam.F:558
mod_ncparam::idefavg
integer, dimension(:), allocatable idefavg
Definition mod_ncparam.F:559
mod_ncparam::lanafile
logical lanafile
Definition mod_ncparam.F:602
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_parallel::myrank
integer myrank
Definition mod_parallel.F:157
mod_param
Definition mod_param.F:2
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_scalars
Definition mod_scalars.F:2
mod_scalars::nrrec
integer, dimension(:), allocatable nrrec
Definition mod_scalars.F:1171
mod_scalars::ntimes
integer, dimension(:), allocatable ntimes
Definition mod_scalars.F:336
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::ldefavg
logical, dimension(:), allocatable ldefavg
Definition mod_scalars.F:955
mod_scalars::navg
integer, dimension(:), allocatable navg
Definition mod_scalars.F:1073
mod_scalars::lwrtavg
logical, dimension(:), allocatable lwrtavg
Definition mod_scalars.F:994
mod_scalars::ldefadj
logical, dimension(:), allocatable ldefadj
Definition mod_scalars.F:954
mod_scalars::lwrtadj
logical, dimension(:), allocatable lwrtadj
Definition mod_scalars.F:993
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::ndefavg
integer, dimension(:), allocatable ndefavg
Definition mod_scalars.F:1058
mod_scalars::lwrtper
logical, dimension(:), allocatable lwrtper
Definition mod_scalars.F:997
mod_scalars::ldefout
logical, dimension(:), allocatable ldefout
Definition mod_scalars.F:1053
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::ndefadj
integer, dimension(:), allocatable ndefadj
Definition mod_scalars.F:1057
mod_scalars::nadj
integer, dimension(:), allocatable nadj
Definition mod_scalars.F:1072
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
wrt_avg_mod
Definition wrt_avg.F:2
wrt_avg_mod::wrt_avg
subroutine, public wrt_avg(ng, tile)
Definition wrt_avg.F:83
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References ad_def_his_mod::ad_def_his(), ad_wrt_his_mod::ad_wrt_his(), mod_iounits::adm, mod_iounits::avg, close_io_mod::close_file(), def_avg_mod::def_avg(), mod_scalars::exit_flag, strings_mod::founderror(), mod_param::iadm, mod_ncparam::idefadj, mod_ncparam::idefavg, mod_scalars::iic, mod_ncparam::lanafile, mod_scalars::ldefadj, mod_scalars::ldefavg, mod_scalars::ldefout, mod_scalars::lwrtadj, mod_scalars::lwrtavg, mod_scalars::lwrtper, mod_parallel::master, mod_parallel::myrank, mod_scalars::nadj, mod_scalars::navg, mod_scalars::ndefadj, mod_scalars::ndefavg, mod_scalars::noerror, mod_scalars::nrrec, mod_scalars::ntimes, mod_scalars::ntstart, mod_iounits::sourcefile, mod_iounits::stdout, wclock_off(), wclock_on(), and wrt_avg_mod::wrt_avg().

Referenced by ad_main3d().

Here is the call graph for this function:
Here is the caller graph for this function: