ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
close_io_mod Module Reference

Functions/Subroutines

subroutine, public close_file (ng, model, s, ncname, lupdate)
 
subroutine, public close_inp (ng, model)
 
subroutine, public close_out
 

Function/Subroutine Documentation

◆ close_file()

subroutine, public close_io_mod::close_file ( integer, intent(in) ng,
integer, intent(in) model,
type(t_io), intent(inout) s,
character (len=*), intent(in), optional ncname,
logical, intent(in), optional lupdate )

Definition at line 42 of file close_io.F.

43!***********************************************************************
44!
45! Imported variable declarations.
46!
47 integer, intent(in) :: ng, model
48!
49 TYPE(T_IO), intent(inout) :: S
50!
51 logical, intent(in), optional :: Lupdate
52!
53 character (len=*), intent(in), optional :: ncname
54!
55! Local variable declarations.
56!
57 integer :: ClosedState = -1
58!
59 character (len=*), parameter :: MyFile = &
60 & __FILE__//", close_file_nf90"
61!
62!-----------------------------------------------------------------------
63! Close specified NetCDF file.
64!-----------------------------------------------------------------------
65!
66 SELECT CASE (s%IOtype)
67 CASE (io_nf90)
68 IF (s%ncid.ne.closedstate) THEN
69 CALL netcdf_close (ng, model, s%ncid, &
70 & trim(ncname), lupdate)
71 s%ncid=closedstate
72 END IF
73
74#if defined PIO_LIB && defined DISTRIBUTE
75 CASE (io_pio)
76 IF (ASSOCIATED(s%pioFile%iosystem)) THEN
77 IF (s%pioFile%fh.ne.closedstate) THEN
78 CALL pio_netcdf_close (ng, model, s%pioFile, &
79 & trim(ncname), lupdate)
80 s%pioFile%fh=closedstate
81 END IF
82 END IF
83#endif
84 END SELECT
85 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
86!
87 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_netcdf::netcdf_close(), mod_scalars::noerror, and mod_pio_netcdf::pio_netcdf_close().

Referenced by ad_output(), i4dvar_mod::analysis(), r4dvar_mod::analysis(), close_inp(), close_out(), edit_multifile(), i4dvar_mod::increment(), r4dvar_mod::increment(), output(), roms_kernel_mod::roms_run(), rp_output(), and tl_output().

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

◆ close_inp()

subroutine, public close_io_mod::close_inp ( integer, intent(in) ng,
integer, intent(in) model )

Definition at line 91 of file close_io.F.

92!***********************************************************************
93!
94! Imported variable declarations.
95!
96 integer, intent(in) :: ng, model
97!
98! Local variable declarations.
99!
100 integer :: Fcount, i
101!
102 character (len=*), parameter :: MyFile = &
103 & __FILE__//", close_inp"
104!
105 sourcefile=myfile
106!
107!-----------------------------------------------------------------------
108! If multi-file input fields, close several input files.
109!-----------------------------------------------------------------------
110!
111! Skip if configuration error.
112!
113 IF ((exit_flag.eq.5).or.(exit_flag.eq.6)) RETURN
114
115#ifdef FRC_FILE
116!
117! If appropriate, close input forcing files and set several parameter
118! to closed state.
119!
120 DO i=1,nffiles(ng)
121 IF ((frc(i,ng)%Nfiles.gt.0).and.(frc(i,ng)%ncid.ne.-1)) THEN
122 fcount=frc(i,ng)%Fcount
123 CALL close_file (ng, model, frc(i,ng), &
124 & frc(i,ng)%files(fcount), .false.)
125 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
126 frcids=-1
127 frcncid=-1
128 fcount=1
129 frc(i,ng)%Fcount=fcount
130 frc(i,ng)%name=trim(frc(i,ng)%files(fcount))
131 END IF
132 END DO
133#endif
134!
135! If appropriate, close boundary files.
136!
137 IF (obcdata(ng)) THEN
138 DO i=1,nbcfiles(ng)
139 IF ((bry(i,ng)%Nfiles.gt.0).and.(bry(i,ng)%ncid.ne.-1)) THEN
140 fcount=bry(i,ng)%Fcount
141 CALL close_file (ng, model, bry(i,ng), &
142 & bry(i,ng)%files(fcount), .false.)
143 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
144 bryids=-1
145 bryncid=-1
146 fcount=1
147 bry(i,ng)%Fcount=fcount
148 bry(i,ng)%name=trim(bry(i,ng)%files(fcount))
149 END IF
150 END DO
151 END IF
152!
153! If appropriate, close climatology files.
154!
155 IF (clm_file(ng)) THEN
156 DO i=1,nclmfiles(ng)
157 IF ((clm(i,ng)%Nfiles.gt.0).and.(clm(i,ng)%ncid.ne.-1)) THEN
158 fcount=clm(i,ng)%Fcount
159 CALL close_file (ng, model, clm(i,ng), &
160 & clm(i,ng)%files(fcount), .false.)
161 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
162 clmids=-1
163 clmncid=-1
164 fcount=1
165 clm(i,ng)%Fcount=fcount
166 clm(i,ng)%name=trim(clm(i,ng)%files(fcount))
167 END IF
168 END DO
169 END IF
170!
171 RETURN

