ROMS
Loading...
Searching...
No Matches
wrt_quick.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE wrt_quick_mod
3!
4!git $Id$
5!================================================== Hernan G. Arango ===
6! Copyright (c) 2002-2025 The ROMS Group !
7! Licensed under a MIT/X style license !
8! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine writes requested model fields into QUICKSAVE file !
12! using the standard NetCDF library or the Parallel-IO (PIO) library. !
13! !
14! Notice that only momentum is affected by the full time-averaged !
15! masks. If applicable, these mask contains information about !
16! river runoff and time-dependent wetting and drying variations. !
17! !
18!=======================================================================
19!
20 USE mod_param
21 USE mod_parallel
22#ifdef BBL_MODEL
23 USE mod_bbl
24#endif
25#ifdef SOLVE3D
26 USE mod_coupling
27#endif
28 USE mod_forces
29 USE mod_grid
30 USE mod_iounits
31 USE mod_mixing
32 USE mod_ncparam
33 USE mod_ocean
34 USE mod_scalars
35#if defined SEDIMENT || defined BBL_MODEL
36 USE mod_sedbed
37 USE mod_sediment
38#endif
39 USE mod_stepping
40!
41#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
42 USE bbl_output_mod, ONLY : bbl_wrt_nf90
43# if defined PIO_LIB && defined DISTRIBUTE
44 USE bbl_output_mod, ONLY : bbl_wrt_pio
45# endif
46#endif
47#if defined ICE_MODEL && defined SOLVE3D
48 USE ice_output_mod, ONLY : ice_wrt_nf90
49# if defined PIO_LIB && defined DISTRIBUTE
50 USE ice_output_mod, ONLY : ice_wrt_pio
51# endif
52#endif
53 USE nf_fwrite2d_mod, ONLY : nf_fwrite2d
54#ifdef SOLVE3D
55 USE nf_fwrite3d_mod, ONLY : nf_fwrite3d
56 USE omega_mod, ONLY : scale_omega
57#endif
58#if defined SEDIMENT && defined SOLVE3D
59 USE sediment_output_mod, ONLY : sediment_wrt_nf90
60# if defined PIO_LIB && defined DISTRIBUTE
61 USE sediment_output_mod, ONLY : sediment_wrt_pio
62# endif
63#endif
64 USE strings_mod, ONLY : founderror
65 USE uv_rotate_mod, ONLY : uv_rotate2d
66#ifdef SOLVE3D
67 USE uv_rotate_mod, ONLY : uv_rotate3d
68#endif
69#if defined WEC_VF && defined SOLVE3D
70 USE wec_output_mod, ONLY : wec_wrt_nf90
71# if defined PIO_LIB && defined DISTRIBUTE
72 USE wec_output_mod, ONLY : wec_wrt_pio
73# endif
74#endif
75!
76 implicit none
77!
78 PUBLIC :: wrt_quick
79 PRIVATE :: wrt_quick_nf90
80#if defined PIO_LIB && defined DISTRIBUTE
81 PRIVATE :: wrt_quick_pio
82#endif
83!
84 CONTAINS
85!
86!***********************************************************************
87 SUBROUTINE wrt_quick (ng, tile)
88!***********************************************************************
89!
90! Imported variable declarations.
91!
92 integer, intent(in) :: ng, tile
93!
94! Local variable declarations.
95!
96 integer :: lbi, ubi, lbj, ubj
97!
98 character (len=*), parameter :: myfile = &
99 & __FILE__
100!
101!-----------------------------------------------------------------------
102! Write out history fields according to IO type.
103!-----------------------------------------------------------------------
104!
105 lbi=bounds(ng)%LBi(tile)
106 ubi=bounds(ng)%UBi(tile)
107 lbj=bounds(ng)%LBj(tile)
108 ubj=bounds(ng)%UBj(tile)
109!
110 SELECT CASE (qck(ng)%IOtype)
111 CASE (io_nf90)
112 CALL wrt_quick_nf90 (ng, inlm, tile, &
113 & lbi, ubi, lbj, ubj)
114
115# if defined PIO_LIB && defined DISTRIBUTE
116 CASE (io_pio)
117 CALL wrt_quick_pio (ng, inlm, tile, &
118 & lbi, ubi, lbj, ubj)
119# endif
120 CASE DEFAULT
121 IF (master) THEN
122 WRITE (stdout,10) qck(ng)%IOtype
123 END IF
124 exit_flag=3
125 END SELECT
126 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
127!
128 10 FORMAT (' WRT_QUICK - Illegal output file type, io_type = ',i0, &
129 & /,13x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
130!
131 RETURN
132 END SUBROUTINE wrt_quick
133!
134!***********************************************************************
135 SUBROUTINE wrt_quick_nf90 (ng, model, tile, &
136 & LBi, UBi, LBj, UBj)
137!***********************************************************************
138!
139 USE mod_netcdf
140!
141! Imported variable declarations.
142!
143 integer, intent(in) :: ng, model, tile
144 integer, intent(in) :: lbi, ubi, lbj, ubj
145!
146! Local variable declarations.
147!
148 integer :: fcount, gfactor, gtype, status
149#ifdef SOLVE3D
150 integer :: i, itrc, j, k
151#endif
152!
153 real(dp) :: scale
154!
155 real(r8), allocatable :: ur2d(:,:)
156 real(r8), allocatable :: vr2d(:,:)
157#ifdef SOLVE3D
158 real(r8), allocatable :: wr3d(:,:,:)
159#endif
160!
161 character (len=*), parameter :: myfile = &
162 & __FILE__//", wrt_quick_nf90"
163
164# include "set_bounds.h"
165!
166 sourcefile=myfile
167!
168!-----------------------------------------------------------------------
169! Write out quicksave fields.
170!-----------------------------------------------------------------------
171!
172 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
173!
174! Set grid type factor to write full (gfactor=1) fields or water
175! points (gfactor=-1) fields only.
176!
177#if defined WRITE_WATER && defined MASKING
178 gfactor=-1
179#else
180 gfactor=1
181#endif
182!
183! Set time record index.
184!
185 qck(ng)%Rindex=qck(ng)%Rindex+1
186 fcount=qck(ng)%load
187 qck(ng)%Nrec(fcount)=qck(ng)%Nrec(fcount)+1
188!
189! Report.
190!
191#ifdef SOLVE3D
192# ifdef NESTING
193 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex, ng
194# else
195 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex
196# endif
197#else
198# ifdef NESTING
199 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex, ng
200# else
201 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex
202# endif
203#endif
204!
205! Write out model time (s).
206!
207 CALL netcdf_put_fvar (ng, model, qck(ng)%name, &
208 & trim(vname(1,idtime)), time(ng:), &
209 & (/qck(ng)%Rindex/), (/1/), &
210 & ncid = qck(ng)%ncid, &
211 & varid = qck(ng)%Vid(idtime))
212 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
213
214#ifdef WET_DRY
215!
216! Write out wet/dry mask at PSI-points.
217!
218 scale=1.0_dp
219 gtype=gfactor*p2dvar
220 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idpwet, &
221 & qck(ng)%Vid(idpwet), &
222 & qck(ng)%Rindex, gtype, &
223 & lbi, ubi, lbj, ubj, scale, &
224# ifdef MASKING
225 & grid(ng) % pmask, &
226# endif
227 & grid(ng) % pmask_wet, &
228 & setfillval = .false.)
229 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
230 IF (master) THEN
231 WRITE (stdout,20) trim(vname(1,idpwet)), qck(ng)%Rindex
232 END IF
233 exit_flag=3
234 ioerror=status
235 RETURN
236 END IF
237!
238! Write out wet/dry mask at RHO-points.
239!
240 scale=1.0_dp
241 gtype=gfactor*r2dvar
242 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idrwet, &
243 & qck(ng)%Vid(idrwet), &
244 & qck(ng)%Rindex, gtype, &
245 & lbi, ubi, lbj, ubj, scale, &
246# ifdef MASKING
247 & grid(ng) % rmask, &
248# endif
249 & grid(ng) % rmask_wet, &
250 & setfillval = .false.)
251 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
252 IF (master) THEN
253 WRITE (stdout,20) trim(vname(1,idrwet)), qck(ng)%Rindex
254 END IF
255 exit_flag=3
256 ioerror=status
257 RETURN
258 END IF
259!
260! Write out wet/dry mask at U-points.
261!
262 scale=1.0_dp
263 gtype=gfactor*u2dvar
264 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduwet, &
265 & qck(ng)%Vid(iduwet), &
266 & qck(ng)%Rindex, gtype, &
267 & lbi, ubi, lbj, ubj, scale, &
268# ifdef MASKING
269 & grid(ng) % umask, &
270# endif
271 & grid(ng) % umask_wet, &
272 & setfillval = .false.)
273 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
274 IF (master) THEN
275 WRITE (stdout,20) trim(vname(1,iduwet)), qck(ng)%Rindex
276 END IF
277 exit_flag=3
278 ioerror=status
279 RETURN
280 END IF
281!
282! Write out wet/dry mask at V-points.
283!
284 scale=1.0_dp
285 gtype=gfactor*v2dvar
286 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvwet, &
287 & qck(ng)%Vid(idvwet), &
288 & qck(ng)%Rindex, gtype, &
289 & lbi, ubi, lbj, ubj, scale, &
290# ifdef MASKING
291 & grid(ng) % vmask, &
292# endif
293 & grid(ng) % vmask_wet, &
294 & setfillval = .false.)
295 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
296 IF (master) THEN
297 WRITE (stdout,20) trim(vname(1,idvwet)), qck(ng)%Rindex
298 END IF
299 exit_flag=3
300 ioerror=status
301 RETURN
302 END IF
303#endif
304#ifdef SOLVE3D
305!
306! Write time-varying depths of RHO-points.
307!
308 IF (qout(idpthr,ng)) THEN
309 scale=1.0_dp
310 gtype=gfactor*r3dvar
311 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthr, &
312 & qck(ng)%Vid(idpthr), &
313 & qck(ng)%Rindex, gtype, &
314 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
315# ifdef MASKING
316 & grid(ng) % rmask, &
317# endif
318 & grid(ng) % z_r, &
319 & setfillval = .false.)
320 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
321 IF (master) THEN
322 WRITE (stdout,20) trim(vname(1,idpthr)), qck(ng)%Rindex
323 END IF
324 exit_flag=3
325 ioerror=status
326 RETURN
327 END IF
328 END IF
329!
330! Write time-varying depths of U-points.
331!
332 IF (qout(idpthu,ng)) THEN
333 scale=1.0_dp
334 gtype=gfactor*u3dvar
335 DO k=1,n(ng)
336 DO j=jstr-1,jend+1
337 DO i=istru-1,iend+1
338 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i-1,j,k)+ &
339 & grid(ng)%z_r(i ,j,k))
340 END DO
341 END DO
342 END DO
343 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthu, &
344 & qck(ng)%Vid(idpthu), &
345 & qck(ng)%Rindex, gtype, &
346 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
347# ifdef MASKING
348 & grid(ng) % umask, &
349# endif
350 & grid(ng) % z_v, &
351 & setfillval = .false.)
352 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
353 IF (master) THEN
354 WRITE (stdout,20) trim(vname(1,idpthu)), qck(ng)%Rindex
355 END IF
356 exit_flag=3
357 ioerror=status
358 RETURN
359 END IF
360 END IF
361!
362! Write time-varying depths of V-points.
363!
364 IF (qout(idpthv,ng)) THEN
365 scale=1.0_dp
366 gtype=gfactor*v3dvar
367 DO k=1,n(ng)
368 DO j=jstrv-1,jend+1
369 DO i=istr-1,iend+1
370 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i,j-1,k)+ &
371 & grid(ng)%z_r(i,j ,k))
372 END DO
373 END DO
374 END DO
375 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthv, &
376 & qck(ng)%Vid(idpthv), &
377 & qck(ng)%Rindex, gtype, &
378 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
379# ifdef MASKING
380 & grid(ng) % vmask, &
381# endif
382 & grid(ng) % z_v, &
383 & setfillval = .false.)
384 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
385 IF (master) THEN
386 WRITE (stdout,20) trim(vname(1,idpthv)), qck(ng)%Rindex
387 END IF
388 exit_flag=3
389 ioerror=status
390 RETURN
391 END IF
392 END IF
393!
394! Write time-varying depths of W-points.
395!
396 IF (qout(idpthw,ng)) THEN
397 scale=1.0_dp
398 gtype=gfactor*w3dvar
399 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idpthw, &
400 & qck(ng)%Vid(idpthw), &
401 & qck(ng)%Rindex, gtype, &
402 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
403# ifdef MASKING
404 & grid(ng) % rmask, &
405# endif
406 & grid(ng) % z_w, &
407 & setfillval = .false.)
408 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
409 IF (master) THEN
410 WRITE (stdout,20) trim(vname(1,idpthw)), qck(ng)%Rindex
411 END IF
412 exit_flag=3
413 ioerror=status
414 RETURN
415 END IF
416 END IF
417#endif
418!
419! Write out free-surface (m)
420!
421 IF (qout(idfsur,ng)) THEN
422 scale=1.0_dp
423 gtype=gfactor*r2dvar
424 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idfsur, &
425 & qck(ng)%Vid(idfsur), &
426 & qck(ng)%Rindex, gtype, &
427 & lbi, ubi, lbj, ubj, scale, &
428#ifdef MASKING
429 & grid(ng) % rmask, &
430#endif
431#ifdef WET_DRY
432 & ocean(ng) % zeta(:,:,kout), &
433 & setfillval = .false.)
434#else
435 & ocean(ng) % zeta(:,:,kout))
436#endif
437 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
438 IF (master) THEN
439 WRITE (stdout,20) trim(vname(1,idfsur)), qck(ng)%Rindex
440 END IF
441 exit_flag=3
442 ioerror=status
443 RETURN
444 END IF
445 END IF
446!
447! Write out 2D U-momentum component (m/s).
448!
449 IF (qout(idubar,ng)) THEN
450 scale=1.0_dp
451 gtype=gfactor*u2dvar
452 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idubar, &
453 & qck(ng)%Vid(idubar), &
454 & qck(ng)%Rindex, gtype, &
455 & lbi, ubi, lbj, ubj, scale, &
456#ifdef MASKING
457 & grid(ng) % umask_full, &
458#endif
459 & ocean(ng) % ubar(:,:,kout))
460 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
461 IF (master) THEN
462 WRITE (stdout,20) trim(vname(1,idubar)), qck(ng)%Rindex
463 END IF
464 exit_flag=3
465 ioerror=status
466 RETURN
467 END IF
468 END IF
469!
470! Write out 2D V-momentum component (m/s).
471!
472 IF (qout(idvbar,ng)) THEN
473 scale=1.0_dp
474 gtype=gfactor*v2dvar
475 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvbar, &
476 & qck(ng)%Vid(idvbar), &
477 & qck(ng)%Rindex, gtype, &
478 & lbi, ubi, lbj, ubj, scale, &
479#ifdef MASKING
480 & grid(ng) % vmask_full, &
481#endif
482 & ocean(ng) % vbar(:,:,kout))
483 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
484 IF (master) THEN
485 WRITE (stdout,20) trim(vname(1,idvbar)), qck(ng)%Rindex
486 END IF
487 exit_flag=3
488 ioerror=status
489 RETURN
490 END IF
491 END IF
492!
493! Write out 2D Eastward and Northward momentum components (m/s) at
494! RHO-points.
495!
496 IF (qout(idu2de,ng).and.qout(idv2dn,ng)) THEN
497 IF (.not.allocated(ur2d)) THEN
498 allocate (ur2d(lbi:ubi,lbj:ubj))
499 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
500 END IF
501 IF (.not.allocated(vr2d)) THEN
502 allocate (vr2d(lbi:ubi,lbj:ubj))
503 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
504 END IF
505 CALL uv_rotate2d (ng, tile, .false., .true., &
506 & lbi, ubi, lbj, ubj, &
507 & grid(ng) % CosAngler, &
508 & grid(ng) % SinAngler, &
509#ifdef MASKING
510 & grid(ng) % rmask_full, &
511#endif
512 & ocean(ng) % ubar(:,:,kout), &
513 & ocean(ng) % vbar(:,:,kout), &
514 & ur2d, vr2d)
515!
516 scale=1.0_dp
517 gtype=gfactor*r2dvar
518 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idu2de, &
519 & qck(ng)%Vid(idu2de), &
520 & qck(ng)%Rindex, gtype, &
521 & lbi, ubi, lbj, ubj, scale, &
522#ifdef MASKING
523 & grid(ng) % rmask_full, &
524#endif
525 & ur2d)
526 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
527 IF (master) THEN
528 WRITE (stdout,20) trim(vname(1,idu2de)), qck(ng)%Rindex
529 END IF
530 exit_flag=3
531 ioerror=status
532 RETURN
533 END IF
534!
535 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idv2dn, &
536 & qck(ng)%Vid(idv2dn), &
537 & qck(ng)%Rindex, gtype, &
538 & lbi, ubi, lbj, ubj, scale, &
539#ifdef MASKING
540 & grid(ng) % rmask_full, &
541#endif
542 & vr2d)
543 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
544 IF (master) THEN
545 WRITE (stdout,20) trim(vname(1,idv2dn)), qck(ng)%Rindex
546 END IF
547 exit_flag=3
548 ioerror=status
549 RETURN
550 END IF
551 deallocate (ur2d)
552 deallocate (vr2d)
553 END IF
554
555#ifdef SOLVE3D
556!
557! Write out 3D U-momentum component (m/s).
558!
559 IF (qout(iduvel,ng)) THEN
560 scale=1.0_dp
561 gtype=gfactor*u3dvar
562 status=nf_fwrite3d(ng, model, qck(ng)%ncid, iduvel, &
563 & qck(ng)%Vid(iduvel), &
564 & qck(ng)%Rindex, gtype, &
565 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
566# ifdef MASKING
567 & grid(ng) % umask_full, &
568# endif
569 & ocean(ng) % u(:,:,:,nout))
570 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
571 IF (master) THEN
572 WRITE (stdout,20) trim(vname(1,iduvel)), qck(ng)%Rindex
573 END IF
574 exit_flag=3
575 ioerror=status
576 RETURN
577 END IF
578 END IF
579!
580! Write out 3D V-momentum component (m/s).
581!
582 IF (qout(idvvel,ng)) THEN
583 scale=1.0_dp
584 gtype=gfactor*v3dvar
585 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idvvel, &
586 & qck(ng)%Vid(idvvel), &
587 & qck(ng)%Rindex, gtype, &
588 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
589# ifdef MASKING
590 & grid(ng) % vmask_full, &
591# endif
592 & ocean(ng) % v(:,:,:,nout))
593 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
594 IF (master) THEN
595 WRITE (stdout,20) trim(vname(1,idvvel)), qck(ng)%Rindex
596 END IF
597 exit_flag=3
598 ioerror=status
599 RETURN
600 END IF
601 END IF
602!
603! Write out surface U-momentum component (m/s).
604!
605 IF (qout(idusur,ng)) THEN
606 scale=1.0_dp
607 gtype=gfactor*u2dvar
608 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusur, &
609 & qck(ng)%Vid(idusur), &
610 & qck(ng)%Rindex, gtype, &
611 & lbi, ubi, lbj, ubj, scale, &
612# ifdef MASKING
613 & grid(ng) % umask_full, &
614# endif
615 & ocean(ng) % u(:,:,n(ng),nout))
616 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
617 IF (master) THEN
618 WRITE (stdout,20) trim(vname(1,idusur)), qck(ng)%Rindex
619 END IF
620 exit_flag=3
621 ioerror=status
622 RETURN
623 END IF
624 END IF
625!
626! Write out surface V-momentum component (m/s).
627!
628 IF (qout(idvsur,ng)) THEN
629 scale=1.0_dp
630 gtype=gfactor*v2dvar
631 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsur, &
632 & qck(ng)%Vid(idvsur), &
633 & qck(ng)%Rindex, gtype, &
634 & lbi, ubi, lbj, ubj, scale, &
635# ifdef MASKING
636 & grid(ng) % vmask_full, &
637# endif
638 & ocean(ng) % v(:,:,n(ng),nout))
639 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
640 IF (master) THEN
641 WRITE (stdout,20) trim(vname(1,idvsur)), qck(ng)%Rindex
642 END IF
643 exit_flag=3
644 ioerror=status
645 RETURN
646 END IF
647 END IF
648!
649! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid.
650!
651 IF (qout(idu3de,ng)) THEN
652 scale=1.0_dp
653 gtype=gfactor*r3dvar
654 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idu3de, &
655 & qck(ng)%Vid(idu3de), &
656 & qck(ng)%Rindex, gtype, &
657 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
658# ifdef MASKING
659 & grid(ng) % rmask_full, &
660# endif
661 & ocean(ng) % ua)
662 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
663 IF (master) THEN
664 WRITE (stdout,20) trim(vname(1,idu3de)), qck(ng)%Rindex
665 END IF
666 exit_flag=3
667 ioerror=status
668 RETURN
669 END IF
670 END IF
671!
672! Write out 3D Northward momentum (m/s) at RHO-points, A-grid.
673!
674 IF (qout(idv3dn,ng)) THEN
675 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idv3dn, &
676 & qck(ng)%Vid(idv3dn), &
677 & qck(ng)%Rindex, gtype, &
678 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
679# ifdef MASKING
680 & grid(ng) % rmask_full, &
681# endif
682 & ocean(ng) % va)
683 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
684 IF (master) THEN
685 WRITE (stdout,20) trim(vname(1,idv3dn)), qck(ng)%Rindex
686 END IF
687 exit_flag=3
688 ioerror=status
689 RETURN
690 END IF
691 END IF
692!
693! Write out surface Eastward momentum (m/s) at RHO-points, A-grid.
694!
695 IF (qout(idusue,ng)) THEN
696 scale=1.0_dp
697 gtype=gfactor*r2dvar
698 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusue, &
699 & qck(ng)%Vid(idusue), &
700 & qck(ng)%Rindex, gtype, &
701 & lbi, ubi, lbj, ubj, scale, &
702# ifdef MASKING
703 & grid(ng) % rmask_full, &
704# endif
705 & ocean(ng) % ua(:,:,n(ng)))
706 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
707 IF (master) THEN
708 WRITE (stdout,20) trim(vname(1,idusue)), qck(ng)%Rindex
709 END IF
710 exit_flag=3
711 ioerror=status
712 RETURN
713 END IF
714 END IF
715!
716! Write out surface Northward momentum (m/s) at RHO-points, A-grid.
717!
718 IF (qout(idvsun,ng)) THEN
719 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsun, &
720 & qck(ng)%Vid(idvsun), &
721 & qck(ng)%Rindex, gtype, &
722 & lbi, ubi, lbj, ubj, scale, &
723# ifdef MASKING
724 & grid(ng) % rmask_full, &
725# endif
726 & ocean(ng) % va(:,:,n(ng)))
727 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
728 IF (master) THEN
729 WRITE (stdout,20) trim(vname(1,idvsun)), qck(ng)%Rindex
730 END IF
731 exit_flag=3
732 ioerror=status
733 RETURN
734 END IF
735 END IF
736!
737! Write out S-coordinate omega vertical velocity (m/s).
738!
739 IF (qout(idovel,ng)) THEN
740 IF (.not.allocated(wr3d)) THEN
741 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
742 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
743 END IF
744 scale=1.0_dp
745 gtype=gfactor*w3dvar
746 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
747 & grid(ng) % pm, &
748 & grid(ng) % pn, &
749 & ocean(ng) % W, &
750 & wr3d)
751 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idovel, &
752 & qck(ng)%Vid(idovel), &
753 & qck(ng)%Rindex, gtype, &
754 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
755# ifdef MASKING
756 & grid(ng) % rmask, &
757# endif
758 & wr3d)
759 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
760 IF (master) THEN
761 WRITE (stdout,20) trim(vname(1,idovel)), qck(ng)%Rindex
762 END IF
763 exit_flag=3
764 ioerror=status
765 RETURN
766 END IF
767 deallocate (wr3d)
768 END IF
769!
770! Write out vertical velocity (m/s).
771!
772 IF (qout(idwvel,ng)) THEN
773 scale=1.0_dp
774 gtype=gfactor*w3dvar
775 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idwvel, &
776 & qck(ng)%Vid(idwvel), &
777 & qck(ng)%Rindex, gtype, &
778 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
779# ifdef MASKING
780 & grid(ng) % rmask, &
781# endif
782 & ocean(ng) % wvel)
783 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
784 IF (master) THEN
785 WRITE (stdout,20) trim(vname(1,idwvel)), qck(ng)%Rindex
786 END IF
787 exit_flag=3
788 ioerror=status
789 RETURN
790 END IF
791 END IF
792!
793! Write out tracer type variables.
794!
795 DO itrc=1,nt(ng)
796 IF (qout(idtvar(itrc),ng)) THEN
797 scale=1.0_dp
798 gtype=gfactor*r3dvar
799 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idtvar(itrc), &
800 & qck(ng)%Tid(itrc), &
801 & qck(ng)%Rindex, gtype, &
802 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
803# ifdef MASKING
804 & grid(ng) % rmask, &
805# endif
806 & ocean(ng) % t(:,:,:,nout,itrc))
807 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
808 IF (master) THEN
809 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
810 & qck(ng)%Rindex
811 END IF
812 exit_flag=3
813 ioerror=status
814 RETURN
815 END IF
816 END IF
817 END DO
818!
819! Write out surface tracer type variables.
820!
821 DO itrc=1,nt(ng)
822 IF (qout(idsurt(itrc),ng)) THEN
823 scale=1.0_dp
824 gtype=gfactor*r2dvar
825 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idsurt(itrc), &
826 & qck(ng)%Vid(idsurt(itrc)), &
827 & qck(ng)%Rindex, gtype, &
828 & lbi, ubi, lbj, ubj, scale, &
829# ifdef MASKING
830 & grid(ng) % rmask, &
831# endif
832 & ocean(ng) % t(:,:,n(ng),nout,itrc))
833 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
834 IF (master) THEN
835 WRITE (stdout,20) trim(vname(1,idsurt(itrc))), &
836 & qck(ng)%Rindex
837 END IF
838 exit_flag=3
839 ioerror=status
840 RETURN
841 END IF
842 END IF
843 END DO
844!
845! Write out density anomaly.
846!
847 IF (qout(iddano,ng)) THEN
848 scale=1.0_dp
849 gtype=gfactor*r3dvar
850 status=nf_fwrite3d(ng, model, qck(ng)%ncid, iddano, &
851 & qck(ng)%Vid(iddano), &
852 & qck(ng)%Rindex, gtype, &
853 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
854# ifdef MASKING
855 & grid(ng) % rmask, &
856# endif
857 & ocean(ng) % rho)
858 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
859 IF (master) THEN
860 WRITE (stdout,20) trim(vname(1,iddano)), qck(ng)%Rindex
861 END IF
862 exit_flag=3
863 ioerror=status
864 RETURN
865 END IF
866 END IF
867# ifdef LMD_SKPP
868!
869! Write out depth surface boundary layer.
870!
871 IF (qout(idhsbl,ng)) THEN
872 scale=1.0_dp
873 gtype=gfactor*r2dvar
874 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idhsbl, &
875 & qck(ng)%Vid(idhsbl), &
876 & qck(ng)%Rindex, gtype, &
877 & lbi, ubi, lbj, ubj, scale, &
878# ifdef MASKING
879 & grid(ng) % rmask, &
880# endif
881 & mixing(ng) % hsbl)
882 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
883 IF (master) THEN
884 WRITE (stdout,20) trim(vname(1,idhsbl)), qck(ng)%Rindex
885 END IF
886 exit_flag=3
887 ioerror=status
888 RETURN
889 END IF
890 END IF
891# endif
892# ifdef LMD_BKPP
893!
894! Write out depth surface boundary layer.
895!
896 IF (qout(idhbbl,ng)) THEN
897 scale=1.0_dp
898 gtype=gfactor*r2dvar
899 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idhbbl, &
900 & qck(ng)%Vid(idhbbl), &
901 & qck(ng)%Rindex, gtype, &
902 & lbi, ubi, lbj, ubj, scale, &
903# ifdef MASKING
904 & grid(ng) % rmask, &
905# endif
906 & mixing(ng) % hbbl)
907 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
908 IF (master) THEN
909 WRITE (stdout,20) trim(vname(1,idhbbl)), qck(ng)%Rindex
910 END IF
911 exit_flag=3
912 ioerror=status
913 RETURN
914 END IF
915 END IF
916# endif
917!
918! Write out vertical viscosity coefficient.
919!
920 IF (qout(idvvis,ng)) THEN
921 scale=1.0_dp
922 gtype=gfactor*w3dvar
923 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idvvis, &
924 & qck(ng)%Vid(idvvis), &
925 & qck(ng)%Rindex, gtype, &
926 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
927# ifdef MASKING
928 & grid(ng) % rmask, &
929# endif
930 & mixing(ng) % Akv, &
931 & setfillval = .false.)
932 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
933 IF (master) THEN
934 WRITE (stdout,20) trim(vname(1,idvvis)), qck(ng)%Rindex
935 END IF
936 exit_flag=3
937 ioerror=status
938 RETURN
939 END IF
940 END IF
941!
942! Write out vertical diffusion coefficient for potential temperature.
943!
944 IF (qout(idtdif,ng)) THEN
945 scale=1.0_dp
946 gtype=gfactor*w3dvar
947 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idtdif, &
948 & qck(ng)%Vid(idtdif), &
949 & qck(ng)%Rindex, gtype, &
950 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
951# ifdef MASKING
952 & grid(ng) % rmask, &
953# endif
954 & mixing(ng) % Akt(:,:,:,itemp), &
955 & setfillval = .false.)
956 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
957 IF (master) THEN
958 WRITE (stdout,20) trim(vname(1,idtdif)), qck(ng)%Rindex
959 END IF
960 exit_flag=3
961 ioerror=status
962 RETURN
963 END IF
964 END IF
965# ifdef SALINITY
966!
967! Write out vertical diffusion coefficient for salinity.
968!
969 IF (qout(idsdif,ng)) THEN
970 scale=1.0_dp
971 gtype=gfactor*w3dvar
972 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idsdif, &
973 & qck(ng)%Vid(idsdif), &
974 & qck(ng)%Rindex, gtype, &
975 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
976# ifdef MASKING
977 & grid(ng) % rmask, &
978# endif
979 & mixing(ng) % Akt(:,:,:,isalt), &
980 & setfillval = .false.)
981 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
982 IF (master) THEN
983 WRITE (stdout,20) trim(vname(1,idsdif)), qck(ng)%Rindex
984 END IF
985 exit_flag=3
986 ioerror=status
987 RETURN
988 END IF
989 END IF
990# endif
991# if defined GLS_MIXING || defined MY25_MIXING
992!
993! Write out turbulent kinetic energy.
994!
995 IF (qout(idmtke,ng)) THEN
996 scale=1.0_dp
997 gtype=gfactor*w3dvar
998 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idmtke, &
999 & qck(ng)%Vid(idmtke), &
1000 & qck(ng)%Rindex, gtype, &
1001 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1002# ifdef MASKING
1003 & grid(ng) % rmask, &
1004# endif
1005 & mixing(ng) % tke(:,:,:,nout), &
1006 & setfillval = .false.)
1007 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1008 IF (master) THEN
1009 WRITE (stdout,20) trim(vname(1,idmtke)), qck(ng)%Rindex
1010 END IF
1011 exit_flag=3
1012 ioerror=status
1013 RETURN
1014 END IF
1015 END IF
1016!
1017! Write out turbulent length scale field.
1018!
1019 IF (qout(idmtls,ng)) THEN
1020 scale=1.0_dp
1021 gtype=gfactor*w3dvar
1022 status=nf_fwrite3d(ng, model, qck(ng)%ncid, idmtls, &
1023 & qck(ng)%Vid(idmtls), &
1024 & qck(ng)%Rindex, gtype, &
1025 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1026# ifdef MASKING
1027 & grid(ng) % rmask, &
1028# endif
1029 & mixing(ng) % gls(:,:,:,nout), &
1030 & setfillval = .false.)
1031
1032 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1033 IF (master) THEN
1034 WRITE (stdout,20) trim(vname(1,idmtls)), qck(ng)%Rindex
1035 END IF
1036 exit_flag=3
1037 ioerror=status
1038 RETURN
1039 END IF
1040 END IF
1041# endif
1042# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
1043!
1044! Write out surface air pressure.
1045!
1046 IF (qout(idpair,ng)) THEN
1047 scale=1.0_dp
1048 gtype=gfactor*r2dvar
1049 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idpair, &
1050 & qck(ng)%Vid(idpair), &
1051 & qck(ng)%Rindex, gtype, &
1052 & lbi, ubi, lbj, ubj, scale, &
1053# ifdef MASKING
1054 & grid(ng) % rmask, &
1055# endif
1056 & forces(ng) % Pair)
1057 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1058 IF (master) THEN
1059 WRITE (stdout,20) trim(vname(1,idpair)), qck(ng)%Rindex
1060 END IF
1061 exit_flag=3
1062 ioerror=status
1063 RETURN
1064 END IF
1065 END IF
1066# endif
1067# if defined BULK_FLUXES
1068!
1069! Write out surface air temperature.
1070!
1071 IF (qout(idtair,ng)) THEN
1072 scale=1.0_dp
1073 gtype=gfactor*r2dvar
1074 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idtair, &
1075 & qck(ng)%Vid(idtair), &
1076 & qck(ng)%Rindex, gtype, &
1077 & lbi, ubi, lbj, ubj, scale, &
1078# ifdef MASKING
1079 & grid(ng) % rmask, &
1080# endif
1081 & forces(ng) % Tair)
1082 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1083 IF (master) THEN
1084 WRITE (stdout,20) trim(vname(1,idtair)), qck(ng)%Rindex
1085 END IF
1086 exit_flag=3
1087 ioerror=status
1088 RETURN
1089 END IF
1090 END IF
1091# endif
1092# if defined BULK_FLUXES || defined ECOSIM
1093!
1094! Write out surface winds.
1095!
1096 IF (qout(iduair,ng)) THEN
1097 scale=1.0_dp
1098 gtype=gfactor*r2dvar
1099 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduair, &
1100 & qck(ng)%Vid(iduair), &
1101 & qck(ng)%Rindex, gtype, &
1102 & lbi, ubi, lbj, ubj, scale, &
1103# ifdef MASKING
1104 & grid(ng) % rmask, &
1105# endif
1106 & forces(ng) % Uwind)
1107 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1108 IF (master) THEN
1109 WRITE (stdout,20) trim(vname(1,iduair)), qck(ng)%Rindex
1110 END IF
1111 exit_flag=3
1112 ioerror=status
1113 RETURN
1114 END IF
1115 END IF
1116!
1117 IF (qout(idvair,ng)) THEN
1118 scale=1.0_dp
1119 gtype=gfactor*r2dvar
1120 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvair, &
1121 & qck(ng)%Vid(idvair), &
1122 & qck(ng)%Rindex, gtype, &
1123 & lbi, ubi, lbj, ubj, scale, &
1124# ifdef MASKING
1125 & grid(ng) % rmask, &
1126# endif
1127 & forces(ng) % Vwind)
1128 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1129 IF (master) THEN
1130 WRITE (stdout,20) trim(vname(1,idvair)), qck(ng)%Rindex
1131 END IF
1132 exit_flag=3
1133 ioerror=status
1134 RETURN
1135 END IF
1136 END IF
1137!
1138! Write out Eastward/Northward surface wind (m/s) at RHO-points.
1139!
1140 IF (qout(iduaie,ng).and.qout(idvain,ng)) THEN
1141 IF (.not.allocated(ur2d)) THEN
1142 allocate (ur2d(lbi:ubi,lbj:ubj))
1143 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
1144 END IF
1145 IF (.not.allocated(vr2d)) THEN
1146 allocate (vr2d(lbi:ubi,lbj:ubj))
1147 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
1148 END IF
1149 CALL uv_rotate2d (ng, tile, .false., .true., &
1150 & lbi, ubi, lbj, ubj, &
1151 & grid(ng) % CosAngler, &
1152 & grid(ng) % SinAngler, &
1153# ifdef MASKING
1154 & grid(ng) % rmask_full, &
1155# endif
1156 & forces(ng) % Uwind, &
1157 & forces(ng) % Vwind, &
1158 & ur2d, vr2d)
1159!
1160 scale=1.0_dp
1161 gtype=gfactor*r2dvar
1162 status=nf_fwrite2d(ng, model, qck(ng)%ncid, iduaie, &
1163 & qck(ng)%Vid(iduaie), &
1164 & qck(ng)%Rindex, gtype, &
1165 & lbi, ubi, lbj, ubj, scale, &
1166# ifdef MASKING
1167 & grid(ng) % rmask, &
1168# endif
1169 & ur2d)
1170 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1171 IF (master) THEN
1172 WRITE (stdout,20) trim(vname(1,iduaie)), qck(ng)%Rindex
1173 END IF
1174 exit_flag=3
1175 ioerror=status
1176 RETURN
1177 END IF
1178!
1179 scale=1.0_dp
1180 gtype=gfactor*r2dvar
1181 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvain, &
1182 & qck(ng)%Vid(idvain), &
1183 & qck(ng)%Rindex, gtype, &
1184 & lbi, ubi, lbj, ubj, scale, &
1185# ifdef MASKING
1186 & grid(ng) % rmask, &
1187# endif
1188 & vr2d)
1189 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1190 IF (master) THEN
1191 WRITE (stdout,20) trim(vname(1,idvain)), qck(ng)%Rindex
1192 END IF
1193 exit_flag=3
1194 ioerror=status
1195 RETURN
1196 END IF
1197 deallocate (ur2d)
1198 deallocate (vr2d)
1199 END IF
1200# endif
1201!
1202! Write out surface active tracers fluxes.
1203!
1204 DO itrc=1,nat
1205 IF (qout(idtsur(itrc),ng)) THEN
1206 IF (itrc.eq.itemp) THEN
1207# ifdef SO_SEMI
1208 scale=1.0_dp
1209# else
1210 scale=rho0*cp ! Celsius m/s to W/m2
1211# endif
1212 ELSE IF (itrc.eq.isalt) THEN
1213 scale=1.0_dp
1214 END IF
1215 gtype=gfactor*r2dvar
1216 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idtsur(itrc), &
1217 & qck(ng)%Vid(idtsur(itrc)), &
1218 & qck(ng)%Rindex, gtype, &
1219 & lbi, ubi, lbj, ubj, scale, &
1220# ifdef MASKING
1221 & grid(ng) % rmask, &
1222# endif
1223 & forces(ng) % stflx(:,:,itrc))
1224 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1225 IF (master) THEN
1226 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1227 & qck(ng)%Rindex
1228 END IF
1229 exit_flag=3
1230 ioerror=status
1231 RETURN
1232 END IF
1233 END IF
1234 END DO
1235
1236# if defined BULK_FLUXES || defined FRC_COUPLING
1237!
1238! Write out latent heat flux.
1239!
1240 IF (qout(idlhea,ng)) THEN
1241 scale=rho0*cp
1242 gtype=gfactor*r2dvar
1243 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idlhea, &
1244 & qck(ng)%Vid(idlhea), &
1245 & qck(ng)%Rindex, gtype, &
1246 & lbi, ubi, lbj, ubj, scale, &
1247# ifdef MASKING
1248 & grid(ng) % rmask, &
1249# endif
1250 & forces(ng) % lhflx)
1251 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1252 IF (master) THEN
1253 WRITE (stdout,20) trim(vname(1,idlhea)), qck(ng)%Rindex
1254 END IF
1255 exit_flag=3
1256 ioerror=status
1257 RETURN
1258 END IF
1259 END IF
1260!
1261! Write out sensible heat flux.
1262!
1263 IF (qout(idshea,ng)) THEN
1264 scale=rho0*cp
1265 gtype=gfactor*r2dvar
1266 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idshea, &
1267 & qck(ng)%Vid(idshea), &
1268 & qck(ng)%Rindex, gtype, &
1269 & lbi, ubi, lbj, ubj, scale, &
1270# ifdef MASKING
1271 & grid(ng) % rmask, &
1272# endif
1273 & forces(ng) % shflx)
1274 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1275 IF (master) THEN
1276 WRITE (stdout,20) trim(vname(1,idshea)), qck(ng)%Rindex
1277 END IF
1278 exit_flag=3
1279 ioerror=status
1280 RETURN
1281 END IF
1282 END IF
1283!
1284! Write out net longwave radiation flux.
1285!
1286 IF (qout(idlrad,ng)) THEN
1287 scale=rho0*cp
1288 gtype=gfactor*r2dvar
1289 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idlrad, &
1290 & qck(ng)%Vid(idlrad), &
1291 & qck(ng)%Rindex, gtype, &
1292 & lbi, ubi, lbj, ubj, scale, &
1293# ifdef MASKING
1294 & grid(ng) % rmask, &
1295# endif
1296 & forces(ng) % lrflx)
1297 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1298 IF (master) THEN
1299 WRITE (stdout,20) trim(vname(1,idlrad)), qck(ng)%Rindex
1300 END IF
1301 exit_flag=3
1302 ioerror=status
1303 RETURN
1304 END IF
1305 END IF
1306# endif
1307
1308# ifdef BULK_FLUXES
1309# ifdef EMINUSP
1310!
1311! Write out evaporation rate (kg/m2/s).
1312!
1313 IF (qout(idevap,ng)) THEN
1314 scale=1.0_dp
1315 gtype=gfactor*r2dvar
1316 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idevap, &
1317 & qck(ng)%Vid(idevap), &
1318 & qck(ng)%Rindex, gtype, &
1319 & lbi, ubi, lbj, ubj, scale, &
1320# ifdef MASKING
1321 & grid(ng) % rmask, &
1322# endif
1323 & forces(ng) % evap)
1324 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1325 IF (master) THEN
1326 WRITE (stdout,20) trim(vname(1,idevap)), qck(ng)%Rindex
1327 END IF
1328 exit_flag=3
1329 ioerror=status
1330 RETURN
1331 END IF
1332 END IF
1333!
1334! Write out precipitation rate (kg/m2/s).
1335!
1336 IF (qout(idrain,ng)) THEN
1337 scale=1.0_dp
1338 gtype=gfactor*r2dvar
1339 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idrain, &
1340 & qck(ng)%Vid(idrain), &
1341 & qck(ng)%Rindex, gtype, &
1342 & lbi, ubi, lbj, ubj, scale, &
1343# ifdef MASKING
1344 & grid(ng) % rmask, &
1345# endif
1346 & forces(ng) % rain)
1347 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1348 IF (master) THEN
1349 WRITE (stdout,20) trim(vname(1,idrain)), qck(ng)%Rindex
1350 END IF
1351 exit_flag=3
1352 ioerror=status
1353 RETURN
1354 END IF
1355 END IF
1356# endif
1357# endif
1358!
1359! Write out E-P (m/s).
1360!
1361 IF (qout(idempf,ng)) THEN
1362 scale=1.0_dp
1363 gtype=gfactor*r2dvar
1364 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idempf, &
1365 & qck(ng)%Vid(idempf), &
1366 & qck(ng)%Rindex, gtype, &
1367 & lbi, ubi, lbj, ubj, scale, &
1368# ifdef MASKING
1369 & grid(ng) % rmask, &
1370# endif
1371 & forces(ng) % stflux(:,:,isalt))
1372 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1373 IF (master) THEN
1374 WRITE (stdout,20) trim(vname(1,idempf)), qck(ng)%Rindex
1375 END IF
1376 exit_flag=3
1377 ioerror=status
1378 RETURN
1379 END IF
1380 END IF
1381# ifdef SHORTWAVE
1382!
1383! Write out net shortwave radiation flux.
1384!
1385 IF (qout(idsrad,ng)) THEN
1386 scale=rho0*cp
1387 gtype=gfactor*r2dvar
1388 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idsrad, &
1389 & qck(ng)%Vid(idsrad), &
1390 & qck(ng)%Rindex, gtype, &
1391 & lbi, ubi, lbj, ubj, scale, &
1392# ifdef MASKING
1393 & grid(ng) % rmask, &
1394# endif
1395 & forces(ng) % srflx)
1396 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1397 IF (master) THEN
1398 WRITE (stdout,20) trim(vname(1,idsrad)), qck(ng)%Rindex
1399 END IF
1400 exit_flag=3
1401 ioerror=status
1402 RETURN
1403 END IF
1404 END IF
1405# endif
1406#endif
1407!
1408! Write out surface U-momentum stress.
1409!
1410 IF (qout(idusms,ng)) THEN
1411 scale=rho0 ! m2/s2 to Pa
1412 gtype=gfactor*u2dvar
1413 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idusms, &
1414 & qck(ng)%Vid(idusms), &
1415 & qck(ng)%Rindex, gtype, &
1416 & lbi, ubi, lbj, ubj, scale, &
1417#ifdef MASKING
1418 & grid(ng) % umask, &
1419#endif
1420 & forces(ng) % sustr)
1421 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1422 IF (master) THEN
1423 WRITE (stdout,20) trim(vname(1,idusms)), qck(ng)%Rindex
1424 END IF
1425 exit_flag=3
1426 ioerror=status
1427 RETURN
1428 END IF
1429 END IF
1430!
1431! Write out surface V-momentum stress.
1432!
1433 IF (qout(idvsms,ng)) THEN
1434 scale=rho0
1435 gtype=gfactor*v2dvar
1436 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvsms, &
1437 & qck(ng)%Vid(idvsms), &
1438 & qck(ng)%Rindex, gtype, &
1439 & lbi, ubi, lbj, ubj, scale, &
1440#ifdef MASKING
1441 & grid(ng) % vmask, &
1442#endif
1443 & forces(ng) % svstr)
1444 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1445 IF (master) THEN
1446 WRITE (stdout,20) trim(vname(1,idvsms)), qck(ng)%Rindex
1447 END IF
1448 exit_flag=3
1449 ioerror=status
1450 RETURN
1451 END IF
1452 END IF
1453!
1454! Write out bottom U-momentum stress.
1455!
1456 IF (qout(idubms,ng)) THEN
1457 scale=-rho0
1458 gtype=gfactor*u2dvar
1459 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idubms, &
1460 & qck(ng)%Vid(idubms), &
1461 & qck(ng)%Rindex, gtype, &
1462 & lbi, ubi, lbj, ubj, scale, &
1463#ifdef MASKING
1464 & grid(ng) % umask, &
1465#endif
1466 & forces(ng) % bustr)
1467 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1468 IF (master) THEN
1469 WRITE (stdout,20) trim(vname(1,idubms)), qck(ng)%Rindex
1470 END IF
1471 exit_flag=3
1472 ioerror=status
1473 RETURN
1474 END IF
1475 END IF
1476!
1477! Write out bottom V-momentum stress.
1478!
1479 IF (qout(idvbms,ng)) THEN
1480 scale=-rho0
1481 gtype=gfactor*v2dvar
1482 status=nf_fwrite2d(ng, model, qck(ng)%ncid, idvbms, &
1483 & qck(ng)%Vid(idvbms), &
1484 & qck(ng)%Rindex, gtype, &
1485 & lbi, ubi, lbj, ubj, scale, &
1486#ifdef MASKING
1487 & grid(ng) % vmask, &
1488#endif
1489 & forces(ng) % bvstr)
1490 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1491 IF (master) THEN
1492 WRITE (stdout,20) trim(vname(1,idvbms)), qck(ng)%Rindex
1493 END IF
1494 exit_flag=3
1495 ioerror=status
1496 RETURN
1497 END IF
1498 END IF
1499
1500#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
1501!
1502!-----------------------------------------------------------------------
1503! Write out the bottom boundary layer model or waves variables.
1504!-----------------------------------------------------------------------
1505!
1506 CALL bbl_wrt_nf90 (ng, model, tile, &
1507 & lbi, ubi, lbj, ubj, &
1508 & qout, qck)
1509 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1510#endif
1511
1512#if defined ICE_MODEL && defined SOLVE3D
1513!
1514!-----------------------------------------------------------------------
1515! Write out the sea-ice model variables.
1516!-----------------------------------------------------------------------
1517!
1518 CALL ice_wrt_nf90 (ng, model, tile, &
1519 & lbi, ubi, lbj, ubj, &
1520 & qout, qck)
1521 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1522#endif
1523
1524#if defined SEDIMENT && defined SOLVE3D
1525!
1526!-----------------------------------------------------------------------
1527! Write out the sediment model variables.
1528!-----------------------------------------------------------------------
1529!
1530 CALL sediment_wrt_nf90 (ng, model, tile, &
1531 & lbi, ubi, lbj, ubj, &
1532 & qout, qck)
1533 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1534#endif
1535
1536#if defined WEC_VF && defined SOLVE3D
1537!
1538!-----------------------------------------------------------------------
1539! Write out the Waves Effect on Currents variables.
1540!-----------------------------------------------------------------------
1541!
1542 CALL wec_wrt_nf90 (ng, model, tile, &
1543 & lbi, ubi, lbj, ubj, &
1544 & qout, qck)
1545 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1546#endif
1547!
1548!-----------------------------------------------------------------------
1549! Synchronize quicksave NetCDF file to disk to allow other processes
1550! to access data immediately after it is written.
1551!-----------------------------------------------------------------------
1552!
1553 CALL netcdf_sync (ng, model, qck(ng)%name, qck(ng)%ncid)
1554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1555!
1556 10 FORMAT (2x,'WRT_QUICK_NF90 - writing quicksave', t42, &
1557#ifdef SOLVE3D
1558# ifdef NESTING
1559 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
1560# else
1561 & 'fields (Index=',i1,',',i1,') in record = ',i0)
1562# endif
1563#else
1564# ifdef NESTING
1565 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
1566# else
1567 & 'fields (Index=',i1,') in record = ',i0)
1568# endif
1569#endif
1570 20 FORMAT (/,' WRT_QUICK_NF90 - error while writing variable: ',a, &
1571 & /,18x,'into quicksave NetCDF file for time record: ',i0)
1572!
1573 RETURN
1574 END SUBROUTINE wrt_quick_nf90
1575
1576#if defined PIO_LIB && defined DISTRIBUTE
1577!
1578!***********************************************************************
1579 SUBROUTINE wrt_quick_pio (ng, model, tile, &
1580 & LBi, UBi, LBj, UBj)
1581!***********************************************************************
1582!
1583 USE mod_pio_netcdf
1584!
1585! Imported variable declarations.
1586!
1587 integer, intent(in) :: ng, model, tile
1588 integer, intent(in) :: lbi, ubi, lbj, ubj
1589!
1590! Local variable declarations.
1591!
1592 integer :: fcount, status
1593# ifdef SOLVE3D
1594 integer :: i, itrc, j, k
1595# endif
1596!
1597 real(dp) :: scale
1598!
1599 real(r8), allocatable :: ur2d(:,:)
1600 real(r8), allocatable :: vr2d(:,:)
1601# ifdef SOLVE3D
1602 real(r8), allocatable :: wr3d(:,:,:)
1603# endif
1604!
1605 character (len=*), parameter :: myfile = &
1606 & __FILE__//", wrt_quick_pio"
1607!
1608 TYPE (io_desc_t), pointer :: iodesc
1609
1610# include "set_bounds.h"
1611!
1612 sourcefile=myfile
1613!
1614!-----------------------------------------------------------------------
1615! Write out quicksave fields.
1616!-----------------------------------------------------------------------
1617!
1618 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1619!
1620! Set time record index.
1621!
1622 qck(ng)%Rindex=qck(ng)%Rindex+1
1623 fcount=qck(ng)%load
1624 qck(ng)%Nrec(fcount)=qck(ng)%Nrec(fcount)+1
1625!
1626! Report.
1627!
1628# ifdef SOLVE3D
1629# ifdef NESTING
1630 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex, ng
1631# else
1632 IF (master) WRITE (stdout,10) kout, nout, qck(ng)%Rindex
1633# endif
1634# else
1635# ifdef NESTING
1636 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex, ng
1637# else
1638 IF (master) WRITE (stdout,10) kout, qck(ng)%Rindex
1639# endif
1640# endif
1641!
1642! Write out model time (s).
1643!
1644 CALL pio_netcdf_put_fvar (ng, model, qck(ng)%name, &
1645 & trim(vname(1,idtime)), time(ng:), &
1646 & (/qck(ng)%Rindex/), (/1/), &
1647 & piofile = qck(ng)%pioFile, &
1648 & piovar = qck(ng)%pioVar(idtime)%vd)
1649 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1650
1651# ifdef WET_DRY
1652!
1653! Write out wet/dry mask at PSI-points.
1654!
1655 scale=1.0_dp
1656 IF (qck(ng)%pioVar(idpwet)%dkind.eq.pio_double) THEN
1657 iodesc => iodesc_dp_p2dvar(ng)
1658 ELSE
1659 iodesc => iodesc_sp_p2dvar(ng)
1660 END IF
1661 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idpwet, &
1662 & qck(ng)%pioVar(idpwet), &
1663 & qck(ng)%Rindex, &
1664 & iodesc, &
1665 & lbi, ubi, lbj, ubj, scale, &
1666# ifdef MASKING
1667 & grid(ng) % pmask, &
1668# endif
1669 & grid(ng) % pmask_wet, &
1670 & setfillval = .false.)
1671 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1672 IF (master) THEN
1673 WRITE (stdout,20) trim(vname(1,idpwet)), qck(ng)%Rindex
1674 END IF
1675 exit_flag=3
1676 ioerror=status
1677 RETURN
1678 END IF
1679!
1680! Write out wet/dry mask at RHO-points.
1681!
1682 scale=1.0_dp
1683 IF (qck(ng)%pioVar(idrwet)%dkind.eq.pio_double) THEN
1684 iodesc => iodesc_dp_r2dvar(ng)
1685 ELSE
1686 iodesc => iodesc_sp_r2dvar(ng)
1687 END IF
1688 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idrwet, &
1689 & qck(ng)%pioVar(idrwet), &
1690 & qck(ng)%Rindex, &
1691 & iodesc, &
1692 & lbi, ubi, lbj, ubj, scale, &
1693# ifdef MASKING
1694 & grid(ng) % rmask, &
1695# endif
1696 & grid(ng) % rmask_wet, &
1697 & setfillval = .false.)
1698 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1699 IF (master) THEN
1700 WRITE (stdout,20) trim(vname(1,idrwet)), qck(ng)%Rindex
1701 END IF
1702 exit_flag=3
1703 ioerror=status
1704 RETURN
1705 END IF
1706!
1707! Write out wet/dry mask at U-points.
1708!
1709 scale=1.0_dp
1710 IF (qck(ng)%pioVar(iduwet)%dkind.eq.pio_double) THEN
1711 iodesc => iodesc_dp_u2dvar(ng)
1712 ELSE
1713 iodesc => iodesc_sp_u2dvar(ng)
1714 END IF
1715 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, iduwet, &
1716 & qck(ng)%pioVar(iduwet), &
1717 & qck(ng)%Rindex, &
1718 & iodesc, &
1719 & lbi, ubi, lbj, ubj, scale, &
1720# ifdef MASKING
1721 & grid(ng) % umask, &
1722# endif
1723 & grid(ng) % umask_wet, &
1724 & setfillval = .false.)
1725 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1726 IF (master) THEN
1727 WRITE (stdout,20) trim(vname(1,iduwet)), qck(ng)%Rindex
1728 END IF
1729 exit_flag=3
1730 ioerror=status
1731 RETURN
1732 END IF
1733!
1734! Write out wet/dry mask at V-points.
1735!
1736 scale=1.0_dp
1737 IF (qck(ng)%pioVar(idvwet)%dkind.eq.pio_double) THEN
1738 iodesc => iodesc_dp_v2dvar(ng)
1739 ELSE
1740 iodesc => iodesc_sp_v2dvar(ng)
1741 END IF
1742 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvwet, &
1743 & qck(ng)%pioVar(idvwet), &
1744 & qck(ng)%Rindex, &
1745 & iodesc, &
1746 & lbi, ubi, lbj, ubj, scale, &
1747# ifdef MASKING
1748 & grid(ng) % vmask, &
1749# endif
1750 & grid(ng) % vmask_wet, &
1751 & setfillval = .false.)
1752 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1753 IF (master) THEN
1754 WRITE (stdout,20) trim(vname(1,idvwet)), qck(ng)%Rindex
1755 END IF
1756 exit_flag=3
1757 ioerror=status
1758 RETURN
1759 END IF
1760# endif
1761# ifdef SOLVE3D
1762!
1763! Write time-varying depths of RHO-points.
1764!
1765 IF (qout(idpthr,ng)) THEN
1766 scale=1.0_dp
1767 IF (qck(ng)%pioVar(idpthr)%dkind.eq.pio_double) THEN
1768 iodesc => iodesc_dp_r3dvar(ng)
1769 ELSE
1770 iodesc => iodesc_sp_r3dvar(ng)
1771 END IF
1772 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idpthr, &
1773 & qck(ng)%pioVar(idpthr), &
1774 & qck(ng)%Rindex, &
1775 & iodesc, &
1776 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1777# ifdef MASKING
1778 & grid(ng) % rmask, &
1779# endif
1780 & grid(ng) % z_r, &
1781 & setfillval = .false.)
1782 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1783 IF (master) THEN
1784 WRITE (stdout,20) trim(vname(1,idpthr)), qck(ng)%Rindex
1785 END IF
1786 exit_flag=3
1787 ioerror=status
1788 RETURN
1789 END IF
1790 END IF
1791!
1792! Write time-varying depths of U-points.
1793!
1794 IF (qout(idpthu,ng)) THEN
1795 scale=1.0_dp
1796 DO k=1,n(ng)
1797 DO j=jstr-1,jend+1
1798 DO i=istru-1,iend+1
1799 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i-1,j,k)+ &
1800 & grid(ng)%z_r(i ,j,k))
1801 END DO
1802 END DO
1803 END DO
1804 IF (qck(ng)%pioVar(idpthu)%dkind.eq.pio_double) THEN
1805 iodesc => iodesc_dp_u3dvar(ng)
1806 ELSE
1807 iodesc => iodesc_sp_u3dvar(ng)
1808 END IF
1809 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idpthu, &
1810 & qck(ng)%pioVar(idpthu), &
1811 & qck(ng)%Rindex, &
1812 & iodesc, &
1813 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1814# ifdef MASKING
1815 & grid(ng) % umask, &
1816# endif
1817 & grid(ng) % z_v, &
1818 & setfillval = .false.)
1819 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1820 IF (master) THEN
1821 WRITE (stdout,20) trim(vname(1,idpthu)), qck(ng)%Rindex
1822 END IF
1823 exit_flag=3
1824 ioerror=status
1825 RETURN
1826 END IF
1827 END IF
1828!
1829! Write time-varying depths of V-points.
1830!
1831 IF (qout(idpthv,ng)) THEN
1832 scale=1.0_dp
1833 DO k=1,n(ng)
1834 DO j=jstrv-1,jend+1
1835 DO i=istr-1,iend+1
1836 grid(ng)%z_v(i,j,k)=0.5_r8*(grid(ng)%z_r(i,j-1,k)+ &
1837 & grid(ng)%z_r(i,j ,k))
1838 END DO
1839 END DO
1840 END DO
1841 IF (qck(ng)%pioVar(idpthv)%dkind.eq.pio_double) THEN
1842 iodesc => iodesc_dp_v3dvar(ng)
1843 ELSE
1844 iodesc => iodesc_sp_v3dvar(ng)
1845 END IF
1846 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idpthv, &
1847 & qck(ng)%pioVar(idpthv), &
1848 & qck(ng)%Rindex, &
1849 & iodesc, &
1850 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
1851# ifdef MASKING
1852 & grid(ng) % vmask, &
1853# endif
1854 & grid(ng) % z_v, &
1855 & setfillval = .false.)
1856 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1857 IF (master) THEN
1858 WRITE (stdout,20) trim(vname(1,idpthv)), qck(ng)%Rindex
1859 END IF
1860 exit_flag=3
1861 ioerror=status
1862 RETURN
1863 END IF
1864 END IF
1865!
1866! Write time-varying depths of W-points.
1867!
1868 IF (qout(idpthw,ng)) THEN
1869 scale=1.0_dp
1870 IF (qck(ng)%pioVar(idpthw)%dkind.eq.pio_double) THEN
1871 iodesc => iodesc_dp_w3dvar(ng)
1872 ELSE
1873 iodesc => iodesc_sp_w3dvar(ng)
1874 END IF
1875 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idpthw, &
1876 & qck(ng)%pioVar(idpthw), &
1877 & qck(ng)%Rindex, &
1878 & iodesc, &
1879 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
1880# ifdef MASKING
1881 & grid(ng) % rmask, &
1882# endif
1883 & grid(ng) % z_w, &
1884 & setfillval = .false.)
1885 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1886 IF (master) THEN
1887 WRITE (stdout,20) trim(vname(1,idpthw)), qck(ng)%Rindex
1888 END IF
1889 exit_flag=3
1890 ioerror=status
1891 RETURN
1892 END IF
1893 END IF
1894# endif
1895!
1896! Write out free-surface (m)
1897!
1898 IF (qout(idfsur,ng)) THEN
1899 scale=1.0_dp
1900 IF (qck(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
1901 iodesc => iodesc_dp_r2dvar(ng)
1902 ELSE
1903 iodesc => iodesc_sp_r2dvar(ng)
1904 END IF
1905 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idfsur, &
1906 & qck(ng)%pioVar(idfsur), &
1907 & qck(ng)%Rindex, &
1908 & iodesc, &
1909 & lbi, ubi, lbj, ubj, scale, &
1910# ifdef MASKING
1911 & grid(ng) % rmask, &
1912# endif
1913# ifdef WET_DRY
1914 & ocean(ng) % zeta(:,:,kout), &
1915 & setfillval = .false.)
1916# else
1917 & ocean(ng) % zeta(:,:,kout))
1918# endif
1919 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1920 IF (master) THEN
1921 WRITE (stdout,20) trim(vname(1,idfsur)), qck(ng)%Rindex
1922 END IF
1923 exit_flag=3
1924 ioerror=status
1925 RETURN
1926 END IF
1927 END IF
1928!
1929! Write out 2D U-momentum component (m/s).
1930!
1931 IF (qout(idubar,ng)) THEN
1932 scale=1.0_dp
1933 IF (qck(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
1934 iodesc => iodesc_dp_u2dvar(ng)
1935 ELSE
1936 iodesc => iodesc_sp_u2dvar(ng)
1937 END IF
1938 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idubar, &
1939 & qck(ng)%pioVar(idubar), &
1940 & qck(ng)%Rindex, &
1941 & iodesc, &
1942 & lbi, ubi, lbj, ubj, scale, &
1943# ifdef MASKING
1944 & grid(ng) % umask_full, &
1945# endif
1946 & ocean(ng) % ubar(:,:,kout))
1947 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1948 IF (master) THEN
1949 WRITE (stdout,20) trim(vname(1,idubar)), qck(ng)%Rindex
1950 END IF
1951 exit_flag=3
1952 ioerror=status
1953 RETURN
1954 END IF
1955 END IF
1956!
1957! Write out 2D V-momentum component (m/s).
1958!
1959 IF (qout(idvbar,ng)) THEN
1960 scale=1.0_dp
1961 IF (qck(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
1962 iodesc => iodesc_dp_v2dvar(ng)
1963 ELSE
1964 iodesc => iodesc_sp_v2dvar(ng)
1965 END IF
1966 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvbar, &
1967 & qck(ng)%pioVar(idvbar), &
1968 & qck(ng)%Rindex, &
1969 & iodesc, &
1970 & lbi, ubi, lbj, ubj, scale, &
1971# ifdef MASKING
1972 & grid(ng) % vmask_full, &
1973# endif
1974 & ocean(ng) % vbar(:,:,kout))
1975 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1976 IF (master) THEN
1977 WRITE (stdout,20) trim(vname(1,idvbar)), qck(ng)%Rindex
1978 END IF
1979 exit_flag=3
1980 ioerror=status
1981 RETURN
1982 END IF
1983 END IF
1984!
1985! Write out 2D Eastward and Northward momentum components (m/s) at
1986! RHO-points.
1987!
1988 IF (qout(idu2de,ng).and.qout(idv2dn,ng)) THEN
1989 IF (.not.allocated(ur2d)) THEN
1990 allocate (ur2d(lbi:ubi,lbj:ubj))
1991 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
1992 END IF
1993 IF (.not.allocated(vr2d)) THEN
1994 allocate (vr2d(lbi:ubi,lbj:ubj))
1995 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
1996 END IF
1997 CALL uv_rotate2d (ng, tile, .false., .true., &
1998 & lbi, ubi, lbj, ubj, &
1999 & grid(ng) % CosAngler, &
2000 & grid(ng) % SinAngler, &
2001# ifdef MASKING
2002 & grid(ng) % rmask_full, &
2003# endif
2004 & ocean(ng) % ubar(:,:,kout), &
2005 & ocean(ng) % vbar(:,:,kout), &
2006 & ur2d, vr2d)
2007!
2008 scale=1.0_dp
2009 IF (qck(ng)%pioVar(idu2de)%dkind.eq.pio_double) THEN
2010 iodesc => iodesc_dp_r2dvar(ng)
2011 ELSE
2012 iodesc => iodesc_sp_r2dvar(ng)
2013 END IF
2014 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idu2de, &
2015 & qck(ng)%pioVar(idu2de), &
2016 & qck(ng)%Rindex, &
2017 & iodesc, &
2018 & lbi, ubi, lbj, ubj, scale, &
2019# ifdef MASKING
2020 & grid(ng) % rmask_full, &
2021# endif
2022 & ur2d)
2023 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2024 IF (master) THEN
2025 WRITE (stdout,20) trim(vname(1,idu2de)), qck(ng)%Rindex
2026 END IF
2027 exit_flag=3
2028 ioerror=status
2029 RETURN
2030 END IF
2031!
2032 IF (qck(ng)%pioVar(idv2dn)%dkind.eq.pio_double) THEN
2033 iodesc => iodesc_dp_r2dvar(ng)
2034 ELSE
2035 iodesc => iodesc_sp_r2dvar(ng)
2036 END IF
2037 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idv2dn, &
2038 & qck(ng)%pioVar(idv2dn), &
2039 & qck(ng)%Rindex, &
2040 & iodesc, &
2041 & lbi, ubi, lbj, ubj, scale, &
2042# ifdef MASKING
2043 & grid(ng) % rmask_full, &
2044# endif
2045 & vr2d)
2046 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2047 IF (master) THEN
2048 WRITE (stdout,20) trim(vname(1,idv2dn)), qck(ng)%Rindex
2049 END IF
2050 exit_flag=3
2051 ioerror=status
2052 RETURN
2053 END IF
2054 deallocate (ur2d)
2055 deallocate (vr2d)
2056 END IF
2057
2058# ifdef SOLVE3D
2059!
2060! Write out 3D U-momentum component (m/s).
2061!
2062 IF (qout(iduvel,ng)) THEN
2063 scale=1.0_dp
2064 IF (qck(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
2065 iodesc => iodesc_dp_u3dvar(ng)
2066 ELSE
2067 iodesc => iodesc_sp_u3dvar(ng)
2068 END IF
2069 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, iduvel, &
2070 & qck(ng)%pioVar(iduvel), &
2071 & qck(ng)%Rindex, &
2072 & iodesc, &
2073 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2074# ifdef MASKING
2075 & grid(ng) % umask_full, &
2076# endif
2077 & ocean(ng) % u(:,:,:,nout))
2078 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2079 IF (master) THEN
2080 WRITE (stdout,20) trim(vname(1,iduvel)), qck(ng)%Rindex
2081 END IF
2082 exit_flag=3
2083 ioerror=status
2084 RETURN
2085 END IF
2086 END IF
2087!
2088! Write out 3D V-momentum component (m/s).
2089!
2090 IF (qout(idvvel,ng)) THEN
2091 scale=1.0_dp
2092 IF (qck(ng)%pioVar(idvvel)%dkind.eq.pio_double) THEN
2093 iodesc => iodesc_dp_v3dvar(ng)
2094 ELSE
2095 iodesc => iodesc_sp_v3dvar(ng)
2096 END IF
2097 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idvvel, &
2098 & qck(ng)%pioVar(idvvel), &
2099 & qck(ng)%Rindex, &
2100 & iodesc, &
2101 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2102# ifdef MASKING
2103 & grid(ng) % vmask_full, &
2104# endif
2105 & ocean(ng) % v(:,:,:,nout))
2106 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2107 IF (master) THEN
2108 WRITE (stdout,20) trim(vname(1,idvvel)), qck(ng)%Rindex
2109 END IF
2110 exit_flag=3
2111 ioerror=status
2112 RETURN
2113 END IF
2114 END IF
2115!
2116! Write out surface U-momentum component (m/s).
2117!
2118 IF (qout(idusur,ng)) THEN
2119 scale=1.0_dp
2120 IF (qck(ng)%pioVar(idusur)%dkind.eq.pio_double) THEN
2121 iodesc => iodesc_dp_u2dvar(ng)
2122 ELSE
2123 iodesc => iodesc_sp_u2dvar(ng)
2124 END IF
2125 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idusur, &
2126 & qck(ng)%pioVar(idusur), &
2127 & qck(ng)%Rindex, &
2128 & iodesc, &
2129 & lbi, ubi, lbj, ubj, scale, &
2130# ifdef MASKING
2131 & grid(ng) % umask_full, &
2132# endif
2133 & ocean(ng) % u(:,:,n(ng),nout))
2134 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2135 IF (master) THEN
2136 WRITE (stdout,20) trim(vname(1,idusur)), qck(ng)%Rindex
2137 END IF
2138 exit_flag=3
2139 ioerror=status
2140 RETURN
2141 END IF
2142 END IF
2143!
2144! Write out surface V-momentum component (m/s).
2145!
2146 IF (qout(idvsur,ng)) THEN
2147 scale=1.0_dp
2148 IF (qck(ng)%pioVar(idvsur)%dkind.eq.pio_double) THEN
2149 iodesc => iodesc_dp_v2dvar(ng)
2150 ELSE
2151 iodesc => iodesc_sp_v2dvar(ng)
2152 END IF
2153 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvsur, &
2154 & qck(ng)%pioVar(idvsur), &
2155 & qck(ng)%Rindex, &
2156 & iodesc, &
2157 & lbi, ubi, lbj, ubj, scale, &
2158# ifdef MASKING
2159 & grid(ng) % vmask_full, &
2160# endif
2161 & ocean(ng) % v(:,:,n(ng),nout))
2162 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2163 IF (master) THEN
2164 WRITE (stdout,20) trim(vname(1,idvsur)), qck(ng)%Rindex
2165 END IF
2166 exit_flag=3
2167 ioerror=status
2168 RETURN
2169 END IF
2170 END IF
2171!
2172! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid.
2173!
2174 IF (qout(idu3de,ng)) THEN
2175 scale=1.0_dp
2176 IF (qck(ng)%pioVar(idu3de)%dkind.eq.pio_double) THEN
2177 iodesc => iodesc_dp_r3dvar(ng)
2178 ELSE
2179 iodesc => iodesc_sp_r3dvar(ng)
2180 END IF
2181 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idu3de, &
2182 & qck(ng)%pioVar(idu3de), &
2183 & qck(ng)%Rindex, &
2184 & iodesc, &
2185 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2186# ifdef MASKING
2187 & grid(ng) % rmask_full, &
2188# endif
2189 & ocean(ng) % ua)
2190 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2191 IF (master) THEN
2192 WRITE (stdout,20) trim(vname(1,idu3de)), qck(ng)%Rindex
2193 END IF
2194 exit_flag=3
2195 ioerror=status
2196 RETURN
2197 END IF
2198 END IF
2199!
2200! Write out 3D Northward momentum (m/s) at RHO-points, A-grid.
2201!
2202 IF (qout(idv3dn,ng)) THEN
2203 scale=1.0_dp
2204 IF (qck(ng)%pioVar(idv3dn)%dkind.eq.pio_double) THEN
2205 iodesc => iodesc_dp_r3dvar(ng)
2206 ELSE
2207 iodesc => iodesc_sp_r3dvar(ng)
2208 END IF
2209 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idv3dn, &
2210 & qck(ng)%pioVar(idv3dn), &
2211 & qck(ng)%Rindex, &
2212 & iodesc, &
2213 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2214# ifdef MASKING
2215 & grid(ng) % rmask_full, &
2216# endif
2217 & ocean(ng) % va)
2218 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2219 IF (master) THEN
2220 WRITE (stdout,20) trim(vname(1,idv3dn)), qck(ng)%Rindex
2221 END IF
2222 exit_flag=3
2223 ioerror=status
2224 RETURN
2225 END IF
2226 END IF
2227!
2228! Write out surface Eastward momentum (m/s) at RHO-points, A-grid.
2229!
2230 IF (qout(idusue,ng)) THEN
2231 scale=1.0_dp
2232 IF (qck(ng)%pioVar(idusue)%dkind.eq.pio_double) THEN
2233 iodesc => iodesc_dp_r2dvar(ng)
2234 ELSE
2235 iodesc => iodesc_sp_r2dvar(ng)
2236 END IF
2237 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idusue, &
2238 & qck(ng)%pioVar(idusue), &
2239 & qck(ng)%Rindex, &
2240 & iodesc, &
2241 & lbi, ubi, lbj, ubj, scale, &
2242# ifdef MASKING
2243 & grid(ng) % rmask_full, &
2244# endif
2245 & ocean(ng) % ua(:,:,n(ng)))
2246 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2247 IF (master) THEN
2248 WRITE (stdout,20) trim(vname(1,idusue)), qck(ng)%Rindex
2249 END IF
2250 exit_flag=3
2251 ioerror=status
2252 RETURN
2253 END IF
2254 END IF
2255!
2256! Write out surface Northward momentum (m/s) at RHO-points, A-grid.
2257!
2258 IF (qout(idvsun,ng)) THEN
2259 scale=1.0_dp
2260 IF (qck(ng)%pioVar(idvsun)%dkind.eq.pio_double) THEN
2261 iodesc => iodesc_dp_r2dvar(ng)
2262 ELSE
2263 iodesc => iodesc_sp_r2dvar(ng)
2264 END IF
2265 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvsun, &
2266 & qck(ng)%pioVar(idvsun), &
2267 & qck(ng)%Rindex, &
2268 & iodesc, &
2269 & lbi, ubi, lbj, ubj, scale, &
2270# ifdef MASKING
2271 & grid(ng) % rmask_full, &
2272# endif
2273 & ocean(ng) % va(:,:,n(ng)))
2274 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2275 IF (master) THEN
2276 WRITE (stdout,20) trim(vname(1,idvsun)), qck(ng)%Rindex
2277 END IF
2278 exit_flag=3
2279 ioerror=status
2280 RETURN
2281 END IF
2282 END IF
2283!
2284! Write out S-coordinate omega vertical velocity (m/s).
2285!
2286 IF (qout(idovel,ng)) THEN
2287 IF (.not.allocated(wr3d)) THEN
2288 allocate (wr3d(lbi:ubi,lbj:ubj,0:n(ng)))
2289 wr3d(lbi:ubi,lbj:ubj,0:n(ng))=0.0_r8
2290 END IF
2291 scale=1.0_dp
2292 CALL scale_omega (ng, tile, lbi, ubi, lbj, ubj, 0, n(ng), &
2293 & grid(ng) % pm, &
2294 & grid(ng) % pn, &
2295 & ocean(ng) % W, &
2296 & wr3d)
2297!
2298 IF (qck(ng)%pioVar(idovel)%dkind.eq.pio_double) THEN
2299 iodesc => iodesc_dp_w3dvar(ng)
2300 ELSE
2301 iodesc => iodesc_sp_w3dvar(ng)
2302 END IF
2303 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idovel, &
2304 & qck(ng)%pioVar(idovel), &
2305 & qck(ng)%Rindex, &
2306 & iodesc, &
2307 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2308# ifdef MASKING
2309 & grid(ng) % rmask, &
2310# endif
2311 & wr3d)
2312 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2313 IF (master) THEN
2314 WRITE (stdout,20) trim(vname(1,idovel)), qck(ng)%Rindex
2315 END IF
2316 exit_flag=3
2317 ioerror=status
2318 RETURN
2319 END IF
2320 deallocate (wr3d)
2321 END IF
2322!
2323! Write out vertical velocity (m/s).
2324!
2325 IF (qout(idwvel,ng)) THEN
2326 scale=1.0_dp
2327 IF (qck(ng)%pioVar(idwvel)%dkind.eq.pio_double) THEN
2328 iodesc => iodesc_dp_w3dvar(ng)
2329 ELSE
2330 iodesc => iodesc_sp_w3dvar(ng)
2331 END IF
2332 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idwvel, &
2333 & qck(ng)%pioVar(idwvel), &
2334 & qck(ng)%Rindex, &
2335 & iodesc, &
2336 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2337# ifdef MASKING
2338 & grid(ng) % rmask, &
2339# endif
2340 & ocean(ng) % wvel)
2341 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2342 IF (master) THEN
2343 WRITE (stdout,20) trim(vname(1,idwvel)), qck(ng)%Rindex
2344 END IF
2345 exit_flag=3
2346 ioerror=status
2347 RETURN
2348 END IF
2349 END IF
2350!
2351! Write out tracer type variables.
2352!
2353 DO itrc=1,nt(ng)
2354 IF (qout(idtvar(itrc),ng)) THEN
2355 scale=1.0_dp
2356 IF (qck(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
2357 iodesc => iodesc_dp_r3dvar(ng)
2358 ELSE
2359 iodesc => iodesc_sp_r3dvar(ng)
2360 END IF
2361 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idtvar(itrc), &
2362 & qck(ng)%pioTrc(itrc), &
2363 & qck(ng)%Rindex, &
2364 & iodesc, &
2365 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2366# ifdef MASKING
2367 & grid(ng) % rmask, &
2368# endif
2369 & ocean(ng) % t(:,:,:,nout,itrc))
2370 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2371 IF (master) THEN
2372 WRITE (stdout,20) trim(vname(1,idtvar(itrc))), &
2373 & qck(ng)%Rindex
2374 END IF
2375 exit_flag=3
2376 ioerror=status
2377 RETURN
2378 END IF
2379 END IF
2380 END DO
2381!
2382! Write out surface tracer type variables.
2383!
2384 DO itrc=1,nt(ng)
2385 IF (qout(idsurt(itrc),ng)) THEN
2386 scale=1.0_dp
2387 IF (qck(ng)%pioVar(idsurt(itrc))%dkind.eq.pio_double) THEN
2388 iodesc => iodesc_dp_r2dvar(ng)
2389 ELSE
2390 iodesc => iodesc_sp_r2dvar(ng)
2391 END IF
2392 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idsurt(itrc), &
2393 & qck(ng)%pioVar(idsurt(itrc)), &
2394 & qck(ng)%Rindex, &
2395 & iodesc, &
2396 & lbi, ubi, lbj, ubj, scale, &
2397# ifdef MASKING
2398 & grid(ng) % rmask, &
2399# endif
2400 & ocean(ng) % t(:,:,n(ng),nout,itrc))
2401 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2402 IF (master) THEN
2403 WRITE (stdout,20) trim(vname(1,idsurt(itrc))), &
2404 & qck(ng)%Rindex
2405 END IF
2406 exit_flag=3
2407 ioerror=status
2408 RETURN
2409 END IF
2410 END IF
2411 END DO
2412!
2413! Write out density anomaly.
2414!
2415 IF (qout(iddano,ng)) THEN
2416 scale=1.0_dp
2417 IF (qck(ng)%pioVar(iddano)%dkind.eq.pio_double) THEN
2418 iodesc => iodesc_dp_r3dvar(ng)
2419 ELSE
2420 iodesc => iodesc_sp_r3dvar(ng)
2421 END IF
2422 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, iddano, &
2423 & qck(ng)%pioVar(iddano), &
2424 & qck(ng)%Rindex, &
2425 & iodesc, &
2426 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
2427# ifdef MASKING
2428 & grid(ng) % rmask, &
2429# endif
2430 & ocean(ng) % rho)
2431 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2432 IF (master) THEN
2433 WRITE (stdout,20) trim(vname(1,iddano)), qck(ng)%Rindex
2434 END IF
2435 exit_flag=3
2436 ioerror=status
2437 RETURN
2438 END IF
2439 END IF
2440
2441# ifdef LMD_SKPP
2442!
2443! Write out depth surface boundary layer.
2444!
2445 IF (qout(idhsbl,ng)) THEN
2446 scale=1.0_dp
2447 IF (qck(ng)%pioVar(idhsbl)%dkind.eq.pio_double) THEN
2448 iodesc => iodesc_dp_r2dvar(ng)
2449 ELSE
2450 iodesc => iodesc_sp_r2dvar(ng)
2451 END IF
2452 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idhsbl, &
2453 & qck(ng)%pioVar(idhsbl), &
2454 & qck(ng)%Rindex, &
2455 & iodesc, &
2456 & lbi, ubi, lbj, ubj, scale, &
2457# ifdef MASKING
2458 & grid(ng) % rmask, &
2459# endif
2460 & mixing(ng) % hsbl)
2461 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2462 IF (master) THEN
2463 WRITE (stdout,20) trim(vname(1,idhsbl)), qck(ng)%Rindex
2464 END IF
2465 exit_flag=3
2466 ioerror=status
2467 RETURN
2468 END IF
2469 END IF
2470# endif
2471# ifdef LMD_BKPP
2472!
2473! Write out depth bottom boundary layer.
2474!
2475 IF (qout(idhbbl,ng)) THEN
2476 scale=1.0_dp
2477 IF (qck(ng)%pioVar(idhbbl)%dkind.eq.pio_double) THEN
2478 iodesc => iodesc_dp_r2dvar(ng)
2479 ELSE
2480 iodesc => iodesc_sp_r2dvar(ng)
2481 END IF
2482 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idhbbl, &
2483 & qck(ng)%pioVar(idhbbl), &
2484 & qck(ng)%Rindex, &
2485 & iodesc, &
2486 & lbi, ubi, lbj, ubj, scale, &
2487# ifdef MASKING
2488 & grid(ng) % rmask, &
2489# endif
2490 & mixing(ng) % hbbl)
2491 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2492 IF (master) THEN
2493 WRITE (stdout,20) trim(vname(1,idhbbl)), qck(ng)%Rindex
2494 END IF
2495 exit_flag=3
2496 ioerror=status
2497 RETURN
2498 END IF
2499 END IF
2500# endif
2501!
2502! Write out vertical viscosity coefficient.
2503!
2504 IF (qout(idvvis,ng)) THEN
2505 scale=1.0_dp
2506 IF (qck(ng)%pioVar(idvvis)%dkind.eq.pio_double) THEN
2507 iodesc => iodesc_dp_w3dvar(ng)
2508 ELSE
2509 iodesc => iodesc_sp_w3dvar(ng)
2510 END IF
2511 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idvvis, &
2512 & qck(ng)%pioVar(idvvis), &
2513 & qck(ng)%Rindex, &
2514 & iodesc, &
2515 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2516# ifdef MASKING
2517 & grid(ng) % rmask, &
2518# endif
2519 & mixing(ng) % Akv, &
2520 & setfillval = .false.)
2521 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2522 IF (master) THEN
2523 WRITE (stdout,20) trim(vname(1,idvvis)), qck(ng)%Rindex
2524 END IF
2525 exit_flag=3
2526 ioerror=status
2527 RETURN
2528 END IF
2529 END IF
2530!
2531! Write out vertical diffusion coefficient for potential temperature.
2532!
2533 IF (qout(idtdif,ng)) THEN
2534 scale=1.0_dp
2535 IF (qck(ng)%pioVar(idtdif)%dkind.eq.pio_double) THEN
2536 iodesc => iodesc_dp_w3dvar(ng)
2537 ELSE
2538 iodesc => iodesc_sp_w3dvar(ng)
2539 END IF
2540 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idtdif, &
2541 & qck(ng)%pioVar(idtdif), &
2542 & qck(ng)%Rindex, &
2543 & iodesc, &
2544 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2545# ifdef MASKING
2546 & grid(ng) % rmask, &
2547# endif
2548 & mixing(ng) % Akt(:,:,:,itemp), &
2549 & setfillval = .false.)
2550 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2551 IF (master) THEN
2552 WRITE (stdout,20) trim(vname(1,idtdif)), qck(ng)%Rindex
2553 END IF
2554 exit_flag=3
2555 ioerror=status
2556 RETURN
2557 END IF
2558 END IF
2559
2560# ifdef SALINITY
2561!
2562! Write out vertical diffusion coefficient for salinity.
2563!
2564 IF (qout(idsdif,ng)) THEN
2565 scale=1.0_dp
2566 IF (qck(ng)%pioVar(idsdif)%dkind.eq.pio_double) THEN
2567 iodesc => iodesc_dp_w3dvar(ng)
2568 ELSE
2569 iodesc => iodesc_sp_w3dvar(ng)
2570 END IF
2571 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idsdif, &
2572 & qck(ng)%pioVar(idsdif), &
2573 & qck(ng)%Rindex, &
2574 & iodesc, &
2575 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2576# ifdef MASKING
2577 & grid(ng) % rmask, &
2578# endif
2579 & mixing(ng) % Akt(:,:,:,isalt), &
2580 & setfillval = .false.)
2581 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2582 IF (master) THEN
2583 WRITE (stdout,20) trim(vname(1,idsdif)), qck(ng)%Rindex
2584 END IF
2585 exit_flag=3
2586 ioerror=status
2587 RETURN
2588 END IF
2589 END IF
2590# endif
2591# if defined GLS_MIXING || defined MY25_MIXING
2592!
2593! Write out turbulent kinetic energy.
2594!
2595 IF (qout(idmtke,ng)) THEN
2596 scale=1.0_dp
2597 IF (qck(ng)%pioVar(idmtke)%dkind.eq.pio_double) THEN
2598 iodesc => iodesc_dp_w3dvar(ng)
2599 ELSE
2600 iodesc => iodesc_sp_w3dvar(ng)
2601 END IF
2602 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idmtke, &
2603 & qck(ng)%pioVar(idmtke), &
2604 & qck(ng)%Rindex, &
2605 & iodesc, &
2606 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2607# ifdef MASKING
2608 & grid(ng) % rmask, &
2609# endif
2610 & mixing(ng) % tke(:,:,:,nout), &
2611 & setfillval = .false.)
2612 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2613 IF (master) THEN
2614 WRITE (stdout,20) trim(vname(1,idmtke)), qck(ng)%Rindex
2615 END IF
2616 exit_flag=3
2617 ioerror=status
2618 RETURN
2619 END IF
2620 END IF
2621!
2622! Write out turbulent length scale field.
2623!
2624 IF (qout(idmtls,ng)) THEN
2625 scale=1.0_dp
2626 IF (qck(ng)%pioVar(idmtls)%dkind.eq.pio_double) THEN
2627 iodesc => iodesc_dp_w3dvar(ng)
2628 ELSE
2629 iodesc => iodesc_sp_w3dvar(ng)
2630 END IF
2631 status=nf_fwrite3d(ng, model, qck(ng)%pioFile, idmtls, &
2632 & qck(ng)%pioVar(idmtls), &
2633 & qck(ng)%Rindex, &
2634 & iodesc, &
2635 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
2636# ifdef MASKING
2637 & grid(ng) % rmask, &
2638# endif
2639 & mixing(ng) % gls(:,:,:,nout), &
2640 & setfillval = .false.)
2641
2642 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2643 IF (master) THEN
2644 WRITE (stdout,20) trim(vname(1,idmtls)), qck(ng)%Rindex
2645 END IF
2646 exit_flag=3
2647 ioerror=status
2648 RETURN
2649 END IF
2650 END IF
2651# endif
2652# if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS
2653!
2654! Write out surface air pressure.
2655!
2656 IF (qout(idpair,ng)) THEN
2657 scale=1.0_dp
2658 IF (qck(ng)%pioVar(idpair)%dkind.eq.pio_double) THEN
2659 iodesc => iodesc_dp_r2dvar(ng)
2660 ELSE
2661 iodesc => iodesc_sp_r2dvar(ng)
2662 END IF
2663 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idpair, &
2664 & qck(ng)%pioVar(idpair), &
2665 & qck(ng)%Rindex, &
2666 & iodesc, &
2667 & lbi, ubi, lbj, ubj, scale, &
2668# ifdef MASKING
2669 & grid(ng) % rmask, &
2670# endif
2671 & forces(ng) % Pair)
2672 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2673 IF (master) THEN
2674 WRITE (stdout,20) trim(vname(1,idpair)), qck(ng)%Rindex
2675 END IF
2676 exit_flag=3
2677 ioerror=status
2678 RETURN
2679 END IF
2680 END IF
2681# endif
2682# if defined BULK_FLUXES
2683!
2684! Write out surface air temperature.
2685!
2686 IF (qout(idtair,ng)) THEN
2687 scale=1.0_dp
2688 IF (qck(ng)%pioVar(idtair)%dkind.eq.pio_double) THEN
2689 iodesc => iodesc_dp_r2dvar(ng)
2690 ELSE
2691 iodesc => iodesc_sp_r2dvar(ng)
2692 END IF
2693 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idtair, &
2694 & qck(ng)%pioVar(idtair), &
2695 & qck(ng)%Rindex, &
2696 & iodesc, &
2697 & lbi, ubi, lbj, ubj, scale, &
2698# ifdef MASKING
2699 & grid(ng) % rmask, &
2700# endif
2701 & forces(ng) % Tair)
2702 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2703 IF (master) THEN
2704 WRITE (stdout,20) trim(vname(1,idtair)), qck(ng)%Rindex
2705 END IF
2706 exit_flag=3
2707 ioerror=status
2708 RETURN
2709 END IF
2710 END IF
2711# endif
2712# if defined BULK_FLUXES || defined ECOSIM
2713!
2714! Write out surface winds.
2715!
2716 IF (qout(iduair,ng)) THEN
2717 scale=1.0_dp
2718 IF (qck(ng)%pioVar(iduair)%dkind.eq.pio_double) THEN
2719 iodesc => iodesc_dp_r2dvar(ng)
2720 ELSE
2721 iodesc => iodesc_sp_r2dvar(ng)
2722 END IF
2723 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, iduair, &
2724 & qck(ng)%pioVar(iduair), &
2725 & qck(ng)%Rindex, &
2726 & iodesc, &
2727 & lbi, ubi, lbj, ubj, scale, &
2728# ifdef MASKING
2729 & grid(ng) % rmask, &
2730# endif
2731 & forces(ng) % Uwind)
2732 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2733 IF (master) THEN
2734 WRITE (stdout,20) trim(vname(1,iduair)), qck(ng)%Rindex
2735 END IF
2736 exit_flag=3
2737 ioerror=status
2738 RETURN
2739 END IF
2740 END IF
2741!
2742 IF (qout(idvair,ng)) THEN
2743 scale=1.0_dp
2744 IF (qck(ng)%pioVar(idvair)%dkind.eq.pio_double) THEN
2745 iodesc => iodesc_dp_r2dvar(ng)
2746 ELSE
2747 iodesc => iodesc_sp_r2dvar(ng)
2748 END IF
2749 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvair, &
2750 & qck(ng)%pioVar(idvair), &
2751 & qck(ng)%Rindex, &
2752 & iodesc, &
2753 & lbi, ubi, lbj, ubj, scale, &
2754# ifdef MASKING
2755 & grid(ng) % rmask, &
2756# endif
2757 & forces(ng) % Vwind)
2758 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2759 IF (master) THEN
2760 WRITE (stdout,20) trim(vname(1,idvair)), qck(ng)%Rindex
2761 END IF
2762 exit_flag=3
2763 ioerror=status
2764 RETURN
2765 END IF
2766 END IF
2767!
2768! Write out Eastward/Northward surface wind (m/s) at RHO-points.
2769!
2770 IF (qout(iduaie,ng).and.qout(idvain,ng)) THEN
2771 IF (.not.allocated(ur2d)) THEN
2772 allocate (ur2d(lbi:ubi,lbj:ubj))
2773 ur2d(lbi:ubi,lbj:ubj)=0.0_r8
2774 END IF
2775 IF (.not.allocated(vr2d)) THEN
2776 allocate (vr2d(lbi:ubi,lbj:ubj))
2777 vr2d(lbi:ubi,lbj:ubj)=0.0_r8
2778 END IF
2779 CALL uv_rotate2d (ng, tile, .false., .true., &
2780 & lbi, ubi, lbj, ubj, &
2781 & grid(ng) % CosAngler, &
2782 & grid(ng) % SinAngler, &
2783# ifdef MASKING
2784 & grid(ng) % rmask_full, &
2785# endif
2786 & forces(ng) % Uwind, &
2787 & forces(ng) % Vwind, &
2788 & ur2d, vr2d)
2789!
2790 scale=1.0_dp
2791 IF (qck(ng)%pioVar(iduaie)%dkind.eq.pio_double) THEN
2792 iodesc => iodesc_dp_r2dvar(ng)
2793 ELSE
2794 iodesc => iodesc_sp_r2dvar(ng)
2795 END IF
2796 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, iduaie, &
2797 & qck(ng)%pioVar(iduaie), &
2798 & qck(ng)%Rindex, &
2799 & iodesc, &
2800 & lbi, ubi, lbj, ubj, scale, &
2801# ifdef MASKING
2802 & grid(ng) % rmask, &
2803# endif
2804 & ur2d)
2805 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2806 IF (master) THEN
2807 WRITE (stdout,20) trim(vname(1,iduaie)), qck(ng)%Rindex
2808 END IF
2809 exit_flag=3
2810 ioerror=status
2811 RETURN
2812 END IF
2813!
2814 scale=1.0_dp
2815 IF (qck(ng)%pioVar(idvain)%dkind.eq.pio_double) THEN
2816 iodesc => iodesc_dp_r2dvar(ng)
2817 ELSE
2818 iodesc => iodesc_sp_r2dvar(ng)
2819 END IF
2820 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvain, &
2821 & qck(ng)%pioVar(idvain), &
2822 & qck(ng)%Rindex, &
2823 & iodesc, &
2824 & lbi, ubi, lbj, ubj, scale, &
2825# ifdef MASKING
2826 & grid(ng) % rmask, &
2827# endif
2828 & vr2d)
2829 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2830 IF (master) THEN
2831 WRITE (stdout,20) trim(vname(1,idvain)), qck(ng)%Rindex
2832 END IF
2833 exit_flag=3
2834 ioerror=status
2835 RETURN
2836 END IF
2837 deallocate (ur2d)
2838 deallocate (vr2d)
2839 END IF
2840# endif
2841!
2842! Write out surface active tracers fluxes.
2843!
2844 DO itrc=1,nat
2845 IF (qout(idtsur(itrc),ng)) THEN
2846 IF (itrc.eq.itemp) THEN
2847# ifdef SO_SEMI
2848 scale=1.0_dp
2849# else
2850 scale=rho0*cp ! Celsius m/s to W/m2
2851# endif
2852 ELSE IF (itrc.eq.isalt) THEN
2853 scale=1.0_dp
2854 END IF
2855 IF (qck(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
2856 iodesc => iodesc_dp_r2dvar(ng)
2857 ELSE
2858 iodesc => iodesc_sp_r2dvar(ng)
2859 END IF
2860 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idtsur(itrc), &
2861 & qck(ng)%pioVar(idtsur(itrc)), &
2862 & qck(ng)%Rindex, &
2863 & iodesc, &
2864 & lbi, ubi, lbj, ubj, scale, &
2865# ifdef MASKING
2866 & grid(ng) % rmask, &
2867# endif
2868 & forces(ng) % stflx(:,:,itrc))
2869 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2870 IF (master) THEN
2871 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
2872 & qck(ng)%Rindex
2873 END IF
2874 exit_flag=3
2875 ioerror=status
2876 RETURN
2877 END IF
2878 END IF
2879 END DO
2880
2881# if defined BULK_FLUXES || defined FRC_COUPLING
2882!
2883! Write out latent heat flux.
2884!
2885 IF (qout(idlhea,ng)) THEN
2886 scale=rho0*cp
2887 IF (qck(ng)%pioVar(idlhea)%dkind.eq.pio_double) THEN
2888 iodesc => iodesc_dp_r2dvar(ng)
2889 ELSE
2890 iodesc => iodesc_sp_r2dvar(ng)
2891 END IF
2892 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idlhea, &
2893 & qck(ng)%pioVar(idlhea), &
2894 & qck(ng)%Rindex, &
2895 & iodesc, &
2896 & lbi, ubi, lbj, ubj, scale, &
2897# ifdef MASKING
2898 & grid(ng) % rmask, &
2899# endif
2900 & forces(ng) % lhflx)
2901 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2902 IF (master) THEN
2903 WRITE (stdout,20) trim(vname(1,idlhea)), qck(ng)%Rindex
2904 END IF
2905 exit_flag=3
2906 ioerror=status
2907 RETURN
2908 END IF
2909 END IF
2910!
2911! Write out sensible heat flux.
2912!
2913 IF (qout(idshea,ng)) THEN
2914 scale=rho0*cp
2915 IF (qck(ng)%pioVar(idshea)%dkind.eq.pio_double) THEN
2916 iodesc => iodesc_dp_r2dvar(ng)
2917 ELSE
2918 iodesc => iodesc_sp_r2dvar(ng)
2919 END IF
2920 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idshea, &
2921 & qck(ng)%pioVar(idshea), &
2922 & qck(ng)%Rindex, &
2923 & iodesc, &
2924 & lbi, ubi, lbj, ubj, scale, &
2925# ifdef MASKING
2926 & grid(ng) % rmask, &
2927# endif
2928 & forces(ng) % shflx)
2929 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2930 IF (master) THEN
2931 WRITE (stdout,20) trim(vname(1,idshea)), qck(ng)%Rindex
2932 END IF
2933 exit_flag=3
2934 ioerror=status
2935 RETURN
2936 END IF
2937 END IF
2938!
2939! Write out net longwave radiation flux.
2940!
2941 IF (qout(idlrad,ng)) THEN
2942 scale=rho0*cp
2943 IF (qck(ng)%pioVar(idlrad)%dkind.eq.pio_double) THEN
2944 iodesc => iodesc_dp_r2dvar(ng)
2945 ELSE
2946 iodesc => iodesc_sp_r2dvar(ng)
2947 END IF
2948 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idlrad, &
2949 & qck(ng)%pioVar(idlrad), &
2950 & qck(ng)%Rindex, &
2951 & iodesc, &
2952 & lbi, ubi, lbj, ubj, scale, &
2953# ifdef MASKING
2954 & grid(ng) % rmask, &
2955# endif
2956 & forces(ng) % lrflx)
2957 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2958 IF (master) THEN
2959 WRITE (stdout,20) trim(vname(1,idlrad)), qck(ng)%Rindex
2960 END IF
2961 exit_flag=3
2962 ioerror=status
2963 RETURN
2964 END IF
2965 END IF
2966# endif
2967
2968# ifdef BULK_FLUXES
2969# ifdef EMINUSP
2970!
2971! Write out evaporation rate (kg/m2/s).
2972!
2973 IF (qout(idevap,ng)) THEN
2974 scale=1.0_dp
2975 IF (qck(ng)%pioVar(idevap)%dkind.eq.pio_double) THEN
2976 iodesc => iodesc_dp_r2dvar(ng)
2977 ELSE
2978 iodesc => iodesc_sp_r2dvar(ng)
2979 END IF
2980 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idevap, &
2981 & qck(ng)%pioVar(idevap), &
2982 & qck(ng)%Rindex, &
2983 & iodesc, &
2984 & lbi, ubi, lbj, ubj, scale, &
2985# ifdef MASKING
2986 & grid(ng) % rmask, &
2987# endif
2988 & forces(ng) % evap)
2989 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2990 IF (master) THEN
2991 WRITE (stdout,20) trim(vname(1,idevap)), qck(ng)%Rindex
2992 END IF
2993 exit_flag=3
2994 ioerror=status
2995 RETURN
2996 END IF
2997 END IF
2998!
2999! Write out precipitation rate (kg/m2/s).
3000!
3001 IF (qout(idrain,ng)) THEN
3002 scale=1.0_dp
3003 IF (qck(ng)%pioVar(idrain)%dkind.eq.pio_double) THEN
3004 iodesc => iodesc_dp_r2dvar(ng)
3005 ELSE
3006 iodesc => iodesc_sp_r2dvar(ng)
3007 END IF
3008 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idrain, &
3009 & qck(ng)%pioVar(idrain), &
3010 & qck(ng)%Rindex, &
3011 & iodesc, &
3012 & lbi, ubi, lbj, ubj, scale, &
3013# ifdef MASKING
3014 & grid(ng) % rmask, &
3015# endif
3016 & forces(ng) % rain)
3017 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3018 IF (master) THEN
3019 WRITE (stdout,20) trim(vname(1,idrain)), qck(ng)%Rindex
3020 END IF
3021 exit_flag=3
3022 ioerror=status
3023 RETURN
3024 END IF
3025 END IF
3026# endif
3027# endif
3028!
3029! Write out E-P (m/s).
3030!
3031 IF (qout(idempf,ng)) THEN
3032 scale=1.0_dp
3033 IF (qck(ng)%pioVar(idempf)%dkind.eq.pio_double) THEN
3034 iodesc => iodesc_dp_r2dvar(ng)
3035 ELSE
3036 iodesc => iodesc_sp_r2dvar(ng)
3037 END IF
3038 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idempf, &
3039 & qck(ng)%pioVar(idempf), &
3040 & qck(ng)%Rindex, &
3041 & iodesc, &
3042 & lbi, ubi, lbj, ubj, scale, &
3043# ifdef MASKING
3044 & grid(ng) % rmask, &
3045# endif
3046 & forces(ng) % stflux(:,:,isalt))
3047 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3048 IF (master) THEN
3049 WRITE (stdout,20) trim(vname(1,idempf)), qck(ng)%Rindex
3050 END IF
3051 exit_flag=3
3052 ioerror=status
3053 RETURN
3054 END IF
3055 END IF
3056
3057# ifdef SHORTWAVE
3058!
3059! Write out net shortwave radiation flux.
3060!
3061 IF (qout(idsrad,ng)) THEN
3062 scale=rho0*cp
3063 IF (qck(ng)%pioVar(idsrad)%dkind.eq.pio_double) THEN
3064 iodesc => iodesc_dp_r2dvar(ng)
3065 ELSE
3066 iodesc => iodesc_sp_r2dvar(ng)
3067 END IF
3068 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idsrad, &
3069 & qck(ng)%pioVar(idsrad), &
3070 & qck(ng)%Rindex, &
3071 & iodesc, &
3072 & lbi, ubi, lbj, ubj, scale, &
3073# ifdef MASKING
3074 & grid(ng) % rmask, &
3075# endif
3076 & forces(ng) % srflx)
3077 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3078 IF (master) THEN
3079 WRITE (stdout,20) trim(vname(1,idsrad)), qck(ng)%Rindex
3080 END IF
3081 exit_flag=3
3082 ioerror=status
3083 RETURN
3084 END IF
3085 END IF
3086# endif
3087# endif
3088!
3089! Write out surface U-momentum stress.
3090!
3091 IF (qout(idusms,ng)) THEN
3092 scale=rho0 ! m2/s2 to Pa
3093 IF (qck(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
3094 iodesc => iodesc_dp_u2dvar(ng)
3095 ELSE
3096 iodesc => iodesc_sp_u2dvar(ng)
3097 END IF
3098 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idusms, &
3099 & qck(ng)%pioVar(idusms), &
3100 & qck(ng)%Rindex, &
3101 & iodesc, &
3102 & lbi, ubi, lbj, ubj, scale, &
3103# ifdef MASKING
3104 & grid(ng) % umask, &
3105# endif
3106 & forces(ng) % sustr)
3107 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3108 IF (master) THEN
3109 WRITE (stdout,20) trim(vname(1,idusms)), qck(ng)%Rindex
3110 END IF
3111 exit_flag=3
3112 ioerror=status
3113 RETURN
3114 END IF
3115 END IF
3116!
3117! Write out surface V-momentum stress.
3118!
3119 IF (qout(idvsms,ng)) THEN
3120 scale=rho0
3121 IF (qck(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
3122 iodesc => iodesc_dp_v2dvar(ng)
3123 ELSE
3124 iodesc => iodesc_sp_v2dvar(ng)
3125 END IF
3126 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvsms, &
3127 & qck(ng)%pioVar(idvsms), &
3128 & qck(ng)%Rindex, &
3129 & iodesc, &
3130 & lbi, ubi, lbj, ubj, scale, &
3131# ifdef MASKING
3132 & grid(ng) % vmask, &
3133# endif
3134 & forces(ng) % svstr)
3135 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3136 IF (master) THEN
3137 WRITE (stdout,20) trim(vname(1,idvsms)), qck(ng)%Rindex
3138 END IF
3139 exit_flag=3
3140 ioerror=status
3141 RETURN
3142 END IF
3143 END IF
3144!
3145! Write out bottom U-momentum stress.
3146!
3147 IF (qout(idubms,ng)) THEN
3148 scale=-rho0
3149 IF (qck(ng)%pioVar(idubms)%dkind.eq.pio_double) THEN
3150 iodesc => iodesc_dp_u2dvar(ng)
3151 ELSE
3152 iodesc => iodesc_sp_u2dvar(ng)
3153 END IF
3154 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idubms, &
3155 & qck(ng)%pioVar(idubms), &
3156 & qck(ng)%Rindex, &
3157 & iodesc, &
3158 & lbi, ubi, lbj, ubj, scale, &
3159# ifdef MASKING
3160 & grid(ng) % umask, &
3161# endif
3162 & forces(ng) % bustr)
3163 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3164 IF (master) THEN
3165 WRITE (stdout,20) trim(vname(1,idubms)), qck(ng)%Rindex
3166 END IF
3167 exit_flag=3
3168 ioerror=status
3169 RETURN
3170 END IF
3171 END IF
3172!
3173! Write out bottom V-momentum stress.
3174!
3175 IF (qout(idvbms,ng)) THEN
3176 scale=-rho0
3177 IF (qck(ng)%pioVar(idvbms)%dkind.eq.pio_double) THEN
3178 iodesc => iodesc_dp_v2dvar(ng)
3179 ELSE
3180 iodesc => iodesc_sp_v2dvar(ng)
3181 END IF
3182 status=nf_fwrite2d(ng, model, qck(ng)%pioFile, idvbms, &
3183 & qck(ng)%pioVar(idvbms), &
3184 & qck(ng)%Rindex, &
3185 & iodesc, &
3186 & lbi, ubi, lbj, ubj, scale, &
3187# ifdef MASKING
3188 & grid(ng) % vmask, &
3189# endif
3190 & forces(ng) % bvstr)
3191 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
3192 IF (master) THEN
3193 WRITE (stdout,20) trim(vname(1,idvbms)), qck(ng)%Rindex
3194 END IF
3195 exit_flag=3
3196 ioerror=status
3197 RETURN
3198 END IF
3199 END IF
3200
3201# if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
3202!
3203!-----------------------------------------------------------------------
3204! Write out the bottom boundary layer model or waves variables.
3205!-----------------------------------------------------------------------
3206!
3207 CALL bbl_wrt_pio (ng, model, tile, &
3208 & lbi, ubi, lbj, ubj, &
3209 & qout, qck)
3210 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3211# endif
3212
3213# if defined ICE_MODEL && defined SOLVE3D
3214!
3215!-----------------------------------------------------------------------
3216! Write out the sea-ice model variables.
3217!-----------------------------------------------------------------------
3218!
3219 CALL ice_wrt_pio (ng, model, tile, &
3220 & lbi, ubi, lbj, ubj, &
3221 & qout, qck)
3222 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3223# endif
3224
3225# if defined SEDIMENT && defined SOLVE3D
3226!
3227!-----------------------------------------------------------------------
3228! Write out the sediment model variables.
3229!-----------------------------------------------------------------------
3230!
3231 CALL sediment_wrt_pio (ng, model, tile, &
3232 & lbi, ubi, lbj, ubj, &
3233 & qout, qck)
3234 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3235# endif
3236
3237# if defined WEC_VF && defined SOLVE3D
3238!
3239!-----------------------------------------------------------------------
3240! Write out the Waves Effect on Currents variables.
3241!-----------------------------------------------------------------------
3242!
3243 CALL wec_wrt_pio (ng, model, tile, &
3244 & lbi, ubi, lbj, ubj, &
3245 & qout, qck)
3246 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3247# endif
3248!
3249!-----------------------------------------------------------------------
3250! Synchronize quicksave NetCDF file to disk to allow other processes
3251! to access data immediately after it is written.
3252!-----------------------------------------------------------------------
3253!
3254 CALL pio_netcdf_sync (ng, model, qck(ng)%name, qck(ng)%pioFile)
3255 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3256!
3257 10 FORMAT (2x,'WRT_QUICK_PIO - writing quicksave', t42, &
3258# ifdef SOLVE3D
3259# ifdef NESTING
3260 & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2)
3261# else
3262 & 'fields (Index=',i1,',',i1,') in record = ',i0)
3263# endif
3264# else
3265# ifdef NESTING
3266 & 'fields (Index=',i1,') in record = ',i0,t92,i2.2)
3267# else
3268 & 'fields (Index=',i1,') in record = ',i0)
3269# endif
3270# endif
3271 20 FORMAT (/,' WRT_QUICK_PIO - error while writing variable: ',a, &
3272 & /,17x,'into quicksave NetCDF file for time record: ',i0)
3273!
3274 RETURN
3275 END SUBROUTINE wrt_quick_pio
3276#endif
3277 END MODULE wrt_quick_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
bbl_output_mod
Definition bbl_output.F:2
bbl_output_mod::bbl_wrt_pio
subroutine, public bbl_wrt_pio(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:4157
bbl_output_mod::bbl_wrt_nf90
subroutine, public bbl_wrt_nf90(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:1702
ice_output_mod
Definition ice_output.F:2
mod_bbl
Definition mod_bbl.F:2
mod_coupling
Definition mod_coupling.F:2
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
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::qck
type(t_io), dimension(:), allocatable qck
Definition mod_iounits.F:237
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::iddano
integer iddano
Definition mod_ncparam.F:200
mod_ncparam::idvair
integer idvair
Definition mod_ncparam.F:358
mod_ncparam::idevap
integer idevap
Definition mod_ncparam.F:204
mod_ncparam::io_nf90
integer, parameter io_nf90
Definition mod_ncparam.F:95
mod_ncparam::idubar
integer idubar
Definition mod_ncparam.F:325
mod_ncparam::idwvel
integer idwvel
Definition mod_ncparam.F:421
mod_ncparam::idvvel
integer idvvel
Definition mod_ncparam.F:381
mod_ncparam::idhsbl
integer idhsbl
Definition mod_ncparam.F:213
mod_ncparam::idvsur
integer idvsur
Definition mod_ncparam.F:379
mod_ncparam::idvsms
integer idvsms
Definition mod_ncparam.F:377
mod_ncparam::idusue
integer idusue
Definition mod_ncparam.F:340
mod_ncparam::idpthw
integer idpthw
Definition mod_ncparam.F:271
mod_ncparam::io_pio
integer, parameter io_pio
Definition mod_ncparam.F:96
mod_ncparam::idsurt
integer, dimension(:), allocatable idsurt
Definition mod_ncparam.F:447
mod_ncparam::idpair
integer idpair
Definition mod_ncparam.F:263
mod_ncparam::idrwet
integer idrwet
Definition mod_ncparam.F:285
mod_ncparam::idv2dn
integer idv2dn
Definition mod_ncparam.F:387
mod_ncparam::idsdif
integer idsdif
Definition mod_ncparam.F:290
mod_ncparam::idvsun
integer idvsun
Definition mod_ncparam.F:378
mod_ncparam::idtsur
integer, dimension(:), allocatable idtsur
Definition mod_ncparam.F:453
mod_ncparam::idempf
integer idempf
Definition mod_ncparam.F:203
mod_ncparam::idvain
integer idvain
Definition mod_ncparam.F:359
mod_ncparam::idtdif
integer idtdif
Definition mod_ncparam.F:306
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::idtvar
integer, dimension(:), allocatable idtvar
Definition mod_ncparam.F:568
mod_ncparam::idhbbl
integer idhbbl
Definition mod_ncparam.F:212
mod_ncparam::idusur
integer idusur
Definition mod_ncparam.F:341
mod_ncparam::idvbms
integer idvbms
Definition mod_ncparam.F:365
mod_ncparam::iduair
integer iduair
Definition mod_ncparam.F:323
mod_ncparam::idmtke
integer idmtke
Definition mod_ncparam.F:237
mod_ncparam::iduvel
integer iduvel
Definition mod_ncparam.F:343
mod_ncparam::idv3dn
integer idv3dn
Definition mod_ncparam.F:390
mod_ncparam::qout
logical, dimension(:,:), allocatable qout
Definition mod_ncparam.F:169
mod_ncparam::idovel
integer idovel
Definition mod_ncparam.F:261
mod_ncparam::iduwet
integer iduwet
Definition mod_ncparam.F:346
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::idshea
integer idshea
Definition mod_ncparam.F:297
mod_ncparam::idpwet
integer idpwet
Definition mod_ncparam.F:265
mod_ncparam::idlrad
integer idlrad
Definition mod_ncparam.F:229
mod_ncparam::idpthu
integer idpthu
Definition mod_ncparam.F:269
mod_ncparam::idusms
integer idusms
Definition mod_ncparam.F:339
mod_ncparam::idvvis
integer idvvis
Definition mod_ncparam.F:382
mod_ncparam::idu3de
integer idu3de
Definition mod_ncparam.F:352
mod_ncparam::idpthv
integer idpthv
Definition mod_ncparam.F:270
mod_ncparam::idu2de
integer idu2de
Definition mod_ncparam.F:349
mod_ncparam::idlhea
integer idlhea
Definition mod_ncparam.F:228
mod_ncparam::idrain
integer idrain
Definition mod_ncparam.F:287
mod_ncparam::idubms
integer idubms
Definition mod_ncparam.F:330
mod_ncparam::idvwet
integer idvwet
Definition mod_ncparam.F:384
mod_ncparam::idsrad
integer idsrad
Definition mod_ncparam.F:293
mod_ncparam::idmtls
integer idmtls
Definition mod_ncparam.F:238
mod_ncparam::iduaie
integer iduaie
Definition mod_ncparam.F:324
mod_ncparam::idpthr
integer idpthr
Definition mod_ncparam.F:268
mod_ncparam::idtair
integer idtair
Definition mod_ncparam.F:305
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
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_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
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::nat
integer nat
Definition mod_param.F:499
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::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::w3dvar
integer, parameter w3dvar
Definition mod_param.F:724
mod_param::p2dvar
integer, parameter p2dvar
Definition mod_param.F:716
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
Definition mod_pio_netcdf.F:212
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_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_p2dvar
Definition mod_pio_netcdf.F:232
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_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_w3dvar
Definition mod_pio_netcdf.F:251
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_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_p2dvar
Definition mod_pio_netcdf.F:193
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::cp
real(dp) cp
Definition mod_scalars.F:456
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_sedbed
Definition sedbed_mod.h:1
mod_sediment
Definition sediment_mod.h:1
mod_stepping
Definition mod_stepping.F:2
nf_fwrite2d_mod
Definition nf_fwrite2d.F:2
nf_fwrite3d_mod
Definition nf_fwrite3d.F:2
omega_mod
Definition omega.F:2
omega_mod::scale_omega
subroutine, public scale_omega(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, pm, pn, w, wscl)
Definition omega.F:382
sediment_output_mod
Definition sediment_output.F:2
sediment_output_mod::sediment_wrt_nf90
subroutine, public sediment_wrt_nf90(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition sediment_output.F:998
sediment_output_mod::sediment_wrt_pio
subroutine, public sediment_wrt_pio(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition sediment_output.F:2345
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
uv_rotate_mod
Definition uv_rotate.F:2
uv_rotate_mod::uv_rotate3d
subroutine, public uv_rotate3d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, lbk, ubk, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:155
uv_rotate_mod::uv_rotate2d
subroutine, public uv_rotate2d(ng, tile, add, lboundary, lbi, ubi, lbj, ubj, cosangler, sinangler, rmask_full, uinp, vinp, uout, vout)
Definition uv_rotate.F:35
wrt_quick_mod
Definition wrt_quick.F:2
wrt_quick_mod::wrt_quick_pio
subroutine, private wrt_quick_pio(ng, model, tile, lbi, ubi, lbj, ubj)
Definition wrt_quick.F:1581
wrt_quick_mod::wrt_quick_nf90
subroutine, private wrt_quick_nf90(ng, model, tile, lbi, ubi, lbj, ubj)
Definition wrt_quick.F:137
wrt_quick_mod::wrt_quick
subroutine, public wrt_quick(ng, tile)
Definition wrt_quick.F:88