ROMS
Loading...
Searching...
No Matches
wrt_diags.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE wrt_diags_mod
3#ifdef DIAGNOSTICS
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 subroutine writes model time-averaged diagnostic fields into !
13! diagnostics file using thestandard NetCDF library or the Parallel- !
14! IO (PIO) library. !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_parallel
20# ifdef BIOLOGY
21 USE mod_biology
22# endif
23 USE mod_diags
24 USE mod_grid
25 USE mod_iounits
26 USE mod_ncparam
27 USE mod_netcdf
28 USE mod_scalars
29!
30 USE nf_fwrite2d_mod, ONLY : nf_fwrite2d
31# ifdef SOLVE3D
32 USE nf_fwrite3d_mod, ONLY : nf_fwrite3d
33# ifdef ECOSIM
34 USE nf_fwrite4d_mod, ONLY : nf_fwrite4d
35# endif
36# endif
37 USE strings_mod, ONLY : founderror
38!
39 implicit none
40!
41 PUBLIC :: wrt_diags
42 PRIVATE :: wrt_diags_nf90
43# if defined PIO_LIB && defined DISTRIBUTE
44 PRIVATE :: wrt_diags_pio
45# endif
46!
47 CONTAINS
48!
49!***********************************************************************
50 SUBROUTINE wrt_diags (ng, tile)
51!***********************************************************************
52!
53! Imported variable declarations.
54!
55 integer, intent(in) :: ng, tile
56!
57! Local variable declarations.
58!
59 integer :: lbi, ubi, lbj, ubj
60!
61 character (len=*), parameter :: myfile = &
62 & __FILE__
63!
64!-----------------------------------------------------------------------
65! Write out time-averaged fields according to IO type.
66!-----------------------------------------------------------------------
67!
68 lbi=bounds(ng)%LBi(tile)
69 ubi=bounds(ng)%UBi(tile)
70 lbj=bounds(ng)%LBj(tile)
71 ubj=bounds(ng)%UBj(tile)
72!
73 SELECT CASE (dia(ng)%IOtype)
74 CASE (io_nf90)
75 CALL wrt_diags_nf90 (ng, tile, &
76 & lbi, ubi, lbj, ubj)
77
78# if defined PIO_LIB && defined DISTRIBUTE
79 CASE (io_pio)
80 CALL wrt_diags_pio (ng, tile, &
81 & lbi, ubi, lbj, ubj)
82# endif
83 CASE DEFAULT
84 IF (master) WRITE (stdout,10) dia(ng)%IOtype
85 exit_flag=3
86 END SELECT
87 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
88!
89 10 FORMAT (' WRT_DIAGS - Illegal output file type, io_type = ',i0, &
90 & /,13x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
91!
92 RETURN
93 END SUBROUTINE wrt_diags
94!
95!***********************************************************************
96 SUBROUTINE wrt_diags_nf90 (ng, tile, &
97 & LBi, UBi, LBj, UBj)
98!***********************************************************************
99!
100 USE mod_netcdf
101!
102! Imported variable declarations.
103!
104 integer, intent(in) :: ng, tile
105 integer, intent(in) :: lbi, ubi, lbj, ubj
106!
107! Local variable declarations.
108!
109 integer :: fcount, gfactor, gtype, ifield, itrc, ivar, status
110!
111 real(dp) :: scale
112# ifdef BIOLOGY
113 real(r8) :: dtbio
114# endif
115!
116 character (len=*), parameter :: myfile = &
117 & __FILE__//", wrt_diags_nf90"
118!
119 sourcefile=myfile
120!
121!-----------------------------------------------------------------------
122! Write out time-averaged diagnostic fields when appropriate.
123!-----------------------------------------------------------------------
124!
125 if (founderror(exit_flag, noerror, __line__, myfile)) RETURN
126!
127! Set grid type factor to write full (gfactor=1) fields or water
128! points (gfactor=-1) fields only.
129!
130# if defined WRITE_WATER && defined MASKING
131 gfactor=-1
132# else
133 gfactor=1
134# endif
135!
136! Set time and time-record index.
137!
138 dia(ng)%Rindex=dia(ng)%Rindex+1
139 fcount=dia(ng)%load
140 dia(ng)%Nrec(fcount)=dia(ng)%Nrec(fcount)+1
141!
142! Report.
143!
144# ifdef NESTING
145 IF (master) WRITE (stdout,10) dia(ng)%Rindex, ng
146# else
147 IF (master) WRITE (stdout,10) dia(ng)%Rindex
148# endif
149!
150! Write out averaged time.
151!
152 CALL netcdf_put_fvar (ng, inlm, dia(ng)%name, &
153 & trim(vname(1,idtime)), diatime(ng:), &
154 & (/dia(ng)%Rindex/), (/1/), &
155 & ncid = dia(ng)%ncid, &
156 & varid = dia(ng)%Vid(idtime))
157 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
158!
159! Write out time-averaged free-surface (m).
160!
161 scale=1.0_dp
162 gtype=gfactor*r2dvar
163 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, idfsur, &
164 & dia(ng)%Vid(idfsur), &
165 & dia(ng)%Rindex, gtype, &
166 & lbi, ubi, lbj, ubj, scale, &
167# ifdef MASKING
168 & grid(ng) % rmask, &
169# endif
170 & diags(ng) % avgzeta)
171 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
172 IF (master) THEN
173 WRITE (stdout,20) trim(vname(1,idfsur)), dia(ng)%Rindex
174 END IF
175 exit_flag=3
176 ioerror=status
177 RETURN
178 END IF
179
180# ifdef DIAGNOSTICS_UV
181!
182! Write out 2D momentum diagnostic fields.
183!
184 DO ivar=1,ndm2d
185 ifield=iddu2d(ivar)
186 IF (dout(ifield,ng)) THEN
187 scale=1.0_dp/dt(ng)
188 gtype=gfactor*u2dvar
189 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
190 & dia(ng)%Vid(ifield), &
191 & dia(ng)%Rindex, gtype, &
192 & lbi, ubi, lbj, ubj, scale, &
193# ifdef MASKING
194 & grid(ng) % umask, &
195# endif
196 & diags(ng) % DiaU2d(:,:,ivar), &
197 & setfillval = .false.)
198 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
199 IF (master) THEN
200 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
201 END IF
202 exit_flag=3
203 ioerror=status
204 RETURN
205 END IF
206 END IF
207!
208 ifield=iddv2d(ivar)
209 IF (dout(ifield,ng)) THEN
210 scale=1.0_dp/dt(ng)
211 gtype=gfactor*v2dvar
212 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
213 & dia(ng)%Vid(ifield), &
214 & dia(ng)%Rindex, gtype, &
215 & lbi, ubi, lbj, ubj, scale, &
216# ifdef MASKING
217 & grid(ng) % vmask, &
218# endif
219 & diags(ng) % DiaV2d(:,:,ivar), &
220 & setfillval = .false.)
221 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
222 IF (master) THEN
223 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
224 END IF
225 exit_flag=3
226 ioerror=status
227 RETURN
228 END IF
229 END IF
230 END DO
231
232# ifdef SOLVE3D
233!
234! Write out 3D momentum diagnostic fields.
235!
236 DO ivar=1,ndm3d
237 ifield=iddu3d(ivar)
238 IF (dout(ifield,ng)) THEN
239 scale=1.0_dp/dt(ng)
240 gtype=gfactor*u3dvar
241 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
242 & dia(ng)%Vid(ifield), &
243 & dia(ng)%Rindex, gtype, &
244 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
245# ifdef MASKING
246 & grid(ng) % umask_dia, &
247# endif
248 & diags(ng) % DiaU3d(:,:,:,ivar), &
249 & setfillval = .false.)
250 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
251 IF (master) THEN
252 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
253 END IF
254 exit_flag=3
255 ioerror=status
256 RETURN
257 END IF
258 END IF
259!
260 ifield=iddv3d(ivar)
261 IF (dout(ifield,ng)) THEN
262 scale=1.0_dp/dt(ng)
263 gtype=gfactor*v3dvar
264 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
265 & dia(ng)%Vid(ifield), &
266 & dia(ng)%Rindex, gtype, &
267 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
268# ifdef MASKING
269 & grid(ng) % vmask_dia, &
270# endif
271 & diags(ng) % DiaV3d(:,:,:,ivar), &
272 & setfillval = .false.)
273 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
274 IF (master) THEN
275 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
276 END IF
277 exit_flag=3
278 ioerror=status
279 RETURN
280 END IF
281 END IF
282 END DO
283# endif
284# endif
285# ifdef DIAGNOSTICS_TS
286!
287! Write out tracer diagnostic fields.
288!
289 DO itrc=1,nt(ng)
290 DO ivar=1,ndt
291 ifield=iddtrc(itrc,ivar)
292 IF (dout(ifield,ng)) THEN
293 scale=1.0_dp/dt(ng)
294 gtype=gfactor*r3dvar
295 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
296 & dia(ng)%Vid(ifield), &
297 & dia(ng)%Rindex, gtype, &
298 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
299# ifdef MASKING
300 & grid(ng) % rmask, &
301# endif
302 & diags(ng) % DiaTrc(:,:,:,itrc,ivar), &
303 & setfillval = .false.)
304 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
305 IF (master) THEN
306 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
307 END IF
308 exit_flag=3
309 ioerror=status
310 RETURN
311 END IF
312 END IF
313 END DO
314 END DO
315# endif
316# ifdef DIAGNOSTICS_BIO
317# if defined BIO_FENNEL || defined HYPOXIA_SRM
318!
319! Write out 2D biological diagnostic fields.
320!
321 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
322
323 DO ivar=1,ndbio2d
324 ifield=idbio2(ivar)
325 IF (dout(ifield,ng)) THEN
326 IF (ivar.eq.ipco2) THEN
327 scale=1.0_dp
328 ELSE
329 scale=1.0_dp/dtbio ! mmole m-2 day-1
330 END IF
331 gtype=gfactor*r2dvar
332 status=nf_fwrite2d(ng, inlm, dia(ng)%ncid, ifield, &
333 & dia(ng)%Vid(ifield), &
334 & dia(ng)%Rindex, gtype, &
335 & lbi, ubi, lbj, ubj, scale, &
336# ifdef MASKING
337 & grid(ng) % rmask, &
338# endif
339 & diags(ng) % DiaBio2d(:,:,ivar), &
340 & setfillval = .false.)
341 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
342 IF (master) THEN
343 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
344 END IF
345 exit_flag=3
346 ioerror=status
347 RETURN
348 END IF
349 END IF
350 END DO
351# endif
352# if defined BIO_FENNEL
353!
354! Write out 3D biological diagnostic fields.
355!
356 DO ivar=1,ndbio3d
357 ifield=idbio3(ivar)
358 IF (dout(ifield,ng)) THEN
359 scale=1.0_dp/dtbio ! mmole m-3 day-1
360 gtype=gfactor*r3dvar
361 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
362 & dia(ng)%Vid(ifield), &
363 & dia(ng)%Rindex, gtype, &
364 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
365# ifdef MASKING
366 & grid(ng) % rmask, &
367# endif
368 & diags(ng) % DiaBio3d(:,:,:,ivar), &
369 & setfillval = .false.)
370 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
371 IF (master) THEN
372 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
373 END IF
374 exit_flag=3
375 ioerror=status
376 RETURN
377 END IF
378 END IF
379 END DO
380
381# elif defined ECOSIM
382!
383! Write out 3D biological diagnostic fields.
384!
385 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
386 DO ivar=1,ndbio3d
387 ifield=idbio3(ivar)
388 IF (dout(ifield,ng)) THEN
389 scale=1.0_dp ! micromole m-2 s-1
390 gtype=gfactor*l3dvar
391 status=nf_fwrite3d(ng, inlm, dia(ng)%ncid, ifield, &
392 & dia(ng)%Vid(ifield), &
393 & dia(ng)%Rindex, gtype, &
394 & lbi, ubi, lbj, ubj, 1, ndbands, scale, &
395# ifdef MASKING
396 & grid(ng) % rmask, &
397# endif
398 & diags(ng) % DiaBio3d(:,:,:,ivar), &
399 & setfillval = .false.)
400 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
401 IF (master) THEN
402 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
403 END IF
404 exit_flag=3
405 ioerror=status
406 RETURN
407 END IF
408 END IF
409 END DO
410!
411! Write out 4D biological diagnostic fields.
412!
413 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
414 DO ivar=1,ndbio4d
415 ifield=idbio4(ivar)
416 IF (dout(ifield,ng)) THEN
417 scale=1.0_dp ! micromole m-2 s-1 or m-1
418 gtype=gfactor*l4dvar
419 status=nf_fwrite4d(ng, inlm, dia(ng)%ncid, ifield, &
420 & dia(ng)%Vid(ifield), &
421 & dia(ng)%Rindex, gtype, &
422 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ndbands, &
423 & scale, &
424# ifdef MASKING
425 & grid(ng) % rmask, &
426# endif
427 & diags(ng) % DiaBio4d(:,:,:,:,ivar), &
428 & setfillval = .false.)
429 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
430 IF (master) THEN
431 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
432 END IF
433 exit_flag=3
434 ioerror=status
435 RETURN
436 END IF
437 END IF
438 END DO
439# endif
440# endif
441!
442! Synchronize time-average NetCDF file to disk to allow other processes
443! to access data immediately after it is written.
444!
445 CALL netcdf_sync (ng, inlm, dia(ng)%name, dia(ng)%ncid)
446 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
447!
448 10 FORMAT (2x,'WRT_DIAGS_NF90 - writing diagnostics fields',t61, &
449# ifdef NESTING
450 & 'in record = ',i0,t92,i2.2)
451# else
452 & 'in record = ',i0)
453# endif
454 20 FORMAT (/,' WRT_DIAGS_NF90 - error while writing variable: ',a, &
455 & /,18x,'into diagnostics NetCDF file for time record: ',i0)
456!
457 RETURN
458 END SUBROUTINE wrt_diags_nf90
459
460# if defined PIO_LIB && defined DISTRIBUTE
461!
462!***********************************************************************
463 SUBROUTINE wrt_diags_pio (ng, tile, &
464 & LBi, UBi, LBj, UBj)
465!***********************************************************************
466!
467 USE mod_pio_netcdf
468!
469! Imported variable declarations.
470!
471 integer, intent(in) :: ng, tile
472 integer, intent(in) :: lbi, ubi, lbj, ubj
473!
474! Local variable declarations.
475!
476 integer :: fcount, ifield, itrc, ivar, status
477!
478 real(dp) :: scale
479# ifdef BIOLOGY
480 real(r8) :: dtbio
481# endif
482!
483 character (len=*), parameter :: myfile = &
484 & __FILE__//", wrt_diags_pio"
485!
486 TYPE (io_desc_t), pointer :: iodesc
487!
488 sourcefile=myfile
489!
490!-----------------------------------------------------------------------
491! Write out time-averaged diagnostic fields when appropriate.
492!-----------------------------------------------------------------------
493!
494 if (founderror(exit_flag, noerror, __line__, myfile)) RETURN
495!
496! Set time and time-record index.
497!
498 dia(ng)%Rindex=dia(ng)%Rindex+1
499 fcount=dia(ng)%load
500 dia(ng)%Nrec(fcount)=dia(ng)%Nrec(fcount)+1
501!
502! Report.
503!
504# ifdef NESTING
505 IF (master) WRITE (stdout,10) dia(ng)%Rindex, ng
506# else
507 IF (master) WRITE (stdout,10) dia(ng)%Rindex
508# endif
509!
510! Write out averaged time.
511!
512 CALL pio_netcdf_put_fvar (ng, inlm, dia(ng)%name, &
513 & trim(vname(1,idtime)), diatime(ng:), &
514 & (/dia(ng)%Rindex/), (/1/), &
515 & piofile = dia(ng)%pioFile, &
516 & piovar = dia(ng)%pioVar(idtime)%vd)
517 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
518!
519! Write out time-averaged free-surface (m).
520!
521 scale=1.0_dp
522 IF (dia(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
523 iodesc => iodesc_dp_r2dvar(ng)
524 ELSE
525 iodesc => iodesc_sp_r2dvar(ng)
526 END IF
527 status=nf_fwrite2d(ng, inlm, dia(ng)%pioFile, idfsur, &
528 & dia(ng)%pioVar(idfsur), &
529 & dia(ng)%Rindex, &
530 & iodesc, &
531 & lbi, ubi, lbj, ubj, scale, &
532# ifdef MASKING
533 & grid(ng) % rmask, &
534# endif
535 & diags(ng) % avgzeta)
536 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
537 IF (master) THEN
538 WRITE (stdout,20) trim(vname(1,idfsur)), dia(ng)%Rindex
539 END IF
540 exit_flag=3
541 ioerror=status
542 RETURN
543 END IF
544
545# ifdef DIAGNOSTICS_UV
546!
547! Write out 2D momentum diagnostic fields.
548!
549 DO ivar=1,ndm2d
550 ifield=iddu2d(ivar)
551 IF (dout(ifield,ng)) THEN
552 scale=1.0_dp/dt(ng)
553 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
554 iodesc => iodesc_dp_u2dvar(ng)
555 ELSE
556 iodesc => iodesc_sp_u2dvar(ng)
557 END IF
558 status=nf_fwrite2d(ng, inlm, dia(ng)%pioFile, ifield, &
559 & dia(ng)%pioVar(ifield), &
560 & dia(ng)%Rindex, &
561 & iodesc, &
562 & lbi, ubi, lbj, ubj, scale, &
563# ifdef MASKING
564 & grid(ng) % umask, &
565# endif
566 & diags(ng) % DiaU2d(:,:,ivar), &
567 & setfillval = .false.)
568 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
569 IF (master) THEN
570 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
571 END IF
572 exit_flag=3
573 ioerror=status
574 RETURN
575 END IF
576 END IF
577!
578 ifield=iddv2d(ivar)
579 IF (dout(ifield,ng)) THEN
580 scale=1.0_dp/dt(ng)
581 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
582 iodesc => iodesc_dp_v2dvar(ng)
583 ELSE
584 iodesc => iodesc_sp_v2dvar(ng)
585 END IF
586 status=nf_fwrite2d(ng, inlm, dia(ng)%pioFile, ifield, &
587 & dia(ng)%pioVar(ifield), &
588 & dia(ng)%Rindex, &
589 & iodesc, &
590 & lbi, ubi, lbj, ubj, scale, &
591# ifdef MASKING
592 & grid(ng) % vmask, &
593# endif
594 & diags(ng) % DiaV2d(:,:,ivar), &
595 & setfillval = .false.)
596 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
597 IF (master) THEN
598 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
599 END IF
600 exit_flag=3
601 ioerror=status
602 RETURN
603 END IF
604 END IF
605 END DO
606
607# ifdef SOLVE3D
608!
609! Write out 3D momentum diagnostic fields.
610!
611 DO ivar=1,ndm3d
612 ifield=iddu3d(ivar)
613 IF (dout(ifield,ng)) THEN
614 scale=1.0_dp/dt(ng)
615 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
616 iodesc => iodesc_dp_u3dvar(ng)
617 ELSE
618 iodesc => iodesc_sp_u3dvar(ng)
619 END IF
620 status=nf_fwrite3d(ng, inlm, dia(ng)%pioFile, ifield, &
621 & dia(ng)%pioVar(ifield), &
622 & dia(ng)%Rindex, &
623 & iodesc, &
624 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
625# ifdef MASKING
626 & grid(ng) % umask_dia, &
627# endif
628 & diags(ng) % DiaU3d(:,:,:,ivar), &
629 & setfillval = .false.)
630 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
631 IF (master) THEN
632 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
633 END IF
634 exit_flag=3
635 ioerror=status
636 RETURN
637 END IF
638 END IF
639!
640 ifield=iddv3d(ivar)
641 IF (dout(ifield,ng)) THEN
642 scale=1.0_dp/dt(ng)
643 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
644 iodesc => iodesc_dp_v3dvar(ng)
645 ELSE
646 iodesc => iodesc_sp_v3dvar(ng)
647 END IF
648 status=nf_fwrite3d(ng, inlm, dia(ng)%pioFile, ifield, &
649 & dia(ng)%pioVar(ifield), &
650 & dia(ng)%Rindex, &
651 & iodesc, &
652 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
653# ifdef MASKING
654 & grid(ng) % vmask_dia, &
655# endif
656 & diags(ng) % DiaV3d(:,:,:,ivar), &
657 & setfillval = .false.)
658 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
659 IF (master) THEN
660 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
661 END IF
662 exit_flag=3
663 ioerror=status
664 RETURN
665 END IF
666 END IF
667 END DO
668# endif
669# endif
670# ifdef DIAGNOSTICS_TS
671!
672! Write out tracer diagnostic fields.
673!
674 DO itrc=1,nt(ng)
675 DO ivar=1,ndt
676 ifield=iddtrc(itrc,ivar)
677 IF (dout(ifield,ng)) THEN
678 scale=1.0_dp/dt(ng)
679 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
680 iodesc => iodesc_dp_r3dvar(ng)
681 ELSE
682 iodesc => iodesc_sp_r3dvar(ng)
683 END IF
684 status=nf_fwrite3d(ng, inlm, dia(ng)%pioFile, ifield, &
685 & dia(ng)%pioVar(ifield), &
686 & dia(ng)%Rindex, &
687 & iodesc, &
688 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
689# ifdef MASKING
690 & grid(ng) % rmask, &
691# endif
692 & diags(ng) % DiaTrc(:,:,:,itrc,ivar), &
693 & setfillval = .false.)
694 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
695 IF (master) THEN
696 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
697 END IF
698 exit_flag=3
699 ioerror=status
700 RETURN
701 END IF
702 END IF
703 END DO
704 END DO
705# endif
706# ifdef DIAGNOSTICS_BIO
707# if defined BIO_FENNEL || defined HYPOXIA_SRM
708!
709! Write out 2D biological diagnostic fields.
710!
711 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
712
713 DO ivar=1,ndbio2d
714 ifield=idbio2(ivar)
715 IF (dout(ifield,ng)) THEN
716 IF (ivar.eq.ipco2) THEN
717 scale=1.0_dp
718 ELSE
719 scale=1.0_dp/dtbio ! mmole m-2 day-1
720 END IF
721 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
722 iodesc => iodesc_dp_r2dvar(ng)
723 ELSE
724 iodesc => iodesc_sp_r2dvar(ng)
725 END IF
726 status=nf_fwrite2d(ng, inlm, dia(ng)%pioFile, ifield, &
727 & dia(ng)%pioVar(ifield), &
728 & dia(ng)%Rindex, &
729 & iodesc, &
730 & lbi, ubi, lbj, ubj, scale, &
731# ifdef MASKING
732 & grid(ng) % rmask, &
733# endif
734 & diags(ng) % DiaBio2d(:,:,ivar), &
735 & setfillval = .false.)
736 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
737 IF (master) THEN
738 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
739 END IF
740 exit_flag=3
741 ioerror=status
742 RETURN
743 END IF
744 END IF
745 END DO
746# endif
747# if defined BIO_FENNEL
748!
749! Write out 3D biological diagnostic fields.
750!
751 DO ivar=1,ndbio3d
752 ifield=idbio3(ivar)
753 IF (dout(ifield,ng)) THEN
754 scale=1.0_dp/dtbio ! mmole m-3 day-1
755 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
756 iodesc => iodesc_dp_r3dvar(ng)
757 ELSE
758 iodesc => iodesc_sp_r3dvar(ng)
759 END IF
760 status=nf_fwrite3d(ng, inlm, dia(ng)%pioFile, ifield, &
761 & dia(ng)%pioVar(ifield), &
762 & dia(ng)%Rindex, &
763 & iodesc, &
764 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
765# ifdef MASKING
766 & grid(ng) % rmask, &
767# endif
768 & diags(ng) % DiaBio3d(:,:,:,ivar), &
769 & setfillval = .false.)
770 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
771 IF (master) THEN
772 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
773 END IF
774 exit_flag=3
775 ioerror=status
776 RETURN
777 END IF
778 END IF
779 END DO
780
781# elif defined ECOSIM
782!
783! Write out 3D biological diagnostic fields.
784!
785 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
786 DO ivar=1,ndbio3d
787 ifield=idbio3(ivar)
788 IF (dout(ifield,ng)) THEN
789 scale=1.0_dp ! micromole m-2 s-1
790 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
791 iodesc => iodesc_dp_l3dvar(ng)
792 ELSE
793 iodesc => iodesc_sp_l3dvar(ng)
794 END IF
795 status=nf_fwrite3d(ng, inlm, dia(ng)%pioFile, ifield, &
796 & dia(ng)%pioVar(ifield), &
797 & dia(ng)%Rindex, &
798 & iodesc, &
799 & lbi, ubi, lbj, ubj, 1, ndbands, scale, &
800# ifdef MASKING
801 & grid(ng) % rmask, &
802# endif
803 & diags(ng) % DiaBio3d(:,:,:,ivar), &
804 & setfillval = .false.)
805 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
806 IF (master) THEN
807 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
808 END IF
809 exit_flag=3
810 ioerror=status
811 RETURN
812 END IF
813 END IF
814 END DO
815!
816! Write out 4D biological diagnostic fields.
817!
818 dtbio=dt(ng)*sec2day/real(bioiter(ng),r8)
819 DO ivar=1,ndbio4d
820 ifield=idbio4(ivar)
821 IF (dout(ifield,ng)) THEN
822 scale=1.0_dp ! micromole m-2 s-1 or m-1
823 IF (dia(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
824 iodesc => iodesc_dp_l4dvar(ng)
825 ELSE
826 iodesc => iodesc_sp_l4dvar(ng)
827 END IF
828 status=nf_fwrite4d(ng, inlm, dia(ng)%pioFile, ifield, &
829 & dia(ng)%pioVar(ifield), &
830 & dia(ng)%Rindex, gtype, &
831 & iodesc, &
832 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ndbands, &
833 & scale, &
834# ifdef MASKING
835 & grid(ng) % rmask, &
836# endif
837 & diags(ng) % DiaBio4d(:,:,:,:,ivar), &
838 & setfillval = .false.)
839 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
840 IF (master) THEN
841 WRITE (stdout,20) trim(vname(1,ifield)), dia(ng)%Rindex
842 END IF
843 exit_flag=3
844 ioerror=status
845 RETURN
846 END IF
847 END IF
848 END DO
849# endif
850# endif
851!
852! Synchronize time-average NetCDF file to disk to allow other processes
853! to access data immediately after it is written.
854!
855 CALL pio_netcdf_sync (ng, inlm, dia(ng)%name, dia(ng)%pioFile)
856 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
857!
858 10 FORMAT (2x,'WRT_DIAGS_PIO - writing diagnostics fields',t61, &
859# ifdef NESTING
860 & 'in record = ',i0,t92,i2.2)
861# else
862 & 'in record = ',i0)
863# endif
864 20 FORMAT (/,' WRT_DIAGS_PIO - error while writing variable: ',a, &
865 & /,18x,'into diagnostics NetCDF file for time record: ',i0)
866!
867 RETURN
868 END SUBROUTINE wrt_diags_pio
869# endif
870#endif
871 END MODULE wrt_diags_mod
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
nf_fwrite2d_mod::nf_fwrite2d
Definition nf_fwrite2d.F:77
nf_fwrite3d_mod::nf_fwrite3d
Definition nf_fwrite3d.F:78
nf_fwrite4d_mod::nf_fwrite4d
Definition nf_fwrite4d.F:80
mod_biology
Definition ecosim_mod.h:1
mod_biology::ipco2
integer ipco2
Definition fennel_mod.h:109
mod_biology::idbio4
integer, dimension(:), allocatable idbio4
Definition ecosim_mod.h:304
mod_biology::bioiter
integer, dimension(:), allocatable bioiter
Definition ecosim_mod.h:343
mod_biology::ndbands
integer ndbands
Definition ecosim_mod.h:212
mod_biology::idbio3
integer, dimension(:), allocatable idbio3
Definition ecosim_mod.h:298
mod_biology::idbio2
integer, dimension(:), allocatable idbio2
Definition fennel_mod.h:105
mod_diags
Definition mod_diags.F:2
mod_diags::diags
type(t_diags), dimension(:), allocatable diags
Definition mod_diags.F:100
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_iounits::dia
type(t_io), dimension(:), allocatable dia
Definition mod_iounits.F:206
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::iddu2d
integer, dimension(:), allocatable iddu2d
Definition mod_ncparam.F:487
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::iddv2d
integer, dimension(:), allocatable iddv2d
Definition mod_ncparam.F:488
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::iddu3d
integer, dimension(:), allocatable iddu3d
Definition mod_ncparam.F:489
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::iddv3d
integer, dimension(:), allocatable iddv3d
Definition mod_ncparam.F:490
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::idtime
integer idtime
Definition mod_ncparam.F:307
mod_ncparam::dout
logical, dimension(:,:), allocatable dout
Definition mod_ncparam.F:167
mod_ncparam::iddtrc
integer, dimension(:,:), allocatable iddtrc
Definition mod_ncparam.F:486
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::ndbio2d
integer ndbio2d
Definition mod_param.F:584
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::l4dvar
integer, parameter l4dvar
Definition mod_param.F:727
mod_param::ndbio4d
integer ndbio4d
Definition mod_param.F:586
mod_param::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::ndm3d
integer ndm3d
Definition mod_param.F:579
mod_param::ndt
integer ndt
Definition mod_param.F:574
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::ndbio3d
integer ndbio3d
Definition mod_param.F:585
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::l3dvar
integer, parameter l3dvar
Definition mod_param.F:726
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_param::ndm2d
integer ndm2d
Definition mod_param.F:578
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
mod_pio_netcdf::pio_netcdf_sync
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9275
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::iodesc_dp_l3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_l3dvar
Definition mod_pio_netcdf.F:244
mod_pio_netcdf::iodesc_sp_l3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_l3dvar
Definition mod_pio_netcdf.F:205
mod_pio_netcdf::iodesc_sp_l4dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_l4dvar
Definition mod_pio_netcdf.F:206
mod_pio_netcdf::iodesc_dp_l4dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_l4dvar
Definition mod_pio_netcdf.F:245
mod_pio_netcdf::iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
Definition mod_pio_netcdf.F:250
mod_pio_netcdf::iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
Definition mod_pio_netcdf.F:235
mod_pio_netcdf::iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196
mod_scalars
Definition mod_scalars.F:2
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::sec2day
real(dp), parameter sec2day
Definition mod_scalars.F:817
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::diatime
real(dp), dimension(:), allocatable diatime
Definition mod_scalars.F:274
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
nf_fwrite2d_mod
Definition nf_fwrite2d.F:2
nf_fwrite3d_mod
Definition nf_fwrite3d.F:2
nf_fwrite4d_mod
Definition nf_fwrite4d.F:2
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
wrt_diags_mod
Definition wrt_diags.F:2
wrt_diags_mod::wrt_diags_pio
subroutine, private wrt_diags_pio(ng, tile, lbi, ubi, lbj, ubj)
Definition wrt_diags.F:465
wrt_diags_mod::wrt_diags_nf90
subroutine, private wrt_diags_nf90(ng, tile, lbi, ubi, lbj, ubj)
Definition wrt_diags.F:98
wrt_diags_mod::wrt_diags
subroutine, public wrt_diags(ng, tile)
Definition wrt_diags.F:51