References mod_iounits::bry, mod_iounits::bryids, mod_ncparam::bryncid, mod_iounits::clm, mod_scalars::clm_file, mod_iounits::clmids, mod_ncparam::clmncid, close_file(), mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::frc, mod_iounits::frcids, mod_ncparam::frcncid, mod_iounits::nbcfiles, mod_iounits::nclmfiles, mod_iounits::nffiles, mod_scalars::noerror, mod_scalars::obcdata, and mod_iounits::sourcefile.

Referenced by ad_initial(), roms_kernel_mod::adm_initial(), initial(), roms_kernel_mod::nlm_initial(), propagator_mod::propagator_afte(), propagator_mod::propagator_fsv(), propagator_mod::propagator_fte(), propagator_mod::propagator_hop(), propagator_mod::propagator_hso(), propagator_mod::propagator_op(), propagator_mod::propagator_so(), roms_kernel_mod::roms_finalize(), roms_kernel_mod::roms_run(), roms_kernel_mod::roms_run(), rp_initial(), tl_initial(), and roms_kernel_mod::tlm_initial().

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

◆ close_out()

subroutine, public close_io_mod::close_out

Definition at line 174 of file close_io.F.

175!
176!=======================================================================
177! !
178! This subroutine flushes and closes all output files. !
179! !
180!=======================================================================
181!
182! Local variable declarations.
183!
184 logical :: First, Lupdate
185!
186 integer :: Fcount, MyError, i, ivalue, ng
187!
188 character (len=256) :: ana_string
189
190 character (len=*), parameter :: MyFile = &
191 & __FILE__//", close_out"
192!
193 sourcefile=myfile
194!
195!-----------------------------------------------------------------------
196! Close output NetCDF files. Set file indices to closed state.
197!-----------------------------------------------------------------------
198!
199! Skip if configuration error.
200!
201 IF ((exit_flag.eq.5).or.(exit_flag.eq.6)) RETURN
202!
203! If appropriate, set switch for updating biology header file global
204! attribute in output NetCDF files.
205!
206#ifdef BIOLOGY
207 lupdate=.true.
208#else
209 lupdate=.false.
210#endif
211!
212! Close output NetCDF files.
213!
214 DO ng=1,ngrids
215 CALL close_file (ng, inlm, rst(ng), rst(ng)%name, lupdate)
216#if defined FOUR_DVAR || defined ENKF_RESTART || defined VERIFICATION
217 CALL close_file (ng, inlm, dai(ng), dai(ng)%name, lupdate)
218 CALL close_file (ng, inlm, dav(ng), dav(ng)%name, lupdate)
219#endif
220#if defined FORWARD_READ || defined FORWARD_WRITE
221 IF (fwd(ng)%IOtype.eq.io_nf90) THEN
222 IF ((fwd(ng)%ncid.ne.-1).and. &
223 & (fwd(ng)%ncid.eq.his(ng)%ncid)) THEN
224 fwd(ng)%ncid=-1
225 END IF
226# if defined PIO_LIB && defined DISTRIBUTE
227 ELSE IF (fwd(ng)%IOtype.eq.io_pio) THEN
228 IF ((fwd(ng)%pioFile%fh.ne.-1).and. &
229 & (fwd(ng)%pioFile%fh.eq.his(ng)%pioFile%fh)) THEN
230 fwd(ng)%pioFile%fh=-1
231 END IF
232# endif
233 END IF
234 CALL close_file (ng, inlm, fwd(ng), fwd(ng)%name, lupdate)
235#endif
236 CALL close_file (ng, inlm, his(ng), his(ng)%name, lupdate)
237 CALL close_file (ng, inlm, qck(ng), qck(ng)%name, lupdate)
238#ifdef SP4DVAR
239 CALL close_file (ng, itlm, spt(ng), spt(ng)%name, lupdate)
240 CALL close_file (ng, itlm, sct(ng), sct(ng)%name, lupdate)
241 CALL close_file (ng, iadm, spa(ng), spa(ng)%name, lupdate)
242#endif
243#ifdef ADJOINT
244 CALL close_file (ng, iadm, adm(ng), adm(ng)%name, lupdate)
245#endif
246#ifdef TANGENT
247 CALL close_file (ng, itlm, itl(ng), itl(ng)%name, lupdate)
248 CALL close_file (ng, itlm, tlm(ng), tlm(ng)%name, lupdate)
249#endif
250#if defined TL_IOMS && defined FOUR_DVAR
251 CALL close_file (ng, irpm, irp(ng), irp(ng)%name, lupdate)
252#endif
253#ifdef WEAK_CONSTRAINT
254 CALL close_file (ng, itlm, tlf(ng), tlf(ng)%name, lupdate)
255#endif
256#ifdef FOUR_DVAR
257 CALL close_file (ng, iadm, hss(ng), hss(ng)%name, lupdate)
258 CALL close_file (ng, iadm, lcz(ng), lcz(ng)%name, lupdate)
259#endif
260#if defined AVERAGES || \
261 (defined ad_averages && defined adjoint) || \
262 (defined rp_averages && defined tl_ioms) || \
263 (defined tl_averages && defined tangent)
264 CALL close_file (ng, inlm, avg(ng), avg(ng)%name, lupdate)
265#endif
266#if defined AVERAGES && defined AVERAGES_DETIDE && \
267 (defined ssh_tides || defined uv_tides)
268 CALL close_file (ng, inlm, har(ng), har(ng)%name, lupdate)
269#endif
270#ifdef DIAGNOSTICS
271 CALL close_file (ng, inlm, dia(ng), dia(ng)%name, lupdate)
272#endif
273#ifdef FLOATS
274 CALL close_file (ng, inlm, flt(ng), flt(ng)%name, lupdate)
275#endif
276#ifdef STATIONS
277 CALL close_file (ng, inlm, sta(ng), sta(ng)%name, lupdate)
278#endif
279#if defined WEAK_CONSTRAINT && \
280 (defined posterior_error_f || defined posterior_error_i)
281 CALL close_file (ng, itlm, err(ng), err(ng)%name, lupdate)
282#endif
283!
284! Report number of time records written.
285!
286 IF (master) THEN
287 WRITE (stdout,10) ng
288
289 IF (associated(his(ng)%Nrec)) THEN
290 IF (any(his(ng)%Nrec.gt.0)) THEN
291 WRITE (stdout,20) 'HISTORY', sum(his(ng)%Nrec)
292 END IF
293 END IF
294
295 IF (associated(rst(ng)%Nrec)) THEN
296 fcount=rst(ng)%load
297 IF (rst(ng)%Nrec(fcount).gt.0) THEN
298 IF (lcyclerst(ng)) THEN
299 IF (rst(ng)%Nrec(fcount).gt.1) THEN
300 rst(ng)%Nrec(fcount)=2
301 ELSE
302 rst(ng)%Nrec(fcount)=1
303 END IF
304 END IF
305 WRITE (stdout,20) 'RESTART', rst(ng)%Nrec(fcount)
306 END IF
307 END IF
308
309#if defined FOUR_DVAR || defined ENKF_RESTART
310 IF (associated(dai(ng)%Nrec)) THEN
311 IF (any(dai(ng)%Nrec.gt.0)) THEN
312 WRITE (stdout,20) 'DA IC ', sum(dai(ng)%Nrec)
313 END IF
314 END IF
315#endif
316
317#ifdef ADJOINT
318 IF (associated(adm(ng)%Nrec)) THEN
319 IF (any(adm(ng)%Nrec.gt.0)) THEN
320 WRITE (stdout,20) 'ADJOINT', sum(adm(ng)%Nrec)
321 END IF
322 END IF
323#endif
324
325#ifdef TANGENT
326 IF (associated(tlm(ng)%Nrec)) THEN
327 IF (any(tlm(ng)%Nrec.gt.0)) THEN
328 WRITE (stdout,20) 'TANGENT', sum(tlm(ng)%Nrec)
329 END IF
330 END IF
331#endif
332
333#if defined AVERAGES || \
334 (defined ad_averages && defined adjoint) || \
335 (defined rp_averages && defined tl_ioms) || \
336 (defined tl_averages && defined tangent)
337 IF (associated(avg(ng)%Nrec)) THEN
338 IF (any(avg(ng)%Nrec.gt.0)) THEN
339 WRITE (stdout,20) 'AVERAGE', sum(avg(ng)%Nrec)
340 END IF
341 END IF
342#endif
343
344#ifdef STATIONS
345 IF (associated(sta(ng)%Nrec)) THEN
346 IF (any(sta(ng)%Nrec.gt.0)) THEN
347 WRITE (stdout,20) 'STATION', sum(sta(ng)%Nrec)
348 END IF
349 END IF
350#endif
351
352#if defined WEAK_CONSTRAINT && \
353 (defined posterior_error_f || defined posterior_error_i)
354 IF (associated(err(ng)%Nrec)) THEN
355 IF (any(err(ng)%Nrec.gt.0)) THEN
356 WRITE (stdout,20) 'ERROR ', sum(err(ng)%Nrec)
357 END IF
358 END IF
359#endif
360 END IF
361 END DO
362!
363!-----------------------------------------------------------------------
364! Report analytical header files used.
365!-----------------------------------------------------------------------
366!
367 IF (master) THEN
368 first=.true.
369 DO i=1,39
370 ana_string=trim(ananame(i))
371 ivalue=ichar(ana_string(1:1))
372 IF (ivalue.ge.47) THEN ! decimal value for characters
373 IF (exit_flag.ne.5) THEN
374 IF (first) THEN
375 first=.false.
376 WRITE (stdout,30) ' Analytical header files used:'
377 END IF
378 WRITE (stdout,'(5x,a)') trim(adjustl(ananame(i)))
379 END IF
380 END IF
381 END DO
382 END IF
383
384#ifdef BIOLOGY
385!
386!-----------------------------------------------------------------------
387! Report biology model header files used.
388!-----------------------------------------------------------------------
389!
390 IF (master) THEN
391 first=.true.
392 DO i=1,4
393 ana_string=trim(bioname(i))
394 ivalue=ichar(ana_string(1:1))
395 IF (ivalue.ge.47) THEN ! decimal value for characters
396 IF (exit_flag.ne.5) THEN
397 IF (first) THEN
398 first=.false.
399 WRITE (stdout,30) ' Biology model header files used:'
400 END IF
401 WRITE (stdout,'(5x,a)') trim(adjustl(bioname(i)))
402 END IF
403 END IF
404 END DO
405 END IF
406#endif
407!
408!-----------------------------------------------------------------------
409! If applicable, report internal exit errors.
410!-----------------------------------------------------------------------
411!
412 IF (master.and. &
413 & (founderror(exit_flag, noerror, __line__, myfile))) THEN
414 WRITE (stdout,40) rerror(exit_flag), exit_flag
415 END IF
416 IF (blowup.ne.0) THEN
417 IF (master) WRITE (stdout,50) trim(blowup_string)
418 ELSE IF (exit_flag.eq.noerror) THEN
419 CALL get_date (date_str)
420 IF (master) WRITE (stdout,60) trim(date_str)
421 ELSE IF (exit_flag.eq.2) THEN
422 IF (master) WRITE (stdout,70) nf90_strerror(ioerror)
423 ELSE IF (exit_flag.eq.3) THEN
424 IF (master) WRITE (stdout,80) nf90_strerror(ioerror)
425 ELSE IF (exit_flag.eq.4) THEN
426 IF (master) WRITE (stdout,90)
427 ELSE IF (exit_flag.eq.5) THEN
428 IF (master) WRITE (stdout,100)
429 ELSE IF (exit_flag.eq.6) THEN
430 IF (master) WRITE (stdout,110)
431 ELSE IF (exit_flag.eq.7) THEN
432 IF (master) WRITE (stdout,120)
433 ELSE IF (exit_flag.eq.8) THEN
434 IF (master) WRITE (stdout,130)
435 END IF
436
437#ifdef ROMS_STDOUT
438!
439!-----------------------------------------------------------------------
440! Close ROMS standard outpu file.
441!-----------------------------------------------------------------------
442!
443 FLUSH (stdout)
444 CLOSE (stdout)
445#endif
446!
447 10 FORMAT (/,' ROMS - Output NetCDF summary for Grid ', &
448 & i2.2,':')
449 20 FORMAT (13x,'number of time records written in ', &
450 & a,' file = ',i0)
451 30 FORMAT (/,a,/)
452 40 FORMAT (/,a,i0,/)
453 50 FORMAT (/,' MAIN: Abnormal termination: BLOWUP.',/, &
454 & ' REASON: ',a)
455 60 FORMAT (/,' ROMS: DONE... ',a)
456 70 FORMAT (/,' ERROR: Abnormal termination: NetCDF INPUT.',/, &
457 & ' REASON: ',a)
458 80 FORMAT (/,' ERROR: Abnormal termination: NetCDF OUTPUT.',/, &
459 & ' REASON: ',a)
460 90 FORMAT (/,' ERROR: I/O related problem.')
461100 FORMAT (/,' ERROR: Illegal model configuration.')
462110 FORMAT (/,' ERROR: Illegal domain partition.')
463120 FORMAT (/,' ERROR: Illegal input parameter.')
464130 FORMAT (/,' ERROR: Fatal algorithm result.')
465!
466 RETURN

References mod_iounits::adm, mod_ncparam::ananame, mod_iounits::avg, mod_scalars::blowup, mod_scalars::blowup_string, close_file(), mod_iounits::dai, mod_ncparam::date_str, mod_iounits::dav, mod_iounits::dia, mod_iounits::err, mod_scalars::exit_flag, mod_iounits::flt, strings_mod::founderror(), mod_iounits::fwd, dateclock_mod::get_date(), mod_iounits::har, mod_iounits::his, mod_iounits::hss, mod_param::iadm, mod_param::inlm, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_iounits::ioerror, mod_iounits::irp, mod_param::irpm, mod_iounits::itl, mod_param::itlm, mod_scalars::lcyclerst, mod_iounits::lcz, mod_parallel::master, mod_param::ngrids, mod_scalars::noerror, mod_iounits::qck, mod_iounits::rerror, mod_iounits::rst, mod_iounits::sct, mod_iounits::sourcefile, mod_iounits::spa, mod_iounits::spt, mod_iounits::sta, mod_iounits::stdout, mod_iounits::tlf, and mod_iounits::tlm.

Referenced by roms_kernel_mod::roms_finalize(), roms_kernel_mod::roms_run(), and roms_kernel_mod::roms_run().

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