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

Go to the source code of this file.

Functions/Subroutines

subroutine rp_output (ng)
 

Function/Subroutine Documentation

◆ rp_output()

subroutine rp_output ( integer, intent(in) ng)

Definition at line 3 of file rp_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 tangent linear model output. It creates output !
13! NetCDF files and writes out data into NetCDF files. If requested, !
14! it can create several tangent history files to avoid generating too !
15! large files during a single model run. !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_parallel
21# ifdef FOUR_DVAR
22 USE mod_fourdvar
23# endif
24 USE mod_iounits
25 USE mod_ncparam
26 USE mod_scalars
27!
28 USE close_io_mod, ONLY : close_file
29# ifdef RP_AVERAGES
30 USE def_avg_mod, ONLY : def_avg
31# endif
32# ifdef DISTRIBUTE
33 USE distribute_mod, ONLY : mp_bcasts
34# endif
35# ifdef OBSERVATIONS
36 USE obs_read_mod, ONLY : obs_read
37 USE obs_write_mod, ONLY : obs_write
38# endif
39 USE strings_mod, ONLY : founderror
40 USE tl_def_his_mod, ONLY : tl_def_his
41# if defined FOUR_DVAR && !defined WEAK_CONSTRAINT
42 USE tl_def_ini_mod, ONLY : tl_def_ini
43# endif
44 USE tl_wrt_his_mod, ONLY : tl_wrt_his
45# ifdef RP_AVERAGES
46 USE wrt_avg_mod, ONLY : wrt_avg
47# endif
48!
49 implicit none
50!
51! Imported variable declarations.
52!
53 integer, intent(in) :: ng
54!
55! Local variable declarations.
56!
57 logical, save :: First = .true.
58 logical :: Ldefine, Lupdate, NewFile
59!
60 integer :: Fcount, ifile, status, tile
61!
62 character (len=*), parameter :: MyFile = &
63 & __FILE__
64!
65 sourcefile=myfile
66
67# ifdef PROFILE
68!
69!-----------------------------------------------------------------------
70! Turn on output data time wall clock.
71!-----------------------------------------------------------------------
72!
73 CALL wclock_on (ng, irpm, 8, __line__, myfile)
74# endif
75!
76!-----------------------------------------------------------------------
77! If appropriate, process tangent linear history NetCDF file.
78!-----------------------------------------------------------------------
79!
80! Turn off checking for analytical header files.
81!
82 IF (lanafile) THEN
83 lanafile=.false.
84 END IF
85!
86! If appropriate, set switch for updating biology header file global
87! attribute in output NetCDF files.
88!
89#ifdef BIOLOGY
90 lupdate=.true.
91#else
92 lupdate=.false.
93#endif
94!
95! Create output tangent NetCDF file or prepare existing file to
96! append new data to it. Also, notice that it is possible to
97! create several files during a single model run.
98!
99 IF (ldeftlm(ng)) THEN
100 IF (ndeftlm(ng).gt.0) THEN
101 IF (ideftlm(ng).lt.0) THEN
102 ideftlm(ng)=((ntstart(ng)-1)/ndeftlm(ng))*ndeftlm(ng)
103 IF (ideftlm(ng).lt.iic(ng)-1) THEN
104 ideftlm(ng)=ideftlm(ng)+ndeftlm(ng)
105 END IF
106 END IF
107 IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
108 IF ((iic(ng)-1).eq.ideftlm(ng)) THEN
109 tlm(ng)%load=0 ! restart, reset counter
110 ldefine=.false. ! finished file, delay
111 ELSE ! creation of next file
112 ldefine=.true.
113 newfile=.false. ! unfinished file, inquire
114 END IF ! content for appending
115 ideftlm(ng)=ideftlm(ng)+ntlm(ng) ! restart offset
116 ELSE IF ((iic(ng)-1).eq.ideftlm(ng)) THEN
117 ideftlm(ng)=ideftlm(ng)+ndeftlm(ng)
118 IF (ntlm(ng).ne.ndeftlm(ng).and.iic(ng).eq.ntstart(ng)) THEN
119 ideftlm(ng)=ideftlm(ng)+ntlm(ng) ! multiple record offset
120 END IF
121 ldefine=.true.
122 newfile=.true.
123 ELSE
124 ldefine=.false.
125 END IF
126 IF (ldefine) THEN ! create new file or
127 IF (iic(ng).eq.ntstart(ng)) THEN ! inquire existing file
128 tlm(ng)%load=0 ! reset filename counter
129 END IF
130 ifile=(iic(ng)-1)/ndeftlm(ng)+1 ! next filename suffix
131 tlm(ng)%load=tlm(ng)%load+1
132 IF (tlm(ng)%load.gt.tlm(ng)%Nfiles) THEN
133 IF (master) THEN
134 WRITE (stdout,10) 'TLM(ng)%load = ', tlm(ng)%load, &
135 & tlm(ng)%Nfiles, trim(tlm(ng)%base), &
136 & ifile
137 END IF
138 exit_flag=4
139 IF (founderror(exit_flag, noerror, &
140 & __line__, myfile)) RETURN
141 END IF
142 fcount=tlm(ng)%load
143 tlm(ng)%Nrec(fcount)=0
144 IF (master) THEN
145 WRITE (tlm(ng)%name,20) trim(tlm(ng)%base), ifile
146 END IF
147# ifdef DISTRIBUTE
148 CALL mp_bcasts (ng, irpm, tlm(ng)%name)
149# endif
150 tlm(ng)%files(fcount)=trim(tlm(ng)%name)
151 CALL close_file (ng, irpm, tlm(ng), tlm(ng)%name, lupdate)
152 CALL tl_def_his (ng, newfile)
153 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
154 END IF
155 IF ((iic(ng).eq.ntstart(ng)).and.(nrrec(ng).ne.0)) THEN
156 lwrttlm(ng)=.false. ! avoid writing initial
157 ELSE ! fields during restart
158 lwrttlm(ng)=.true.
159 END IF
160 ELSE
161 IF (iic(ng).eq.ntstart(ng)) THEN
162 CALL tl_def_his (ng, ldefout(ng))
163 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
164 lwrttlm(ng)=.true.
165 ldeftlm(ng)=.false.
166 END IF
167 END IF
168 END IF
169!
170! Write out data into tangent NetCDF file. Avoid writing initial
171! conditions in perturbation mode computations.
172!
173 IF (lwrttlm(ng)) THEN
174 IF (lwrtper(ng)) THEN
175 IF ((iic(ng).gt.ntstart(ng)).and. &
176 & (mod(iic(ng)-1,ntlm(ng)).eq.0)) THEN
177# ifdef DISTRIBUTE
178 CALL tl_wrt_his (ng, myrank)
179# else
180 CALL tl_wrt_his (ng, -1)
181# endif
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183 END IF
184 ELSE
185 IF ((mod(iic(ng)-1,ntlm(ng)).eq.0).and. &
186 & ((nrrec(ng).eq.0).or.(iic(ng).ne.ntstart(ng)))) THEN
187# ifdef DISTRIBUTE
188 CALL tl_wrt_his (ng, myrank)
189# else
190 CALL tl_wrt_his (ng, -1)
191# endif
192 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
193 END IF
194 END IF
195 END IF
196
197# ifdef RP_AVERAGES
198!
199!-----------------------------------------------------------------------
200! If appropriate, process time-averaged NetCDF file.
201!-----------------------------------------------------------------------
202!
203! Create output time-averaged NetCDF file or prepare existing file
204! to append new data to it. Also, notice that it is possible to
205! create several files during a single model run.
206!
207 IF (ldefavg(ng)) THEN
208 IF (ndefavg(ng).gt.0) THEN
209 IF (idefavg(ng).lt.0) THEN
210 idefavg(ng)=((ntstart(ng)-1)/ndefavg(ng))*ndefavg(ng)
211 IF ((ndefavg(ng).eq.navg(ng)).and.(idefavg(ng).le.0)) THEN
212 idefavg(ng)=ndefavg(ng) ! one file per record
213 ELSE IF (idefavg(ng).lt.iic(ng)-1) THEN
214 idefavg(ng)=idefavg(ng)+ndefavg(ng)
215 END IF
216 END IF
217 IF ((nrrec(ng).ne.0).and.(iic(ng).eq.ntstart(ng))) THEN
218 IF ((iic(ng)-1).eq.idefavg(ng)) THEN
219 avg(ng)%load=0 ! restart, reset counter
220 ldefine=.false. ! finished file, delay
221 ELSE ! creation of next file
222 newfile=.false.
223 ldefine=.true. ! unfinished file, inquire
224 END IF ! content for appending
225 idefavg(ng)=idefavg(ng)+navg(ng) ! restart offset
226 ELSE IF ((iic(ng)-1).eq.idefavg(ng)) THEN
227 idefavg(ng)=idefavg(ng)+ndefavg(ng)
228 IF (navg(ng).ne.ndefavg(ng).and.iic(ng).eq.ntstart(ng)) THEN
229 idefavg(ng)=idefavg(ng)+navg(ng)
230 END IF
231 ldefine=.true.
232 newfile=.true.
233 ELSE
234 ldefine=.false.
235 END IF
236 IF (ldefine) THEN
237 IF (iic(ng).eq.ntstart(ng)) THEN
238 avg(ng)%load=0 ! reset filename counter
239 END IF
240 IF (ndefavg(ng).eq.navg(ng)) THEN ! next filename suffix
241 ifile=(iic(ng)-1)/ndefavg(ng)
242 ELSE
243 ifile=(iic(ng)-1)/ndefavg(ng)+1
244 END IF
245 avg(ng)%load=avg(ng)%load+1
246 IF (avg(ng)%load.gt.avg(ng)%Nfiles) THEN
247 IF (master) THEN
248 WRITE (stdout,10) 'AVG(ng)%load = ', avg(ng)%load, &
249 & avg(ng)%Nfiles, trim(avg(ng)%base), &
250 & ifile
251 END IF
252 exit_flag=4
253 IF (founderror(exit_flag, noerror, &
254 & __line__, myfile)) RETURN
255 END IF
256 fcount=avg(ng)%load
257 avg(ng)%Nrec(fcount)=0
258 IF (master) THEN
259 WRITE (avg(ng)%name,20) trim(avg(ng)%base), ifile
260 END IF
261# ifdef DISTRIBUTE
262 CALL mp_bcasts (ng, irpm, avg(ng)%name)
263# endif
264 avg(ng)%files(fcount)=trim(avg(ng)%name)
265 CALL close_file (ng, irpm, avg(ng), avg(ng)%name, lupdate)
266 CALL def_avg (ng, newfile)
267 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
268 lwrtavg(ng)=.true.
269 END IF
270 ELSE
271 IF (iic(ng).eq.ntstart(ng)) THEN
272 CALL def_avg (ng, ldefout(ng))
273 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
274 lwrtavg(ng)=.true.
275 ldefavg(ng)=.false.
276 END IF
277 END IF
278 END IF
279!
280! Write out data into time-averaged NetCDF file.
281!
282 IF (lwrtavg(ng)) THEN
283 IF ((iic(ng).gt.ntstart(ng)).and. &
284 & (mod(iic(ng)-1,navg(ng)).eq.0)) THEN
285# ifdef DISTRIBUTE
286 CALL wrt_avg (ng, myrank)
287# else
288 CALL wrt_avg (ng, -1)
289# endif
290
291 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
292 END IF
293 END IF
294# endif
295
296# ifdef FOUR_DVAR
297# ifndef WEAK_CONSTRAINT
298!
299!-----------------------------------------------------------------------
300! Create tangent linear model initial conditions file, if necessary.
301!-----------------------------------------------------------------------
302!
303! If start of descent algorithm iterations, create initial conditions
304! file or prepare existing file to append new data to it.
305!
306 IF (first) THEN
307 first=.false.
308 CALL tl_def_ini (ng)
309 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
310 END IF
311# endif
312# ifdef OBSERVATIONS
313!
314!-----------------------------------------------------------------------
315! If appropriate, process and write model state at observation
316! locations. Compute misfit (model-observations) cost function.
317!-----------------------------------------------------------------------
318!
319 IF (((time(ng)-0.5_r8*dt(ng)).le.obstime(ng)).and. &
320 & (obstime(ng).lt.(time(ng)+0.5_r8*dt(ng)))) THEN
321 processobs(ng)=.true.
322# ifdef DISTRIBUTE
323 tile=myrank
324# else
325 tile=-1
326# endif
327 CALL obs_read (ng, irpm, .false.)
328 CALL obs_write (ng, tile, irpm)
329# if defined R4DVAR || defined R4DVAR_ANA_SENSITIVITY || \
330 defined tl_r4dvar
331 CALL obs_cost (ng, irpm)
332# endif
333 ELSE
334 processobs(ng)=.false.
335 END IF
336# endif
337# endif
338# ifdef PROFILE
339!
340!-----------------------------------------------------------------------
341! Turn off output data time wall clock.
342!-----------------------------------------------------------------------
343!
344 CALL wclock_off (ng, irpm, 8, __line__, myfile)
345# endif
346!
347 10 FORMAT (/,' RP_OUTPUT - multi-file counter ',a,i0, &
348 & ', is greater than Nfiles = ',i0,1x,'dimension', &
349 & /,13x,'in structure when creating next file: ', &
350 & a,'_',i4.4,'.nc', &
351 & /,13x,'Incorrect OutFiles logic in ''read_phypar''.')
352 20 FORMAT (a,'_',i4.4,'.nc')
353!
354 RETURN
distribute_mod::mp_bcasts
Definition distribute.F:101
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_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::processobs
logical, dimension(:), allocatable processobs
Definition mod_fourdvar.F:483
mod_iounits
Definition mod_iounits.F:2
mod_iounits::tlm
type(t_io), dimension(:), allocatable tlm
Definition mod_iounits.F:250
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::idefavg
integer, dimension(:), allocatable idefavg
Definition mod_ncparam.F:559
mod_ncparam::ideftlm
integer, dimension(:), allocatable ideftlm
Definition mod_ncparam.F:563
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::irpm
integer, parameter irpm
Definition mod_param.F:664
mod_scalars
Definition mod_scalars.F:2
mod_scalars::nrrec
integer, dimension(:), allocatable nrrec
Definition mod_scalars.F:1171
mod_scalars::obstime
real(dp), dimension(:), allocatable obstime
Definition mod_scalars.F:278
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::ntlm
integer, dimension(:), allocatable ntlm
Definition mod_scalars.F:1080
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::ndeftlm
integer, dimension(:), allocatable ndeftlm
Definition mod_scalars.F:1062
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::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::lwrttlm
logical, dimension(:), allocatable lwrttlm
Definition mod_scalars.F:1004
mod_scalars::ldefout
logical, dimension(:), allocatable ldefout
Definition mod_scalars.F:1053
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::ldeftlm
logical, dimension(:), allocatable ldeftlm
Definition mod_scalars.F:981
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
obs_read_mod
Definition obs_read.F:2
obs_read_mod::obs_read
subroutine, public obs_read(ng, model, backward)
Definition obs_read.F:42
obs_write_mod
Definition obs_write.F:2
obs_write_mod::obs_write
subroutine, public obs_write(ng, tile, model)
Definition obs_write.F:56
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
tl_def_his_mod
Definition tl_def_his.F:2
tl_def_his_mod::tl_def_his
subroutine, public tl_def_his(ng, ldef)
Definition tl_def_his.F:51
tl_def_ini_mod
Definition tl_def_ini.F:2
tl_def_ini_mod::tl_def_ini
subroutine, public tl_def_ini(ng)
Definition tl_def_ini.F:43
tl_wrt_his_mod
Definition tl_wrt_his.F:2
tl_wrt_his_mod::tl_wrt_his
subroutine, public tl_wrt_his(ng, tile)
Definition tl_wrt_his.F:68
wrt_avg_mod
Definition wrt_avg.F:2
wrt_avg_mod::wrt_avg
subroutine, public wrt_avg(ng, tile)
Definition wrt_avg.F:83
obs_cost
subroutine obs_cost(ng, model)
Definition obs_cost.F:4
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 mod_iounits::avg, close_io_mod::close_file(), def_avg_mod::def_avg(), mod_scalars::dt, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::idefavg, mod_ncparam::ideftlm, mod_scalars::iic, mod_param::irpm, mod_ncparam::lanafile, mod_scalars::ldefavg, mod_scalars::ldefout, mod_scalars::ldeftlm, mod_scalars::lwrtavg, mod_scalars::lwrtper, mod_scalars::lwrttlm, mod_parallel::master, mod_parallel::myrank, mod_scalars::navg, mod_scalars::ndefavg, mod_scalars::ndeftlm, mod_scalars::noerror, mod_scalars::nrrec, mod_scalars::ntlm, mod_scalars::ntstart, obs_cost(), obs_read_mod::obs_read(), obs_write_mod::obs_write(), mod_scalars::obstime, mod_fourdvar::processobs, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::time, tl_def_his_mod::tl_def_his(), tl_def_ini_mod::tl_def_ini(), tl_wrt_his_mod::tl_wrt_his(), mod_iounits::tlm, wclock_off(), wclock_on(), and wrt_avg_mod::wrt_avg().

Referenced by rp_main3d().

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